这中问题太多啦,你搜一下Shell_NotifyIcon吧.
解决方案 »
- wise install使用
- 很久米用DELPHI啦,现在装了个DELPHI 10 Lite V3.0,请问
- 网络问题
- 赫赫,过年了。问DX们一个DBGRID问题
- Delphi新手做了一个使用SQL Server数据库的程序,如何打包比较合适?
- delphi登陆窗口关闭后 主程序也关闭啦 请高手们帮忙修改
- word文件問題?高手請進!!在線等待....
- 有这样一个开发需求,应该怎么弄呢?
- delphi clientdataset 赋值 多绑定lookup 引起全局卡
- 有一个字符串,长度未知,要去掉字符串最后一个字符该怎么做????
- 关于数据库恢复的问题?
- 好久没来了,也没看到Focus(老鱼)来游泳了
Forms,
Windows,
ShellAPI,
Messages,
Sysutils,
exSystem,
Pontifex_TLB in 'Pontifex_TLB.pas',
Server_CORBA in '..\2.program\0.服务器\Server_CORBA.pas' {CORBAServer_WeiHai: TCorbaDataModule} {CORBAServer_WeiHai: CoClass},
Server_System in '..\2.program\0.服务器\Server_System.pas',
Server in '..\2.program\0.服务器\Server.pas' {Form_Server};{$R *.TLB} {CORBA}{$R *.res}{$R Server.res}var AboutStr: string;
var NID: TNotifyIconData;
WndClass: array[0..50] of char;procedure Panic(szMessage: PChar);
begin
if szMessage<>nil then MessageBox(0, szMessage, PChar(Host.AppName), MB_OK);
Halt(0);
end;procedure HandleCommand(Wnd: hWnd; Cmd: Word);
begin
case Cmd of
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//主窗口********************************************************************
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Ord('C'): if not Form_Server.Visible then Form_Server.ShowModal;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//关于**********************************************************************
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Ord('A'): MessageBox(0, PChar(AboutStr), PChar('关于...'), MB_OK);
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//退出系统******************************************************************
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Ord('E'): begin
ServerOver;
if Form_Server.Visible then Form_Server.Close;
PostMessage(Wnd, WM_CLOSE, 0, 0);
end;
end;
end;function DummyWindowProc(Wnd: hWnd; Msg, wParam: Word; lParam: LongInt): LongInt; stdcall;
var TrayHandle: THandle;
DC: hDC;
pm: HMenu;
pt: TPoint;
begin
DummyWindowProc := 0;
StrPCopy(@WndClass[0], 'Quark');
TrayHandle := FindWindow(@WndClass[0], nil);
case Msg of
WM_CREATE: begin//Program initialisation - just set up a tray icon
NID.cbSize := SizeOf(NID);
NID.Wnd := Wnd;
NID.uID := 1;
NID.uFlags := nif_Message or nif_Icon or nif_Tip;
NID.uCallBackMessage := WM_User;
NID.hIcon := LoadIcon(hInstance, 'TRAYICON');
Lstrcpy(NID.szTip,'Pontifex for Windows');
Shell_NotifyIcon(nim_Add, @NID);
end;
WM_DESTROY: begin
Shell_NotifyIcon(nim_Delete, @NID);
PostQuitMessage(0);
ShowWindow(TrayHandle, SW_RESTORE);
end;
WM_COMMAND: begin//Command notification
HandleCommand(Wnd, LoWord(wParam));
Exit;
end;
WM_USER: case lParam of
//双击鼠标左键************************************************
WM_LBUTTONDBLCLK: if not Form_Server.Visible then Form_Server.ShowModal;
//单击鼠标右键************************************************
WM_RBUTTONDOWN: begin
GetCursorPos(pt);
pm := CreatePopupMenu;
AppendMenu(pm, 0, Ord('C'), '客户端状态');
AppendMenu(pm, MF_SEPARATOR, 0, nil);
AppendMenu(pm, 0, Ord('A'), '关于Pontifex...');
AppendMenu(pm, 0, Ord('E'), '退出');
SetForegroundWindow(Wnd);
DC := GetDC(0);
if TrackPopupMenu(pm, tpm_BottomAlign or tpm_RightAlign, pt.x,GetDeviceCaps(DC,HORZRES){pt.y}, 0, Wnd, nil)
then SetForegroundWindow(Wnd);
DestroyMenu(pm);
end;
end;//case lParam of
end;
DummyWindowProc := DefWindowProc(Wnd, Msg, wParam, lParam);
end;procedure WinMain;
var Wnd: hWnd;
Msg: TMsg;
WndClass: TWndClass;
begin
{ Previous instance running ? If so, exit }
if FindWindow(PChar(Host.AppName), nil)<>0 then Panic(PChar(Host.AppName + ' 已经运行。')); { Register the window class }
FillChar(WndClass, SizeOf(WndClass), 0);
WndClass.lpfnWndProc := @DummyWindowProc;
WndClass.hInstance := hInstance;
WndClass.lpszClassName := PChar(Host.AppName);
RegisterClass(WndClass); { Now create the dummy window }
Wnd := CreateWindow(PChar(Host.AppName), PChar(Host.AppName), WS_OVERLAPPEDWINDOW, 0, 0, 0, 0, 0, 0, hInstance, nil);
if Wnd<>0 then
begin
ShowWindow(Wnd, SW_HIDE);
while GetMessage(Msg, 0, 0, 0) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
end;begin
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//系统变量初始化**************************************************************
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ServerInit;
AboutStr := '北京博达新创科技发展有限公司(R)' + #13;
AboutStr := AboutStr + '供热企业收费管理信息系统(C)' + #13;
AboutStr := AboutStr + 'Version of Server ' + GetApplicationVersion(Application.ExeName); //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//创建主窗体,开始运行********************************************************
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
try
Application.Initialize;
Application.CreateForm(TForm_Server, Form_Server);
WinMain;
except
MessageBox(Application.Handle,PChar('数据库连接错误,请与系统管理员联系!'),'提示!',MB_OK+MB_ICONINFORMATION);
Exit;
end;
end.
begin
With IconData do//加入TrayIcon
Begin
cbSize := SizeOf(IconData);
Wnd := main.handle;
uID := iID;
uFlags := nif_Icon Or NIF_MESSAGE Or nif_Tip;
uCallBackMessage := wm_MyCall;
hicon:=icos.handle;
lstrcpy(szTip,pchar(tip));
Shell_NotifyIcon(msgs,@IconData);
End;
end;
//以上是过程,以下是调用
sysboxicon(nim_Add,fmflash.icon);//add
sysboxicon(nim_Modify,icon);//modify
sysboxicon(nim_Delete,ico);//del
这个过程是我自己写的,第一个参数是操作常数(add、Modify、Del),第二个参数是一个图标句柄,用于在右下角显示,后两参数你也可以试试,iID是你在右下角生成多个ICON时用的,Tip是你提示的字符
请注意,要在uses中引用shellapi
你在uses之后要定义:
Const //自定义消息
wm_MyCall = wm_User+$1000;并实现
Procedure MyCallICON(var message:Tmessage);Message MyCall ;