unit NFormABlend;

interface

uses KOL, Windows;

type
 TSetLayeredWindowAttributes=
   function( hwnd: Integer; crKey: TColor; bAlpha: Byte; dwFlags: DWORD )
   : Boolean; stdcall;

PTimerAlphaBlend = ^TNTimerAlphaBlend;
TNTimerAlphaBlend = object(TTimer)
 procedure TimerShowAction(Sender: pObj);
 procedure TimerHideAction(Sender: pObj);
public
 Step,
 Alpha: Integer;
 Form: PControl;
   destructor Destroy; virtual;
   procedure SetAlpha(const Value: Byte);
   procedure Execute;
end;

procedure NewTimerAB(pForm: PControl; aInterval, aStep: Integer; aShow: Boolean);

var
 SetLayeredWindowAttributes: TSetLayeredWindowAttributes;
 User32: THandle;

implementation

procedure NewTimerAB(pForm: PControl; aInterval, aStep: Integer; aShow: Boolean);
var P: PTimerAlphaBlend;
begin
 New(P, Create);
   with P^ do begin
    Form:= pForm;
              Interval:= aInterval;
    if Ashow then begin
     Alpha:= 0;
      OnTimer:= TimerShowAction;
    end else begin
      Alpha:= 255;
     OnTimer:= TimerHideAction;
    end;
    SetAlpha(Alpha);
  Step:= aStep;
    Execute;
   end;
end;

{ TNTimerAlphaBlend }

destructor TNTimerAlphaBlend.Destroy;
begin
   Form:= nil;
  inherited;
end;

procedure TNTimerAlphaBlend.Execute;
begin
   Enabled:= True;
  while Alpha > 0 do Applet.ProcessMessages;
end;

procedure TNTimerAlphaBlend.SetAlpha(const Value: Byte);
 const WS_EX_LAYERED=$00080000;
 LWA_ALPHA      = $00000002;
 var dw: DWORD;
 begin
  if Assigned(SetLayeredWindowAttributes ) then begin
     dw:= GetWindowLong(Form.Handle, GWL_EXSTYLE );
     SetWindowLong(Form.Handle, GWL_EXSTYLE, dw or WS_EX_LAYERED );
     SetLayeredWindowAttributes(Form.Handle, 0, Value and $FF, LWA_ALPHA);
   end;
end;

procedure TNTimerAlphaBlend.TimerHideAction(Sender: pObj);
begin
 dec(Alpha, Step);
 if (Alpha > 0) then SetAlpha(Alpha) else Free;
end;

procedure TNTimerAlphaBlend.TimerShowAction(Sender: pObj);
begin
  inc(Alpha, Step);
 if Alpha > 254 then begin
  SetAlpha(255);
  Free;
 end else SetAlpha(Alpha);
end;

initialization
 User32:= GetModuleHandle('User32');
 SetLayeredWindowAttributes:= GetProcAddress(User32, 'SetLayeredWindowAttributes');

end.