写过托盘的朋友帮帮我!(200分)(200分)

  • 主题发起人 主题发起人 socket
  • 开始时间 开始时间
S

socket

Unregistered / Unconfirmed
GUEST, unregistred user!
想让自己的程序有个性,需要为程序写一个托盘,不知道如何写
给位帮帮小弟
 
什么叫“为程序写一个托盘”?
http://delphi.mychangshu.com/dispdoc.asp?id=540
 
用RX控件
 
用全文检索搜索一下,以前讨论过n次了
 
象WINDOWS里的“开始”那个菜单
 
Faint,是这个意思。搜一下已答问题,这个问题以前肯定讨论过。
 
ahm我有 我现在想自己写,搜了一下,没有啥,给位继续呀
 
到 http://www.playicq.com/
看看
或许有你需要的
 
[red][/red]哥们儿:希望下面的东东对你有帮助

  1:向系统托盘中加入图标控制菜单:

  向系统托盘中加入图标控制菜单须用到函数Shell_NotifyIconA,而这个函数又有两个参数:'TnotifyIconDataA'结构的参数和一个消息参数即:Shell_NotifyIconA(dwMessage:DWORD;lpData:PNotifyIconDataA),第一个参数dwMessage可以是以下值:NIM_ADD:增加一个图标 ;NIM_MODIFY:修改一个已有的图标 ;NIM_DELETE:删除一个已有的图标 ;

  第二个参数的TnotifyIconDataA结构如下:

TnotifyIconDataA=record

cbSize:DWORD; {表示该结构的长度}

Wnd:HWND; {是调用Shell_NotifyIconA函数的窗口的句柄即Handle}

iID:UINT; {是在下面的uCallbackMessage参数指定的消息中使用的一个自定义数值}

uFlags:UINT; {决定该结构中的有效部分,如有NIF_MESSAGE则 uCallbackMessage参数有 效 ;若有NIF_ICON 则hIcon有效;有 NIF_TIP则 szTip参数有效,当然你可 以让这三个参数都有效只须要在这个参数中写成NIF_MESSAGE+NIF_ICON+NIF_TIP即可}

uCallbackMessage:UNIT; {当添加的图标上有鼠标事件如右击等等时系统向Wnd参数所指定的窗口发 送消息,这个消息的Msg参数是uCallbackMessage,这个消息的wParam参数是 uID,这个消息的lParam参数是鼠标事件的 Msg值}

Icon:HICON; {是出现在系统托盘中的图标的句柄即handle}

szTip:array[0..63] of AnsiChar; {即delphi是常用的hint即当鼠标停留在托盘图标上时的提示,例如你可用 ‘这是我的第一个托盘图标菜单’}

end;
 
我还是想问托盘的菜单如何写,实在是写不出来了!
 
菜单好办呀!!
在你的程序里访一个popmenu,然后就等着托盘图标来的消息就行了,比如传来单击消息就
popmenu.pop(x,y..)
good luck![:)]
其实这个自己写一遍后就没有什么神秘的了.写过一次后我更喜欢用rxlib的控件,方便,再说我也明白原理了[:)]
 
这个我当然知道,我要的是象任务栏‘开始’那样的,
RXLIB里有吗?哪个,我是RXD6
 
给你一个托盘控件的源代码,使用它published里的属性和方法就可以了

unit TrayNotifyIcon;

interface

uses Windows, SysUtils, Messages, ShellAPI, Classes, Graphics, Forms, Menus, StdCtrls, ExtCtrls;

type
EnotifyIconError = class(Exception);

TTrayNotifyIcon = class(TComponent)
private
FDefaultIcon: THandle;
FIcon: TIcon;
FHideTask: Boolean;
FHint: string;
FIconVisible: Boolean;
FPopupMenu: TPopupMenu;
FOnClick: TNotifyEvent;
FOnDblClick: TNotifyEvent;
FOnShowClick: Boolean;
FTimer: TTimer;
Tnd: TNotifyIconData;
procedure SetIcon(Value: TIcon);
procedure SetHideTask(Value: Boolean);
procedure SetHint(Value: string);
procedure SetIconVisible(Value: Boolean);
procedure SetPopupMenu(Value: TPopupMenu);
procedure SendTrayMessage(Msg:DWORD; Flags: UINT);
function ActiveIconHandle: THandle;
procedure OnButtonTimer(Sender: TObject);
protected
procedure Loaded; override;
procedure LoadDefaultIcon; virtual;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Icon: TIcon read FIcon write SetIcon;
property HideTask: Boolean read FHideTask write SetHideTask default False;
property Hint: String read FHint write SetHint;
property IconVisible: boolean read FIconVisible write SetIconVisible default False;
property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
property OnClick: TNOtifyEvent read FOnClick write FOnClick;
property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Cooton', [TTrayNotifyIcon]);
end;

type
TIconManager = Class
private
FHWindow: HWnd;
procedure TrayWndProc(var Message: TMessage);
public
constructor Create;
destructor Destroy; override;
property HWindow: HWnd read FHWindow write FHWindow;
end;

var
IconMgr: TIconManager;
DDGM_TRAYICON: integer;

constructor TIconManager.Create;
begin
FHWindow := AllocateHWnd(TrayWndProc);
end;

destructor TIconManager.Destroy;
begin
if FHWindow <> 0 then DeallocateHWnd(FHWindow);
inherited Destroy;
end;

procedure TIconManager.TrayWndProc(var Message: TMessage);
var
Pt: TPoint;
TheIcon: TTrayNotifyIcon;
begin
with Message do
begin
if (Msg = DDGM_TRAYICON) then
begin
TheIcon := TTrayNotifyIcon(WParam);
case lParam of
WM_LBUTTONDOWN: TheIcon.FTimer.Enabled := True;
WM_LBUTTONDBLCLK:
begin
TheIcon.FOnShowClick := True;
if Assigned(TheIcon.FOnDblClick) then TheIcon.FOnDblClick(self);
end;
WM_RBUTTONDOWN:
begin
if Assigned(TheIcon.FPopupMenu) then
begin
SetForegroundWindow(IconMgr.HWindow);
GetCursorPos(Pt);
TheIcon.FPopupMenu.Popup(Pt.X, Pt.Y);
PostMessage(IconMgr.HWindow, WM_USER, 0, 0);
end;
end;
end;
end
else
Result := DefWindowProc(FHWindow, Msg, wParam, lParam);
end;
end;

constructor TTrayNotifyIcon.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FIcon := TIcon.Create;
FTimer := TTimer.Create(self);
with FTimer do
begin
Enabled := false;
Interval := GetDoubleClickTime;
OnTimer := OnButtonTimer;
end;
LoadDefaultIcon;
end;

destructor TTrayNotifyIcon.Destroy;
begin
if FIconVisible then SetIconVisible(false);
FIcon.Free;
FTimer.Free;
inherited Destroy;
end;

function TTrayNotifyIcon.ActiveIconHandle: THandle;
begin
if (FIcon.Handle <> 0) then
Result := FIcon.Handle
else
Result := FDefaultIcon;
end;

procedure TTrayNotifyIcon.LoadDefaultIcon;
begin
FDefaultIcon := LoadIcon(0, IDI_WINLOGO);
end;

procedure TTrayNotifyIcon.Loaded;
begin
if FIconVisible then
SendTrayMessage(NIM_ADD, NIF_MESSAGE or NIF_ICON or NIF_TIP);
end;

procedure TTrayNotifyIcon.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = PopupMenu) then
PopupMenu := nil;
end;

procedure TTrayNotifyIcon.OnButtonTimer(Sender: TObject);
begin
FTimer.Enabled := False;
if (not FOnShowClick) and (Assigned(FOnClick)) then
FOnClick(self);
FOnShowClick := false;
end;

procedure TTrayNotifyIcon.SendTrayMessage(Msg: DWORD; Flags: UINT);
begin
with Tnd do
begin
cbSize := SizeOf(Tnd);
StrPLCopy(szTip, PChar(FHint), SizeOF(szTip));
uFlags := Flags;
uID := UINT(self);
Wnd := IconMgr.HWindow;
uCallbackmessage := DDGM_TRAYICON;
hIcon := ActiveIconHandle;
end;
Shell_NotifyIcon(Msg, @Tnd);
end;

procedure TTrayNotifyIcon.SetHideTask(Value: boolean);
const
ShowArray: array[boolean] of integer = (sw_ShowNormal, sw_Hide);
begin
if FHideTask <> Value then
begin
FHideTask := Value;
if not (csDesigning in ComponentState) then
ShowWindow(Application.Handle, ShowArray[FHideTask]);
end;
end;

procedure TTrayNotifyIcon.SetHint(Value: string);
begin
if FHint <> Value then
begin
FHint := Value;
if FIconVisible then
SendTraymessage(NIM_MODIFY, NIF_TIP);
end;
end;

procedure TTrayNotifyIcon.SetIcon(Value: TIcon);
begin
if FIconVisible then SendTrayMessage(NIM_MODIFY, NIF_ICON);
end;

procedure TTrayNotifyIcon.SetIconVisible(Value: boolean);
const
MsgArray: array[boolean] of DWORD = (NIM_DELETE, NIM_ADD);
begin
if FIconVisible <> Value then
begin
FIconVisible := Value;
SendTrayMessage(MsgArray[Value], NIF_Message or NIF_ICON or NIF_TIP);
end;
end;

procedure TTrayNotifyIcon.SetPopupMenu(Value: TPopupMenu);
begin
FPopupMenu := Value;
if Value <> nil then Value.FreeNotification(self);
end;

const
TrayMsgStr = 'DDG.TrayNotifyIconMsg';

initialization
DDGM_TRAYICON := RegisterWindowMessage(TrayMsgStr);
IconMgr := TIconManager.Create;
finalization
IconMgr.Free;


end.
 
为什么不用控件呢?
 
确实是用控件好,因为写了以后我也觉得没劲!!没意思!!
你说的像开始菜单,是不是要画一个竖条的??
那个更没劲,还不如直接用xpmunu好看.
 
呵呵,学习
 
我有个自己写的托盘源程序,功能简单的很,就设了几个showmessage的菜单,要的话,留下邮箱,发给你。
 
CoolTrayIcon google
 
后退
顶部