老问题？没搞定！:(
防止程序运行多份（只起一个），这个方法多多！
可是，如何做到在程序最小化（或者被其他程序遮挡）时，再次运行时
既不会开启第二边，又使该程序到前台
就像OutLook那样！
问题点数：100、回复次数：16Top
1 楼goodloop（小志）回复于 2003-01-07 17:39:44 得分 0
这个很多书上有的（比如mastering delphi 6），看看以前的帖子也有的Top
2 楼xiamang（瞎忙）回复于 2003-01-07 17:48:47 得分 0
还是在判断程序是否运行的的 dpr 文件中加入显示的代码.
Application.? 忘了.
Top
3 楼xzhifei（饭桶超人(最讨厌两种人，一种是有种族歧视的人，一种是日本人！)）回复于 2003-01-07 17:49:35 得分 30
唉，看到100分的面子上，给你：
在工程文件(dpr文件)中加入：
Var
prvHandle: THandle;
ds: TCopyDataStruct;
hd: THandle;
Begin
prvHandle := CreateMutex(Nil, false, 'form1');
If GetLastError = ERROR_ALREADY_EXISTS Then
Begin
//传送消息
ds.cbData := 10;
GetMem(ds.lpData, ds.cbData); //为传递的数据区分配内存
StrCopy(ds.lpData, 'Show');
Hd := FindWindow(Nil, Version); // 获得接受窗口的句柄
If Hd <> 0 Then
SendMessage(Hd, WM_COPYDATA, Application.Handle, Cardinal(@ds)); // 发送WM_COPYDATA消息
// else
// ShowMessage('目标窗口没找到！');
System.FreeMem(ds.lpData); //释放资源
CloseHandle(prvHandle);
Application.Terminate;
Exit;
End;
Application.Initialize;
Application.Title := 'form1';
Application.CreateForm(TFrm_Main, Frm_Main);
Application.Run;
End.
在主窗体中加入：
private
{ Private declarations }
Procedure Mymessage(Var t: TWmCopyData); message WM_COPYDATA;
Procedure TFrm_Main.Mymessage(Var t: TWmCopyData);
Begin
If StrPas(t.CopyDataStruct.lpData) = 'Show' Then
Begin
Self.show;
End;
End;
Top
4 楼murphy（从现在开始）回复于 2003-01-08 08:37:20 得分 0
xzhifei(飞) ：
你的方法好像是可以（从流程方法上），可是有时候可以有时候不可以！？
而且是调试时可以，独立测试时不可以！？
我哪里理解不够吗？
请指教！Top
5 楼xzhifei（饭桶超人(最讨厌两种人，一种是有种族歧视的人，一种是日本人！)）回复于 2003-01-08 09:24:08 得分 0
请注意下面语句中的'form1',它是指当前程序的名字，你一定要设置正确
prvHandle := CreateMutex(Nil, false, 'form1');
Application.Title := 'form1';
还有Mymessage中的'Show'与发送时的" StrCopy(ds.lpData, 'Show');"是否一致。
如果还不行，你可以把程序贴出来，我看一下
Top
6 楼xirumin（吃好喝好）回复于 2003-01-08 09:41:52 得分 0
我也学习一下Top
7 楼murphy（从现在开始）回复于 2003-01-08 09:45:18 得分 0
xzhifei(飞) ：
Hd := FindWindow(Nil, Version); // 获得接受窗口的句柄
这句话的意义是什么？Version？是个常量！？
我调试时把Version改成'Project1'，要不Hd=0！Top
8 楼murphy（从现在开始）回复于 2003-01-08 09:47:35 得分 0
没搞定！:(
xzhifei(飞) 怎么和你联系？我的QQ是1597820，谢谢！
大伙再给点新思路！学习学习:)
Top
9 楼jackystar（我）回复于 2003-01-08 12:37:08 得分 0
upTop
10 楼diruser（既来之，则安之）回复于 2003-01-08 13:03:05 得分 0
FindWindow(Nil, Version)
Version为要找的窗体CaptionTop
11 楼starcbh（信仰）回复于 2003-01-08 17:14:42 得分 0
靠Top
12 楼joky1981（共享）回复于 2003-01-08 17:57:57 得分 0
给你一个例程,发信到我的邮箱:joky1981@163.comTop
13 楼ccc_wh（cwh）回复于 2003-01-08 20:39:53 得分 70
unit MultInst;
interface
const
MI_QUERYWINDOWHANDLE = 1;
MI_RESPONDWINDOWHANDLE = 2;
MI_ERROR_NONE = 0;
MI_ERROR_FAILSUBCLASS = 1;
MI_ERROR_CREATINGMUTEX = 2;
// Call this function to determine if error occurred in startup.
// Value will be one or more of the MI_ERROR_* error flags.
function GetMIError: Integer;
implementation
uses Forms, Windows, SysUtils;
const
UniqueAppStr = 'DDG.I_am_the_Eggman!';
var
MessageId: Integer;
WProc: TFNWndProc;
MutHandle: THandle;
MIError: Integer;
function GetMIError: Integer;
begin
Result := MIError;
end;
function NewWndProc(Handle: HWND; Msg: Integer; wParam, lParam: Longint):
Longint; stdcall;
begin
Result := 0;
// If this is the registered message...
if Msg = MessageID then
begin
case wParam of
MI_QUERYWINDOWHANDLE:
// A new instance is asking for main window handle in order
// to focus the main window, so normalize app and send back
// message with main window handle.
begin
if IsIconic(Application.Handle) then
begin
Application.MainForm.WindowState := wsNormal;
Application.Restore;
end;
PostMessage(HWND(lParam), MessageID, MI_RESPONDWINDOWHANDLE,
Application.MainForm.Handle);
end;
MI_RESPONDWINDOWHANDLE:
// The running instance has returned its main window handle,
// so we need to focus it and go away.
begin
SetForegroundWindow(HWND(lParam));
Application.Terminate;
end;
end;
end
// Otherwise, pass message on to old window proc
else
Result := CallWindowProc(WProc, Handle, Msg, wParam, lParam);
end;
procedure SubClassApplication;
begin
// We subclass Application window procedure so that
// Application.OnMessage remains available for user.
WProc := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC,
Longint(@NewWndProc)));
// Set appropriate error flag if error condition occurred
if WProc = nil then
MIError := MIError or MI_ERROR_FAILSUBCLASS;
end;
procedure DoFirstInstance;
// This is called only for the first instance of the application
begin
// Create the mutex with the (hopefully) unique string
MutHandle := CreateMutex(nil, False, UniqueAppStr);
if MutHandle = 0 then
MIError := MIError or MI_ERROR_CREATINGMUTEX;
end;
procedure BroadcastFocusMessage;
// This is called when there is already an instance running.
var
BSMRecipients: DWORD;
begin
// Prevent main form from flashing
Application.ShowMainForm := False;
// Post message to try to establish a dialogue with previous instance
BSMRecipients := BSM_APPLICATIONS;
BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE,
@BSMRecipients, MessageID, MI_QUERYWINDOWHANDLE,
Application.Handle);
end;
procedure InitInstance;
begin
SubClassApplication; // hook application message loop
MutHandle := OpenMutex(MUTEX_ALL_ACCESS, False, UniqueAppStr);
if MutHandle = 0 then
// Mutex object has not yet been created, meaning that no previous
// instance has been created.
DoFirstInstance
else
BroadcastFocusMessage;
end;
initialization
MessageID := RegisterWindowMessage(UniqueAppStr);
InitInstance;
finalization
// Restore old application window procedure
if WProc <> Nil then
SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(WProc));
if MutHandle <> 0 then CloseHandle(MutHandle); // Free mutex
end.
呵呵,给分吧Top
14 楼ccc_wh（cwh）回复于 2003-01-08 20:41:14 得分 0
在主窗体中Uses MultInst;
Top
15 楼murphy（从现在开始）回复于 2003-01-09 08:59:45 得分 0
ccc_wh(cwh)：
Thanks!
:)
初测成功！
Top
16 楼murphy（从现在开始）回复于 2003-01-09 09:01:54 得分 0
ccc_wh(cwh)：
有时间讲解一下好吗？
QQ联系，方便吗？
我的：1597820Top
