发新话题
打印

[基础] 如何实现只打开一个窗体?

如何实现只打开一个窗体?

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

附件

悬浮窗体.rar (20.1 KB)

2006-10-29 10:37, 下载次数: 376

悬浮窗体

TOP

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

关于DDE的使用请参考
http://bbs.lihuasoft.net/viewthr ... 8&highlight=dde
换个头像,看见广告就眼红,直接封ID。

TOP

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

TOP

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

TOP

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

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

附件

悬浮窗体.rar (21.67 KB)

2006-10-29 20:31, 下载次数: 389

我调试过的

TOP

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

TOP

发新话题