home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD1179411172000.psc / basMain.bas < prev    next >
Encoding:
BASIC Source File  |  2000-11-12  |  11.2 KB  |  381 lines

  1. Attribute VB_Name = "basMain"
  2. Option Explicit
  3.  
  4. ' Win32 Structures
  5. Public Type RECT
  6.    Left As Long
  7.    Top As Long
  8.    Right As Long
  9.    Bottom As Long
  10. End Type
  11.  
  12. Public Type WINDOWINFO
  13.     cbSize As Long
  14.     rcWindow As RECT
  15.     rcClient As RECT
  16.     dwStyle As Long
  17.     dwExStyle As Long
  18.     dwWindowStatus As Long
  19.     cxWindowBorders As Long
  20.     cyWindowBorders As Long
  21.     atomWindowType As Long
  22.     wCreatorVersion As Long
  23. End Type
  24.  
  25.  
  26. 'Win32 constants used throughout
  27. Public Const MAX_PATH = 260
  28. Public Const LB_SETTABSTOPS As Long = &H192
  29.  
  30. 'For SetWindowPos()
  31. Public Const HWND_TOPMOST = -1
  32. Public Const HWND_NOTOPMOST = -2
  33. Public Const HWND_BOTTOM = 1
  34. Public Const HWND_TOP = 0
  35. Public Const SWP_FRAMECHANGED = &H20
  36. Public Const SWP_DRAWFRAME = SWP_FRAMECHANGED
  37. Public Const SWP_HIDEWINDOW = &H80
  38. Public Const SWP_NOACTIVATE = &H10
  39. Public Const SWP_NOCOPYBITS = &H100
  40. Public Const SWP_NOMOVE = &H2
  41. Public Const SWP_NOOWNERZORDER = &H200
  42. Public Const SWP_NOREDRAW = &H8
  43. Public Const SWP_NOREPOSITION = SWP_NOOWNERZORDER
  44. Public Const SWP_NOSIZE = &H1
  45. Public Const SWP_NOZORDER = &H4
  46. Public Const SWP_SHOWWINDOW = &H40
  47. Public Const SWP_NOSENDCHANGING = &H400
  48. Public Const SWP_DEFERERASE = &H2000
  49.  
  50. 'Button related messages
  51. Public Const STN_DBLCLK = &H1&
  52. Public Const MK_LBUTTON = &H1
  53. Public Const MK_MBUTTON = &H10
  54. Public Const MK_RBUTTON = &H2
  55. Public Const BM_CLICK = &HF5
  56. Public Const BM_SETSTYLE = &HF4
  57. Public Const BN_DOUBLECLICKED = 5
  58. Public Const BN_CLICKED = 0
  59.  
  60. 'Button styles
  61. Public Const BS_AUTOCHECKBOX = &H3&
  62. Public Const BS_AUTORADIOBUTTON = &H9&
  63. Public Const BS_AUTO3STATE = &H6&
  64. Public Const BS_CHECKBOX = &H2&
  65. Public Const BS_DEFPUSHBUTTON = &H1&
  66. Public Const BS_GROUPBOX = &H7&
  67. Public Const BS_PUSHLIKE = &H1000&
  68. Public Const BS_LEFTTEXT = &H20&
  69. Public Const BS_3STATE = &H5&
  70. Public Const BS_PUSHBUTTON = &H0&
  71. Public Const BS_RADIOBUTTON = &H4&
  72. Public Const BS_SOLID = 0
  73. Public Const BS_BOTTOM = &H800&
  74. Public Const BS_CENTER = &H300&
  75. Public Const BS_LEFT = &H100&
  76. Public Const BS_MULTILINE = &H2000&
  77. Public Const BS_RIGHT = &H200&
  78. Public Const BS_TOP = &H400&
  79. Public Const BS_VCENTER = &HC00&
  80.  
  81. 'Window Messages
  82. Public Const WM_NCLBUTTONDBLCLK = &HA3
  83. Public Const WM_NCLBUTTONDOWN = &HA1
  84. Public Const WM_NCLBUTTONUP = &HA2
  85. Public Const WM_NCRBUTTONDOWN = &HA4
  86. Public Const WM_NCRBUTTONUP = &HA5
  87. Public Const WM_COMMAND = &H111
  88. Public Const WM_DESTROY = &H2
  89. Public Const WM_ENABLE = &HA
  90. Public Const WM_HSCROLL = &H114
  91. Public Const WM_LBUTTONDBLCLK = &H203
  92. Public Const WM_LBUTTONDOWN = &H201
  93. Public Const WM_LBUTTONUP = &H202
  94. Public Const WM_MBUTTONDBLCLK = &H209
  95. Public Const WM_MBUTTONDOWN = &H207
  96. Public Const WM_MBUTTONUP = &H208
  97. Public Const WM_PASTE = &H302
  98. Public Const WM_QUIT = &H12
  99. Public Const WM_RBUTTONDBLCLK = &H206
  100. Public Const WM_RBUTTONDOWN = &H204
  101. Public Const WM_RBUTTONUP = &H205
  102. Public Const WM_SETFOCUS = &H7
  103. Public Const WM_VSCROLL = &H115
  104. Public Const WM_CLOSE = &H10
  105. Public Const WM_COPY = &H301
  106. Public Const WM_GETTEXT = &HD
  107. Public Const WM_GETTEXTLENGTH = &HE
  108. Public Const WM_SETTEXT = &HC
  109. Public Const WM_CLEAR = &H303
  110. Public Const WM_CUT = &H300
  111. Public Const WM_FONTCHANGE = &H1D
  112. Public Const WM_GETFONT = &H31
  113. Public Const WM_GETMINMAXINFO = &H24
  114. Public Const WM_KEYDOWN = &H100
  115. Public Const WM_KEYUP = &H101
  116. Public Const WM_SETFONT = &H30
  117. Public Const WM_UNDO = &H304
  118.  
  119. 'GetWindow()
  120. Public Const GW_CHILD = 5
  121. Public Const GW_HWNDFIRST = 0
  122. Public Const GW_HWNDLAST = 1
  123. Public Const GW_HWNDNEXT = 2
  124. Public Const GW_HWNDPREV = 3
  125. Public Const GW_MAX = 5
  126. Public Const GW_OWNER = 4
  127.  
  128. 'Application specific variables
  129. Public CurrenthWnd As Long
  130. Public OwnerhWnd As Long
  131. Public Childhwnd As Long
  132.  
  133. 'API declarations
  134. Public Declare Function SetActiveWindow Lib "user32" (ByVal hwnd As Long) As Long
  135. Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  136. Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
  137.  
  138. Public Declare Function GetWindowInfo Lib "user32" (ByVal hwnd As Long, ByRef pwi As WINDOWINFO) As Long
  139.  
  140. Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
  141.  
  142. Public Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
  143.  
  144. Public 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
  145.     
  146. Public Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
  147.  
  148. Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
  149.  
  150. Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
  151.  
  152. Public Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
  153.  
  154. Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  155.  
  156. Public Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
  157.  
  158. 'Finds strItem in ComboBox cbo and returns the index.
  159. '-1 if not found
  160. Public Function FindInCombo(strItem As String, cbo As ComboBox) As Integer
  161. Dim cnt As Integer
  162. Dim Found As Boolean
  163.  
  164. Found = False
  165. For cnt = 0 To cbo.ListCount - 1
  166.     If Left(cbo.List(cnt), Len(strItem)) = strItem Then
  167.         Found = True
  168.         FindInCombo = cnt
  169.         Exit Function
  170.     End If
  171. Next cnt
  172. If Not Found Then FindInCombo = -1
  173. End Function
  174. Function Button(but%)
  175. clickicon% = SendMessage(but%, WM_KEYDOWN, VK_SPACE, 0)
  176. clickicon% = SendMessage(but%, WM_KEYUP, VK_SPACE, 0)
  177. End Function
  178. 'Finds strItem in ListBox lst and returns the index.
  179. '-1 if not found
  180. Public Function FindIndex(strItem As String, lst As ListBox) As Integer
  181. Dim cnt As Integer
  182. Dim Found As Boolean
  183.  
  184. Found = False
  185. For cnt = 0 To lst.ListCount - 1
  186.     If lst.List(cnt) = strItem Then
  187.         Found = True
  188.         FindIndex = cnt
  189.         Exit Function
  190.     End If
  191. Next cnt
  192. If Not Found Then FindIndex = -1
  193. End Function
  194.  
  195. 'Callback function for EnumChildWindows
  196. Public Function EnumChildWindowProc(ByVal hwnd As Long, ByVal lParam As Long) As Long
  197. Dim Txt As String
  198. Dim class As String
  199. Dim newentry As String
  200. Dim dummy As Integer
  201.  
  202. Txt = Space$(MAX_PATH)
  203. class = Space$(MAX_PATH)
  204.  
  205. Call GetClassName(hwnd, class, MAX_PATH)
  206. Call GetWindowText(hwnd, Txt, MAX_PATH)
  207.  
  208. newentry = TrimNull(class) & vbTab & hwnd & vbTab & TrimNull(Txt)
  209. frmChildWindows.lstChildWindows.AddItem newentry
  210. dummy = FindIndex(newentry, frmChildWindows.lstChildWindows)
  211.  
  212. If dummy <> -1 Then
  213.     frmChildWindows.lstChildWindows.ItemData(dummy) = hwnd
  214. End If
  215. EnumChildWindowProc = 1
  216. End Function
  217.  
  218. Public Function EnumWindowProc(ByVal hwnd As Long, ByVal lParam As Long) As Long
  219.    
  220.   'working vars
  221.    Dim nSize As Long
  222.    Dim sTitle As String
  223.    Dim sClass As String
  224.    Dim pos As Integer
  225.    Dim dummy As Integer
  226.    Dim newentry As String
  227.   
  228.   'set up the strings to receive the class and
  229.   'window text. You could use GetWindowTextLength,
  230.   'but I'll cheat and use MAX_PATH instead.
  231.    sTitle = Space$(MAX_PATH)
  232.    sClass = Space$(MAX_PATH)
  233.    
  234.    Call GetClassName(hwnd, sClass, MAX_PATH)
  235.    Call GetWindowText(hwnd, sTitle, MAX_PATH)
  236.    newentry = TrimNull(sClass) & vbTab & _
  237.                        hwnd & vbTab & TrimNull(sTitle)
  238.   'strip the trailing chr$(0)'s from the strings
  239.   'returned above and add the window data to the list
  240.    frmMain.lstEnumWindows.AddItem newentry
  241.                        
  242.   dummy = FindIndex(newentry, frmMain.lstEnumWindows)
  243.   If dummy <> -1 Then
  244.     frmMain.lstEnumWindows.ItemData(dummy) = hwnd
  245.   End If
  246.   
  247.   'to continue enumeration, we must return True
  248.   '(in C that's 1).  If we wanted to stop (perhaps
  249.   'using if this as a specialized FindWindow method,
  250.   'comparing a known class and title against the
  251.   'returned values, and a match was found, we'd need
  252.   'to return False (0) to stop enumeration. When 1 is
  253.   'returned, enumeration continues until there are no
  254.   'more windows left.
  255.    EnumWindowProc = 1
  256.  
  257. End Function
  258.  
  259.  
  260. Private Function TrimNull(item As String)
  261.  
  262.   'remove string before the terminating null(s)
  263.    Dim pos As Integer
  264.    
  265.    pos = InStr(item, Chr$(0))
  266.    
  267.    If pos Then
  268.          TrimNull = Left$(item, pos - 1)
  269.    Else: TrimNull = item
  270.    End If
  271.    
  272. End Function
  273.  
  274. 'Pass the message as string and get the LONG equivalent.
  275. 'Used to determine what has been selected from comboboxes and elsewhere
  276. Public Function GetMessageValue(strMessage As String) As Long
  277. Dim msg As Long
  278.  
  279. Select Case strMessage
  280.     Case "WM_DESTROY":
  281.         msg = WM_DESTROY
  282.     Case "WM_ENABLE":
  283.         msg = WM_ENABLE
  284.     Case "WM_HSCROLL":
  285.         msg = WM_HSCROLL
  286.     Case "WM_LBUTTONDBLCLK":
  287.         msg = WM_LBUTTONDBLCLK
  288.     Case "WM_LBUTTONDOWN":
  289.         msg = WM_LBUTTONDOWN
  290.     Case "WM_LBUTTONUP":
  291.         msg = WM_LBUTTONUP
  292.     Case "WM_MBUTTONDBLCLK":
  293.         msg = WM_MBUTTONDBLCLK
  294.     Case "WM_MBUTTONDOWN":
  295.         msg = WM_MBUTTONDOWN
  296.     Case "WM_MBUTTONUP":
  297.         msg = WM_MBUTTONUP
  298.     Case "WM_PASTE":
  299.         msg = WM_PASTE
  300.     Case "WM_QUIT":
  301.         msg = WM_QUIT
  302.     Case "WM_RBUTTONDBLCLK":
  303.         msg = WM_RBUTTONDBLCLK
  304.     Case "WM_RBUTTONDOWN":
  305.         msg = WM_RBUTTONDOWN
  306.     Case "WM_RBUTTONUP":
  307.         msg = WM_RBUTTONUP
  308.     Case "WM_SETFOCUS":
  309.         msg = WM_SETFOCUS
  310.     Case "WM_VSCROLL":
  311.         msg = WM_VSCROLL
  312.     Case "WM_CLOSE":
  313.         msg = WM_CLOSE
  314.     Case "WM_COPY":
  315.         msg = WM_COPY
  316.     Case "WM_GETTEXT":
  317.         msg = WM_GETTEXT
  318.     Case "WM_GETTEXTLENGTH":
  319.         msg = WM_GETTEXTLENGTH
  320.     Case "WM_SETTEXT":
  321.         msg = WM_SETTEXT
  322.     Case "WM_CLEAR":
  323.         msg = WM_CLEAR
  324.     Case "WM_CUT":
  325.         msg = WM_CUT
  326.     Case "WM_FONTCHANGE":
  327.         msg = WM_FONTCHANGE
  328.     Case "WM_GETFONT":
  329.         msg = WM_GETFONT
  330.     Case "WM_GETMINMAXINFO":
  331.         msg = WM_GETMINMAXINFO
  332.     Case "WM_KEYDOWN":
  333.         msg = WM_KEYDOWN
  334.     Case "WM_KEYUP":
  335.         msg = WM_KEYUP
  336.     Case "WM_SETFONT":
  337.         msg = WM_SETFONT
  338.     Case "WM_UNDO":
  339.         msg = WM_UNDO
  340. End Select
  341.  
  342. GetMessageValue = msg
  343. End Function
  344.  
  345. 'Converts a string into a Byte Array
  346. Public Function StringToByteArray(str As String) As Variant
  347. Dim bray() As Byte
  348. Dim cnt As Integer
  349. Dim ln As Integer
  350.  
  351. ln = Len(str)
  352.  
  353. ReDim bray(ln)
  354.  
  355. For cnt = 0 To ln - 1
  356.     bray(cnt) = Asc(Mid(str, cnt + 1, 1))
  357. Next cnt
  358. bray(ln) = 0
  359. StringToByteArray = bray
  360.  
  361. End Function
  362.  
  363. 'Converts a Byte Array to a string
  364. Public Function ByteArrayToString(bry As Variant) As String
  365. Dim cnt As Integer
  366. Dim dummy As String
  367.  
  368. For cnt = 0 To UBound(bry)
  369.     dummy = dummy & Chr$(bry(cnt))
  370. Next cnt
  371. ByteArrayToString = dummy
  372. End Function
  373.  
  374. 'Highlights the text in a textbox
  375. Public Sub MakeSelection(Txt As TextBox)
  376. With Txt
  377.     .SelStart = 0
  378.     .SelLength = Len(.text)
  379. End With
  380. End Sub
  381.