COOL!将所有菜单设置为半透明的代码（只适用于WIN2000以下版本)

Question

library HookMenu;{*************************************************************}
{*                                                           *}
{*      HookMenu Library,Copyright lfpsoft 2002              *}
{*             All rights reserverd.                         *}
{*         Bug Report : [email protected]                      *}
{*         WEB : http://www.lkgarden.com/lfpsoft             *}
{*                                                           *}
{* 效果不是很好，因为到现在我还没有想出如何得到菜单中的子菜单*}
{* 好方法，只能在WM_MENUSELECT这个消息里得到该子菜单的句柄   *}
{* 现在发布源代码，希望高手们指点指点，或者大家共同研究      *}
{* 还有手头上有基本实现当拖动窗体时就显示半透明的代码，过些天*}
{* 整理好后我会再放出来大家研究研究                          *}
{*************************************************************}uses
  SysUtils,
  Classes,
  HookMenuProc in 'HooKMenuProc.pas';{$R *.RES}exports
  EnableMenuHook,
  DisableMenuHook,
  MenuHookExit,
  SetAlpha,
  SetTrayAlpha;begin
  IntoShare;
end.
unit HooKMenuProc;{*************************************************************}
{*                                                           *}
{*      HookMenu Library,Copyright lfpsoft 2002              *}
{*             All rights reserverd.                         *}
{*         Bug Report : [email protected]                      *}
{*         WEB : http://www.lkgarden.com/lfpsoft             *}
{*                                                           *}
{* 效果不是很好，因为到现在我还没有想出如何得到菜单中的子菜单*}
{* 好方法，只能在WM_MENUSELECT这个消息里得到该子菜单的句柄   *}
{* 现在发布源代码，希望高手们指点指点，或者大家共同研究      *}
{* 还有手头上有基本实现当拖动窗体时就显示半透明的代码，过些天*}
{* 整理好后我会再放出来大家研究研究                          *}
{*************************************************************}interfaceuses
  Windows, Messages, SysUtils;
var
  hNextHookProc: HHook;
  procSaveExit: Pointer; function MenuHookHandler(iCode: Integer;
  wParam: WPARAM;
  lParam: LPARAM): LRESULT; stdcall; export;
 function EnableMenuHook: BOOL; export;
 function DisableMenuHook: BOOL; export;
 procedure MenuHookExit; far;
 procedure IntoShare; stdcall;export;
 procedure SetAlpha( bAlpha: Byte );stdcall; export;
 procedure SetTrayAlpha( bAlpha: Byte);stdcall; export;implementationtype
  TGoData = record //将设置半透明的值共享到内存中的数据结构
    bAlpha: byte;
  end;
  PGoData = ^TGoData;const
  user32        = 'user32.dll';var
  GoData : PGoData;
  MemFile : THandle;procedure GetWindowsVersion(var Major : integer;var Minor : integer);
var
  l : longint;
begin
  l := GetVersion;
  Major := LoByte(LoWord(l));
  Minor := HiByte(LoWord(l));
end;procedure SetAlpha( bAlpha: Byte );stdcall; export;   //设置半透明值
begin
  if bAlpha <10 then bAlpha :=10;
  GoData^.bAlpha  := bAlpha;
end;procedure SetWndAlpha(MenuHwnd:hwnd;const Alpha: Byte);  // 设置半透明
var
  major, minor : integer;  User32: Cardinal;
  l: Longint;
  SetLayeredWindowAttributes: function (hwnd: LongInt; crKey: byte; bAlpha: byte; dwFlags: LongInt): LongInt; stdcall;
begin
     GetWindowsVersion(major, minor);
     if ((major >= 5) and (minor >= 0)) then //判断是否是WIN2000以上的版本。
     begin
        User32 := LoadLibrary('user32');
        if User32 <> 0 then
        try
           SetLayeredWindowAttributes := GetProcAddress(user32, 'SetLayeredWindowAttributes');
           if @SetLayeredWindowAttributes <> nil then
           begin
             l := GetWindowLong(MenuHwnd, GWL_EXSTYLE);
             l := l or WS_EX_LAYERED;
             SetWindowLong(MenuHwnd, GWL_EXSTYLE, l);
             SetLayeredWindowAttributes(MenuHwnd,0,Alpha,LWA_ALPHA);
           end;
        finally
                FreeLibrary(User32);
        end;
     end;
end;//枚举所有窗体，如果是菜单或是历史菜单就设置半透明
function EnumWindowsProc(hWindow:hWnd;lParam:LongInt) : Bool {$IFDEF Win32} stdcall;{$ELSE}:Export;{$ENDIF}
var
  csCompare,csClassName:String;
  szClassname:Array[0..128] of Char;
begin  if ((lParam = 0) or (lParam = 2)) then csCompare := 'BaseBar'
else if (lParam = 1) then csCompare := '#32768';  GetClassName(hWindow, szClassname, 128);
  csClassName := Trim(szClassname);
if csClassName = csCompare  then
  begin
  if (lParam = 2) then SetWndAlpha(hWindow,255)
    else
     SetWndAlpha(hWindow,GoData^.bAlpha);
  end;
result :=true;
end;
//钩子程序
function MenuHookHandler(iCode: Integer;
  wParam: WPARAM;
  lParam: LPARAM): LRESULT; stdcall; export;
var
  szClassname:Array[0..128] of Char;
  cwp: CWPRETSTRUCT;
  hwndMenu:HWND;
  csClassname:String;
begin
  Result := 0;
  If iCode < 0 Then
  begin
    Result := CallNextHookEx(hNextHookProc, iCode, wParam, lParam);
    Exit;
 end;
cwp := PCWPRETSTRUCT(lParam)^;  if((cwp.message = WM_CREATE) or (cwp.message = WM_INITMENUPOPUP) or
   (cwp.message = WM_INITMENU) or (cwp.message = WM_MENUSELECT)) then
  begin
  if cwp.message = WM_CREATE then
    begin
  hwndMenu := cwp.hwnd;
GetClassName(hwndMenu, szClassname, 128);//取得类名
      csClassname := Trim(szClassname);
if ((csClassname ='#32768') or (csClassname = 'BaseBar')) then
begin    //如果是菜单或历史菜单就...
        SetWndAlpha(hwndMenu,GoData^.bAlpha) ;
end;
    end
else
    begin
    EnumWindows(@EnumWindowsProc, 1);
    end;
  end; Result := CallNextHookEx( hNextHookProc, iCode, wParam, lParam);
end;//挂钩子
function EnableMenuHook: BOOL; export;
begin
  Result := False;
  EnumWindows(@EnumWindowsProc, 0);
  if hNextHookProc <> 0 then Exit;
  hNextHookProc := SetWindowsHookEx(WH_CALLWNDPROCRET,
    MenuHookHandler,
    HInstance,
    0);
  Result := hNextHookProc <> 0;
end;//取消钩子
function DisableMenuHook: BOOL; export;
begin
  if hNextHookProc <> 0 then
  begin
    SetWndAlpha(FindWindow('Shell_TrayWnd', nil),255);
    EnumWindows(@EnumWindowsProc, 2);
    UnhookWindowsHookEx(hNextHookProc);
    hNextHookProc := 0;
  end;
  Result := hNextHookProc = 0;
end;//退出钩子
procedure MenuHookExit;
begin
  SetWndAlpha(FindWindow('Shell_TrayWnd', nil),255);
  if hNextHookProc <> 0 then DisableMenuHook;
  ExitProc := procSaveExit;
end;//将要设置半透明的值共享到内存中去
procedure IntoShare; stdcall;export;
begin
  MemFile := OpenFileMapping( FILE_MAP_WRITE, False, 'CCSOFT' );
  if MemFile = 0 then
    MemFile:=CreateFileMapping( $FFFFFFFF, nil,
             PAGE_READWRITE, 0, SizeOf( TGoData ), 'CCSOFT');
  GoData := MapViewOfFile( MemFile, FILE_MAP_WRITE, 0, 0, 0 );
  if MemFile = 0 then
  FillChar( GoData^, SizeOf( TGoData ),0);
end;procedure SetTrayAlpha( bAlpha: Byte);stdcall;export; //设置任务栏半透明
begin
   SetWndAlpha(FindWindow('Shell_TrayWnd', nil),bAlpha);
end;end.

Answer 1

以上代码是今晚一个晚上的结果。但是效果不是很理想。主要是没有
正确得到菜单下的子菜单的句柄。哪位高手有好方法请不惜相告。
以下为测试代码unit main;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;type
  TForm1 = class(TForm)
    TrackBar1: TTrackBar;
    CheckBox1: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  //调用DLL
  procedure EnableMenuHook; stdcall;external 'HookMenu.dll';
  procedure MenuHookExit; stdcall;external 'HookMenu.dll';
  procedure DisableMenuHook; stdcall;external 'HookMenu.dll';
  procedure SetAlpha( bAlpha : Byte ); stdcall;external 'HookMenu.dll';
  procedure SetTrayAlpha( bAlpha: Byte);stdcall; external 'HookMenu.dll';
var
  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.FormCreate(Sender: TObject);
begin    setalpha(100);
    SetTrayAlpha( 100);
    EnableMenuHook;end;procedure TForm1.FormDestroy(Sender: TObject);
begin
    MenuHookExit;
end;
procedure TForm1.TrackBar1Change(Sender: TObject);
begin
    setalpha(trackbar1.Position);
    SetTrayAlpha( trackbar1.Position);
end;procedure TForm1.CheckBox1Click(Sender: TObject);
begin
    if CheckBox1.Checked then
       EnableMenuHook
    else DisableMenuHook;end;end.

Answer 2

俺试了，但什么都没变化。
Windows 98 SE，中文版。

Answer 3

在98下面是没有效果，只能在2000以上的版本。
XPMENU对我这个是没有关系的。我要实现是所有的系统的菜单都变为透明。
不是要像XP那样的菜单。

Answer 4

GetSubMenu在自己的程序是可以，可是不知道为什么在这里就不行。
我的代码是这样的：
var
   MenuHwnd:HMENU;
   MenuCount,i:Integer;
begin
   MenuCount := GetMenuItemCount(hWindow);//得到菜单的项目数
   if MenuCount > 0 then
      for i:=0 to MenuCount -1 do 
      begin
           MenuHwnd := GetSubMenu(hWindow,i);
           if GetMenuItemCount(MenuHwnd) <> -1 then //<>-1就是有子菜单
               SetTrayAlpha(MenuHwnd,100);
      end;
           
不知道我的代码是有什么问题呢？

Answer 5

已编译好的程序和源代码可以到下面下载。
http://www.lkgarden.com/lfpsoft/HookMenu.zip