home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / Multithrea985736252002.psc / Module1.bas < prev    next >
Encoding:
BASIC Source File  |  2001-07-27  |  3.5 KB  |  71 lines
  1. Attribute VB_Name = "Module1"
  2. Public Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
  3. Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
  4. Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  5. Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
  6. Public Declare Function GetCurrentProcessId Lib "kernel32" () As Long
  7. Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
  8. Public Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
  9. Public Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
  10. Public Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As Long, ByVal wFlag As Long) As Long
  11. Public Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
  12. Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
  13. Public Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long
  14.  
  15.  
  16.  
  17. 'MAKE SURE TO SET THE PROJECT PROPERTIES TO STANDALONE
  18. 'EXE AND NOT ActiveX SERVER
  19. 'RUN THIS DEMO ONLY AS A COMPILED EXE
  20. 'MAKE SURE THE THREADING OPTION IS "THREAD PER OBJECT"
  21. Sub Main()
  22.     Dim ProcessID As Long, curProcessID As Long
  23.     hwnd = FindWindow(vbNullString, "Multithreading Demo")
  24. '   This routine is called whenever a new object (on a new thread)
  25. '   is created. Therefore we use the FindWindow API to check
  26. '   whether the main form is loaded or not.
  27. '   If not we load it
  28.     
  29.     If hwnd <> 0 Then
  30.     'We perform an additional check here since the window
  31.     'with the title "Multithreading Demo" can be any other window
  32.     'Other than that of this app !
  33.     'If this check is not present then we may prevent
  34.     ' the loading of our app just because another Window
  35.     'with the same title happens to be open
  36.     'Also we need to able to start multiple instances of our app
  37.     'which will not be possible without this step !
  38.     
  39.     'Get the ProcessID of the Windows identified with the hwnd Handle
  40.     'returned
  41.     'This we compare with the ProcessID of our app to see
  42.     'whether the supposed "Main Window" is our app's Window or not
  43.     'Also we compare the processIds to allow users to start multiple
  44.     'instances of our app !
  45.         GetWindowThreadProcessId hwnd, ProcessID
  46.         curProcessID = GetCurrentProcessId
  47.         'Compare both process ids
  48.         
  49.         If curProcessID <> ProcessID Then
  50. '        Main form not loaded, so load it
  51.             Dim Frm As New Form1
  52.                 Frm.Show
  53.             Set Frm = Nothing
  54.  
  55.         End If
  56.     End If
  57.         
  58.         
  59.              
  60.    If hwnd = 0 Then
  61. '       A Window with such a title does not exist
  62. '       So no problem ! Just directly load it
  63.             Dim Frm2 As New Form1
  64.                 Frm2.Show
  65.             Set Frm2 = Nothing
  66.     End If
  67.         'Otherwise do nothing and let the secondary objects be created
  68. End Sub
  69.  
  70.  
  71.