为什么编译不过 ( 积分: 100 )

  • 主题发起人 主题发起人 adminmaker
  • 开始时间 开始时间
A

adminmaker

Unregistered / Unconfirmed
GUEST, unregistred user!
找了个隐藏托盘图标的代码，但是编译不过，是不是漏了什么
麻烦给出完整代码
代码地址 http://www.bention.com/article.asp?id=154&page=1

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;


private
{ Private declarations }
function GetSysTrayWnd: HWND;
function GetSysTrayIconRect(Text: string): TRect;
function GetToolBarButtonRect(hWnd: HWND; Title: string): TRect;
public
{ Public declarations }


end;

var
Form1: TForm1;

implementation

{$R *.dfm}

function TForm1.GetSysTrayIconRect(Text: string): TRect;
{
返回系统托盘中指定文字的图标的矩形区域。
例如返回音量控制图标的矩形区域：
GetSysTrayIconRect('音量');
}
begin
Result := GetToolBarButtonRect(GetSysTrayWnd, Text);
end;


function TForm1.GetSysTrayWnd: HWND;
{
返回系统托盘的句柄，适合于WinXP以上版本
}
begin
Result := FindWindow('Shell_TrayWnd', nil);
Result := FindWindowEx(Result, 0, 'TrayNotifyWnd', nil);
Result := FindWindowEx(Result, 0, 'SysPager', nil);
Result := FindWindowEx(Result, 0, 'ToolbarWindow32', nil);
end;

function TForm1.GetToolBarButtonRect(hWnd: HWND; Title: string): TRect;
{
返回指定工具栏对应的按钮指定文本的矩形区域
hWnd:工具栏句柄，Title：需要返回矩形区域的按钮文字
返回值：指定按钮的边界矩形，屏幕坐标
}
var
C, i: integer;
Info: _TBUTTON;
Item: tagTCITEM;
Buff: PChar;
S: array[0..1024] of char;
PID: THandle;
PRC: THandle;
R: Cardinal;
begin
FillChar(Result, SizeOf(Result), 0);
if hWnd = 0 then Exit;
GetWindowThreadProcessId(hWnd, @PID);
PRC := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or PROCESS_VM_WRITE, False, PID);
Buff := VirtualAllocEx(PRC, nil, 4096, MEM_RESERVE or MEM_COMMIT, PAGE_READWRITE);

