关于程序启动后自动最小化到右下脚区域的问题! 这中问题太多啦,你搜一下Shell_NotifyIcon吧. 解决方案 » 免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货 用托盘,不会用可以用第三方控件,例如RxLib 用托盘,不会用可以用第三方控件,例如RxLib program Pontifex;uses 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. procedure sysboxIcon(msgs:Dword;icos:Ticon;iID:integer=0;Tip:string='视窗超人');//处理任务栏图标过程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);//modifysysboxicon(nim_Delete,ico);//del这个过程是我自己写的,第一个参数是操作常数(add、Modify、Del),第二个参数是一个图标句柄,用于在右下角显示,后两参数你也可以试试,iID是你在右下角生成多个ICON时用的,Tip是你提示的字符请注意,要在uses中引用shellapi 这是个回调函数(Callback),你在uses之后要定义: Const //自定义消息 wm_MyCall = wm_User+$1000;并实现 Procedure MyCallICON(var message:Tmessage);Message MyCall ; 错了,是 Procedure MyCallICON(var message:Tmessage);Message WM_MyCall ; 一个奇怪的问题 如何更新ms sql2000数据库下的money型数据列 谁有树型下拉控件,带拼音搜索功能的. 关于删除空文件夹的问题 DBGrid中如何确定那一行被选择了? 请投中国的长城和布达拉宫一票 16进制,二进制,10进制之间的转换函数?急 大家帮个忙,进者有分。 OpenFileMapping函数在NT下是否能够使用? DELPHI写ASP组件怎样? 关于数据库恢复的问题? 好久没来了,也没看到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 ;