begin
application.Minimize
end;
application.Minimize
end;
解决方案 »
- delphi构造ADO数据库连接,密码中带分号
- 程序开始只创建了DataMoudle,在DataMoudle中如何获取本应用程序路径?
- 请问:如何实现“悬浮窗”
- 我编译(compile)时很快,但链接(build)费时很长,而且链接后就见不到代码窗口和对象窗口了,为什么?
- 各位,要使用TBlobStream的前提要uses什么?
- DELPHI可以调用VB做的DLL吗?
- 谁用过价格只要3999、4999的winbook笔记本?感觉如何,发表一下看法。
- D2010 下的fastreport4.9版本,导出PDF是乱码
- delphi中的TToolBar问题?
- ADO连接sql2000如何用数据字典?
- 关于安装盘的制作,我用Delphi5做了一个系统,现在使用D版光盘上带的insertshield express 打包,却出现安装错误。
- 再问怎样判断某个ActiveX控件是否已经注册?一定给分的!
WM_REMIND_ICON_MESSAGE = WM_USER + 1;
REMIND_TRAY_ICON = 1001;
...
procedure ChangeIcon(Action: Integer);
procedure IconAction(var Message: TMessage); message WM_REMIND_ICON_MESSAGE;
procedure WMSysCommand(var Message: TMessage); message WM_SYSCOMMAND;
...
procedure TReminderForm.IconAction(var Message: TMessage);
var
pos: TPoint;
begin
if Message.LParam = WM_LBUTTONDOWN then
ShowTipForm()
else if Message.Lparam = WM_RBUTTONUP then
begin
GetCursorPos(pos);
pmIcon.Popup(pos.x, pos.y);
end;
end;procedure TReminderForm.WMSysCommand(var Message: TMessage);
begin
if Message.WParam = SC_MINIMIZE then
begin
if IsInAll then
begin
MonthCalendar1.Enabled := True;
fsbBack.Enabled := True;
fsbForward.Enabled := True;
fsbRealAll.Enabled := True;
fsbAll.Enabled := True;
IsInAll := False;
SetList();
end;
WindowState := wsMinimized;
Hide();
end
else
inherited;
end;
...
procedure TReminderForm.ChangeIcon(Action: Integer);
var
nid: NOTIFYICONDATA;
begin
nid.Wnd := ReminderForm.Handle;
nid.hIcon := ReminderForm.Icon.Handle;
nid.uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
nid.uID := REMIND_TRAY_ICON;
nid.szTip := 'ATFA Reminder';
nid.uCallbackMessage := WM_REMIND_ICON_MESSAGE;
nid.cbSize := SizeOf(nid); if Action = 1 then
Shell_NotifyIcon(NIM_ADD, @nid)
else
Shell_NotifyIcon(NIM_DELETE, @nid);
end;
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;procedure Register;
implementation
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.FNoShowClick := 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 ;
{TTrayNotifyIcon}
Constructor TTRayNotifyIcon.Create (Aowner : TComponent);
begin
Inherited Create(AOwner);
FIcon := TIcon.Create ;
Ftimer := ttimer.Create (self );
with Ftimer do
begin
Enabled := true ;
Interval := GetDoubleClickTime ;
Ontimer := OnButtonTimer ;
end ;
{keep Default window Icon Handy..}
LoadDefaulticon ;
end;
Destructor TTrayNotifyIcon.Destroy ;
begin
if FIconVisible then SetIconVisible(false );
fIcon.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
Inherited Loaded ;
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 FNoshowclick) AND assigned(FOnclick) then
Fonclick (self);
Fnoshowclick := 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
ficon.Assign (Value);
if FIconvisible then sendTrayMessage(NIM_MODIFY,NIF_ICON);
end ;
procedure TTrayNotifyIcon.setpopupMenu(value : TpopupMenu);begin
FPOPupmenu :=Value ;
if Value <> nil then Value.FreeNotification (self );
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 Register;
begin
RegisterComponents('KNTEMP', [TTrayNotifyIcon]);
end;
const TrayMsgStr ='DDG.TrayNotifyIconMsg';initialization
DDGM_TRAYICON := RegisterWindowMessage(TrayMsgStr);
IconMgr := TiconManager.Create ;
finalization
Iconmgr.Free ;
end.
把托盘做成组件
你也可点击一个BUTTON(close)在onclose中加东西放到托盘上
BUTTON的click事件应该怎样写?
急