Unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TfrmMain = class(TForm)
Button1: TButton;
Button2: TButton;
Label1: TLabel;
Label2: TLabel;
Text1: TEdit;
Text2: TEdit;
Timer1: TTimer;
procedure Button1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
public
end;
var
frmMain: TfrmMain;
implementation
{$R *.DFM}
Const WS_EX_LAYERED = $80000;
Const LWA_ALPHA = $2;
Const GWL_EXSTYLE = (-20);
Const RDW_INVALIDATE = $1;
Const RDW_ERASE = $4;
Const RDW_ALLCHILDREN = $80;
Const RDW_FRAME = $400;
Var
mAlpha: LongInt;
Procedure LayerWindow (dwFlags: Integer);
Type
TSetLayeredWindowAttributes = Function (Wnd: HWND;
crKey: Word;
Alpha: Word;
dwFlags: Word): Integer; stdcall;
Var
exLibrary: THandle;
SetLayeredWindowAttributes: TSetLayeredWindowAttributes;
Begin
exLibrary := LoadLibrary(PChar('user32.dll'));
If exLibrary = 0 then
Raise Exception.Create('No se pudo cargar user32.DLL');
@SetLayeredWindowAttributes := GetProcAddress(exLibrary, 'SetLayeredWindowAttributes');
If @SetLayeredWindowAttributes = nil then
Begin
FreeLibrary(exLibrary);
Raise
Exception.Create('No se pudo encontrar SetLayeredWindowAttributes en user32.DLL');
End;
If dwFlags = 0 then
Begin
SetWindowLong(frmMain.Handle, GWL_EXSTYLE, GetWindowLong(frmMain.Handle, GWL_EXSTYLE) Or WS_EX_LAYERED);
SetLayeredWindowAttributes(frmMain.Handle, 0, (255 * mAlpha) div 100, LWA_ALPHA);
End;
If dwFlags = 1 then
Begin
SetLayeredWindowAttributes(frmMain.Handle, 0, (255 * mAlpha) div 100, LWA_ALPHA);
End;
If dwFlags = 2 then
Begin
SetWindowLong(frmMain.Handle, GWL_EXSTYLE, GetWindowLong(frmMain.Handle, GWL_EXSTYLE) And Not WS_EX_LAYERED);
RedrawWindow (frmMain.Handle, nil, 0, RDW_ERASE Or RDW_INVALIDATE Or RDW_FRAME Or RDW_ALLCHILDREN);
End;
FreeLibrary(exLibrary);
End;
Procedure TfrmMain.Button1Click(Sender: TObject);
Var
cAlpha: Integer;
Begin
LayerWindow (0);
cAlpha := StrToInt(Text1.Text);
SetWindowLong(frmMain.Handle, GWL_EXSTYLE, GetWindowLong(frmMain.Handle, GWL_EXSTYLE) Or WS_EX_LAYERED);
mAlpha := cAlpha;
Timer1.Interval := StrToInt(Text2.Text);
Timer1.Enabled := True;
End;
Procedure TfrmMain.Timer1Timer(Sender: TObject);
Begin
LayerWindow (1);
mAlpha := mAlpha + 10;
If mAlpha >= 100 Then
Begin
Timer1.Enabled := False;
LayerWindow (2);
End;
End;
Procedure TfrmMain.Button2Click(Sender: TObject);
Begin
mAlpha := StrToInt (Text1.Text);
SetWindowLong(frmMain.Handle, GWL_EXSTYLE, GetWindowLong(frmMain.Handle, GWL_EXSTYLE) Or WS_EX_LAYERED);
LayerWindow (1);
End;
End.