5,388
社区成员
发帖
与我相关
我的任务
分享请发表友善的回复…
发表回复
lqwxfdwj 2004-08-24
- 打赏
- 举报
with NotifyIcon do
begin
cbSize:=SizeOf(TNotifyIconData);
Wnd:=Handle; //指向当前窗体Form1的句柄
uID:=1;
uFlags:=NIM_ICON or NIM_MESSAGE or NIM_TIP;
uCallBackMessage:=WM_NID;
hIcon:=Application.Icon.Handle;
szTip:=”张家恶少”；
//////////////////////////////////////////////////////////
uFlags:=NIM_ICON or NIM_MESSAGE or NIM_TIP;
这句是这样的吧：uFlags:=NIf_ICON or NIf_MESSAGE or NIf_TIP;
你们这般家伙，这么大错误都在网上照搬照抄，错的地方都不改一下就发给别人。可悲。
begin
cbSize:=SizeOf(TNotifyIconData);
Wnd:=Handle; //指向当前窗体Form1的句柄
uID:=1;
uFlags:=NIM_ICON or NIM_MESSAGE or NIM_TIP;
uCallBackMessage:=WM_NID;
hIcon:=Application.Icon.Handle;
szTip:=”张家恶少”；
//////////////////////////////////////////////////////////
uFlags:=NIM_ICON or NIM_MESSAGE or NIM_TIP;
这句是这样的吧：uFlags:=NIf_ICON or NIf_MESSAGE or NIf_TIP;
你们这般家伙，这么大错误都在网上照搬照抄，错的地方都不改一下就发给别人。可悲。
fw0011 2004-03-29
- 打赏
- 举报
mark
aiirii 2004-03-16
- 打赏
- 举报
使用
var ari: TAriTrayIcon;
procedure TForm1.msg11Click(Sender: TObject);
begin
showmessage('msg1');
end;
procedure TForm1.msg21Click(Sender: TObject);
begin
showmessage('msg2');
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Ari := nil;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Ari := TariTrayIcon.GetAriTrayIcon(Self);
Ari.PopupMenu := PopupMenu1;
btnMoving.Enabled := true;
end;
procedure TForm1.btnMovingClick(Sender: TObject);
begin
if not Assigned(Ari) then exit;
Ari.IconList := ImageList1;
Ari.CycleIcons := not Ari.CycleIcons;
end;
var ari: TAriTrayIcon;
procedure TForm1.msg11Click(Sender: TObject);
begin
showmessage('msg1');
end;
procedure TForm1.msg21Click(Sender: TObject);
begin
showmessage('msg2');
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Ari := nil;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Ari := TariTrayIcon.GetAriTrayIcon(Self);
Ari.PopupMenu := PopupMenu1;
btnMoving.Enabled := true;
end;
procedure TForm1.btnMovingClick(Sender: TObject);
begin
if not Assigned(Ari) then exit;
Ari.IconList := ImageList1;
Ari.CycleIcons := not Ari.CycleIcons;
end;
aiirii 2004-03-16
- 打赏
- 举报
var
Pt: TPoint;
Shift: TShiftState;
I: Integer;
M: TMenuItem;
begin
if Msg.Msg = WM_TRAYNOTIFY then
begin
case Msg.lParam of
WM_LBUTTONDOWN:
if FEnabled then
begin
Shift := ShiftState + [ssLeft];
GetCursorPos(Pt);
FClickStart := True;
// if FLeftPopup then PopupAtCursor;
end;
WM_RBUTTONDOWN:
if FEnabled then
begin
Shift := ShiftState + [ssRight];
GetCursorPos(Pt);
PopupAtCursor;
end;
WM_LBUTTONUP:
if FEnabled then
begin
Shift := ShiftState + [ssLeft];
GetCursorPos(Pt);
if FClickStart then
begin
FClickStart := False;
Click;
end;
end;
WM_LBUTTONDBLCLK:
if FEnabled then
begin
M := nil;
if Assigned(FPopupMenu) then
if (FPopupMenu.AutoPopup) then //and (not FLeftPopup)
for I := PopupMenu.Items.Count -1 downto 0 do
begin
if PopupMenu.Items[I].Default then
M := PopupMenu.Items[I];
end;
if M <> nil then
M.Click;
end;
end;
end
else
case Msg.Msg of
WM_QUERYENDSESSION: begin
Msg.Result := 1;
end;
else
Msg.Result := DefWindowProc(IconData.Wnd, Msg.Msg, Msg.wParam, Msg.lParam);
end;
end;
procedure TAriTrayIcon.SetIcon(Value: TIcon);
begin
FIcon.Assign(Value);
ModifyIcon;
end;
procedure TAriTrayIcon.SetIconVisible(Value: Boolean);
begin
if Value then
ShowIcon
else
HideIcon;
end;
procedure TAriTrayIcon.SetCycleIcons(Value: Boolean);
begin
FCycleIcons := Value;
if Value then
SetIconIndex(0);
CycleTimer.Enabled := Value;
end;
procedure TAriTrayIcon.SetCycleInterval(Value: Cardinal);
begin
FCycleInterval := Value;
CycleTimer.Interval := FCycleInterval;
end;
procedure TAriTrayIcon.SetIconList(Value: TImageList);
begin
FIconList := Value;
SetIconIndex(0);
end;
procedure TAriTrayIcon.SetIconIndex(Value: Integer);
begin
if FIconList <> nil then
begin
FIconIndex := Value;
if Value >= FIconList.Count then
FIconIndex := FIconList.Count -1;
FIconList.GetIcon(FIconIndex, FIcon);
end
else
FIconIndex := 0;
ModifyIcon;
end;
procedure TAriTrayIcon.SetHint(Value: String);
begin
FHint := Value;
ModifyIcon;
end;
procedure TAriTrayIcon.SetShowHint(Value: Boolean);
begin
FShowHint := Value;
ModifyIcon;
end;
function TAriTrayIcon.InitIcon: Boolean;
begin
Result := False;
IconData.hIcon := FIcon.Handle;
if (FHint <> '') and (FShowHint) then
StrLCopy(IconData.szTip, PChar(FHint), SizeOf(IconData.szTip)-1)
else
IconData.szTip := '';
Result := True;
end;
function TAriTrayIcon.ShowIcon: Boolean;
begin
Result := False;
FIconVisible := True;
begin
if InitIcon then
Result := Shell_NotifyIcon(NIM_ADD, @IconData);
end;
end;
function TAriTrayIcon.HideIcon: Boolean;
begin
Result := False;
FIconVisible := False;
begin
if InitIcon then
Result := Shell_NotifyIcon(NIM_DELETE, @IconData);
end;
end;
function TAriTrayIcon.ModifyIcon: Boolean;
begin
Result := False;
if InitIcon then
Result := Shell_NotifyIcon(NIM_MODIFY, @IconData);
end;
procedure TAriTrayIcon.TimerCycle(Sender: TObject);
begin
if Assigned(FIconList) then
begin
FIconList.GetIcon(FIconIndex, FIcon);
// CycleIcon;
ModifyIcon;
if FIconIndex < FIconList.Count-1 then
SetIconIndex(FIconIndex+1)
else
SetIconIndex(0);
end;
end;
function TAriTrayIcon.ShowBalloonHint(Title: String; Text: String;
IconType: TBalloonHintIcon; TimeoutSecs: TBalloonHintTimeOut): Boolean;
const
aBalloonIconTypes: array[TBalloonHintIcon] of Byte =
(NIIF_NONE, NIIF_INFO, NIIF_WARNING, NIIF_ERROR);
begin
if FEnabled then
begin
with IconData do
begin
uFlags := uFlags or NIF_INFO;
StrPCopy(szInfo, '');
end;
ModifyIcon;
with IconData do
begin
uFlags := uFlags or NIF_INFO;
StrPCopy(szInfo, Text);
StrPCopy(szInfoTitle, Title);
uTimeout := TimeoutSecs * 1000;
dwInfoFlags := aBalloonIconTypes[IconType];
end;
Result := ModifyIcon;
with IconData do
uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP;
end
else
Result := True;
end;
function TAriTrayIcon.Refresh: Boolean;
begin
Result := ModifyIcon;
end;
procedure TAriTrayIcon.PopupAtCursor;
var
CursorPos: TPoint;
begin
if Assigned(PopupMenu) then
if PopupMenu.AutoPopup then
if GetCursorPos(CursorPos) then
begin
Application.ProcessMessages;
SetForegroundWindow(Handle);
if Owner is TWinControl then
SetForegroundWindow((Owner as TWinControl).Handle);
PopupMenu.PopupComponent := Self;
PopupMenu.Popup(CursorPos.X, CursorPos.Y);
if Owner is TWinControl then
PostMessage((Owner as TWinControl).Handle, WM_NULL, 0, 0)
end;
end;
procedure TAriTrayIcon.Click;
begin
ShowMainForm;
// if Assigned(FOnClick) then FOnClick(Self);
end;
procedure TAriTrayIcon.DoMinimizeToTray;
begin
HideMainForm;
IconVisible := True;
end;
procedure TAriTrayIcon.ShowMainForm;
begin
if Owner is TWinControl then
if Application.MainForm <> nil then
begin
ShowWindow(Application.Handle, SW_RESTORE);
Application.MainForm.Visible := True;
end;
end;
procedure TAriTrayIcon.HideMainForm;
begin
if Owner is TWinControl then
if Application.MainForm <> nil then
begin
Application.MainForm.Visible := False;
ShowWindow(Application.Handle, SW_HIDE);
end;
end;
{
procedure TAriTrayIcon.FreeInstance;
begin
nCount := 0;
inherited FreeInstance;
Instance := nil;
end;
class function TAriTrayIcon.NewInstance: TObject;
begin
if not Assigned(Instance) then
Instance := inherited NewInstance;
Inc(nCount);
Result := Instance;
end;
}
class function TAriTrayIcon.GetAriTrayIcon(AOwner: TComponent): TAriTrayIcon;
begin
if not Assigned(AriTrayIcon1) then
AriTrayIcon1 := TAriTrayIcon.Create(AOwner);
Inc(nCount);
result := AriTrayIcon1;
end;
class procedure TAriTrayIcon.FreeAriTrayIcon;
begin
Dec(nCount);
if nCount > 0 then exit;
if Assigned(AriTrayIcon1) then FreeAndNil(AriTrayIcon1);
end;
class procedure TAriTrayIcon.FreeAllATI;
begin
nCount := 0;
if Assigned(AriTrayIcon1) then FreeAndNil(AriTrayIcon1);
end;
initialization
finalization
TAriTrayIcon.FreeAllATI;
end.
Pt: TPoint;
Shift: TShiftState;
I: Integer;
M: TMenuItem;
begin
if Msg.Msg = WM_TRAYNOTIFY then
begin
case Msg.lParam of
WM_LBUTTONDOWN:
if FEnabled then
begin
Shift := ShiftState + [ssLeft];
GetCursorPos(Pt);
FClickStart := True;
// if FLeftPopup then PopupAtCursor;
end;
WM_RBUTTONDOWN:
if FEnabled then
begin
Shift := ShiftState + [ssRight];
GetCursorPos(Pt);
PopupAtCursor;
end;
WM_LBUTTONUP:
if FEnabled then
begin
Shift := ShiftState + [ssLeft];
GetCursorPos(Pt);
if FClickStart then
begin
FClickStart := False;
Click;
end;
end;
WM_LBUTTONDBLCLK:
if FEnabled then
begin
M := nil;
if Assigned(FPopupMenu) then
if (FPopupMenu.AutoPopup) then //and (not FLeftPopup)
for I := PopupMenu.Items.Count -1 downto 0 do
begin
if PopupMenu.Items[I].Default then
M := PopupMenu.Items[I];
end;
if M <> nil then
M.Click;
end;
end;
end
else
case Msg.Msg of
WM_QUERYENDSESSION: begin
Msg.Result := 1;
end;
else
Msg.Result := DefWindowProc(IconData.Wnd, Msg.Msg, Msg.wParam, Msg.lParam);
end;
end;
procedure TAriTrayIcon.SetIcon(Value: TIcon);
begin
FIcon.Assign(Value);
ModifyIcon;
end;
procedure TAriTrayIcon.SetIconVisible(Value: Boolean);
begin
if Value then
ShowIcon
else
HideIcon;
end;
procedure TAriTrayIcon.SetCycleIcons(Value: Boolean);
begin
FCycleIcons := Value;
if Value then
SetIconIndex(0);
CycleTimer.Enabled := Value;
end;
procedure TAriTrayIcon.SetCycleInterval(Value: Cardinal);
begin
FCycleInterval := Value;
CycleTimer.Interval := FCycleInterval;
end;
procedure TAriTrayIcon.SetIconList(Value: TImageList);
begin
FIconList := Value;
SetIconIndex(0);
end;
procedure TAriTrayIcon.SetIconIndex(Value: Integer);
begin
if FIconList <> nil then
begin
FIconIndex := Value;
if Value >= FIconList.Count then
FIconIndex := FIconList.Count -1;
FIconList.GetIcon(FIconIndex, FIcon);
end
else
FIconIndex := 0;
ModifyIcon;
end;
procedure TAriTrayIcon.SetHint(Value: String);
begin
FHint := Value;
ModifyIcon;
end;
procedure TAriTrayIcon.SetShowHint(Value: Boolean);
begin
FShowHint := Value;
ModifyIcon;
end;
function TAriTrayIcon.InitIcon: Boolean;
begin
Result := False;
IconData.hIcon := FIcon.Handle;
if (FHint <> '') and (FShowHint) then
StrLCopy(IconData.szTip, PChar(FHint), SizeOf(IconData.szTip)-1)
else
IconData.szTip := '';
Result := True;
end;
function TAriTrayIcon.ShowIcon: Boolean;
begin
Result := False;
FIconVisible := True;
begin
if InitIcon then
Result := Shell_NotifyIcon(NIM_ADD, @IconData);
end;
end;
function TAriTrayIcon.HideIcon: Boolean;
begin
Result := False;
FIconVisible := False;
begin
if InitIcon then
Result := Shell_NotifyIcon(NIM_DELETE, @IconData);
end;
end;
function TAriTrayIcon.ModifyIcon: Boolean;
begin
Result := False;
if InitIcon then
Result := Shell_NotifyIcon(NIM_MODIFY, @IconData);
end;
procedure TAriTrayIcon.TimerCycle(Sender: TObject);
begin
if Assigned(FIconList) then
begin
FIconList.GetIcon(FIconIndex, FIcon);
// CycleIcon;
ModifyIcon;
if FIconIndex < FIconList.Count-1 then
SetIconIndex(FIconIndex+1)
else
SetIconIndex(0);
end;
end;
function TAriTrayIcon.ShowBalloonHint(Title: String; Text: String;
IconType: TBalloonHintIcon; TimeoutSecs: TBalloonHintTimeOut): Boolean;
const
aBalloonIconTypes: array[TBalloonHintIcon] of Byte =
(NIIF_NONE, NIIF_INFO, NIIF_WARNING, NIIF_ERROR);
begin
if FEnabled then
begin
with IconData do
begin
uFlags := uFlags or NIF_INFO;
StrPCopy(szInfo, '');
end;
ModifyIcon;
with IconData do
begin
uFlags := uFlags or NIF_INFO;
StrPCopy(szInfo, Text);
StrPCopy(szInfoTitle, Title);
uTimeout := TimeoutSecs * 1000;
dwInfoFlags := aBalloonIconTypes[IconType];
end;
Result := ModifyIcon;
with IconData do
uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP;
end
else
Result := True;
end;
function TAriTrayIcon.Refresh: Boolean;
begin
Result := ModifyIcon;
end;
procedure TAriTrayIcon.PopupAtCursor;
var
CursorPos: TPoint;
begin
if Assigned(PopupMenu) then
if PopupMenu.AutoPopup then
if GetCursorPos(CursorPos) then
begin
Application.ProcessMessages;
SetForegroundWindow(Handle);
if Owner is TWinControl then
SetForegroundWindow((Owner as TWinControl).Handle);
PopupMenu.PopupComponent := Self;
PopupMenu.Popup(CursorPos.X, CursorPos.Y);
if Owner is TWinControl then
PostMessage((Owner as TWinControl).Handle, WM_NULL, 0, 0)
end;
end;
procedure TAriTrayIcon.Click;
begin
ShowMainForm;
// if Assigned(FOnClick) then FOnClick(Self);
end;
procedure TAriTrayIcon.DoMinimizeToTray;
begin
HideMainForm;
IconVisible := True;
end;
procedure TAriTrayIcon.ShowMainForm;
begin
if Owner is TWinControl then
if Application.MainForm <> nil then
begin
ShowWindow(Application.Handle, SW_RESTORE);
Application.MainForm.Visible := True;
end;
end;
procedure TAriTrayIcon.HideMainForm;
begin
if Owner is TWinControl then
if Application.MainForm <> nil then
begin
Application.MainForm.Visible := False;
ShowWindow(Application.Handle, SW_HIDE);
end;
end;
{
procedure TAriTrayIcon.FreeInstance;
begin
nCount := 0;
inherited FreeInstance;
Instance := nil;
end;
class function TAriTrayIcon.NewInstance: TObject;
begin
if not Assigned(Instance) then
Instance := inherited NewInstance;
Inc(nCount);
Result := Instance;
end;
}
class function TAriTrayIcon.GetAriTrayIcon(AOwner: TComponent): TAriTrayIcon;
begin
if not Assigned(AriTrayIcon1) then
AriTrayIcon1 := TAriTrayIcon.Create(AOwner);
Inc(nCount);
result := AriTrayIcon1;
end;
class procedure TAriTrayIcon.FreeAriTrayIcon;
begin
Dec(nCount);
if nCount > 0 then exit;
if Assigned(AriTrayIcon1) then FreeAndNil(AriTrayIcon1);
end;
class procedure TAriTrayIcon.FreeAllATI;
begin
nCount := 0;
if Assigned(AriTrayIcon1) then FreeAndNil(AriTrayIcon1);
end;
initialization
finalization
TAriTrayIcon.FreeAllATI;
end.
aiirii 2004-03-16
- 打赏
- 举报
var
// Instance: TObject = nil;
nCount: integer = 0;
AriTrayIcon1: TAriTrayIcon = nil;
constructor TAriTrayIcon.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FIconVisible := True;
FEnabled := True;
FShowHint := True;
FCycleInterval := 500;
WM_TASKBARCREATED := RegisterWindowMessage('TaskbarCreated');
FIcon := TIcon.Create;
IconData.cbSize := SizeOf(TNotifyIconDataEx);
IconData.wnd := AllocateHWnd(HandleIconMessage);
IconData.uId := IconID;
IconData.uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP;
IconData.uCallbackMessage := WM_TRAYNOTIFY;
FWindowHandle := GetWindowLong(IconData.wnd, GWL_HWNDPARENT);
CycleTimer := TTimer.Create(Self);
CycleTimer.Enabled := False;
CycleTimer.Interval := FCycleInterval;
CycleTimer.OnTimer := TimerCycle;
FIcon.Assign(Application.Icon);
// FIcon.Handle := LoadIcon(0, IDI_WINLOGO);
if not (csDesigning in ComponentState) then
begin
HookApp;
if Owner is TWinControl then
HookForm;
end;
ShowIcon;
end;
destructor TAriTrayIcon.Destroy;
begin
SetIconVisible(False);
FIcon.Free;
DeallocateHWnd(IconData.Wnd);
CycleTimer.Free;
if not (csDesigning in ComponentState) then
begin
UnhookApp;
if Owner is TWinControl then
UnhookForm;
end;
inherited Destroy;
end;
procedure TAriTrayIcon.Loaded;
begin
inherited Loaded;
ModifyIcon;
SetIconVisible(FIconVisible);
end;
procedure TAriTrayIcon.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (AComponent = IconList) and (Operation = opRemove) then
begin
FIconList := nil;
IconList := nil;
end;
if (AComponent = PopupMenu) and (Operation = opRemove) then
begin
FPopupMenu := nil;
PopupMenu := nil;
end;
end;
procedure TAriTrayIcon.HookApp;
begin
OldAppProc := Pointer(GetWindowLong(Application.Handle, GWL_WNDPROC));
NewAppProc := MakeObjectInstance(HookAppProc);
SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(NewAppProc));
end;
procedure TAriTrayIcon.UnhookApp;
begin
if Assigned(OldAppProc) then
SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(OldAppProc));
if Assigned(NewAppProc) then
FreeObjectInstance(NewAppProc);
NewAppProc := nil;
OldAppProc := nil;
end;
procedure TAriTrayIcon.HookAppProc(var Msg: TMessage);
begin
case Msg.Msg of
WM_SIZE:
if Msg.wParam = SIZE_MINIMIZED then
begin
DoMinimizeToTray;
end;
end;
if Msg.Msg = WM_TASKBARCREATED then
if FIconVisible then
ShowIcon;
Msg.Result := CallWindowProc(OldAppProc, Application.Handle,
Msg.Msg, Msg.wParam, Msg.lParam);
end;
procedure TAriTrayIcon.HookForm;
begin
if (Owner as TWinControl) <> nil then
begin
OldWndProc := Pointer(GetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC));
NewWndProc := MakeObjectInstance(HookFormProc);
SetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC, LongInt(NewWndProc));
end;
end;
procedure TAriTrayIcon.UnhookForm;
begin
if ((Owner as TWinControl) <> nil) and (Assigned(OldWndProc)) then
SetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC, LongInt(OldWndProc));
if Assigned(NewWndProc) then
FreeObjectInstance(NewWndProc);
NewWndProc := nil;
OldWndProc := nil;
end;
procedure TAriTrayIcon.HookFormProc(var Msg: TMessage);
begin
case Msg.Msg of
WM_SHOWWINDOW: begin
if (Msg.lParam = 0) and (Msg.wParam = 1) then
begin
ShowWindow(Application.Handle, SW_RESTORE);
SetForegroundWindow(Application.Handle);
SetForegroundWindow((Owner as TWinControl).Handle);
end;
end;
WM_ACTIVATE: begin
if Assigned(Screen.ActiveControl) then
if (Msg.WParamLo = WA_ACTIVE) or (Msg.WParamLo = WA_CLICKACTIVE) then
if Assigned(Screen.ActiveControl.Parent) then
begin
if HWND(Msg.lParam) <> Screen.ActiveControl.Parent.Handle then
SetFocus(Screen.ActiveControl.Handle);
end
else
begin
if HWND(Msg.lParam) <> Screen.ActiveControl.Handle then
SetFocus(Screen.ActiveControl.Handle);
end;
end;
end;
Msg.Result := CallWindowProc(OldWndProc, (Owner as TWinControl).Handle,
Msg.Msg, Msg.wParam, Msg.lParam);
end;
procedure TAriTrayIcon.HandleIconMessage(var Msg: TMessage);
function ShiftState: TShiftState;
begin
Result := [];
if GetAsyncKeyState(VK_SHIFT) < 0 then
Include(Result, ssShift);
if GetAsyncKeyState(VK_CONTROL) < 0 then
Include(Result, ssCtrl);
if GetAsyncKeyState(VK_MENU) < 0 then
Include(Result, ssAlt);
end;
// Instance: TObject = nil;
nCount: integer = 0;
AriTrayIcon1: TAriTrayIcon = nil;
constructor TAriTrayIcon.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FIconVisible := True;
FEnabled := True;
FShowHint := True;
FCycleInterval := 500;
WM_TASKBARCREATED := RegisterWindowMessage('TaskbarCreated');
FIcon := TIcon.Create;
IconData.cbSize := SizeOf(TNotifyIconDataEx);
IconData.wnd := AllocateHWnd(HandleIconMessage);
IconData.uId := IconID;
IconData.uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP;
IconData.uCallbackMessage := WM_TRAYNOTIFY;
FWindowHandle := GetWindowLong(IconData.wnd, GWL_HWNDPARENT);
CycleTimer := TTimer.Create(Self);
CycleTimer.Enabled := False;
CycleTimer.Interval := FCycleInterval;
CycleTimer.OnTimer := TimerCycle;
FIcon.Assign(Application.Icon);
// FIcon.Handle := LoadIcon(0, IDI_WINLOGO);
if not (csDesigning in ComponentState) then
begin
HookApp;
if Owner is TWinControl then
HookForm;
end;
ShowIcon;
end;
destructor TAriTrayIcon.Destroy;
begin
SetIconVisible(False);
FIcon.Free;
DeallocateHWnd(IconData.Wnd);
CycleTimer.Free;
if not (csDesigning in ComponentState) then
begin
UnhookApp;
if Owner is TWinControl then
UnhookForm;
end;
inherited Destroy;
end;
procedure TAriTrayIcon.Loaded;
begin
inherited Loaded;
ModifyIcon;
SetIconVisible(FIconVisible);
end;
procedure TAriTrayIcon.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (AComponent = IconList) and (Operation = opRemove) then
begin
FIconList := nil;
IconList := nil;
end;
if (AComponent = PopupMenu) and (Operation = opRemove) then
begin
FPopupMenu := nil;
PopupMenu := nil;
end;
end;
procedure TAriTrayIcon.HookApp;
begin
OldAppProc := Pointer(GetWindowLong(Application.Handle, GWL_WNDPROC));
NewAppProc := MakeObjectInstance(HookAppProc);
SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(NewAppProc));
end;
procedure TAriTrayIcon.UnhookApp;
begin
if Assigned(OldAppProc) then
SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(OldAppProc));
if Assigned(NewAppProc) then
FreeObjectInstance(NewAppProc);
NewAppProc := nil;
OldAppProc := nil;
end;
procedure TAriTrayIcon.HookAppProc(var Msg: TMessage);
begin
case Msg.Msg of
WM_SIZE:
if Msg.wParam = SIZE_MINIMIZED then
begin
DoMinimizeToTray;
end;
end;
if Msg.Msg = WM_TASKBARCREATED then
if FIconVisible then
ShowIcon;
Msg.Result := CallWindowProc(OldAppProc, Application.Handle,
Msg.Msg, Msg.wParam, Msg.lParam);
end;
procedure TAriTrayIcon.HookForm;
begin
if (Owner as TWinControl) <> nil then
begin
OldWndProc := Pointer(GetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC));
NewWndProc := MakeObjectInstance(HookFormProc);
SetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC, LongInt(NewWndProc));
end;
end;
procedure TAriTrayIcon.UnhookForm;
begin
if ((Owner as TWinControl) <> nil) and (Assigned(OldWndProc)) then
SetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC, LongInt(OldWndProc));
if Assigned(NewWndProc) then
FreeObjectInstance(NewWndProc);
NewWndProc := nil;
OldWndProc := nil;
end;
procedure TAriTrayIcon.HookFormProc(var Msg: TMessage);
begin
case Msg.Msg of
WM_SHOWWINDOW: begin
if (Msg.lParam = 0) and (Msg.wParam = 1) then
begin
ShowWindow(Application.Handle, SW_RESTORE);
SetForegroundWindow(Application.Handle);
SetForegroundWindow((Owner as TWinControl).Handle);
end;
end;
WM_ACTIVATE: begin
if Assigned(Screen.ActiveControl) then
if (Msg.WParamLo = WA_ACTIVE) or (Msg.WParamLo = WA_CLICKACTIVE) then
if Assigned(Screen.ActiveControl.Parent) then
begin
if HWND(Msg.lParam) <> Screen.ActiveControl.Parent.Handle then
SetFocus(Screen.ActiveControl.Handle);
end
else
begin
if HWND(Msg.lParam) <> Screen.ActiveControl.Handle then
SetFocus(Screen.ActiveControl.Handle);
end;
end;
end;
Msg.Result := CallWindowProc(OldWndProc, (Owner as TWinControl).Handle,
Msg.Msg, Msg.wParam, Msg.lParam);
end;
procedure TAriTrayIcon.HandleIconMessage(var Msg: TMessage);
function ShiftState: TShiftState;
begin
Result := [];
if GetAsyncKeyState(VK_SHIFT) < 0 then
Include(Result, ssShift);
if GetAsyncKeyState(VK_CONTROL) < 0 then
Include(Result, ssCtrl);
if GetAsyncKeyState(VK_MENU) < 0 then
Include(Result, ssAlt);
end;
aiirii 2004-03-16
- 打赏
- 举报
我修改一個網上的控件
{*****************************************************************}
{ }
{ Aiirii -- aiirii@21cn.com }
{ Copyright (c) 2003 }
{ }
{*****************************************************************}
unit ariTrayIcon;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Menus, ShellApi, ExtCtrls;
const
WM_TRAYNOTIFY = WM_USER + 1024;
IconID = 1;
WM_RESETTOOLTIP = WM_USER + 1025;
NIIF_NONE = $00000000;
NIIF_INFO = $00000001;
NIIF_WARNING = $00000002;
NIIF_ERROR = $00000003;
NIF_INFO = $00000010;
var
WM_TASKBARCREATED: Cardinal;
type
TNotifyIconDataEx = record
cbSize: DWORD;
Wnd: HWND;
uID: UINT;
uFlags: UINT;
uCallbackMessage: UINT;
hIcon: HICON;
szTip: array[0..127] of AnsiChar; // 0..63 of WideChar in stead?
dwState: DWORD;
dwStateMask: DWORD;
szInfo: array[0..255] of AnsiChar;
uTimeout: UINT;
szInfoTitle: array[0..63] of AnsiChar;
dwInfoFlags: DWORD;
end;
TBalloonHintIcon = (bitNone, bitInfo, bitWarning, bitError);
TBalloonHintTimeOut = 10..60;
TCycleEvent = procedure(Sender: TObject; NextIndex: Integer) of object;
TAriTrayIcon = class(TComponent)
private
FEnabled: Boolean;
FIcon: TIcon;
FIconVisible: Boolean;
FHint: String;
FShowHint: Boolean;
FPopupMenu: TPopupMenu;
FClickStart: Boolean;
CycleTimer: TTimer;
FIconIndex: Integer;
FIconList: TImageList;
FCycleIcons: Boolean;
FCycleInterval: Cardinal;
OldAppProc, NewAppProc: Pointer;
OldWndProc, NewWndProc: Pointer;
FWindowHandle: HWND;
procedure SetCycleIcons(Value: Boolean);
procedure SetCycleInterval(Value: Cardinal);
procedure TimerCycle(Sender: TObject);
procedure HandleIconMessage(var Msg: TMessage);
function InitIcon: Boolean;
procedure SetIcon(Value: TIcon);
procedure SetIconVisible(Value: Boolean);
procedure SetIconList(Value: TImageList);
procedure SetIconIndex(Value: Integer);
procedure SetHint(Value: String);
procedure SetShowHint(Value: Boolean);
procedure PopupAtCursor;
procedure HookApp;
procedure UnhookApp;
procedure HookAppProc(var Msg: TMessage);
procedure HookForm;
procedure UnhookForm;
procedure HookFormProc(var Msg: TMessage);
class procedure FreeAllATI;
protected
IconData: TNotifyIconDataEx;
procedure Loaded; override;
function ShowIcon: Boolean; virtual;
function HideIcon: Boolean; virtual;
function ModifyIcon: Boolean; virtual;
procedure Click; dynamic;
procedure DoMinimizeToTray; dynamic;
procedure Notification(AComponent: TComponent; Operation: TOperation);
override;
public
property Handle: HWND read IconData.Wnd;
property WindowHandle: HWND read FWindowHandle;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function Refresh: Boolean;
function ShowBalloonHint(Title: String; Text: String; IconType: TBalloonHintIcon;
TimeoutSecs: TBalloonHintTimeOut): Boolean;
procedure ShowMainForm;
procedure HideMainForm;
published
// class function NewInstance: TObject; override;
class function GetAriTrayIcon(AOwner: TComponent): TAriTrayIcon;
class procedure FreeAriTrayIcon();
// procedure FreeInstance; override;
property IconList: TImageList read FIconList write SetIconList;
property CycleIcons: Boolean read FCycleIcons write SetCycleIcons
default False;
property CycleInterval: Cardinal read FCycleInterval
write SetCycleInterval;
property Enabled: Boolean read FEnabled write FEnabled default True;
property Hint: String read FHint write SetHint;
property ShowHint: Boolean read FShowHint write SetShowHint
default True;
property Icon: TIcon read FIcon write SetIcon stored True;
property IconVisible: Boolean read FIconVisible write SetIconVisible
default True;
property IconIndex: Integer read FIconIndex write SetIconIndex;
property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu;
end;
//var AriTrayIcon1: TAriTrayIcon;
implementation
{*****************************************************************}
{ }
{ Aiirii -- aiirii@21cn.com }
{ Copyright (c) 2003 }
{ }
{*****************************************************************}
unit ariTrayIcon;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Menus, ShellApi, ExtCtrls;
const
WM_TRAYNOTIFY = WM_USER + 1024;
IconID = 1;
WM_RESETTOOLTIP = WM_USER + 1025;
NIIF_NONE = $00000000;
NIIF_INFO = $00000001;
NIIF_WARNING = $00000002;
NIIF_ERROR = $00000003;
NIF_INFO = $00000010;
var
WM_TASKBARCREATED: Cardinal;
type
TNotifyIconDataEx = record
cbSize: DWORD;
Wnd: HWND;
uID: UINT;
uFlags: UINT;
uCallbackMessage: UINT;
hIcon: HICON;
szTip: array[0..127] of AnsiChar; // 0..63 of WideChar in stead?
dwState: DWORD;
dwStateMask: DWORD;
szInfo: array[0..255] of AnsiChar;
uTimeout: UINT;
szInfoTitle: array[0..63] of AnsiChar;
dwInfoFlags: DWORD;
end;
TBalloonHintIcon = (bitNone, bitInfo, bitWarning, bitError);
TBalloonHintTimeOut = 10..60;
TCycleEvent = procedure(Sender: TObject; NextIndex: Integer) of object;
TAriTrayIcon = class(TComponent)
private
FEnabled: Boolean;
FIcon: TIcon;
FIconVisible: Boolean;
FHint: String;
FShowHint: Boolean;
FPopupMenu: TPopupMenu;
FClickStart: Boolean;
CycleTimer: TTimer;
FIconIndex: Integer;
FIconList: TImageList;
FCycleIcons: Boolean;
FCycleInterval: Cardinal;
OldAppProc, NewAppProc: Pointer;
OldWndProc, NewWndProc: Pointer;
FWindowHandle: HWND;
procedure SetCycleIcons(Value: Boolean);
procedure SetCycleInterval(Value: Cardinal);
procedure TimerCycle(Sender: TObject);
procedure HandleIconMessage(var Msg: TMessage);
function InitIcon: Boolean;
procedure SetIcon(Value: TIcon);
procedure SetIconVisible(Value: Boolean);
procedure SetIconList(Value: TImageList);
procedure SetIconIndex(Value: Integer);
procedure SetHint(Value: String);
procedure SetShowHint(Value: Boolean);
procedure PopupAtCursor;
procedure HookApp;
procedure UnhookApp;
procedure HookAppProc(var Msg: TMessage);
procedure HookForm;
procedure UnhookForm;
procedure HookFormProc(var Msg: TMessage);
class procedure FreeAllATI;
protected
IconData: TNotifyIconDataEx;
procedure Loaded; override;
function ShowIcon: Boolean; virtual;
function HideIcon: Boolean; virtual;
function ModifyIcon: Boolean; virtual;
procedure Click; dynamic;
procedure DoMinimizeToTray; dynamic;
procedure Notification(AComponent: TComponent; Operation: TOperation);
override;
public
property Handle: HWND read IconData.Wnd;
property WindowHandle: HWND read FWindowHandle;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function Refresh: Boolean;
function ShowBalloonHint(Title: String; Text: String; IconType: TBalloonHintIcon;
TimeoutSecs: TBalloonHintTimeOut): Boolean;
procedure ShowMainForm;
procedure HideMainForm;
published
// class function NewInstance: TObject; override;
class function GetAriTrayIcon(AOwner: TComponent): TAriTrayIcon;
class procedure FreeAriTrayIcon();
// procedure FreeInstance; override;
property IconList: TImageList read FIconList write SetIconList;
property CycleIcons: Boolean read FCycleIcons write SetCycleIcons
default False;
property CycleInterval: Cardinal read FCycleInterval
write SetCycleInterval;
property Enabled: Boolean read FEnabled write FEnabled default True;
property Hint: String read FHint write SetHint;
property ShowHint: Boolean read FShowHint write SetShowHint
default True;
property Icon: TIcon read FIcon write SetIcon stored True;
property IconVisible: Boolean read FIconVisible write SetIconVisible
default True;
property IconIndex: Integer read FIconIndex write SetIconIndex;
property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu;
end;
//var AriTrayIcon1: TAriTrayIcon;
implementation
zblaoshu1979 2004-03-16
- 打赏
- 举报
（转摘）
一．新建一个应用程序：File->New Applicaton 在Interface部分定义一个消息常量：const WM_NID=WM_USER+1000; 系统规定从WM_USER开始为用户自定义消息。
二．定义一个全局变量： NotifyIcon:TNotifyIconData，NotifyIcon是非常重要的一个变量，整个程序基本上是围着这个变量在转。TNotifyIconData是一个记录类型，按住Ctrl键，在TNotifyIconData 双击即进入ShellAPI.pas单元。（注：在Delphi中，这是一个非常好的对源代码进行分析的方法，源代码说明一切，你要想知道程序背后的内幕，最好的方法就是分析源代码！）此时出现了以下赋值语句：
TNotifyIconData = TNotifyIconDataA，这个意思很明显，就是说TNotifyIconData和TNotifyIconDataA是同种数据类型，接着往下看有：
TNotifyIconDataA = _NOTIFYICONDATAA，意思与刚才的一样，再往下看：
type
_NOTIFYICONDATAA = record
cbSize: DWORD;
Wnd: HWND;
uID: UINT;
uFlags: UINT;
uCallbackMessage: UINT;
hIcon: HICON;
szTip: array [0..63] of AnsiChar;
end;
这可真是“千呼万唤始出来，犹抱琵琶半遮面”。现在大家很清楚了，我们刚才定义的全局变量NotifyIcon其实是一个包含有7个成分的记录类型变量，就相当于C/C++中的结构体变量（C/C++的程序员应该是再熟悉不过了）。下面我们逐个来解释记录类型中的7个部分各有什么功能。
1> cbSize就是你定义的NotifyIcon变量的大小，用SizeOf(TNotifyIconData)可以取得，如果你是一个熟练的C/C++程序员，你应该不会陌生。在C/C++中，每当要为一个结构体变量分配内存的时候都要：通过 SizeOf(Struct type) 来获知存放一个这样的结构体变量要多少内存。
2> Wnd是一个句柄，你希望托盘程序产生的消息有哪个窗体来处理就让Wnd指向那个窗体。
例如：你准备在任务栏的托盘小图标上单击时窗体是窗体在“显示”和“隐藏”之间切换，则把Wnd指向主窗体。
3> uID:如果你要创建多个托盘小程序，那么怎么区分它们呢？就是靠这个ID号来区分。
4> uFlags是一个标志位，它表示当前所创建的托盘程序具有哪些性质：
NIF_ICON 表示当前所设置的图标（即hIcon的值）是有效的
NIF_MESSAGE 表示当前所设置的系统消息（即uCallBackMessage的值）是有效的
NIF_TIP 表示当前所设置的提示条（即szTip的值）是有效的。
5> uCallBackMessage这是7个部分里面最重要的一个。这里指定一个回调消息，也就是说这里定义一个消息名，当你单击或者右击托盘图标的时候就会向你在Wnd所指向的窗体发送一个在uCallBackMessage中定义的消息名，然后你在程序中定义一个消息出来函数来处理这个消息。这样就把Windows关于消息的整套流程都处理好了。
6> hIcon为托盘图标的句柄，根据这个句柄你就可以增加、修改、删除图标。
7> szTip就是当你的鼠标放到任务栏托盘的小图标上的时候弹出来的提示信息。
在这里我花了大量的笔墨介绍TNotifyIconData的内幕，把这部分搞清楚了，后面的东西就顺理成章了。
三．双击主窗体，进入FormCreate的代码区域：
TForm1.FormCreate(Sender:TObject);
Begin
//NotifyIcon为全局变量，在程序的开头已经定义了
with NotifyIcon do
begin
cbSize:=SizeOf(TNotifyIconData);
Wnd:=Handle; //指向当前窗体Form1的句柄
uID:=1;
uFlags:=NIM_ICON or NIM_MESSAGE or NIM_TIP;
uCallBackMessage:=WM_NID;
hIcon:=Application.Icon.Handle;
szTip:=”张家恶少”；
end;.
//把设置好的变量NotifyIcon加入到系统中以便处理
Shell_NotifyIcon(NIM_ADD,@NotifyIcon);
End;
四．接下来就是定义一个消息处理函数：系统给窗体发来了一个消息，就由下面这个函数来处理。每个消息处理函数都是处理某一类消息的，大家仔细地看看下面函数体的定义和一般的函数定义有什么不一样：消息处理函数要在后面加上消息的名称，这样当系统发来WM_NID消息时，就是自动触发WMNID消息处理函数。
procedure WMNID(var msg:TMessage);message WM_NID;
begin
case msg.LParam of
WM_LBUTTONUp; Form1.Visible:=not Form1.Visible;
WM_RBUTTONUP: ShowMessage(‘您点击的是右键’);
End;
End;
好了，一个最简单的程序诞生了，大家自己设置好自己喜欢的图标.
Project->Options,选中Application页面，在Icon项中加载自己喜欢的图标，这样程序运行时，在任务栏里显示的就是你喜欢的图标了。当你单击图标时，窗体Form1会在可见与不可见之间切换，也就是说单击一下显示，再单击一下又隐藏。当你右击图标的时候会弹出一条消息：“你点击的是右键”。
五．最后要记住在关闭应用程序的时候要释放掉建立的托盘程序，否则会占用系统资源。
TForm1.FormDestroy(Sender:TObject);
Begin
Shell_NotifyIcon(NIM_DELETE,@NotifyIcon);
End;
一．新建一个应用程序：File->New Applicaton 在Interface部分定义一个消息常量：const WM_NID=WM_USER+1000; 系统规定从WM_USER开始为用户自定义消息。
二．定义一个全局变量： NotifyIcon:TNotifyIconData，NotifyIcon是非常重要的一个变量，整个程序基本上是围着这个变量在转。TNotifyIconData是一个记录类型，按住Ctrl键，在TNotifyIconData 双击即进入ShellAPI.pas单元。（注：在Delphi中，这是一个非常好的对源代码进行分析的方法，源代码说明一切，你要想知道程序背后的内幕，最好的方法就是分析源代码！）此时出现了以下赋值语句：
TNotifyIconData = TNotifyIconDataA，这个意思很明显，就是说TNotifyIconData和TNotifyIconDataA是同种数据类型，接着往下看有：
TNotifyIconDataA = _NOTIFYICONDATAA，意思与刚才的一样，再往下看：
type
_NOTIFYICONDATAA = record
cbSize: DWORD;
Wnd: HWND;
uID: UINT;
uFlags: UINT;
uCallbackMessage: UINT;
hIcon: HICON;
szTip: array [0..63] of AnsiChar;
end;
这可真是“千呼万唤始出来，犹抱琵琶半遮面”。现在大家很清楚了，我们刚才定义的全局变量NotifyIcon其实是一个包含有7个成分的记录类型变量，就相当于C/C++中的结构体变量（C/C++的程序员应该是再熟悉不过了）。下面我们逐个来解释记录类型中的7个部分各有什么功能。
1> cbSize就是你定义的NotifyIcon变量的大小，用SizeOf(TNotifyIconData)可以取得，如果你是一个熟练的C/C++程序员，你应该不会陌生。在C/C++中，每当要为一个结构体变量分配内存的时候都要：通过 SizeOf(Struct type) 来获知存放一个这样的结构体变量要多少内存。
2> Wnd是一个句柄，你希望托盘程序产生的消息有哪个窗体来处理就让Wnd指向那个窗体。
例如：你准备在任务栏的托盘小图标上单击时窗体是窗体在“显示”和“隐藏”之间切换，则把Wnd指向主窗体。
3> uID:如果你要创建多个托盘小程序，那么怎么区分它们呢？就是靠这个ID号来区分。
4> uFlags是一个标志位，它表示当前所创建的托盘程序具有哪些性质：
NIF_ICON 表示当前所设置的图标（即hIcon的值）是有效的
NIF_MESSAGE 表示当前所设置的系统消息（即uCallBackMessage的值）是有效的
NIF_TIP 表示当前所设置的提示条（即szTip的值）是有效的。
5> uCallBackMessage这是7个部分里面最重要的一个。这里指定一个回调消息，也就是说这里定义一个消息名，当你单击或者右击托盘图标的时候就会向你在Wnd所指向的窗体发送一个在uCallBackMessage中定义的消息名，然后你在程序中定义一个消息出来函数来处理这个消息。这样就把Windows关于消息的整套流程都处理好了。
6> hIcon为托盘图标的句柄，根据这个句柄你就可以增加、修改、删除图标。
7> szTip就是当你的鼠标放到任务栏托盘的小图标上的时候弹出来的提示信息。
在这里我花了大量的笔墨介绍TNotifyIconData的内幕，把这部分搞清楚了，后面的东西就顺理成章了。
三．双击主窗体，进入FormCreate的代码区域：
TForm1.FormCreate(Sender:TObject);
Begin
//NotifyIcon为全局变量，在程序的开头已经定义了
with NotifyIcon do
begin
cbSize:=SizeOf(TNotifyIconData);
Wnd:=Handle; //指向当前窗体Form1的句柄
uID:=1;
uFlags:=NIM_ICON or NIM_MESSAGE or NIM_TIP;
uCallBackMessage:=WM_NID;
hIcon:=Application.Icon.Handle;
szTip:=”张家恶少”；
end;.
//把设置好的变量NotifyIcon加入到系统中以便处理
Shell_NotifyIcon(NIM_ADD,@NotifyIcon);
End;
四．接下来就是定义一个消息处理函数：系统给窗体发来了一个消息，就由下面这个函数来处理。每个消息处理函数都是处理某一类消息的，大家仔细地看看下面函数体的定义和一般的函数定义有什么不一样：消息处理函数要在后面加上消息的名称，这样当系统发来WM_NID消息时，就是自动触发WMNID消息处理函数。
procedure WMNID(var msg:TMessage);message WM_NID;
begin
case msg.LParam of
WM_LBUTTONUp; Form1.Visible:=not Form1.Visible;
WM_RBUTTONUP: ShowMessage(‘您点击的是右键’);
End;
End;
好了，一个最简单的程序诞生了，大家自己设置好自己喜欢的图标.
Project->Options,选中Application页面，在Icon项中加载自己喜欢的图标，这样程序运行时，在任务栏里显示的就是你喜欢的图标了。当你单击图标时，窗体Form1会在可见与不可见之间切换，也就是说单击一下显示，再单击一下又隐藏。当你右击图标的时候会弹出一条消息：“你点击的是右键”。
五．最后要记住在关闭应用程序的时候要释放掉建立的托盘程序，否则会占用系统资源。
TForm1.FormDestroy(Sender:TObject);
Begin
Shell_NotifyIcon(NIM_DELETE,@NotifyIcon);
End;