if Format('%d.%d', [Win32MajorVersion, Win32MinorVersion]) >= '5.1' then {// Is Windows XP or Higher}
begin
C := SendMessage(hWnd, TB_BUTTONCOUNT, 0, 0);
for i := 0 to C - 1 do
begin
FillChar(Info, SizeOf(Info), 0);
WriteProcessMemory(PRC, Buff, @Info, SizeOf(Info), R);

SendMessage(hWnd, TB_GETBUTTON, i, integer(Buff));
ReadProcessMemory(PRC, Buff, @Info, SizeOf(Info), R);

SendMessage(hWnd, TB_GETBUTTONTEXT, Info.idCommand, integer(integer(@Buff[0]) + SizeOf(Info)));
ReadProcessMemory(PRC, Pointer(integer(@Buff[0]) + SizeOf(Info)), @S[0], SizeOf(S), R);

if SameText(StrPas(S), Title) and not Boolean(SendMessage(hWnd, TB_ISBUTTONHIDDEN, Info.idCommand, 0)) then
begin
IconId:=(C-1)-i;
SendMessage(hWnd, TB_GETRECT, Info.idCommand, integer(integer(@Buff[0]) + SizeOf(Info)));
ReadProcessMemory(PRC, Pointer(integer(@Buff[0]) + SizeOf(Info)), @Result, SizeOf(Result), R);

Windows.ClientToScreen(hWnd, Result.TopLeft);
Windows.ClientToScreen(hWnd, Result.BottomRight);
mHandle:=hWnd;

Break;
end;
end;
end
else
begin
C := SendMessage(hWnd, TCM_GETITEMCOUNT, 0, 0);
for i := 0 to C - 1 do
begin
with Item do
begin
mask := TCIF_TEXT;
dwState := 0;
dwStateMask := 0;
cchTextMax := 2048;
pszText := PChar(integer(Buff) + SizeOf(Item) * 4);
iImage := 0;
lParam := 0;
end;
WriteProcessMemory(PRC, Buff, @Item, SizeOf(Item), R);
SendMessage(hWnd, TCM_GETITEM, i, Integer(Buff));

ReadProcessMemory(PRC, Buff, @Item, SizeOf(Item), R);
ReadProcessMemory(PRC, PChar(integer(Buff) + SizeOf(Item) * 4), @S[0], SizeOf(S), R);

if SameText(S, Title) then
begin
SendMessage(hWnd, TCM_GETITEMRECT, i, integer(Buff));
ReadProcessMemory(PRC, Buff, @Result, SizeOf(Result), R);

Windows.ClientToScreen(hWnd, Result.TopLeft);
Windows.ClientToScreen(hWnd, Result.BottomRight);
Break;
end;
end;
end;

VirtualFreeEx(PRC, Buff, 0, MEM_RELEASE);
CloseHandle(PRC);
end;

procedure TForm1.HideTrayIcon;
var
trayIcon:String;
isHide:boolean;
myRect:TRect;
begin
trayIcon:="迅雷5"

myRect:=GetSysTrayIconRect(trayIcon);

if isHide then
SendMessage(GetSysTrayWnd,TB_HIDEBUTTON,IconId,1)
else
SendMessage(GetSysTrayWnd,TB_HIDEBUTTON,IconId,0);

end;
end.
 
看清楚uses单元最后
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, commctrl;

type
TForm1 = class(TForm)
HideanyTrayIcon: TButton;
procedure HideanyTrayIconClick(Sender: TObject);
function GetSysTrayIconRect(Text: string): TRect;
function GetSysTrayWnd: HWND;
function GetToolBarButtonRect(hWnd: HWND; Title: string): TRect;
procedure HideTrayIcon;

private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
IconId: integer;
implementation

{$R *.dfm}

function TForm1.GetSysTrayIconRect(Text: string): TRect;
{
返回系统托盘中指定文字的图标的矩形区域。
例如返回音量控制图标的矩形区域：
GetSysTrayIconRect('音量');
}
begin
Result := GetToolBarButtonRect(GetSysTrayWnd, Text);
end;

function TForm1.GetSysTrayWnd: HWND;
{
返回系统托盘的句柄，适合于WinXP以上版本
}
begin
Result := FindWindow('Shell_TrayWnd', nil);
Result := FindWindowEx(Result, 0, 'TrayNotifyWnd', nil);
Result := FindWindowEx(Result, 0, 'SysPager', nil);
Result := FindWindowEx(Result, 0, 'ToolbarWindow32', nil);
end;

function TForm1.GetToolBarButtonRect(hWnd: HWND; Title: string): TRect;
{
返回指定工具栏对应的按钮指定文本的矩形区域
hWnd:工具栏句柄，Title：需要返回矩形区域的按钮文字
返回值：指定按钮的边界矩形，屏幕坐标
}
var
C, i: integer;
Info: _TBBUTTON;
Item: tagTCITEM;
Buff: PChar;
S: array[0..1024] of char;
PID: THandle;
PRC: THandle;
R: Cardinal;
// mHandle:THandle;

begin
FillChar(Result, SizeOf(Result), 0);
if hWnd = 0 then Exit;
GetWindowThreadProcessId(hWnd, @PID);
PRC := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or PROCESS_VM_WRITE, False, PID);
Buff := VirtualAllocEx(PRC, nil, 4096, MEM_RESERVE or MEM_COMMIT, PAGE_READWRITE);

