📄 timeclock.dpr
字号:
program TimeClock;
uses
PrjConst in 'PrjConst.pas',
Functions in 'Functions.pas',
GB2Big5 in 'GB2Big5.pas',
Forms,
SysUtils,
Windows,
Messages,
Main in 'Main.pas' {frmMain},
ChDevPwd in 'ChDevPwd.pas' {frmChDevPwd},
ListCard in 'ListCard.pas' {dlgListCard},
ClockTime in 'ClockTime.pas' {dlgClockTime},
RingTime in 'RingTime.pas' {dlgRingTime},
CardNo in 'CardNo.pas' {dlgCardNo},
Hints in 'Hints.pas' {dlgHints},
SearchPort in 'SearchPort.pas' {dlgSearchPort},
ClockOptions in 'ClockOptions.pas' {dlgOptions},
EastRiver in 'EastRiver.pas',
Progress in 'Progress.pas' {dlgProgress},
RealControl in 'RealControl.pas' {frmRealControl},
GateCard in 'GateCard.pas' {dlgGateCard},
DoorPeriods in 'DoorPeriods.pas' {dlgDoorPeriods},
SuperUserDialog in 'SuperUserDialog.pas' {dlgSuperUser},
Periods in 'Periods.pas' {dlgPeriods},
FindListItem in 'FindListItem.pas' {dlgFindListItem};
type
TMyMutex=class(TObject)
private
MutHandle: THandle;
MessageId: Cardinal;
SaveOnMessage: TMessageEvent;
protected
procedure BroadCastFocusMessage;
procedure OnAppMessage(var Msg: TMsg; var Handled: Boolean);
public
PrevMutexExists: Boolean;
constructor Create(const UniqueAppStr: string);
destructor Destory;
end;
{$R *.RES}
const
MI_QUERYWINDOWHANDLE=1;
MI_RESPONDWINDOWHANDLE=2;
MI_ERROR_NONE=0;
MI_ERROR_FAILSUBCLASS=1;
MI_ERROR_CREATINGMUTEX=2;
constructor TMyMutex.Create(const UniqueAppStr: string);
begin
SaveOnMessage:=Application.OnMessage;
Application.OnMessage:=OnAppMessage;
MessageId := RegisterWindowMessage(PChar(UniqueAppStr));
MutHandle := OpenMutex(MUTEX_ALL_ACCESS, False, PChar(UniqueAppStr));
if MutHandle=0 then
begin
PrevMutexExists:=False;
MutHandle := CreateMutex(nil, False, PChar(UniqueAppStr));
end
else
begin
PrevMutexExists:=True;
BroadCastFocusMessage;
end;
end;
destructor TMyMutex.Destory;
begin
if MutHandle<>0 then CloseHandle(MutHandle);
Application.OnMessage:=SaveOnMessage;
end;
procedure TMyMutex.OnAppMessage(var Msg: TMsg;var Handled: Boolean);
begin
if Msg.message=MessageId then
begin
case Msg.wParam of
MI_QUERYWINDOWHANDLE:
begin
if IsIconic(Application.Handle) or
(Assigned(Application.MainForm) and not IsWindowVisible(Application.MainForm.Handle)) then
begin
ShowWindow(Application.Handle, SW_MINIMIZE);
ShowWindow(Application.Handle, SW_RESTORE);
end;
SetActiveWindow(Application.Handle);
SetForegroundWindow(Application.Handle);
if Msg.lParam<>0 then
PostMessage(HWND(Msg.lParam), MessageId, MI_RESPONDWINDOWHANDLE, Application.Handle);
end;
MI_RESPONDWINDOWHANDLE:
begin
SetForegroundWindow(HWND(Msg.lParam));
if Assigned(Application) then
Application.Terminate;
end;
end;
end
else
if Assigned(SaveOnMessage) then SaveOnMessage(Msg, Handled);
end;
procedure TMyMutex.BroadCastFocusMessage;
var
BSMRecipients: DWORD;
begin
BSMRecipients := BSM_APPLICATIONS;
BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE, @BSMRecipients, MessageId, MI_QUERYWINDOWHANDLE, Application.Handle);
end;
var
MyMutex: TMyMutex;
begin
Application.Initialize;
MyMutex:=TMyMutex.Create(UniqueAppStr);
if not MyMutex.PrevMutexExists then
begin
Application.CreateForm(TfrmMain, frmMain);
Application.Run;
end;
MyMutex.Free;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -