2005. január 23., vasárnap

AlphaBlend your forms with a component


Problem/Question/Abstract:

Do you like the AlphaBlending of Windows 2000/XP menus, panels and other visual components? Use that and you'll implement in your applications.

Answer:

unit uAlphaWindow;

interface

uses
  Windows, Messages, Classes, Controls, Forms;

type
  TAlphaPercent = 0..100;
  TAlphaWindow =
    class(TComponent)
  protected
    User32: HModule;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetTransparentHWND(HWnd: THandle; Percent: TAlphaPercent);
    procedure SetTransparent(Percent: TAlphaPercent);
    procedure SetOpaqueHWND(HWnd: THandle);
    procedure SetOpaque;
  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.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('Christian', [TAlphaWindow]);
end;

end.


Example:

tAlphaWindow1.SetTransparent;

or use this:

tAlphaWindow1.SetTransparent(50);

Nincsenek megjegyzések:

Megjegyzés küldése