if Format('%d.%d', [Win32MajorVersion, Win32MinorVersion]) >= '5.1' then {// Is Windows XP or Higher}
begin
C := SendMessage(hWnd, TB_BUTTONCOUNT, 0, 0);
for i := 0 to C - 1 do
begin
FillChar(Info, SizeOf(Info), 0);
WriteProcessMemory(PRC, Buff, @Info, SizeOf(Info), R);

SendMessage(hWnd, TB_GETBUTTON, i, integer(Buff));
ReadProcessMemory(PRC, Buff, @Info, SizeOf(Info), R);

SendMessage(hWnd, TB_GETBUTTONTEXT, Info.idCommand, integer(integer(@Buff[0]) + SizeOf(Info)));
ReadProcessMemory(PRC, Pointer(integer(@Buff[0]) + SizeOf(Info)), @S[0], SizeOf(S), R);

if SameText(StrPas(S), Title) and not Boolean(SendMessage(hWnd, TB_ISBUTTONHIDDEN, Info.idCommand, 0)) then
begin
IconId := (C - 1) - i;
SendMessage(hWnd, TB_GETRECT, Info.idCommand, integer(integer(@Buff[0]) + SizeOf(Info)));
ReadProcessMemory(PRC, Pointer(integer(@Buff[0]) + SizeOf(Info)), @Result, SizeOf(Result), R);

Windows.ClientToScreen(hWnd, Result.TopLeft);
Windows.ClientToScreen(hWnd, Result.BottomRight);
// mHandle:=hWnd;

Break;
end;
end;
end
else
begin
C := SendMessage(hWnd, TCM_GETITEMCOUNT, 0, 0);
for i := 0 to C - 1 do
begin
with Item do
begin
mask := TCIF_TEXT;
dwState := 0;
dwStateMask := 0;
cchTextMax := 2048;
pszText := PChar(integer(Buff) + SizeOf(Item) * 4);
iImage := 0;
lParam := 0;
end;
WriteProcessMemory(PRC, Buff, @Item, SizeOf(Item), R);
SendMessage(hWnd, TCM_GETITEM, i, Integer(Buff));

ReadProcessMemory(PRC, Buff, @Item, SizeOf(Item), R);
ReadProcessMemory(PRC, PChar(integer(Buff) + SizeOf(Item) * 4), @S[0], SizeOf(S), R);

if SameText(S, Title) then
begin
SendMessage(hWnd, TCM_GETITEMRECT, i, integer(Buff));
ReadProcessMemory(PRC, Buff, @Result, SizeOf(Result), R);

Windows.ClientToScreen(hWnd, Result.TopLeft);
Windows.ClientToScreen(hWnd, Result.BottomRight);
Break;
end;
end;
end;

VirtualFreeEx(PRC, Buff, 0, MEM_RELEASE);
CloseHandle(PRC);
end;

procedure TForm1.HideTrayIcon;
var
trayIcon: string;
isHide: boolean;
myRect: TRect;
begin
trayIcon := '音量';

myRect := GetSysTrayIconRect(trayIcon);

if isHide then
SendMessage(GetSysTrayWnd, TB_HIDEBUTTON, IconId, 1)
else
SendMessage(GetSysTrayWnd, TB_HIDEBUTTON, IconId, 0);

end;

procedure TForm1.HideanyTrayIconClick(Sender: TObject);
begin
HideTrayIcon;
end;

end.
 
看这张帖子可能对你更有帮助 http://www.delphibbs.com/delphibbs/dispq.asp?lid=3132145
 
接受答案了.
 
您必须登录或注册才可回复。

Similar threads

I
一个很有用的单元
回复
0
查看
720
import
I
I
一个IE工具单元
回复
0
查看
830
import
I
I
打开文件对话框API
回复
0
查看
1K
import
I
I
一些编码的解码
回复
0
查看
687
import
I
I
将汉字翻译成拼音简写
回复
0
查看
875
import
I
后退
顶部