Private Sub Command1_Click()
Shell "rundll32.exe url.dll,FileProtocolHandler " & App.Path & "\xj1.exe", vbMaximizedFocus
Unload olpk
End Sub
上面是打开xj1.exe窗体和同时关闭一个olpk窗体的代码．
问题是：在多个窗体上都设置有Command1的钮，它们都可以打开xj1窗体．如何防止连续打开xj1窗体？
即要求屏幕上只能打开一个xj1窗体，不论谁，再按Command1钮，就出现提示＂此窗体已被打开＂，并禁止再打开这同一个窗体．
应该增加什么样的控制代码？

[此贴子已经被作者于2006-10-31 7:36:22编辑过]

如果只有一个窗体上设置一个这样的钮，用楼上天才版主的办法是可以的,但对多个窗体都有此功能的钮,在属性上就不知该怎么办了.因为事件只再一个窗体上发生,而另一个或其它窗体还没有发生过.

楼上的办法还是不行，现在将原文件打包上传，请各位直接在上面修改，就知道行不行了。

请问,你的代码应加在下面的什么地方?(若要在你的窗体上通过验证,还需要加两个计时控件,参见楼上附件)
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function PtInRect Lib "user32" (lpRect As RECT, ByVal ptx As Long, ByVal pty As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter _
As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal X As Long, _
ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Const HWND_TOPMOST = -1
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Is_Move_B As Boolean
Private Is_Movestar_B As Boolean
Private MyRect As RECT
Private MyPoint As POINTAPI
Private Movex As Long, Movey As Long
Private max As Long

Private Sub Command1_Click()
Shell "rundll32.exe url.dll,FileProtocolHandler " & App.Path & "\xj1.exe", vbMaximizedFocus
End Sub

Private Sub Command2_Click()
Shell "rundll32.exe url.dll,FileProtocolHandler " & App.Path & "\xj15.exe", vbMaximizedFocus
End Sub

Private Sub Command3_Click()
Shell "rundll32.exe url.dll,FileProtocolHandler " & App.Path & "\xj27.exe", vbMaximizedFocus
End Sub

Private Sub Command4_Click()
If MsgBox("你确实要退出吗?", vbYesNo + vbExclamation, "系统询问") = vbYes Then
Unload Me
End
Else
Cancel = True
End If
End Sub

Private Sub Form_Load()
Timer1.Interval = 50: Timer2.Interval = 1000
Form1.BackColor = vbBlue
Get_Windows_Rect
Picture1.Width = 10745
Form1.Width = 10770

End Sub
Sub Get_Windows_Rect()
Dim dl&
max = 2200: Form1.Height = max '弹出窗体高度调整
Form1.Top = 0
dl& = GetWindowRect(Form1.hwnd, MyRect)
End Sub
Private Sub Form_Paint()
If PtInRect(MyRect, MyPoint.X, MyPoint.Y) = 0 Then
SetWindowPos Me.hwnd, HWND_TOPMOST, Me.Left / Screen.TwipsPerPixelX, _
Me.Top \ Screen.TwipsPerPixelY, Me.Width \ Screen.TwipsPerPixelX, _
Form1.Height \ Screen.TwipsPerPixelY, 0
End If
End Sub

Private Sub Timer1_Timer()
Dim dl&
dl& = GetCursorPos(MyPoint)
If (PtInRect(MyRect, MyPoint.X, MyPoint.Y) And _
Form1.Height = max) Or MyPoint.Y <= 30 Then
Form1.BackColor = vbBlue
Form1.Height = max
If MyPoint.X - MyRect.Left <= 10 Or Is_Movestar_B Then
Screen.MousePointer = 15
Is_Move_B = True
Else
Screen.MousePointer = 0
Is_Move_B = False
End If
Else
If Not Is_Movestar_B Then
Form1.Height = 30
End If
End If
End Sub

这个问题已解决,代码如下:(注:xj1,xj15,xj27为悬浮窗体上要打开的三个窗体,下面的代码可以做到打开任一窗体,另一窗体卸载)
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function PtInRect Lib "user32" (lpRect As RECT, ByVal ptx As Long, ByVal pty As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter _
As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal X As Long, _
ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Const HWND_TOPMOST = -1
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Is_Move_B As Boolean
Private Is_Movestar_B As Boolean
Private MyRect As RECT
Private MyPoint As POINTAPI
Private Movex As Long, Movey As Long
Private max As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Const PROCESS_TERMINATE = 1

Private Sub Command1_Click()
Dim Ltem As Long
Dim LpID As Long
Dim hLong As Long
Dim strWinName As String
strWinName = "xj15"
hLong = FindWindow(vbNullString, strWinName)
If hLong Then
GetWindowThreadProcessId hLong, LpID
Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
TerminateProcess Ltem, 0
hLong = 0
End If
strWinName = "xj27"
hLong = FindWindow(vbNullString, strWinName)
If hLong Then
GetWindowThreadProcessId hLong, LpID
Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
TerminateProcess Ltem, 0
hLong = 0
End If
Shell "rundll32.exe url.dll,FileProtocolHandler " & App.Path & "\xj1.exe", vbMaximizedFocus
End Sub

Private Sub Command2_Click()
Dim Ltem As Long
Dim LpID As Long
Dim hLong As Long
Dim strWinName As String
strWinName = "xj1"
hLong = FindWindow(vbNullString, strWinName)
If hLong Then
GetWindowThreadProcessId hLong, LpID
Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
TerminateProcess Ltem, 0
hLong = 0
End If
strWinName = "xj27"
hLong = FindWindow(vbNullString, strWinName)
If hLong Then
GetWindowThreadProcessId hLong, LpID
Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
TerminateProcess Ltem, 0
hLong = 0
End If
Shell "rundll32.exe url.dll,FileProtocolHandler " & App.Path & "\xj15.exe", vbMaximizedFocus
End Sub

Private Sub Command3_Click()
Dim Ltem As Long
Dim LpID As Long
Dim hLong As Long
Dim strWinName As String
strWinName = "xj15"
hLong = FindWindow(vbNullString, strWinName)
If hLong Then
GetWindowThreadProcessId hLong, LpID
Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
TerminateProcess Ltem, 0
hLong = 0
End If
strWinName = "xj1"
hLong = FindWindow(vbNullString, strWinName)
If hLong Then
GetWindowThreadProcessId hLong, LpID
Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
TerminateProcess Ltem, 0
hLong = 0
End If
Shell "rundll32.exe url.dll,FileProtocolHandler " & App.Path & "\xj27.exe", vbMaximizedFocus
End Sub

Private Sub Command4_Click()
Dim Ltem As Long
Dim LpID As Long
Dim hLong As Long
Dim strWinName As String
If MsgBox("你确实要退出吗?", vbYesNo + vbExclamation, "系统询问") = vbYes Then
strWinName = "xj15"
hLong = FindWindow(vbNullString, strWinName)
If hLong Then
GetWindowThreadProcessId hLong, LpID
Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
TerminateProcess Ltem, 0
hLong = 0
End If
strWinName = "xj27"
hLong = FindWindow(vbNullString, strWinName)
If hLong Then
GetWindowThreadProcessId hLong, LpID
Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
TerminateProcess Ltem, 0
hLong = 0
End If
strWinName = "xj1"
hLong = FindWindow(vbNullString, strWinName)
If hLong Then
GetWindowThreadProcessId hLong, LpID
Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
TerminateProcess Ltem, 0
hLong = 0
End If

Unload Me
End
Else
Cancel = True
End If
End Sub

Private Sub Form_Load()
Timer1.Interval = 50: Timer2.Interval = 1000
Form1.BackColor = vbBlue
Get_Windows_Rect
Picture1.Width = 10745
Form1.Width = 10770

End Sub
Sub Get_Windows_Rect()
Dim dl&
max = 2200: Form1.Height = max '弹出窗体高度调整
Form1.Top = 0
dl& = GetWindowRect(Form1.hwnd, MyRect)
End Sub
Private Sub Form_Paint()
If PtInRect(MyRect, MyPoint.X, MyPoint.Y) = 0 Then
SetWindowPos Me.hwnd, HWND_TOPMOST, Me.Left / Screen.TwipsPerPixelX, _
Me.Top \ Screen.TwipsPerPixelY, Me.Width \ Screen.TwipsPerPixelX, _
Form1.Height \ Screen.TwipsPerPixelY, 0
End If
End Sub

Private Sub Timer1_Timer()
Dim dl&
dl& = GetCursorPos(MyPoint)
If (PtInRect(MyRect, MyPoint.X, MyPoint.Y) And _
Form1.Height = max) Or MyPoint.Y <= 30 Then
Form1.BackColor = vbBlue
Form1.Height = max
If MyPoint.X - MyRect.Left <= 10 Or Is_Movestar_B Then
Screen.MousePointer = 15
Is_Move_B = True
Else
Screen.MousePointer = 0
Is_Move_B = False
End If
Else
If Not Is_Movestar_B Then
Form1.Height = 30
End If
End If
End Sub