title image


Smiley Re: mehrfachen Programmaufruf verhindern
Hallo, um das Programm zu aktivieren füge folgenden Code in ein Modul.

In den Projekt Eigenschaften musst Du als Startobjekt SubMain eingeben.

Private Declare Function FindWindowA Lib "user32" ( _

ByVal lpClassName As String, _

ByVal lpWindowName As String) As Long

 

Private Declare Function GetParent Lib "user32" ( _

ByVal hWnd As Long) As Long

 

Private Declare Function GetWindow Lib "user32" ( _

ByVal hWnd As Long, ByVal wCmd As Long) As Long

 

Private Declare Function GetWindowTextA Lib "user32" ( _

ByVal hWnd As Long, ByVal lpString As String, _

ByVal cch As Long) As Long

 

Private Declare Function IsIconic Lib "user32" ( _

ByVal hWnd As Long) As Long

 

Private Declare Sub SetForegroundWindow Lib "user32" ( _

ByVal hWnd As Long)

 

Private Declare Sub ShowWindow Lib "user32" ( _

ByVal hWnd As Long, ByVal nCmdShow As Long)

 

Public Sub Main()

 

If App.PrevInstance Then

PrevActivate "Form1" ' Titel der Form

Else

Form1.Show

End If

 

End Sub

 

Public Sub PrevActivate(Optional ByVal Title As String)

 

'Checken, ob Aktivierung notwendig:

If Not App.PrevInstance Then Exit Sub

 

'Caption merken und maskieren:

If Len(Title) = 0 Then _

Title = Screen.ActiveForm.Caption

If Not Screen.ActiveForm Is Nothing Then _

Screen.ActiveForm.Caption = CStr(Rnd)

 

'Andere Instanz aktivieren:

ApplActivate Title

 

End Sub

 

Sub ApplActivate(ByVal Appl As Variant)

 

Const SW_RESTORE = 9

 

'Ggf. Handle zu Caption suchen:

If Not IsNumeric(Appl) Then _

Appl = ApplHandle(Appl)

 

'Ggf. "Wiederherstellen":

If IsIconic(Appl) Then _

ShowWindow Appl, SW_RESTORE

 

'Anwendung in den Vordergrund bringen:

SetForegroundWindow Appl

 

End Sub

 

Function ApplHandle(ByVal Caption As String) As Long

 

Dim vClass As Variant

 

'VB-Applikationen/Klassen bevorzugen:

For Each vClass In Array( _

"ThunderRT5MDIForm", "ThunderRT6MDIForm", _

"ThunderRT5Form", "ThunderRT6Form", _

vbNullString)

 

'Applikation/Klasse checken:

ApplHandle = GetHandle(vClass, Caption)

If ApplHandle Then Exit Function

 

Next vClass

 

End Function

 

Function GetHandle(ByVal Class As String, ByVal Caption As String) As Long

 

Const GW_HWNDNEXT = 2

Dim Buffer As String

Dim Length As Long

 

'Auf exakten Treffer checken:

GetHandle = FindWindowA(Class, Caption)

If GetHandle Then Exit Function

 

'Alle Klassen-Windows durchlaufen:

Caption = UCase$(Trim$(Caption))

GetHandle = FindWindowA(Class, vbNullString)

Do While GetHandle

 

'Nur Top-Windows berücksichtigen:

If GetParent(GetHandle) = 0 Then

 

'Caption holen:

Buffer = Space$(255)

Length = GetWindowTextA(GetHandle, Buffer, 255)

Buffer = UCase$(Left$(Buffer, Length))

 

'Exakter Vergleich:

If Buffer = Caption Then Exit Do

 

'MDI-Form berücksichtigen:

If Buffer Like Caption & " - *" Then Exit Do

 

End If

GetHandle = GetWindow(GetHandle, GW_HWNDNEXT)

 

Loop

 

End Function

 

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: