Articles   Members Online: 3
-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 create transparent menus 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
26-Oct-02
Category
VCL-Menu
Language
Delphi 2.x
Views
100
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			Author: Jonas Bilinkevicius

How to create transparent menus

Answer:

This works only for Win 2000 and XP:

1   { ... }
2   var
3     hHookID: HHOOK;
4   
5     {Function to make the menu transparent }
6   
7   function MakeWndTrans(Wnd: HWND; nAlpha: Integer = 10): Boolean;
8   type
9     TSetLayeredWindowAttributes = function(hwnd: HWND; crKey: COLORREF; bAlpha: Byte;
10      dwFlags: Longint): Longint; stdcall;
11  const
12    {Use crKey as the transparency color}
13    LWA_COLORKEY = 1;
14    {Use bAlpha to determine the opacity of the layered window}
15    LWA_ALPHA = 2;
16    WS_EX_LAYERED = $80000;
17  var
18    hUser32: HMODULE;
19    SetLayeredWindowAttributes: TSetLayeredWindowAttributes;
20    i: Integer;
21  begin
22    Result := False;
23    {Here we import the function from USER32.DLL}
24    hUser32 := GetModuleHandle('USER32.DLL');
25    if hUser32 <> 0 then
26    begin
27      @SetLayeredWindowAttributes := GetProcAddress(hUser32,
28        'SetLayeredWindowAttributes');
29      {If the import did not succeed, make sure your app can handle it!}
30      if @SetLayeredWindowAttributes <> nil then
31      begin
32        {Check the current state of the dialog, and then add the
33  			WS_EX_LAYERED attribute}
34        SetWindowLong(Wnd, GWL_EXSTYLE, GetWindowLong(Wnd, GWL_EXSTYLE)
35          or WS_EX_LAYERED);
36        {The SetLayeredWindowAttributes function sets the opacity and transparency 
37  color
38        key of a layered window}
39        SetLayeredWindowAttributes(Wnd, 0, Trunc((255 / 100) * (100 - nAlpha)),
40          LWA_ALPHA);
41        Result := True;
42      end;
43    end;
44  end;
45  
46  {Hook procedure}
47  
48  function HookCallWndProc(nCode: Integer; wParam, lParam: Longint): Longint; stdcall;
49  const
50    MENU_CLASS = '#32768';
51    N_ALPHA = 60;
52  var
53    cwps: TCWPStruct;
54    lRet: THandle;
55    szClass: array[0..8] of char;
56  begin
57    if (nCode = HC_ACTION) then
58    begin
59      CopyMemory(@cwps, Pointer(lParam), SizeOf(CWPSTRUCT));
60      case cwps.message of
61        WM_CREATE:
62          begin
63            GetClassName(cwps.hwnd, szClass, Length(szClass) - 1);
64            {Window name for menu is #32768}
65            if (lstrcmpi(szClass, MENU_CLASS) = 0) then
66            begin
67              MakeWndTrans(cwps.hwnd, N_ALPHA {Alphablending});
68            end;
69          end;
70      end;
71    end;
72    {Call the next hook in the chain}
73    Result := CallNextHookEx(WH_CALLWNDPROC, nCode, wParam, lParam);
74  end;
75  
76  {Install the hook in the OnCreate Handler}
77  
78  procedure TForm1.FormCreate(Sender: TObject);
79  var
80    tpid: DWORD;
81  begin
82    {Retrieve the identifier of the thread that created the specified window}
83    tpid := GetWindowThreadProcessId(Handle, nil);
84    {The SetWindowsHookEx function installs an application-defined
85    hook procedure into a hook chain}
86    hHookID := SetWindowsHookEx(WH_CALLWNDPROC, HookCallWndProc, 0, tpid);
87  end;
88  
89  {Stop the hook in the OnDestroy Handler}
90  
91  procedure TForm1.FormDestroy(Sender: TObject);
92  begin
93    if (hHookID <> 0) then
94      {Removes the hook procedure}
95      UnhookWindowsHookEx(hHookID);
96  end;


			
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