Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
How to AlphaBlend your forms with a component Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
28-Aug-03
Category
VCL-Menu
Language
Delphi 5.x
Views
128
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			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);


			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC