前段时间因为要在原来的软件上增加一个快捷键提示窗体，这个提示窗要求在显示的时候比较醒目美观能引起用户注意，显示后不影响用户操作，能够关掉。很自然的就想到了Messenger那个从屏幕右下角逐渐弹出的消息提示窗体，不过相对Messenger我更喜欢QQ2004奥运版的配色风格，反正都是偷就多偷点吧，下面快捷键提示窗的最终效果：
这个窗体有以下几个特点：
1、显示的时候是从屏幕右下角逐渐弹出的；
2、它是个无标题窗体，但它必须允许用户移动和改变大小，因此要用到无标题窗体拖动、改变大小的技术；
3、它是个不规则的窗体，主要是左上角和右上角是圆形导角，因此要为窗体创建外形，且窗体改变大小时必须重建；
4、它标题和内容显示区都有渐层色，标题还有几个小点点，在实现时使用取巧的方法，直接利用截图进行填充。
当然界面可以偷，代码就得老老实实的写的了，下面是界面设计图和实现代码
unit formPSHotKey;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Buttons;
{========================================================================
DESIGN BY : 彭国辉
DATE: 2004-10-28
SITE: http://kacarton.yeah.net/
BLOG: http://blog.csdn.net/nhconch
EMAIL: kacarton@sohu.com
文章为作者原创，转载前请先与本人联系，转载请注明文章出处、保留作者信息，谢谢支持！
=========================================================================}
type
TfrmPSHotKey = class(TForm)
imgTitleBar: TImage;
imgTitleBarBG: TImage;
imgShapeBG: TImage;
SpeedButton1: TSpeedButton;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
Label11: TLabel;
Label12: TLabel;
Label13: TLabel;
procedure FormPaint(Sender: TObject);
procedure imgTitleBarMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure Label11MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormResize(Sender: TObject);
procedure Label12MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Label13MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure imgTitleBarMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Label11MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmPSHotKey: TfrmPSHotKey;
implementation
{$R *.dfm}
procedure TfrmPSHotKey.FormCreate(Sender: TObject);
begin
Tag := Height;
Height := 16;
//定位到屏幕右下角
Top := Screen.Height - 40;
Left := Screen.Width - Width - 2;
Show;
//从屏幕右下角逐渐弹出
while Height<Tag do begin
Height := Height + 5;
Top := Top - 5;
Update;
Application.ProcessMessages;
Sleep(10);
end;
Height := Tag;
Tag := 0;
Color := $F4BA9D;
FormResize(Sender);
end;
procedure TfrmPSHotKey.FormPaint(Sender: TObject);
var
i: integer;
rgn: HRGN;
r: TRect;
begin
with Canvas do begin
//利用imgTitleBarBG绘制标题背景
for i:=0 to ClientWidth div imgTitleBarBG.Width do
Draw(i*imgTitleBarBG.Width, 0, imgTitleBarBG.Picture.Bitmap);
if Tag<>0 then Exit; //如果窗体正在弹出状态，不绘制内容面板背景
//绘制内容面板背景
SetRect(r, 5, 15, Width-5, Height-5);
StretchDraw(r, imgShapeBG.Picture.Bitmap);
Pen.Color := $C97F55;
Brush.Style := bsClear;
RoundRect(r.Left, r.Top, r.Right, r.Bottom, 6, 6);
//绘制窗体边框
rgn := CreateRectRgn(0,0,0,0);
GetWindowRgn(Self.Handle, rgn);
Brush.Color := $BE796B;
windows.FrameRgn(Handle, rgn, Brush.Handle, 2, 2);
DeleteObject(rgn);
end;
end;
procedure TfrmPSHotKey.imgTitleBarMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
//在标题按下鼠标键时，允许移动窗体或改变窗体大小
ReleaseCapture;
if X < 5 then Perform(WM_SYSCOMMAND, $F004, 0)
else if X > Width - 5 then Perform(WM_SYSCOMMAND, $F005, 0)
else if Y < 3 then Perform(WM_SYSCOMMAND, $F003, 0)
else Perform(WM_SYSCOMMAND, $F012, 0);
end;
procedure TfrmPSHotKey.FormResize(Sender: TObject);
var
rgn, rgn2: HRGN;
begin
if Tag<>0 then Exit;
//窗体改变大小时重建Rgn
rgn := CreateRoundRectRgn(0, 0, Width+1, Height, 4, 4);
rgn2 := CreateRectRgn(0, 11, Width, Height);
CombineRgn(rgn, rgn, rgn2, RGN_OR);
SetWindowRgn(Handle, rgn, True);
DeleteObject(rgn);
DeleteObject(rgn2);
Invalidate;
end;
procedure TfrmPSHotKey.SpeedButton1Click(Sender: TObject);
begin
Close;
end;
//以下几个Label用来改变窗体大小
procedure TfrmPSHotKey.Label11MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
if X < 5 then Perform(WM_SYSCOMMAND, $F007, 0)
else if X > Width - 5 then Perform(WM_SYSCOMMAND, $F008, 0)
else Perform(WM_SYSCOMMAND, $F006, 0);
end;
procedure TfrmPSHotKey.Label12MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
Perform(WM_SYSCOMMAND, $F001, 0);
end;
procedure TfrmPSHotKey.Label13MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
Perform(WM_SYSCOMMAND, $F002, 0);
end;
//下面代码判断鼠标所在位置，并改变鼠标光标，提示用户可以拖动窗体或改变大小
procedure TfrmPSHotKey.imgTitleBarMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
if X < 5 then imgTitleBar.Cursor := crSizeNWSE
else if X > Width - 5 then imgTitleBar.Cursor := crSizeNESW
else if Y < 3 then imgTitleBar.Cursor := crSizeNS
else imgTitleBar.Cursor := crSizeAll;
end;
procedure TfrmPSHotKey.Label11MouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
if X < 5 then Label11.Cursor := crSizeNESW
else if X > Width - 5 then Label11.Cursor := crSizeNWSE
else Label11.Cursor := crSizeNS;
end;
end.
=================================================================================
如何写托盘程序
什么叫做托盘区？
答：
托盘区就是在windows的状态栏下方显示时钟、输入法状态的地方，
要把你的程序显示在托盘区：
下面是一个托盘类，只要把下面粘贴到文本文件中，改成TrayIcon.pas，使用时uses TrayIcon就可以了。
先声明一个全局变量：
var tray:TTrayNotifyIcon;
然后在窗体的OnCreate事件中：
tray:=TTrayNotifyIcon.Create(self);//将窗体创建为托盘
tray.Icon:=application.Icon;//定义托盘的显示图标
tray.IconVisible:=true;//托盘可见
tray.PopupMenu:=popmenu;//给托盘定义一个右击时的弹出菜单
tray.OnDblClick:=trayDblClick;//给托盘定义一个双击事件(当然要自己写了，不过多数情况只有一行，就是Form1.show);
unit TrayIcon;
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;
FNoShowClick: 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;
implementation
{ TIconManager }
{ This class creates a hidden window which handles and routes }
{ tray icon messages }
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: Cardinal;
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);
{ This allows us to handle all tray callback messages }
{ from within the context of the component. }
var
Pt: TPoint;
TheIcon: TTrayNotifyIcon;
begin
with Message do
begin
{ if it’s the tray callback message }
if (Msg = DDGM_TRAYICON) then
begin
TheIcon := TTrayNotifyIcon(WParam);
case lParam of
{ enable timer on first mouse down. }
{ OnClick will be fired by OnTimer method, provided }
{ double click has not occurred. }
WM_LBUTTONDOWN: TheIcon.FTimer.Enabled := True;
{ Set no click flag on double click. This will supress }
{ the single click. }
WM_LBUTTONDBLCLK:
begin
TheIcon.FNoShowClick := True;
if Assigned(TheIcon.FOnDblClick) then TheIcon.FOnDblClick(Self);
end;
WM_RBUTTONDOWN:
begin
if Assigned(TheIcon.FPopupMenu) then
begin
{ Call to SetForegroundWindow is required by API }
SetForegroundWindow(IconMgr.HWindow);
{ Popup local menu at the cursor position. }
GetCursorPos(Pt);
TheIcon.FPopupMenu.Popup(Pt.X, Pt.Y);
{ Message post required by API to force task switch }
PostMessage(IconMgr.HWindow, WM_USER, 0, 0);
end;
end;
end;
end
else
{ If it isn’t a tray callback message, then call DefWindowProc }
Result := DefWindowProc(FHWindow, Msg, wParam, lParam);
end;
end;
{ TTrayNotifyIcon }
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;
{ Keep default windows icon handy... }
LoadDefaultIcon;
end;
destructor TTrayNotifyIcon.Destroy;
begin
if FIconVisible then SetIconVisible(False); // destroy icon
FIcon.Free; // free stuff
FTimer.Free;
inherited Destroy;
end;
function TTrayNotifyIcon.ActiveIconHandle: THandle;
{ Returns handle of active icon }
begin
{ If no icon is loaded, then return default icon }
if (FIcon.Handle <> 0) then
Result := FIcon.Handle
else
Result := FDefaultIcon;
end;
procedure TTrayNotifyIcon.LoadDefaultIcon;
{ Loads default window icon to keep it handy. }
{ This will allow the component to use the windows logo }
{ icon as the default when no icon is selected in the }
{ Icon property. }
begin
FDefaultIcon := LoadIcon(0, IDI_WINLOGO);
end;
procedure TTrayNotifyIcon.Loaded;
{ Called after component is loaded from stream }
begin
inherited Loaded;
{ if icon is supposed to be visible, create it. }
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);
{ Timer used to keep track of time between two clicks of a }
{ double click. This delays the first click long enough to }
{ ensure that a double click hasn’t occurred. The whole }
{ point of these gymnastics is to allow the component to }
{ receive OnClicks and OnDblClicks independently. }
begin
{ Disable timer because we only want it to fire once. }
FTimer.Enabled := False;
{ if double click has not occurred, then fire single click. }
if (not FNoShowClick) and Assigned(FOnClick) then
FOnClick(Self);
FNoShowClick := False; // reset flag
end;
procedure TTrayNotifyIcon.SendTrayMessage(Msg: DWORD; Flags: UINT);
{ This method wraps up the call to the API’s Shell_NotifyIcon }
begin
{ Fill up record with appropriate values }
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);
{ Write method for HideTask property }
const
{ Flags to show application normally or hide it }
ShowArray: array[Boolean] of integer = (sw_ShowNormal, sw_Hide);
begin
if FHideTask <> Value then
begin
FHideTask := Value;
{ Don’t do anything in design mode }
if not (csDesigning in ComponentState) then
ShowWindow(Application.Handle, ShowArray[FHideTask]);
end;
end;
procedure TTrayNotifyIcon.SetHint(Value: string);
{ Set method for Hint property }
begin
if FHint <> Value then
begin
FHint := Value;
if FIconVisible then
{ Change hint on icon on tray notification area }
SendTrayMessage(NIM_MODIFY, NIF_TIP);
end;
end;
procedure TTrayNotifyIcon.SetIcon(Value: TIcon);
{ Write method for Icon property. }
begin
FIcon.Assign(Value); // set new icon
{ Change icon on notification tray }
if FIconVisible then SendTrayMessage(NIM_MODIFY, NIF_ICON);
end;
procedure TTrayNotifyIcon.SetIconVisible(Value: Boolean);
{ Write method for IconVisible property }
const
{ Flags to add or delete a tray notification icon }
MsgArray: array[Boolean] of DWORD = (NIM_DELETE, NIM_ADD);
begin
if FIconVisible <> Value then
begin
FIconVisible := Value;
{ Set icon as appropriate }
SendTrayMessage(MsgArray[Value], NIF_MESSAGE or NIF_ICON or NIF_TIP);
end;
end;
procedure TTrayNotifyIcon.SetPopupMenu(Value: TPopupMenu);
{ Write method for PopupMenu property }
begin
FPopupMenu := Value;
if Value <> nil then Value.FreeNotification(Self);
end;
const
{ String to identify registered window message }
TrayMsgStr = ’DDG.TrayNotifyIconMsg’;
initialization
{ Get a unique windows message ID for tray callback }
DDGM_TRAYICON := RegisterWindowMessage(TrayMsgStr);
IconMgr := TIconManager.Create;
finalization
IconMgr.Free;
end.
KeyLife富翁笔记
作者: findwo
标题: 组件制作之五（托盘组件） 选择自 mailyxg 的 Blog
关键字: 组件制作之五（托盘组件） 选择自 mailyxg 的 Blog
分类: 个人专区
密级: 公开
(评分: , 回复: 0, 阅读: 168) »»
这将是最后一个组件了,目标定为非可视化,事实上非可视化组件要比可视化组件难做,因为是从TComponent继承而来,就没有了很多属性和事件。而这些都要我们从头来做过。
这个非可视化榧揖龆ㄎ信套榧渲杏玫降募际踅隙啵也蝗缌幸桓霰沓隼矗缓笤倮唇步夂靡坏恪Ａ硗猓赡芷岫嘁恍肽托目础?
用到的技术：
1作为核心功能，当然是托盘的应用啦。
2?托盘组件怎么样影响到主窗口最小化时隐藏
3?托盘如何处理消息
4?组件编辑器的用法
上面每一个技术都非常有趣，让我们一个个来看吧：
?
一??托盘，是系统壳编程的一个功能，相信我们也看过很多啦，大概知道它用起来是什么样子的。
那么它是如何实现的呢，
Windows定义了这样一个结构来存放托盘的信息：
typedef?struct?_NOTIFYICONDATA?{?//?nid??
DWORD?cbSize;
????HWND?hWnd;?
????UINT?uID;?
????UINT?uFlags;?
????UINT?uCallbackMessage;?
????HICON?hIcon;?
????char?szTip[64];?
}?NOTIFYICONDATA,?*PNOTIFYICONDATA;
cbSize是NOTIFYICONDATA结构的尺寸，我们一般用Sizeof就可以了
hWnd一个窗口句柄，用于检索托盘消息的。然而我们的非可视组件并没有窗口呀，这就是技术列表第三条要讲的，这里从略
uID?唯?一标识托盘图标的，我们可以随便指定一个数，但如果同时有不同的图标，则数应该不同
uFlags是NIF_ICON，NIF_MESSAGE，NIF_TIP中的一个或多个，我们全用就可以了。
uCallbackMessage;托盘消息，是我们自定义的消息，这里我们定义为：
????????????????const
??????????????????WM_TrayMsg=WM_USER+10;
hIcon托盘图标句柄
szTip这个是托盘提示，当托盘出现时，鼠标移到哪里，就会出现该提示。
Delphi将这个结构重定义为TNotifyIconData，我们照这个来用就行了
?
我们应用托盘要用到API函数Shell_NotifyIcon，其中有两个参数，第一个为
NIM_ADD，NIM_DELETE??，NIM_MODIFY中的一个，分别表示添加托盘（图标出现）
修改托盘（比如图标，提示），删除（图标消失）第二个参数是NOTIFYICONDATA的指针
嗯，托盘应该差不多了。
?
二?这个组件能够决定主窗体最小化时，是否是正常最小化并没有托盘图标。还是最小化到屏幕之外，使我们看不见，且托盘区出现了图标。这里有一个成员为FActive来决定。
那么我们是怎么样影响到主窗体呢，也即怎么截获窗体的最小化消息呢。
全局变量Application有一个方法为procedure?HookMainWindow(Hook:?TWindowHook);
顾名思义，就是钩到主窗口的所有消息。里面的参数是TWindowHook类型，它是一个方法指针，定义如下：
type?TWindowHook?=?function(var?Message:?TMessage):?Boolean?of?object;
我们要自己定义过程的，然后传给HookMainWindow：
function?AppMsgHook(var?Msg:TMessage):Boolean;
Application.HookMainWindow(AppMsgHook);
这样做之后，主窗口的所有消息都会经过AppMsgHook方法啦，最小化消息也不例外，则我们可以在里面截获这个消息，并做一些操作：
?
做什么操作呢，先判断组件是否为设计时，如果是，不进行操作，如果不是进行下一步
if?not?(csDesigning?in?ComponentState)?then
这样的意图是很明显的，因为当设计时的主窗其实是Delphi的IDE，如果让他处理该消息，其实是处理IDE的最小化消息，这时如果你最小化IDE，就会出现托盘啦。所以不能。
?
下一步是是否截获了最小化消息，以及FActive是否为真：
if?(Msg.Msg=WM_SYSCOMMAND)?and(FActive)?then
两样都成立，执行里面的代码，代码中有解释，这里只说两个：
SetWindowLong(Application.Handle,GWL_EXSTYLE?,WS_EX_TOOLWINDOW);
设置了这个属性后,窗口最小化就不会停在任务栏了,而是停在屏幕的某个位置，这个位置在哪里呢，由
placement.flags:=WPF_SETMINPOSITION;
?????placement.ptMinPosition.x:=1050;
?????placement.ptMinPosition.y:=800;
?????SetWindowPlacement(Application.Handle,@placement);
决定，具体的看代码，自己查帮助吧，这里不多说
?
而上说的设置SetWindowLong后，问题来了，窗口最小化的风格一变了，当你把Factive设为False，再最小化窗口，此时是没有托盘图标，但窗口还是最小化到屏幕的那个位置去了，我们看不到，又不能使其恢复（没有托盘）。怎么办呢，
原来还有一个GetWindowLong函数会返回当前风格的值，我们可以在控件的构造函数中这样调用
OldStyleEX:=GetWindowLong(Application.Handle,GWL_EXSTYLE);
这时，OldStyleEX:就保存了窗口原来最小化的风格了，窗口最小化，调用SetWindowLong，设置了新的最小风格。而当我们触发托盘事件，使窗体恢复大小时，我们在处理函数中调用
SetWindowLong(Application.Handle,GWL_EXSTYLE?,OldStyleEX);
这样，窗口又回到了原来的风格，这时我们设Factive为False，则窗口就能正常最小化了。
?
到控件被释放时，我们一定要调用Application.UnhookMainWindow(AppMsgHook);来解除钩子
?
其实这里也有一个不完善的地方，应该再设一个成员变量，确定设置托盘时，窗口是正常最小化，还是最小化到看不见。而我没有这么做，直接如果FActive为True，最小化会出现托盘图标，并且窗口最小化到看不见。不过影响不大，有兴趣的朋友看了之后可以帮我完善一下，也当做自己的练习吗。
?
三?托盘如果处理消息，上面说到，要设置托盘结构，一定要有一个窗口句柄，才能检索托盘消息，那么这个句柄是什么呢，非可视组件没有窗口句柄呀。
?
如果你有看过TTimer的源码，一定知道这一句代码：
FWindowHandle?:=?AllocateHWnd(WndProc);
它创建一个看不见的窗口，返回他的句柄，并指定WndProc为窗口的消息处理过程
我们何不效仿它呢。
于是也定义一个成员句柄：
FHandle:?HWnd;
把该句柄赋给NOTIFYICONDATA的hWnd字段
再定义一个消息处理过程：
procedure?WndProc(var?Msg:?TMessage);
再在组件构造函数中：
FHandle?:=?AllocateHWnd(WndProc);
如此之后，组件就可以截获托盘的消息了，并在WndProc过程中作相应处理。这里有必要对托盘的自定义消息做一个介绍：
我们自定义了这个消息WM_TrayMsg，它的lParam与托盘的uID相同，wParam是鼠标在图标上发生的事件消息，比如单击，双击等。
我们就要把这些消息转化为事件，供给用户处理，所以定义几个事件调度函数：
//以下为事件的调度函数
????procedure?DblClick;?dynamic;
????procedure?Click;?dynamic;
????procedure?MouseDown(Button:?TMouseButton;?Shift:?TShiftState;?X,?Y:?Integer);?dynamic;
????procedure?MouseUp(Button:?TMouseButton;?Shift:?TShiftState;?X,?Y:?Integer);?dynamic;
procedure?MouseMove(Shift:?TShiftState;?X,?Y:?Integer);?dynamic;
意思很明显，不多说，
当然也有几个事件方法指针：
FOnIconClick:?TNotifyEvent;
FOnIconDblClick:?TNotifyEvent;
FOnIconMouseMove:?TMouseMoveEvent;
FOnIconMouseDown:?TMouseEvent;
FOnIconMouseUp:?TMouseEvent;
然后在WndProc中判断消息，并调用相应的事件调度函数。看代码吧，有解释。
?
好了，三个技术解决了，第四个呢，还是等代码出来以后再加组件编辑器吧。以下是源代码：
?
unit?MyTray;
?
interface
?
uses
??Windows,?Messages,?SysUtils,?Classes,?Graphics,?Controls,
??Forms,?Dialogs,?ShellApi,?ExtCtrls,StdCtrls;
?
const
//自定义托盘消息
???WM_TrayMsg=WM_USER+10;
?
type
?//恢复窗口的方式，左双击，右双击，左单击，右双击
??TRMode=(LDbClick,RDbClick,LCLick,RClick);
?
??TMyTray=class(TComponent)
??private
??//私有成员
????FIcon:TIcon;???//图标
????FDfIcon:THandle;?//应用程序的默认图标
????FSetDfIcon:Boolean;?//是否用应用程序的图标，如果为True，则Ficon为nil
????FIconData:?TNotifyIconData;??//托盘数据结构
????isMin:Boolean;//标识是否窗口最小化了
????FHandle:?HWnd;??//不可视建窗体句柄,用于处理托盘事件
????FActive:?Boolean;??//是否启用托盘
????FHint:?string;??//托盘提示字符串
????FRMode:TRMode;?//恢复窗口的方式
????isClickIn:Boolean;//标识鼠标是否点在图标上
????OldStyleEX:longInt;?//保存老的窗口风格
??//事件成员
????FOnIconClick:?TNotifyEvent;
????FOnIconDblClick:?TNotifyEvent;
????FOnIconMouseMove:?TMouseMoveEvent;
????FOnIconMouseDown:?TMouseEvent;
????FOnIconMouseUp:?TMouseEvent;
??//设置方法
????procedure?SetIcon(value:TIcon);
????procedure?SetDfIcon(value:boolean);
????procedure?SetActive(value:boolean);
????procedure?SetHint(value:string);
????procedure?SetRMode(value:TRMode);
??//私有方法
????procedure?SetTray(Way:DWORD);??//设置托盘样式,修改,删除,增加
????function?GetActiveIcon:THandle;?//取得有用的图标句柄
??protected
????//应用程序的消息钩子，获得主窗口的最小化消息
????function?AppMsgHook(var?Msg:TMessage):Boolean;
????procedure?WndProc(var?Msg:?TMessage);//不可视窗口的窗口过程
????//以下为事件的调度函数
????procedure?DblClick;?dynamic;
????procedure?Click;?dynamic;
????procedure?MouseDown(Button:?TMouseButton;?Shift:?TShiftState;?X,?Y:?Integer);?dynamic;
????procedure?MouseUp(Button:?TMouseButton;?Shift:?TShiftState;?X,?Y:?Integer);?dynamic;
????procedure?MouseMove(Shift:?TShiftState;?X,?Y:?Integer);?dynamic;
??public
?????constructor?Create(AOwner:TComponent);override;
?????destructor??Destroy;override;
??published
?????property?Active:Boolean?read?FActive?write?SetActive?default?False;
?????property?Icon:TIcon?read?FIcon?write?SetICon;
?????property?SetDfIconed:?boolean?read?FSetDfIcon?write?SetDfIcon?default?true;
?????property?Hint:String?read?FHint?write?SetHint;
?????property?RMode:TRmode?read?FRmode?write?SetRMode?default?LDbClick;
??//事件的方法指针
?????property?OnIconClick:?TNotifyEvent?read?FOnIconClick?write?FOnIconClick;
?????property?OnIconDblClick:?TNotifyEvent?read?FOnIconDblClick?write?FOnIconDblClick;
?????property?OnIconMouseMove:?TMouseMoveEvent?read?FOnIconMouseMove?write?FOnIconMouseMove;
?????property?OnIconMouseDown:?TMouseEvent?read?FOnIconMouseDown?write?FOnIconMouseDown;
?????property?OnIconMouseUp:?TMouseEvent?read?FOnIconMouseUp?write?FOnIconMouseUp;
??end;
?
procedure?Register;
?
implementation
?
procedure?Register;
begin
??RegisterComponents('Wind',?[TMyTray]);
end;
?
///////////TmyTray////////////////////////////
constructor?TMyTray.Create(AOwner:TComponent);
begin
??inherited?Create(AOwner);
??//设置程序钩子,指定AppMsgHook为处理函数,
??//则,应用程序的任何消息都将经过这个函数
???Application.HookMainWindow(AppMsgHook);
???FICon:=TICon.Create;
???//得到默认图标的句柄，图标为应用程序的图标
???FDfIcon:=Application.Icon.Handle;
???FSetDfIcon:=True;
???FActive:=False;
???FRMode:=LDbClick;
???isMin:=False;
??//创建一个不可视窗口，并指定窗口过程，以处理托盘事件
????FHandle?:=?AllocateHWnd(WndProc);
??//保存窗体的老的风格,在恢复窗口的同时也恢复原来的窗口风格
????OldStyleEX:=GetWindowLong(Application.Handle,GWL_EXSTYLE);
end;
?
destructor?TMyTray.Destroy;
begin
??Application.UnhookMainWindow(AppMsgHook);
??//对象释放之前先消除托盘
????SetTray(NIM_DELETE);
??//释放不可能窗口的句柄
??DeallocateHWnd(FHandle);
??FICon.Free;
??inherited?Destroy;
end;
//应用程序钩子,可以截获应用程序的所有消息
function?TMyTray.AppMsgHook(var?Msg:TMessage):Boolean;
var?placement:WINDOWPLACEMENT;
begin
?Result:=False;
?//保证程序不会在设计时处理最小化消息
?if?not?(csDesigning?in?ComponentState)?then
?if?(Msg.Msg=WM_SYSCOMMAND)?and(FActive)?then
?begin
???if?msg.WParam=SC_MINIMIZE?Then
????begin
????//设置了这个属性后,窗口最小化就不会停在任务栏了,而是停在屏幕,
????//位置由SetWindowPlacement来决定
?????ShowWindow(Application.Handle,SW_HIDE);
?????SetWindowLong(Application.Handle,GWL_EXSTYLE??????,WS_EX_TOOLWINDOW);
?????GetWindowPlacement(Application.Handle,@placement);
?????placement.flags:=WPF_SETMINPOSITION;
?????placement.ptMinPosition.x:=1050;
?????placement.ptMinPosition.y:=800;
?????SetWindowPlacement(Application.Handle,@placement);
?????SetTray(NIM_ADD?);
???end;
?end;
end;
?
procedure?TMyTray.SetIcon(Value:TIcon);
begin
???FIcon.Assign(Value);
???FsetDfIcon:=False;?//有了自定义的图标,则默认图标自动设为False
???if?FIcon.Empty?then
????FsetDfIcon:=True;
???if?(isMin)and(Factive)?then
?????SetTray(NIM_MODIFY?);
end;
//设置是否为默认图标,与FIcon为互相的变量,只能有其中一个
procedure?TMyTray.SetDfIcon(Value:Boolean);
begin
??if?FSetDfIcon<>Value?then
??begin
????FSetDfIcon:=Value;
????if?not?FSetDfIcon?then
????begin
??????if?FIcon.Empty?then?begin
????????FSetDfIcon:=True;
????????exit;
??????end;
????end
????else?begin
????????if?(IsMin)and(FActive)?then
?????????SetTray(NIM_MODIFY);
????end;
??end;
end;
?
procedure?TMyTray.SetActive(Value:Boolean);
begin
??if?FActive<>Value?then
??begin
????FActive:=Value;
??end;
end;
?
procedure?TMyTray.SetHint(Value:String);
begin
???if?FHint<>Value?then
???begin
?????FHInt:=Value;
?????if?(IsMin)and(FActive)?then
????????SetTray(NIM_MODIFY);
???end;
end;
?
procedure?TMyTray.SetRMode(Value:TRMode);
begin
??if?FRmode<>Value?then
????FRmode:=Value;
end;
//设置托盘方式,显示,修改,删掉,重要方法
procedure?TMyTray.SetTray(Way:DWORD);
begin
???FIconData.cbSize:=Sizeof(FIconData);
???FIconData.Wnd:=FHandle;
???FIConData.uID:=0;
???FIConData.uFlags:=NIF_ICON?or?NIF_MESSAGE?or?NIF_TIP;
???FIConData.uCallbackMessage:=WM_TrayMsg;
???FIConData.hIcon:=GetActiveIcon;
???StrLCopy(FIConData.szTip,Pchar(FHint),63);
???Shell_NotifyIcon(Way,@FIconData);
end;
//取得可用的图标
function?TMyTray.GetActiveIcon:THandle;
begin
???if?not?FSetDfIcon?then
?????result:=FIcon.Handle
???else
?????result:=FDfIcon;
end;
//托盘消息的截获,以调用相应的事件调度方法
procedure?TMyTray.WndProc(var?Msg:?TMessage);
var?p:TPoint;
begin
??if?(Msg.Msg=WM_TrayMsg)and(FActive)?then
??begin
????case?Msg.LParam?of
??????WM_LBUTTONDBLCLK://左双击
??????begin
????????GetCursorPos(p);
????????DblClick;
????????MouseDown(mbLeft,?KeysToShiftState(TWMMouse(Msg).Keys)+[ssDouble],?P.X,?P.Y);
????????if?FRmode=LDbclick?then
????????begin
??????????ShowWindow(Application.Handle,SW_SHOW);
??????????//这里很重要的一个就是恢复窗口风格,不然下次把Active设为True
??????????//最小化后,窗口依然会往左下角飞去,而托盘图标却看不见了.
??????????SetWindowLong(Application.Handle,GWL_EXSTYLE????,OldStyleEX);
??????????SendMessage(Application.Handle,WM_SYSCOMMAND,SC_RESTORE,0);
??????????SetTray(NIM_DELETE);
????????end;
??????end;
??????WM_RBUTTONDBLCLK://右双击
??????begin
????????GetCursorPos(P);
????????DblClick;
????????MouseDown(mbRight,?KeysToShiftState(TWMMouse(Msg).Keys)+[ssDouble],?P.X,?P.Y);
????????if?FRmode=RDbclick?then
????????begin
??????????ShowWindow(Application.Handle,SW_SHOW);
??????????SetWindowLong(Application.Handle,GWL_EXSTYLE????,OldStyleEX);
??????????SendMessage(Application.Handle,WM_SYSCOMMAND,SC_RESTORE,0);
??????????SetTray(NIM_DELETE?);
????????end;
??????end;
??????WM_MOUSEMOVE:?//鼠标移动
??????begin
????????GetCursorPos(P);
????????MouseMove(KeysToShiftState(TWMMouse(Msg).Keys),?P.X,?P.Y);
??????end;
??????WM_LBUTTONDOWN:?//左单击下
??????begin
????????GetCursorPos(P);
????????IsClickIn:=True;
????????MouseDown(mbLeft,?KeysToShiftState(TWMMouse(Msg).Keys)?+?[ssLeft],?P.X,?P.Y);
??????end;
??????WM_LBUTTONUP:??//左单击弹起
??????begin
????????GetCursorPos(P);
????????if?IsClickIn?then
????????begin
??????????IsClickIn:=False;
??????????Click;
??????????if?FRmode=LClick?then
??????????begin
????????????ShowWindow(Application.Handle,SW_SHOW);
????????????SetWindowLong(Application.Handle,GWL_EXSTYLE?,OldStyleEX);
????????????SendMessage(Application.Handle,WM_SYSCOMMAND,SC_RESTORE,0);
????????????SetTray(NIM_DELETE?);
??????????end;
????????end;
??????????MouseUp(mbLeft,?KeysToShiftState(TWMMouse(Msg).Keys)+?[ssLeft],?P.X,?P.Y);
??????end;
??????WM_RBUTTONDOWN:?//右单击下
??????begin
????????GetCursorPos(P);
????????IsClickIn:=True;
????????MouseDown(mbRight,?KeysToShiftState(TWMMouse(Msg).Keys)?+?[ssRight],?P.X,?P.Y);
??????end;
??????WM_RBUTTONUP:?//右单击弹起
??????begin
????????GetCursorPos(P);
????????if?IsClickIn?then
????????begin
??????????IsClickIn:=False;
??????????Click;
??????????if?FRmode=RClick?then
??????????begin
????????????ShowWindow(Application.Handle,SW_SHOW);
????????????SetWindowLong(Application.Handle,GWL_EXSTYLE?,OldStyleEX);
????????????SendMessage(Application.Handle,WM_SYSCOMMAND,SC_RESTORE,0);
????????????SetTray(NIM_DELETE?);
??????????end;
????????end;
????????MouseUp(mbRight,?KeysToShiftState(TWMMouse(Msg).Keys)+?[ssRight],?P.X,?P.Y);
???????end;
??????end;
??end
??else
?????Msg.Result?:=?DefWindowProc(FHandle,?Msg.Msg,?Msg.wParam,?Msg.lParam);
end;
//以下为几个事件的调度函数,比较简单.
procedure?TMyTray.DblClick;
begin
??if?Assigned(FOnIconDblClick)?then
????FOnIconDblClick(Self);
end;
?
procedure?TMyTray.Click;
begin
??if?Assigned(FOnIconClick)?then
????FOnIconClick(Self);
end;
?
procedure?TMyTray.MouseDown(Button:?TMouseButton;?Shift:?TShiftState;?X,?Y:?Integer);
begin
??if?Assigned(FOnIconMouseDown)?then
????FOnIconMouseDown(Self,?Button,?Shift,?X,?Y);
end;
?
procedure?TMyTray.MouseUp(Button:?TMouseButton;?Shift:?TShiftState;?X,?Y:?Integer);
begin
??if?Assigned(FOnIconMouseUp)?then
????FOnIconMouseUp(Self,?Button,?Shift,?X,?Y);
end;
?
procedure?TMyTray.MouseMove(Shift:?TShiftState;?X,?Y:?Integer);
begin
??if?Assigned(FOnIconMouseMove)?then
????FOnIconMouseMove(Self,?Shift,?X,?Y);
end;
?
end.
?
组制作完毕，相信经过上面的讲解，以及代码的注释，应该不难理解。接下来是什么呢，给我的托盘控件来点效果，即在设计器中，当双击该组件，或右击快捷菜单第一项时，会弹出一个About对话框，来说明我的托盘组件。
这个就要用到组件编辑器啦?。几本经典书中都有说及，比如Deplphi开发人员指南，我也是从那里学来的，不过却遇到了一些问题，折磨了几天才解决。
这里不想详细介绍，去看一下那些书，大概也就知道了，只略说一下。
其原理就是实现一个继承自TComponentEditor的子类TTrayIconEditor，并在其中覆盖以下三个方法：
function?GetVerbCount:?Integer;?override;
function?GetVerb(Index:?Integer):?string;?override;
procedure?ExecuteVerb(Index:?Integer);?override;
可以精略理解为：
GetVerbCount指定控件快捷菜单的项数
GetVerb指定快捷菜单中的相关项的名字
ExecuteVerb执行点击快捷菜单项后的动作
?
接着在Register方法中调用RegisterComponentEditor(TMyTray,TTrayIconEditor);
第一个参数为组件类名，第二个为组件编辑器的类名。
而上面的方法必须引用DesignIntf,DesignEditors。
?
当我在我的组件单元这样做之后出现问题了，编译安装没有问题。我建立测试程序，并拉一个托盘组件，双击它，可以出现About对话框，右击菜单第一项也没有问题。可是当我运行测试程序时，却出现了这样的编译错误：
[Fatal?Error]?Unit1.pas(7):?File?not?found:?'DesignEditors.dcu'
?
这让我痛苦了好几天，书上是这么说的，应该没有什么错误呀。后来经过摸索，才找到了解决之道。
解决的办法就是将组件编辑器类放在另一个单元中，并在这个单元引用我的托盘组件单元。
并安装之。这才可以正常运行，这个编辑器单元如下：
?
unit?AboutTray;
?
interface
?
uses
??SysUtils,Classes,DesignIntf,DesignEditors,Forms,
??MyTray;
?
type
?TTrayIconEditor?=?class?(TComponentEditor)
????function?GetVerbCount:?Integer;?override;
????function?GetVerb(Index:?Integer):?string;?override;
????procedure?ExecuteVerb(Index:?Integer);?override;
??end;
?
procedure?Register;
?
implementation
?
///////TTrayIconEditor////////////////////////
procedure?TTrayIconEditor.ExecuteVerb(index:integer);
begin
?case?index?of
?0:?application.MessageBox('你好,这是风做的托盘组件!!','关于');
?end;
end;
?
function?TTrayIconEditor.GetVerb(index:integer):String;
begin
??case?index?of
????0:Result:='About?MyTray';
??end;
end;
?
function?TTrayIconEditor.GetVerbCount:integer;
begin
??Result:=1;
end;
?
?
procedure?Register;
begin
??RegisterComponentEditor(TMyTray,TTrayIconEditor);
end;
?
end.
?
至此，托盘组件完毕，拉下它放在窗体设计器中，双击，弹出对话框
里面内容为：“你好,这是风做的托盘组件!!”。哈哈，你成功啦
?
?
做为组件制作的最后一个内容，我想用一个包来把我的所有组件单元包含起来，并放在我自己新建的一个面板中。
这样做之前，要把以前安装下去的组件删除。知道怎么样删除，如果不知道，请看我在第一篇中说的。
然后在打开所有的组件单元，把RegisterComponents(‘Samples',?[TCoolMemo]);里面的
Samples改为Wind。然后保存
接着，在IDE中点File－》New－》Other…
弹出来的New?Items对话框，选中New页面，并选中其中的Package，
这里弹出一个新建的包编辑器。
先在IDE中点File－》Save。将包编辑器保存。保存在组件的单元所在的文件夹中
我的所有组件单元都放在Delphi7\MyCom文件夹中。因此这个包当然也保存在这里。
?
然后，点包编辑器上边的Add，将所有的组件单元加进去，当然也保括上面说的组件编辑器单元啦。
加进去后，点包编辑器上边的Compile，编译完毕，再点Insall。
成功，看看面板。所有以前做过的组件全在Wind面板中了。
而这时候，我的任务也完毕了。
?
?
结语
?
这次的组件之旅终于走完了，也许有人会笑我浅薄，认为这么简单的东西，有必要拿出来么。也许是比较简单吧，但一定有人会需要的，相信我的文章会给他们帮助的。因为这些是我曾经学到的知道，遇到的问题并解决它。所以我个人觉得是很珍贵的。并且经过写这几篇，我把这些知识记得更牢了。这种利己利人的事，何乐而不为呀。
浙公网安备 33010602011771号