Author: Christian Cristofori
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:
1 unit uAlphaWindow;
2
3 interface
4
5 uses
6 Windows, Messages, Classes, Controls, Forms;
7
8 type
9 TAlphaPercent = 0..100;
10 TAlphaWindow =
11 class(TComponent)
12 protected
13 User32: HModule;
14 public
15 constructor Create(AOwner: TComponent); override;
16 destructor Destroy; override;
17 procedure SetTransparentHWND(HWnd: THandle; Percent: TAlphaPercent);
18 procedure SetTransparent(Percent: TAlphaPercent);
19 procedure SetOpaqueHWND(HWnd: THandle);
20 procedure SetOpaque;
21 end;
22
23 procedure register;
24
25 implementation
26
27 const
28 LWA_ALPHA = $2;
29 GWL_EXSTYLE = -20;
30 WS_EX_LAYERED = $80000;
31 WS_EX_TRANSPARENT = $20;
32
33 var
34 SetLayeredWindowAttributes: function(HWnd: LongInt; crKey: Byte; bAlpha: Byte;
35 dwFlags: LongInt): LongInt; stdcall;
36
37 constructor TAlphaWindow.Create(AOwner: TComponent);
38 begin
39 inherited;
40 User32 := LoadLibrary('USER32.DLL');
41 if (User32 <> 0) then
42 @SetLayeredWindowAttributes := GetProcAddress(User32,
43 'SetLayeredWindowAttributes')
44 else
45 SetLayeredWindowAttributes := nil;
46 end;
47
48 destructor TAlphaWindow.Destroy;
49 begin
50 if (User32 <> 0) then
51 FreeLibrary(User32);
52 inherited;
53 end;
54
55 procedure TAlphaWindow.SetOpaqueHWND(HWnd: THandle);
56 var
57 Old: THandle;
58 begin
59 if (IsWindow(HWnd)) then
60 begin
61 Old := GetWindowLongA(HWnd, GWL_EXSTYLE);
62 SetWindowLongA(HWnd, GWL_EXSTYLE, Old and ((not 0) - WS_EX_LAYERED));
63 end;
64 end;
65
66 procedure TAlphaWindow.SetOpaque;
67 begin
68 Self.SetOpaqueHWND((Self.Owner as TWinControl).Handle);
69 end;
70
71 procedure TAlphaWindow.SetTransparentHWND(HWnd: THandle; Percent: TAlphaPercent);
72 var
73 Old: THandle;
74 begin
75 if ((User32 <> 0) and (Assigned(SetLayeredWindowAttributes)) and (IsWindow(HWnd)))
76 then
77 if (Percent = 0) then
78 SetOpaqueHWND(HWnd)
79 else
80 begin
81 Percent := 100 - Percent;
82 Old := GetWindowLongA(HWnd, GWL_EXSTYLE);
83 SetWindowLongA(HWnd, GWL_EXSTYLE, Old or WS_EX_LAYERED);
84 SetLayeredWindowAttributes(HWnd, 0, (255 * Percent) div 100, LWA_ALPHA);
85 end;
86 end;
87
88 procedure TAlphaWindow.SetTransparent(Percent: TAlphaPercent);
89 begin
90 Self.SetTransparentHWND((Self.Owner as TForm).Handle, Percent);
91 end;
92
93 procedure register;
94 begin
95 RegisterComponents('Christian', [TAlphaWindow]);
96 end;
97
98 end.
99
100
101 //Example:
102
103 tAlphaWindow1.SetTransparent;
104
105 //or use this:
106
107 tAlphaWindow1.SetTransparent(50);
|
