API - transparencias Win2000 componente

Unit uAlphaWindow; 

Interface 

Uses 

    Windows, Messages, Classes, Controls, Forms; 

Type 

    tAlphaPercent = 0..100; 

    tAlphaWindow = 

        Class( TComponent ) 

            Protected 

                FAlphaPercent : tAlphaPercent; 

                FAutomatic    : Boolean; 

                User32        : HModule; 

            Public 

                Constructor Create( AOwner : TComponent ); OverRide; 

                Destructor  Destroy; OverRide; 

                Procedure   SetTransparentHWND( HWnd : THandle; Percent : tAlphaPercent ); 

                Procedure   SetTransparent; OverLoad; 

                Procedure   SetTransparent( Percent : tAlphaPercent ); OverLoad; 

                Procedure   SetOpaqueHWND( HWnd : THandle ); 

                Procedure   SetOpaque; 

            Published 

                Property Percent   : tAlphaPercent Read FAlphaPercent Write FAlphaPercent Default 0; 

                Property Automatic : Boolean       Read FAutomatic    Write FAutomatic    Default True; 

        End; 

    Procedure Register; 

Implementation 

Const 

    LWA_ALPHA         = $2; 

    GWL_EXSTYLE       = (-20); 

    WS_EX_LAYERED     = $80000; 

    WS_EX_TRANSPARENT = $20; 

Var 

    SetLayeredWindowAttributes : Function( HWnd : LongInt; crKey : Byte; bAlpha : Byte; dwFlags : LongInt ) : LongInt; StdCall; 

Constructor tAlphaWindow.Create( AOwner : TComponent ); 

Begin 

    Inherited; 

    User32 := LoadLibrary( 'USER32.DLL' ); 

    If ( User32 <> 0 ) Then 

        @SetLayeredWindowAttributes := GetProcAddress( User32, 'SetLayeredWindowAttributes' ) 

    Else 

        SetLayeredWindowAttributes := NIL; 

End; 

Destructor tAlphaWindow.Destroy; 

Begin 

    If ( User32 <> 0 ) Then FreeLibrary( User32 ); 

    Inherited; 

End; 

Procedure tAlphaWindow.SetOpaqueHWND( HWnd : THandle ); 

Var 

    Old : THandle; 

Begin 

    If ( IsWindow( HWnd ) ) Then Begin 

        Old := GetWindowLongA( HWnd, GWL_EXSTYLE ); 

        SetWindowLongA( HWnd, GWL_EXSTYLE, Old And ( ( Not 0 ) - WS_EX_LAYERED ) ); 

    End; 

End; 

Procedure tAlphaWindow.SetOpaque; 

Begin 

    Self.SetOpaqueHWND( ( Self.Owner As TWinControl ).Handle ); 

End; 

Procedure tAlphaWindow.SetTransparent; 

Begin 

    Self.SetTransparentHWND( ( Self.Owner As TWinControl ).Handle, Self.FAlphaPercent ); 

End; 

Procedure tAlphaWindow.SetTransparentHWND( HWnd : THandle; Percent : tAlphaPercent ); 

var 

  Old : THandle; 

begin 

  if ( ( User32 <> 0 ) and ( Assigned( SetLayeredWindowAttributes ) ) and ( IsWindow( HWnd ) ) ) then 

    if ( Percent = 0 ) then 

      SetOpaqueHWND( HWnd ) 

    else 

    begin 

      Percent := 100 - Percent; 

      Old := GetWindowLongA( HWnd, GWL_EXSTYLE ); 

      SetWindowLongA( HWnd, GWL_EXSTYLE, Old Or WS_EX_LAYERED ); 

      SetLayeredWindowAttributes( HWnd, 0, ( 255 * Percent ) Div 100, LWA_ALPHA ); 

    end; 

End; 

Procedure tAlphaWindow.SetTransparent( Percent : tAlphaPercent ); 

begin 

  Self.SetTransparentHWND( ( Self.Owner As TForm ).Handle, Percent ); 

end; 

Procedure Register; 

begin 

  RegisterComponents( 'Graphic', [ tAlphaWindow ] ); 

end; 

End.