Ver Mensaje Individual
  #1  
Antiguo 15-06-2008
[coso] coso is offline
Miembro Premium
 
Registrado: may 2008
Ubicación: Girona
Posts: 1.678
Reputación: 0
coso Va por buen camino
Semitransparencia sin alphablend

Semitransparencia sin usar la propiedad alphablend (Windows 2000 y mas)

Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TForm1 = class(TForm)
  procedure SetTransparentForm(AHandle : THandle; AValue : byte = 0);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
const
  WS_EX_LAYERED = $80000;
  LWA_COLORKEY = 1;
  LWA_ALPHA    = 2;

type
  TSetLayeredWindowAttributes = function (
      hwnd : HWND;         // handle to the layered window
      crKey : TColor;      // specifies the color key
      bAlpha : byte;       // value for the blend function
      dwFlags : DWORD      // action
      ): BOOL; stdcall;

var


  Form1: TForm1;

implementation

{$R *.DFM}


procedure TForm1.SetTransparentForm(AHandle : THandle; AValue : byte = 0);
var
  Info: TOSVersionInfo;
  SetLayeredWindowAttributes: TSetLayeredWindowAttributes;
begin
  //Check Windows version
  Info.dwOSVersionInfoSize := SizeOf(Info);
  GetVersionEx(Info);
  if (Info.dwPlatformId = VER_PLATFORM_WIN32_NT) and
  (Info.dwMajorVersion >= 5) then
    begin
      SetLayeredWindowAttributes := GetProcAddress(GetModulehandle(user32), 'SetLayeredWindowAttributes');
       if Assigned(SetLayeredWindowAttributes) then
        begin
         SetWindowLong(AHandle, GWL_EXSTYLE, GetWindowLong(AHandle, GWL_EXSTYLE) or WS_EX_LAYERED);
         //Make form transparent
         SetLayeredWindowAttributes(AHandle, 0, AValue, LWA_ALPHA);
       end;
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  SetTransparentForm(Handle, 100);
end;

end.
Responder Con Cita