Cool!将系统所有菜单变为半透明的代码(只适用Win2000以上的版本) (0分)

昨晚干到3点多，效果还是不是很理想。
主要是没有正确得到菜单中子菜单的句柄。高手们有没有好办法呢？
现在公开源代码，和大家一起研究研究。
如果这个问题解决，我想将功能扩张到拖动窗体时也将窗体变为半透明。这个功能我试
了，基本一能实现了。到时我也会将代码献出来给大家！
希望大家不会也UP一下！

以下是代码，功能当然是使用钩子实现

library HookMenu;

{*************************************************************}
{* *}
{* HookMenu Library,Copyright lfpsoft 2002 *}
{* All rights reserverd. *}
{* Bug Report : lfpsoft@163.net *}
{* WEB : http://www.soft520.com *}
{* *}
{* 效果不是很好，因为到现在我还没有想出如何得到菜单中的子菜单*}
{* 好方法，只能在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 : lfpsoft@163.net *}
{* WEB : http://www.soft520.com *}
{* *}
{* 效果不是很好，因为到现在我还没有想出如何得到菜单中的子菜单*}
{* 好方法，只能在WM_MENUSELECT这个消息里得到该子菜单的句柄 *}
{* 现在发布源代码，希望高手们指点指点，或者大家共同研究 *}
{* 还有手头上有基本实现当拖动窗体时就显示半透明的代码，过些天*}
{* 整理好后我会再放出来大家研究研究 *}
{*************************************************************}

interface

uses
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;

implementation

type
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.

//测试代码
unit main;

interface

uses
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.

没人对这个问题有兴趣吗？

我很感兴趣，可是我水平不够[!]

帮你 UP ^[]

水平不够也可以学呀！

我没有仔细看你的想法，不过我想你主要是以下的思路吧：
1：获取窗体句柄，菜单也是窗体的一种；
2：对窗体应用SetLayeredWindowAttributesAPI函数，此函数只在win2000以上版本才有
对吗？
其实在win98/me下也可实现啊，自己加个滤镜算法就可以了。

按楼上的方法，应该在98/ME下也可以实现。但是我现在的问题是应该如何得到菜单中的
子菜单的句柄。你有好办法吗？

不是有现成的API函数可以使用吗？GetSubMenu();
hSubMenu = GetSubMenu(hMenu, 0);
呵呵，还是一样的操作行了

我试过了，不行的。如果是自己的程序里的菜单就可以
要不你可以试试看。

我现在没时间，今晚回去做做看，今天晚上再讨论一下，好吗？

好，我等你。

gz

to shawn-yau:
等你等到我心痛!

不好意思，最近我在跟老师做项目，所以很晚才能回宿舍，你的代码我运行了一下，但
调试不通过，我明天再看看，或许你能把你编译的dll发个到我的邮箱吗？

我试过了，没有错呀。

现在没有事做了，快过年了。
大家一起再来讨论下这个问题如何？

gz

gz

Mark

Study

哈哈,真的成功了,可是好像透明度不可以调啊

有点问题，菜单刚弹出时并不透明，鼠标只要移到菜单上就变透明了。菜单弹出有延迟。