编程开发论坛 - Powered by Discuz! Board

标题: [基础] 如何实现只打开一个窗体? [打印本页]

作者: jrs123 时间: 2006-10-29 10:37 标题: 如何实现只打开一个窗体?

有个悬浮窗体,上面有三个钮可以打开三个窗体,问题是:连续接各钮无法卸载前面的窗体,现将原代码上传,请哪位朋友能帮助解决一下.如何实现只打开一个窗体,并卸载前一个窗体,但不能卸载悬浮窗体.初到此网站,请多关照!

附件: [悬浮窗体] 悬浮窗体.rar (2006-10-29 10:37, 20.1 KB) / 该附件被下载次数 478
http://bbs.lihuasoft.net/attachment.php?aid=526

作者: Nothing 时间: 2006-10-29 15:40

这个简单，不打开重复的窗体你可以让其他的三个程序不能重复加载
If App.PrevInstance Then
'当程序已经加载过了
'可以在里面加载DDE，激活以前打开的窗体
end if

关于DDE的使用请参考
http://bbs.lihuasoft.net/viewthr ... 8&highlight=dde

作者: 冰点 时间: 2006-10-29 15:43

把按钮搞成互斥，杀进程！
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

作者: jrs123 时间: 2006-10-29 19:18

冰点版主的代码安装后,无法打开xj15,xj27,而连续按command1可以连续出xj1窗体,不知何故?

作者: 冰点 时间: 2006-10-29 20:18

Nothing不是说了，要在三个被加载的程序里加入防止被重载的代码！

[ 本帖最后由冰点于 2006-10-29 20:31 编辑 ]

附件: [我调试过的] 悬浮窗体.rar (2006-10-29 20:31, 21.67 KB) / 该附件被下载次数 501
http://bbs.lihuasoft.net/attachment.php?aid=527

作者: jrs123 时间: 2006-10-30 13:01

谢谢冰点版主,问题已解决了!
困扰了多时的、多个论坛没有解决的问题解决了,真是高手。
偶还应该多努力,现在太菜了.

欢迎光临编程开发论坛 (http://bbs.lihuasoft.net/)