home *** CD-ROM | disk | FTP | other *** search
/ Dan Appleman's Visual Bas…s Guide to the Win32 API / Dan.Applmans.Visual.Basic.5.0.Programmers.Guide.To.The.Win32.API.1997.Ziff-Davis.Press.CD / VB5PG32.mdf / classlib / desaware / dwsystem.cls < prev    next >
Encoding:
Text File  |  1996-04-05  |  42.6 KB  |  1,089 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "dwSystem"
  6. Attribute VB_Creatable = True
  7. Attribute VB_Exposed = True
  8. Option Explicit
  9.  
  10. ' Class dwSystem
  11. ' System control and configuration class
  12. ' Copyright (c) 1996 by Desaware Inc.
  13. ' Part of the Desaware API Classes Library
  14. ' All rights reserved
  15.  
  16. ' These flags will activate certain functions that require
  17. ' classes that most functions do not need.  If you do not
  18. ' need to use a function that is triggered by a flag, you
  19. ' can set the flag to False, and prevent an unneeded class
  20. ' from being loaded.
  21. #Const FlagGlobalAlloc = True
  22. #Const FlagGetSystemPowerStatus = True
  23. #Const FlagGetVersionEx = True
  24. #Const FlagGetCPInfo = True
  25. #Const FlagDeviceContext = True
  26. #Const FlagMetaFile = True
  27.  
  28. ' Sub classes:
  29. Public Metrics As New dwMetrics
  30. Public SysColor As New dwSysColor
  31.  
  32. '**  Functions From Chapter 5 Index
  33.  
  34. #If Win32 Then
  35. Private Declare Function apiAdjustWindowRect& Lib "user32" Alias "AdjustWindowRect" (lpRect As RECT, ByVal dwStyle As Long, ByVal bMenu As Long)
  36. Private Declare Function apiAdjustWindowRectEx& Lib "user32" Alias "AdjustWindowRectEx" (lpRect As RECT, ByVal dsStyle As Long, ByVal bMenu As Long, ByVal dwEsStyle As Long)
  37. Private Declare Function apiAnyPopup& Lib "user32" Alias "AnyPopup" ()
  38. Private Declare Function apiGetActiveWindow& Lib "user32" Alias "GetActiveWindow" ()
  39. Private Declare Function apiFindWindow& Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String)
  40. Private Declare Function apiGetCapture& Lib "user32" Alias "GetCapture" ()
  41. Private Declare Function apiGetDesktopWindow& Lib "user32" Alias "GetDesktopWindow" ()
  42. Private Declare Function apiGetFocus& Lib "user32" Alias "GetFocus" ()
  43. Private Declare Function apiGetForegroundWindow& Lib "user32" Alias "GetForegroundWindow" ()
  44. Private Declare Function apiGetLastActivePopup& Lib "user32" Alias "GetLastActivePopup" (ByVal hwndOwnder As Long)
  45. Private Declare Function apiWindowFromPoint& Lib "user32" Alias "WindowFromPoint" (ByVal x As Long, ByVal y As Long)
  46.  
  47. #Else
  48. Private Declare Sub apiAdjustWindowRect Lib "user" Alias "AdjustWindowRec" (lpRect As RECT, ByVal dwStyle As Long, ByVal bMenu As Integer)
  49. Private Declare Sub apiAdjustWindowRectEx Lib "user" Alias "AdjustWindowRectEx" (lpRect As RECT, ByVal dsStyle As Long, ByVal bMenu As Integer, ByVal dwEsStyle As Long)
  50. Private Declare Function apiAnyPopup% Lib "user" Alias "AnyPopup" ()
  51. Private Declare Function apiGetActiveWindow% Lib "user" Alias "GetActiveWindow" ()
  52. Private Declare Function apiFindWindow% Lib "user" Alias "FindWindow" (ByVal lpClassName As Any, ByVal lpWindowName As Any)
  53. Private Declare Function apiGetCapture% Lib "user" Alias "GetCapture" ()
  54. Private Declare Function apiGetDesktopWindow% Lib "user" Alias "GetDesktopWindow" ()
  55. Private Declare Function apiGetFocus% Lib "user" Alias "GetFocus" ()
  56. 'function apiGetForegroundWindow is not available in the WIN16 API.
  57. Private Declare Function apiGetLastActivePopup% Lib "user" Alias "GetLastActivePopup" (ByVal hwndOwnder As Integer)
  58. Private Declare Function apiWindowFromPoint% Lib "user" Alias "WindowFromPoint" (ByVal pnt As Any)
  59. #End If 'WIN32
  60.  
  61. '**  Functions From Chapter 6 Index
  62.  
  63. #If Win32 Then
  64. Private Declare Function apiBeep& Lib "kernel32" Alias "Beep" (ByVal dwFreq As Long, ByVal dwDuration As Long)
  65. Private Declare Function apiCharToOem& Lib "user32" Alias "CharToOemA" (ByVal lpszSrc As String, ByVal lpszDst As String)
  66. Private Declare Function apiCharToOemBuff& Lib "user32" Alias "CharToOemBuffA" (ByVal lpszSrc As String, ByVal lpszDst As String, ByVal cchDstLength As Long)
  67. Private Declare Function apiClipCursor& Lib "user32" Alias "ClipCursor" (lpRect As RECT)
  68. Private Declare Function apiClipCursorBynum& Lib "user32" Alias "ClipCursor" (ByVal lpRect As Long)
  69. Private Declare Function apiExitWindowsEx& Lib "user32" Alias "ExitWindowsEx" (ByVal uFlags As Long, ByVal dwReserved As Long)
  70. Private Declare Function apiGetACP& Lib "kernel32" Alias "GetACP" ()
  71. Private Declare Function apiGetAsyncKeyState% Lib "user32" Alias "GetAsyncKeyState" (ByVal vKey As Long)
  72. Private Declare Function apiGetCaretBlinkTime& Lib "user32" Alias "GetCaretBlinkTime" ()
  73. Private Declare Function apiGetCPInfo& Lib "kernel32" Alias "GetCPInfo" (ByVal CodePage As Long, lpCPInfo As CPINFO)
  74. Private Declare Function apiGetClipCursor& Lib "user32" Alias "GetClipCursor" (lprc As RECT)
  75. Private Declare Function apiGetCommandLine& Lib "kernel32" Alias "GetCommandLineA" ()
  76. Private Declare Function apiGetComputerName& Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long)
  77. Private Declare Function apiGetCursorPos& Lib "user32" Alias "GetCursorPos" (lpPoint As POINTAPI)
  78. Private Declare Function apiGetDoubleClickTime& Lib "user32" Alias "GetDoubleClickTime" ()
  79. Private Declare Function apiGetInputState& Lib "user32" Alias "GetInputState" ()
  80. Private Declare Function apiGetKBCodePage& Lib "user32" Alias "GetKBCodePage" ()
  81. Private Declare Function apiGetKeyboardLayoutName& Lib "user32" Alias "GetKeyboardLayoutNameA" (ByVal pwszKLID As String)
  82. Private Declare Function apiGetKeyboardLayout& Lib "user32" Alias "GetKeyboardLayout" (ByVal dwLayout As Long)
  83. Private Declare Function apiGetKeyboardState& Lib "user32" Alias "GetKeyboardState" (pbKeyState As Byte)
  84. Private Declare Function apiGetKeyboardType& Lib "user32" Alias "GetKeyboardType" (ByVal nTypeFlag As Long)
  85. Private Declare Function apiGetKeyNameText& Lib "user32" Alias "GetKeyNameTextA" (ByVal lParam As Long, ByVal lpBuffer As String, ByVal nSize As Long)
  86. Private Declare Function apiGetKeyState% Lib "user32" Alias "GetKeyState" (ByVal nVirtKey As Long)
  87. Private Declare Function apiGetOEMCP& Lib "kernel32" Alias "GetOEMCP" ()
  88. Private Declare Function apiGetQueueStatus& Lib "user32" Alias "GetQueueStatus" (ByVal fuFlags As Long)
  89. Private Declare Function apiGetSystemDefaultLangID% Lib "kernel32" Alias "GetSystemDefaultLangID" ()
  90. Private Declare Function apiGetSystemDefaultLCID& Lib "kernel32" Alias "GetSystemDefaultLCID" ()
  91. Private Declare Function apiGetSystemPowerStatus& Lib "kernel32" Alias "GetSystemPowerStatus" (lpSystemPowerStatus As SYSTEM_POWER_STATUS)
  92. Private Declare Function apiGetThreadLocale& Lib "kernel32" Alias "GetThreadLocale" ()
  93. Private Declare Function apiGetUserDefaultLangID% Lib "kernel32" Alias "GetUserDefaultLangID" ()
  94. Private Declare Function apiGetUserDefaultLCID& Lib "kernel32" Alias "GetUserDefaultLCID" ()
  95. Private Declare Function apiGetUserName& Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long)
  96. Private Declare Function apiGetVersion& Lib "kernel32" Alias "GetVersion" ()
  97. Private Declare Function apiGetVersionEx& Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO)
  98. Private Declare Function apiIsValidCodePage& Lib "kernel32" Alias "IsValidCodePage" (ByVal CodePage As Long)
  99. Private Declare Function apiIsValidLocale& Lib "kernel32" Alias "IsValidLocale" (ByVal Locale As Long, ByVal dwFlags As Long)
  100. Private Declare Function apiMessageBeep& Lib "user32" Alias "MessageBeep" (ByVal wType As Long)
  101. Private Declare Function apiSetCaretBlinkTime& Lib "user32" Alias "SetCaretBlinkTime" (ByVal wMSeconds As Long)
  102. Private Declare Function apiSetComputerName& Lib "kernel32" Alias "SetComputerNameA" (ByVal lpComputerName As String)
  103. Private Declare Function apiSetCursorPos& Lib "user32" Alias "SetCursorPos" (ByVal x As Long, ByVal y As Long)
  104. Private Declare Function apiSetDoubleClickTime& Lib "user32" Alias "SetDoubleClickTime" (ByVal wCount As Long)
  105. Private Declare Function apiSetThreadLocale& Lib "kernel32" Alias "SetThreadLocale" (ByVal Locale As Long)
  106. Private Declare Function apiShowCursor& Lib "user32" Alias "ShowCursor" (ByVal bShow As Long)
  107. Private Declare Function apiSwapMouseButton& Lib "user32" Alias "SwapMouseButton" (ByVal bSwap As Long)
  108.  
  109. #Else
  110. 'function apiBeep is not available in the WIN16 API.
  111. 'function apiCharToOem is not available in the WIN16 API.
  112. 'function apiCharToOemBuff is not available in the WIN16 API.
  113. Private Declare Sub apiClipCursor Lib "user" Alias "ClipCursor" (lpRect As Any)
  114. Private Declare Sub apiClipCursorBynum Lib "user" Alias "ClipCursor" (ByVal lpRect As Long)
  115. 'function apiExitWindowsEx is not available in the WIN16 API.
  116. Private Declare Function apiExitWindows% Lib "user" Alias "ExitWindows" (ByVal dwReturnCode&, ByVal Reserved%)
  117. 'function apiGetACP is not available in the WIN16 API.
  118. Private Declare Function apiGetAsyncKeyState% Lib "user" Alias "GetAsyncKeyState" (ByVal vKey As Integer)
  119. Private Declare Function apiGetCaretBlinkTime% Lib "user" Alias "GetCaretBlinkTime" ()
  120. 'function apiGetCPInfo is not available in the WIN16 API.
  121. Private Declare Sub apiGetClipCursor Lib "user" Alias "GetClipCursor" (lprc As RECT)
  122. 'function apiGetCommandLine is not available in the WIN16 API.
  123. 'function apiGetComputerName is not available in the WIN16 API.
  124. Private Declare Sub apiGetCursorPos Lib "user" Alias "GetCursorPos" (lpPoint As POINTAPI)
  125. Private Declare Function apiGetDoubleClickTime% Lib "user" Alias "GetDoubleClickTime" ()
  126. Private Declare Function apiGetInputState% Lib "user" Alias "GetInputState" ()
  127. Private Declare Function apiGetKBCodePage% Lib "keyboard.dll" Alias "GetKBCodePage" ()
  128. 'function apiGetKeyboardLayoutName is not available in the WIN16 API.
  129. Private Declare Sub apiGetKeyboardState Lib "user" Alias "GetKeyboardState" (LpKeyState As Any)
  130. Private Declare Function apiGetKeyboardType% Lib "keyboard.dll" Alias "GetKeyboardType" (ByVal nTypeFlag As Integer)
  131. Private Declare Function apiGetKeyNameText% Lib "keyboard.dll" Alias "GetKeyNameText" (ByVal lParam As Long, ByVal lpBuffer As String, ByVal nSize As Integer)
  132. Private Declare Function apiGetKeyState% Lib "user" Alias "GetKeyState" (ByVal nVirtKey As Integer)
  133. 'Function GetOEMCP is not available in the WIN16 API.
  134. Private Declare Function apiGetQueueStatus& Lib "user" Alias "GetQueueStatus" (ByVal fuFlags As Integer)
  135. 'Function GetSystemDefaultLangID is not available in the WIN16 API.
  136. 'Function GetSystemDefaultLCID is not available in the WIN16 API.
  137. 'Function GetSystemPowerStatus is not available in the WIN16 API.
  138. 'Function GetThreadLocale is not available in the WIN16 API.
  139. 'Function GetUserDefaultLangID is not available in the WIN16 API.
  140. 'Function GetUserDefaultLCID is not available in the WIN16 API.
  141. 'Function GetUserName is not available in the WIN16 API.
  142. Private Declare Function apiGetVersion& Lib "kernel" Alias "GetVersion" ()
  143. 'Function GetVersionEx is not available in the WIN16 API.
  144. 'Function IsValidCodePage is not available in the WIN16 API.
  145. 'Function IsValidLocale is not available in the WIN16 API.
  146. Private Declare Sub apiMessageBeep Lib "user" Alias "MessageBeep" (ByVal wType As Integer)
  147. Private Declare Sub apiSetCaretBlinkTime Lib "user" Alias "SetCaretBlinkTime" (ByVal wMSeconds As Integer)
  148. 'Function SetComputerName is not available in the WIN16 API.
  149. Private Declare Sub apiSetCursorPos Lib "user" Alias "SetCursorPos" (ByVal x As Integer, ByVal y As Integer)
  150. Private Declare Sub apiSetDoubleClickTime Lib "user" Alias "SetDoubleClickTime" (ByVal wCount As Integer)
  151. 'Function SetThreadLocale is not available in the WIN16 API.
  152. Private Declare Function apiShowCursor% Lib "user" Alias "ShowCursor" (ByVal bShow As Integer)
  153. Private Declare Function apiSwapMouseButton% Lib "user" Alias "SwapMouseButton" (ByVal bSwap As Integer)
  154. #End If 'WIN32
  155.  
  156. '**  Functions From Chapter 8 Index
  157.  
  158. #If Win32 Then
  159. Private Declare Function apiCreateMetaFile& Lib "gdi32" Alias "CreateMetaFileA" (ByVal lpstring As String)
  160. Private Declare Function apiCreatePen& Lib "gdi32" Alias "CreatePen" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long)
  161. Private Declare Function apiGdiFlush& Lib "gdi32" Alias "GdiFlush" ()
  162. Private Declare Function apiGdiGetBatchLimit& Lib "gdi32" Alias "GdiGetBatchLimit" ()
  163. Private Declare Function apiGdiSetBatchLimit& Lib "gdi32" Alias "GdiSetBatchLimit" (ByVal dwLimit As Long)
  164. Private Declare Function apiGetEnhMetaFile& Lib "gdi32" Alias "GetEnhMetaFileA" (ByVal lpszMetaFile As String)
  165. Private Declare Function apiGetMetaFile& Lib "gdi32" Alias "GetMetaFileA" (ByVal lpFileName As String)
  166. #Else
  167. Private Declare Function apiCreateMetaFile% Lib "gdi" Alias "CreateMetaFile" (ByVal lpstring As Any)
  168. Private Declare Function apiCreatePen% Lib "gdi" Alias "CreatePen" (ByVal nPenStyle As Integer, ByVal nWidth As Integer, ByVal crColor As Long)
  169. 'function apiGdiFlush is not available in the WIN16 API.
  170. 'function apiGdiGetBatchLimit is not available in the WIN16 API.
  171. 'function apiGdiSetBatchLimit is not available in the WIN16 API.
  172. 'function apiGetEnhMetaFile is not available in the WIN16 API.
  173. Private Declare Function apiGetMetaFile% Lib "gdi" Alias "GetMetaFile" (ByVal lpFileName As String)
  174. #End If 'WIN32
  175.  
  176. #If Win32 Then
  177. Private Declare Function apiGlobalAlloc& Lib "kernel32" Alias "GlobalAlloc" (ByVal fuFlags As Long, ByVal cdBytes As Long)
  178. Private Declare Function apiMessageBox& Lib "user32" Alias "MessageBox" (ByVal hWnd&, ByVal lpText$, ByVal lpCaption$, ByVal wType&)
  179. Private Declare Function apiGetTickCount& Lib "user32" Alias "GetTickCount" ()
  180. #Else
  181. Private Declare Function apiGlobalAlloc% Lib "kernel" Alias "GlobalAlloc" (ByVal fuFlags As Integer, ByVal cdBytes As Long)
  182. Private Declare Function apiMessageBox% Lib "user" Alias "MessageBox" (ByVal hWnd%, ByVal lpText$, ByVal lpCaption$, ByVal wType%)
  183. Private Declare Function apiGetTickCount& Lib "user" Alias "GetTickCount" ()
  184. #End If 'WIN32
  185.  
  186.  
  187. Private Sub RaiseSysError(Optional errval)
  188.     If IsMissing(errval) Then
  189.         RaiseError DWERR_APIRESULT, "dwSystem"
  190.     Else
  191.         RaiseError errval, "dwSystem"
  192.     End If
  193. End Sub
  194.  
  195. Public Function CreatePen(ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As dwPen
  196. Attribute CreatePen.VB_HelpID = 2510
  197. Attribute CreatePen.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  198.     Dim newPen As New dwPen
  199. #If Win32 Then
  200.     Dim penHandle As Long
  201. #Else
  202.     Dim penHandle As Integer
  203. #End If
  204.     
  205.     penHandle = apiCreatePen(nPenStyle, nWidth, crColor)
  206.     newPen.hPen = penHandle
  207.     Set CreatePen = newPen
  208. End Function
  209.  
  210. #If FlagDeviceContext Then
  211. Public Function CreateMetafile(filename As String) As dwDeviceContext
  212. Attribute CreateMetafile.VB_HelpID = 2508
  213. Attribute CreateMetafile.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  214.     Dim newHDC As New dwDeviceContext
  215. #If Win32 Then
  216.     Dim hDC As Long
  217. #Else
  218.     Dim hDC As Integer
  219. #End If
  220.     
  221.     hDC = apiCreateMetaFile(filename)
  222.     newHDC.DCsource = 3
  223.     newHDC.hDC = hDC
  224.     Set CreateMetafile = newHDC
  225. End Function
  226. #End If ' FlagDeviceContext
  227.  
  228. Public Sub Beep(ByVal lFreq As Long, ByVal lDuration As Long)
  229. Attribute Beep.VB_HelpID = 2340
  230. Attribute Beep.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  231. #If Win32 Then
  232.     Dim ret&
  233.     
  234.     ret& = apiBeep(lFreq, lDuration)
  235.     If ret& = 0 Then RaiseSysError
  236. #Else
  237.     RaiseSysError DWERR_NOTINWIN16
  238. #End If
  239. End Sub
  240.  
  241. Public Sub CharToOem(lpszSrc As String, lpszDst As String)
  242. Attribute CharToOem.VB_HelpID = 2838
  243. Attribute CharToOem.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  244. #If Win32 Then
  245.     lpszDst = String$(Len(lpszSrc), 0)
  246.     apiCharToOem lpszSrc, lpszDst
  247. #Else
  248.     RaiseSysError DWERR_NOTINWIN16
  249. #End If
  250. End Sub
  251.  
  252. Public Sub ClipCursor(lpRect As dwRECT)
  253. Attribute ClipCursor.VB_HelpID = 2965
  254. Attribute ClipCursor.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  255.     Dim ret&
  256.     
  257. #If Win32 Then
  258.     ret& = apiClipCursorBynum(lpRect.GetAddress())
  259.     If ret& = 0 Then RaiseSysError
  260. #Else
  261.     apiClipCursorBynum lpRect.GetAddress()
  262. #End If
  263. End Sub
  264.  
  265. ' Use this to stop clipping the cursor.
  266. Public Sub UnClipCursor()
  267. Attribute UnClipCursor.VB_HelpID = 2965
  268. Attribute UnClipCursor.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  269.     Dim ret&
  270.  
  271. #If Win32 Then
  272.     ret& = apiClipCursorBynum(0)
  273.     If ret& = 0 Then RaiseSysError
  274. #Else
  275.     apiClipCursorBynum 0
  276. #End If
  277. End Sub
  278.  
  279. Public Sub ExitWindows(ByVal uFlags As Long) ' was ExitWindowsEx in 32-bit
  280. Attribute ExitWindows.VB_HelpID = 2756
  281. Attribute ExitWindows.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  282. #If Win32 Then
  283.     Dim ret&
  284.     
  285.     ret& = apiExitWindowsEx(uFlags, 0)
  286.     If ret& = 0 Then RaiseSysError
  287. #Else
  288.     Dim ret%
  289.     
  290.     ret% = apiExitWindows(uFlags, 0)
  291.     If ret% = 0 Then RaiseSysError
  292. #End If
  293. End Sub
  294.  
  295. Public Function GetACP() As Long
  296. Attribute GetACP.VB_HelpID = 2418
  297. Attribute GetACP.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  298. #If Win32 Then
  299.     GetACP = apiGetACP()
  300. #Else
  301.     GetACP = 0
  302. #End If
  303. End Function
  304.  
  305. Public Function GetAsyncKeyState(ByVal vKey As Long) As Integer
  306. Attribute GetAsyncKeyState.VB_HelpID = 2857
  307. Attribute GetAsyncKeyState.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  308.     GetAsyncKeyState = apiGetAsyncKeyState(vKey)
  309. End Function
  310.  
  311. Public Function GetCaretBlinkTime() As Long
  312. Attribute GetCaretBlinkTime.VB_HelpID = 2970
  313. Attribute GetCaretBlinkTime.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  314.     GetCaretBlinkTime = apiGetCaretBlinkTime()
  315. End Function
  316.  
  317. #If FlagGetCPInfo Then
  318. Public Sub GetCPInfo(ByVal CodePage As Long, lpCPInfo As dwCPInfo)
  319. Attribute GetCPInfo.VB_HelpID = 2420
  320. Attribute GetCPInfo.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  321. #If Win32 Then
  322.     Dim ret&
  323.     Dim tempCPinfo As CPINFO
  324.     
  325.     ret& = apiGetCPInfo(CodePage, tempCPinfo)
  326.     lpCPInfo.CopyFromCPINFO agGetAddressForObject(tempCPinfo)
  327.     If ret& = 0 Then RaiseSysError
  328. #Else
  329.     RaiseSysError DWERR_NOTINWIN16
  330. #End If
  331. End Sub
  332. #End If ' FlagGetCPInfo
  333.  
  334. Public Sub GetClipCursor(lprc As dwRECT)
  335. Attribute GetClipCursor.VB_HelpID = 2968
  336. Attribute GetClipCursor.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  337.     Dim ret&
  338.     Dim tmpRect As RECT
  339.     
  340. #If Win32 Then
  341.     ret& = apiGetClipCursor(tmpRect)
  342.     If ret& = 0 Then RaiseSysError
  343. #Else
  344.     apiGetClipCursor tmpRect
  345. #End If
  346.     lprc.SetRect tmpRect.left, tmpRect.top, tmpRect.right, tmpRect.bottom
  347. End Sub
  348.  
  349. Public Function GetCommandLine() As String
  350. Attribute GetCommandLine.VB_HelpID = 2057
  351. Attribute GetCommandLine.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  352. #If Win32 Then
  353.     Dim addr As Long
  354.     
  355.     addr = apiGetCommandLine()
  356.     GetCommandLine = agGetStringFromPointer(addr)
  357. #Else
  358.     RaiseSysError DWERR_NOTINWIN16
  359. #End If
  360. End Function
  361.  
  362. Public Function GetComputerName() As String
  363. Attribute GetComputerName.VB_HelpID = 2412
  364. Attribute GetComputerName.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  365. #If Win32 Then
  366.     Dim ret&
  367.     Dim strng$
  368.     Dim strngLen&
  369.     
  370.     strng$ = String$(MAX_COMPUTERNAME_LENGTH + 1, 0)
  371.     strngLen& = MAX_COMPUTERNAME_LENGTH
  372.     ret& = apiGetComputerName(strng$, strngLen&)
  373.     If ret& = 0 Then RaiseSysError
  374.     GetComputerName = left$(strng$, strngLen&)
  375. #Else
  376.     RaiseSysError DWERR_NOTINWIN16
  377. #End If
  378. End Function
  379.  
  380. Public Function GetCursorPos() As dwPoint
  381. Attribute GetCursorPos.VB_HelpID = 2964
  382. Attribute GetCursorPos.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  383.     Dim tmpdwPoint As New dwPoint
  384.     Dim tmpPoint As POINTAPI
  385.     Dim ret&
  386.  
  387. #If Win32 Then
  388.     ret& = apiGetCursorPos(tmpPoint)
  389.     If ret& = 0 Then RaiseSysError
  390. #Else
  391.     apiGetCursorPos tmpPoint
  392. #End If
  393.     tmpdwPoint.x = tmpPoint.x
  394.     tmpdwPoint.y = tmpPoint.y
  395.     Set GetCursorPos = tmpdwPoint
  396. End Function
  397.  
  398. Public Function GetDoubleClickTime() As Long
  399. Attribute GetDoubleClickTime.VB_HelpID = 2778
  400. Attribute GetDoubleClickTime.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  401.     GetDoubleClickTime = apiGetDoubleClickTime()
  402. End Function
  403.  
  404. Public Function GetInputState() As Boolean
  405. Attribute GetInputState.VB_HelpID = 2869
  406. Attribute GetInputState.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  407.     If apiGetInputState() = 0 Then
  408.         GetInputState = False
  409.     Else
  410.         GetInputState = True
  411.     End If
  412. End Function
  413.  
  414. Public Function GetKeyboardLayoutName() As String
  415. Attribute GetKeyboardLayoutName.VB_HelpID = 2743
  416. Attribute GetKeyboardLayoutName.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  417. #If Win32 Then
  418.     Dim strng As String
  419.     Dim ret&
  420.     
  421.     strng = String$(KL_NAMELENGTH, 0)
  422.     ret& = apiGetKeyboardLayoutName(strng)
  423.     If ret& = 0 Then RaiseSysError
  424.     GetKeyboardLayoutName = strng
  425. #Else
  426.     RaiseSysError DWERR_NOTINWIN16
  427. #End If
  428. End Function
  429.  
  430. ' lpClassName as String, lpWindowName as String
  431. Public Function FindWindow(Optional lpClassName As Variant, Optional lpWindowName As Variant) As dwWindow
  432. Attribute FindWindow.VB_HelpID = 2790
  433. Attribute FindWindow.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  434.     Dim ret&
  435.     Dim newWindow As New dwWindow
  436.  
  437.     If lpClassName = Empty Then
  438.         ret& = apiFindWindow(vbNullString, CStr(lpWindowName))
  439.     ElseIf lpWindowName = Empty Then
  440.         ret& = apiFindWindow(CStr(lpClassName), vbNullString)
  441.     Else
  442.         ret& = apiFindWindow(CStr(lpClassName), CStr(lpWindowName))
  443.     End If
  444.     
  445.     If ret& = 0 Then RaiseSysError
  446.     
  447.     newWindow.hWnd = ret&
  448.     Set FindWindow = newWindow
  449. End Function
  450.  
  451. Public Function GetActiveWindow() As dwWindow
  452. Attribute GetActiveWindow.VB_HelpID = 2854
  453. Attribute GetActiveWindow.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  454.     Dim newWindow As New dwWindow
  455.     
  456.     newWindow.hWnd = apiGetActiveWindow()
  457.     Set GetActiveWindow = newWindow
  458. End Function
  459.  
  460. Public Function GetCapture() As dwWindow
  461. Attribute GetCapture.VB_HelpID = 2871
  462. Attribute GetCapture.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  463.     Dim newWindow As New dwWindow
  464.  
  465.     newWindow.hWnd = apiGetCapture()
  466.     Set GetCapture = newWindow
  467. End Function
  468.  
  469. Public Function GetDesktopWindow() As dwWindow
  470. Attribute GetDesktopWindow.VB_HelpID = 3007
  471. Attribute GetDesktopWindow.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  472.     Dim newWindow As New dwWindow
  473.  
  474.     newWindow.hWnd = apiGetDesktopWindow()
  475.     Set GetDesktopWindow = newWindow
  476. End Function
  477.  
  478. Public Function GetFocus() As dwWindow
  479. Attribute GetFocus.VB_HelpID = 2853
  480. Attribute GetFocus.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  481.     Dim newWindow As New dwWindow
  482.  
  483.     newWindow.hWnd = apiGetFocus()
  484.     Set GetFocus = newWindow
  485. End Function
  486.  
  487. Public Function GetForegroundWindow() As dwWindow
  488. Attribute GetForegroundWindow.VB_HelpID = 2919
  489. Attribute GetForegroundWindow.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  490. #If Win32 Then
  491.     Dim newWindow As New dwWindow
  492.  
  493.     newWindow.hWnd = apiGetForegroundWindow()
  494.     Set GetForegroundWindow = newWindow
  495. #Else
  496.     RaiseSysError DWERR_NOTINWIN16
  497. #End If
  498. End Function
  499.  
  500. Public Function GetLastActivePopup(hwndOwner As dwWindow) As dwWindow
  501. Attribute GetLastActivePopup.VB_HelpID = 3015
  502. Attribute GetLastActivePopup.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  503. #If Win32 Then
  504.     Dim newWindow As New dwWindow
  505.  
  506.     newWindow.hWnd = apiGetLastActivePopup(hwndOwner.hWnd)
  507.     Set GetLastActivePopup = newWindow
  508. #Else
  509.     RaiseSysError DWERR_NOTINWIN16
  510. #End If
  511. End Function
  512.  
  513. Public Function WindowFromPoint(pPoint As dwPoint) As dwWindow
  514. Attribute WindowFromPoint.VB_HelpID = 2980
  515. Attribute WindowFromPoint.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  516. #If Win32 Then
  517.     Dim ret As Long
  518. #Else
  519.     Dim ret As Integer
  520.     Dim lPnt As Long
  521. #End If
  522.     Dim newWindow As New dwWindow
  523.     
  524. #If Win32 Then
  525.     ret = apiWindowFromPoint(pPoint.x, pPoint.y)
  526. #Else
  527.     lPnt = (pPoint.x * 65536) + pPoint.y ' convert point coordinates into a long integer
  528.     ret = apiWindowFromPoint(lPnt)
  529. #End If
  530.     If ret = 0 Then RaiseSysError
  531.     newWindow.hWnd = ret
  532.     Set WindowFromPoint = newWindow
  533. End Function
  534.  
  535. Public Sub AdjustWindowRect(lpRect As dwRECT, ByVal dwStyle As Long, ByVal bMenu As Long)
  536. Attribute AdjustWindowRect.VB_HelpID = 2956
  537. Attribute AdjustWindowRect.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  538.     lpRect.AdjustWindowRect dwStyle, bMenu
  539. End Sub
  540.  
  541. Public Sub AdjustWindowRectEx(lpRect As dwRECT, ByVal dwStyle, ByVal bMenu As Long, ByVal dwEsStyle As Long)
  542. Attribute AdjustWindowRectEx.VB_HelpID = 2957
  543. Attribute AdjustWindowRectEx.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  544.     lpRect.AdjustWindowRectEx dwStyle, bMenu, dwEsStyle
  545. End Sub
  546.  
  547. Public Sub GdiFlush()
  548. Attribute GdiFlush.VB_HelpID = 2717
  549. Attribute GdiFlush.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  550. #If Win32 Then
  551.     Dim ret&
  552.     
  553.     ret& = apiGdiFlush()
  554.     If ret& = 0 Then RaiseSysError
  555. #Else
  556.     RaiseSysError DWERR_NOTINWIN16
  557. #End If
  558. End Sub
  559.  
  560. Public Function GdiGetBatchLimit() As Long
  561. Attribute GdiGetBatchLimit.VB_HelpID = 2719
  562. Attribute GdiGetBatchLimit.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  563. #If Win32 Then
  564.     Dim ret&
  565.     
  566.     ret& = apiGdiGetBatchLimit()
  567.     If ret& = 0 Then RaiseSysError
  568.     GdiGetBatchLimit = ret&
  569. #Else
  570.     RaiseSysError DWERR_NOTINWIN16
  571. #End If
  572. End Function
  573.  
  574. Public Function GdiSetBatchLimit(ByVal dwLimit As Long) As Long
  575. Attribute GdiSetBatchLimit.VB_HelpID = 2718
  576. Attribute GdiSetBatchLimit.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  577. #If Win32 Then
  578.     Dim ret&
  579.     
  580.     ret& = apiGdiSetBatchLimit(dwLimit)
  581.     If ret& = 0 Then RaiseSysError
  582.     GdiSetBatchLimit = ret&
  583. #Else
  584.     RaiseSysError DWERR_NOTINWIN16
  585. #End If
  586. End Function
  587.  
  588. #If FlagMetaFile Then
  589. Public Function GetEnhMetaFile(lpszMetaFile As String) As dwMetaFile
  590. Attribute GetEnhMetaFile.VB_HelpID = 2645
  591. Attribute GetEnhMetaFile.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  592. #If Win32 Then
  593.     Dim ret&
  594.     Dim newMFile As New dwMetaFile
  595.     
  596.     ret& = apiGetEnhMetaFile(lpszMetaFile)
  597.     newMFile.InitializeMetafile ret&, True
  598.     Set GetEnhMetaFile = newMFile
  599. #Else
  600.     RaiseSysError DWERR_NOTINWIN16
  601. #End If
  602. End Function
  603. #End If ' FlagMetaFile
  604.  
  605. #If FlagMetaFile Then
  606. Public Function GetMetaFile(lpszFileName As String) As dwMetaFile
  607. Attribute GetMetaFile.VB_HelpID = 2558
  608. Attribute GetMetaFile.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  609.     Dim ret&
  610.     Dim newMFile As New dwMetaFile
  611.     
  612.     ret& = apiGetMetaFile(lpszFileName)
  613.     newMFile.InitializeMetafile ret&, False
  614.     Set GetMetaFile = newMFile
  615. End Function
  616. #End If ' FlagMetaFile
  617.  
  618. Public Function AnyPopup() As Long
  619. Attribute AnyPopup.VB_HelpID = 2803
  620. Attribute AnyPopup.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  621.     Dim ret&
  622.     
  623.     ret& = apiAnyPopup()
  624.     If ret& = 0 Then RaiseSysError
  625.     AnyPopup = ret&
  626. End Function
  627.  
  628. Public Function GetKeyboardLayout(ByVal lLayout As Long) As Long
  629. Attribute GetKeyboardLayout.VB_HelpID = 3550
  630. Attribute GetKeyboardLayout.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  631. #If Win32 Then
  632.     Dim ret&
  633.     
  634.     ret& = apiGetKeyboardLayout(lLayout)
  635.     If ret& = 0 Then RaiseSysError
  636.     GetKeyboardLayout = ret&
  637. #Else
  638.     RaiseSysError DWERR_NOTINWIN16
  639. #End If
  640. End Function
  641.  
  642. #If Win32 Then
  643. Public Sub GetKeyboardState(pbKeyState As Byte)
  644. Attribute GetKeyboardState.VB_HelpID = 2858
  645. Attribute GetKeyboardState.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  646.     Dim ret&
  647.     
  648.     ret& = apiGetKeyboardState(pbKeyState)
  649.     If ret& = 0 Then RaiseSysError
  650. End Sub
  651. #Else ' pbKeyState should be a 256 character array
  652. Public Sub GetKeyboardState(pbKeyState As Byte)
  653.     apiGetKeyboardState pbKeyState
  654. End Sub
  655. #End If
  656.  
  657. Public Function GetKeyboardType(ByVal nTypeFlag As Long) As Long
  658. Attribute GetKeyboardType.VB_HelpID = 2861
  659. Attribute GetKeyboardType.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  660.     Dim ret&
  661.     
  662.     ret& = apiGetKeyboardType(nTypeFlag)
  663.     If ret& = 0 Then RaiseSysError
  664.     GetKeyboardType = ret&
  665. End Function
  666.  
  667. Public Function GetKeyNameText(ByVal lParam As Long, lpBuffer As String, ByVal nSize As Long) As Long
  668. Attribute GetKeyNameText.VB_HelpID = 2861
  669. Attribute GetKeyNameText.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  670.     Dim ret&
  671.     
  672.     ret& = apiGetKeyNameText(lParam, lpBuffer, nSize)
  673.     If ret& = 0 Then RaiseSysError
  674.     GetKeyNameText = ret&
  675. End Function
  676.  
  677. Public Function GetKeyState(ByVal nVirtKey As Long) As Integer
  678. Attribute GetKeyState.VB_HelpID = 2856
  679. Attribute GetKeyState.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  680.     GetKeyState = apiGetKeyState(nVirtKey)
  681. End Function
  682.  
  683. Public Function GetOEMCP() As Long
  684. Attribute GetOEMCP.VB_HelpID = 2419
  685. Attribute GetOEMCP.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  686. #If Win32 Then
  687.     Dim ret&
  688.     
  689.     ret& = apiGetOEMCP()
  690.     If ret& = 0 Then RaiseSysError
  691.     GetOEMCP = ret&
  692. #Else
  693.     RaiseSysError DWERR_NOTINWIN16
  694. #End If
  695. End Function
  696.  
  697. Public Function GetQueueStatus(ByVal fuFlags As Long) As Long
  698. Attribute GetQueueStatus.VB_HelpID = 2870
  699. Attribute GetQueueStatus.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  700.     Dim ret&
  701.     
  702.     ret& = apiGetQueueStatus(fuFlags)
  703.     If ret& = 0 Then RaiseSysError
  704.     GetQueueStatus = ret&
  705. End Function
  706.  
  707.  
  708. Public Function GetSystemDefaultLangID() As Integer
  709. Attribute GetSystemDefaultLangID.VB_HelpID = 2431
  710. Attribute GetSystemDefaultLangID.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  711. #If Win32 Then
  712.     Dim ret&
  713.     
  714.     ret& = apiGetSystemDefaultLangID()
  715.     If ret& = 0 Then RaiseSysError
  716.     GetSystemDefaultLangID = ret&
  717. #Else
  718.     RaiseSysError DWERR_NOTINWIN16
  719. #End If
  720. End Function
  721.  
  722. Public Function GetSystemDefaultLCID() As Long
  723. Attribute GetSystemDefaultLCID.VB_HelpID = 2433
  724. Attribute GetSystemDefaultLCID.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  725. #If Win32 Then
  726.     Dim ret&
  727.     
  728.     ret& = apiGetSystemDefaultLCID()
  729.     If ret& = 0 Then RaiseSysError
  730.     GetSystemDefaultLCID = ret&
  731. #Else
  732.     RaiseSysError DWERR_NOTINWIN16
  733. #End If
  734. End Function
  735.  
  736. 'Only works under Win95
  737. #If FlagGetSystemPowerStatus = True Then
  738. Public Function GetSystemPowerStatus() As dwSysPower
  739. Attribute GetSystemPowerStatus.VB_HelpID = 3421
  740. Attribute GetSystemPowerStatus.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  741. #If Win32 Then
  742.     Dim ret&
  743.     Dim tempSysPower As SYSTEM_POWER_STATUS
  744.     Dim tempSysPower2 As New dwSysPower
  745.     
  746.     ret& = apiGetSystemPowerStatus(tempSysPower)
  747.     If ret& = 0 Then RaiseSysError
  748.     Call tempSysPower2.SetSysPower(tempSysPower.ACLineStatus, tempSysPower.BatteryFlag, tempSysPower.BatteryLifePercent, tempSysPower.Reserved1, tempSysPower.BatteryLifeTime, tempSysPower.BatteryFullLifeTime)
  749.     Set GetSystemPowerStatus = tempSysPower2
  750. #Else
  751.     RaiseSysError DWERR_NOTINWIN16
  752. #End If
  753. End Function
  754. #End If 'FlagGetSystemPowerStatus
  755.  
  756. Public Function GetThreadLocale() As Long
  757. Attribute GetThreadLocale.VB_HelpID = 2441
  758. Attribute GetThreadLocale.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  759. #If Win32 Then
  760.     Dim ret&
  761.     
  762.     ret& = apiGetThreadLocale()
  763.     If ret& = 0 Then RaiseSysError
  764.     GetThreadLocale = ret&
  765. #Else
  766.     RaiseSysError DWERR_NOTINWIN16
  767. #End If
  768. End Function
  769.  
  770. Public Function GetUserDefaultLangID() As Long
  771. Attribute GetUserDefaultLangID.VB_HelpID = 2432
  772. Attribute GetUserDefaultLangID.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  773. #If Win32 Then
  774.     Dim ret&
  775.     
  776.     ret& = apiGetUserDefaultLangID()
  777.     If ret& = 0 Then RaiseSysError
  778.     GetUserDefaultLangID = ret&
  779. #Else
  780.     RaiseSysError DWERR_NOTINWIN16
  781. #End If
  782. End Function
  783.  
  784. Public Function GetUserDefaultLCID() As Long
  785. Attribute GetUserDefaultLCID.VB_HelpID = 2434
  786. Attribute GetUserDefaultLCID.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  787. #If Win32 Then
  788.     Dim ret&
  789.     
  790.     ret& = apiGetUserDefaultLCID()
  791.     If ret& = 0 Then RaiseSysError
  792.     GetUserDefaultLCID = ret&
  793. #Else
  794.     RaiseSysError DWERR_NOTINWIN16
  795. #End If
  796. End Function
  797.  
  798. Public Function GetUserName() As String
  799. Attribute GetUserName.VB_HelpID = 2414
  800. Attribute GetUserName.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  801. #If Win32 Then
  802.     Dim lpBuffer As String
  803.     Dim ret&
  804.     
  805.     ret& = apiGetUserName(lpBuffer, MAX_LEN)
  806.     If ret& = 0 Then RaiseSysError
  807.     lpBuffer = left$(lpBuffer, ret&)
  808.     GetUserName = lpBuffer
  809. #Else
  810.     RaiseSysError DWERR_NOTINWIN16
  811. #End If
  812. End Function
  813.  
  814. Public Function GetVersion() As Long
  815. Attribute GetVersion.VB_HelpID = 2082
  816. Attribute GetVersion.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  817.     Dim ret&
  818.     
  819.     ret& = apiGetVersion()
  820.     If ret& = 0 Then RaiseSysError
  821.     GetVersion = ret&
  822. End Function
  823.  
  824. #If FlagGetVersionEx = True Then
  825. Public Function GetVersionEx(lpVersionInformation As dwOSVersionInfo) As Long
  826. Attribute GetVersionEx.VB_HelpID = 3420
  827. Attribute GetVersionEx.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  828. #If Win32 Then
  829.     Dim ret&
  830.     Dim tempOSVerInfo As OSVERSIONINFO
  831.     
  832.     tempOSVerInfo.dwOSVersionInfoSize = 148
  833.     ret& = apiGetVersionEx(tempOSVerInfo)
  834.     lpVersionInformation.setOSVERSIONINFO tempOSVerInfo.dwOSVersionInfoSize, tempOSVerInfo.dwMajorVersion, tempOSVerInfo.dwMinorVersion, tempOSVerInfo.dwBuildNumber, tempOSVerInfo.dwPlatformId, tempOSVerInfo.szCSDVersion
  835.     If ret& = 0 Then RaiseSysError
  836.     GetVersionEx = ret&
  837. #Else
  838.     RaiseSysError DWERR_NOTINWIN16
  839. #End If
  840. End Function
  841. #End If 'FlagGetVersionEx
  842.  
  843. Public Function IsValidCodePage(CodePage As Long) As Boolean
  844. Attribute IsValidCodePage.VB_HelpID = 2417
  845. Attribute IsValidCodePage.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  846. #If Win32 Then
  847.     Dim ret&
  848.     
  849.     ret& = apiIsValidCodePage(CodePage)
  850.     If ret& = 0 Then
  851.         IsValidCodePage = False
  852.     Else
  853.         IsValidCodePage = True
  854.     End If
  855. #Else
  856.     RaiseSysError DWERR_NOTINWIN16
  857. #End If
  858. End Function
  859.  
  860. Public Function IsValidLocale(Locale As Long, lFlags As Long) As Boolean
  861. Attribute IsValidLocale.VB_HelpID = 2439
  862. Attribute IsValidLocale.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  863. #If Win32 Then
  864.     Dim ret&
  865.     
  866.     ret& = apiIsValidLocale(Locale, lFlags)
  867.     If ret& = 0 Then
  868.         IsValidLocale = False
  869.     Else
  870.         IsValidLocale = True
  871.     End If
  872. #Else
  873.     RaiseSysError DWERR_NOTINWIN16
  874. #End If
  875. End Function
  876.  
  877. Public Sub MessageBeep(ByVal wType As Long)
  878. Attribute MessageBeep.VB_HelpID = 2960
  879. Attribute MessageBeep.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  880.     Dim ret&
  881.  
  882. #If Win32 Then
  883.     ret& = apiMessageBeep(wType)
  884.     If ret& = 0 Then RaiseSysError
  885. #Else
  886.     apiMessageBeep wType
  887. #End If
  888. End Sub
  889.  
  890. Public Sub SetCaretBlinkTime(ByVal wMSeconds As Long)
  891. Attribute SetCaretBlinkTime.VB_HelpID = 2971
  892. Attribute SetCaretBlinkTime.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  893.     Dim ret&
  894.     
  895. #If Win32 Then
  896.     ret& = apiSetCaretBlinkTime(wMSeconds)
  897.     If ret& = 0 Then RaiseSysError
  898. #Else
  899.     apiSetCaretBlinkTime wMSeconds
  900. #End If
  901. End Sub
  902.  
  903. Public Sub SetComputerName(ByVlpComputerName As String)
  904. Attribute SetComputerName.VB_HelpID = 2413
  905. Attribute SetComputerName.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  906. #If Win32 Then
  907.     Dim ret&
  908.     
  909.     ret& = apiSetComputerName(ByVlpComputerName)
  910.     If ret& = 0 Then RaiseSysError
  911. #Else
  912.     RaiseSysError DWERR_NOTINWIN16
  913. #End If
  914. End Sub
  915.  
  916. Public Sub SetCursorPos(pPoint As dwPoint)
  917. Attribute SetCursorPos.VB_HelpID = 2962
  918. Attribute SetCursorPos.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  919. #If Win32 Then
  920.     Dim ret&
  921.     
  922.     ret& = apiSetCursorPos(pPoint.x, pPoint.y)
  923.     If ret& = 0 Then RaiseSysError
  924. #Else
  925.     apiSetCursorPos pPoint.x, pPoint.y
  926. #End If
  927. End Sub
  928.  
  929. Public Sub SetDoubleClickTime(ByVal wCount As Long)
  930. Attribute SetDoubleClickTime.VB_HelpID = 2779
  931. Attribute SetDoubleClickTime.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  932. #If Win32 Then
  933.     Dim ret&
  934.     
  935.     ret& = apiSetDoubleClickTime(wCount)
  936.     If ret& = 0 Then RaiseSysError
  937. #Else
  938.     apiSetDoubleClickTime wCount
  939. #End If
  940. End Sub
  941.  
  942. Public Sub SetThreadLocale(Locale As Long)
  943. Attribute SetThreadLocale.VB_HelpID = 2430
  944. Attribute SetThreadLocale.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  945. #If Win32 Then
  946.     Dim ret&
  947.     
  948.     ret& = apiSetThreadLocale(Locale)
  949.     If ret& = 0 Then RaiseSysError
  950. #Else
  951.     RaiseSysError DWERR_NOTINWIN16
  952. #End If
  953. End Sub
  954.  
  955. Public Function ShowCursor(ByVal bShow As Long) As Long
  956. Attribute ShowCursor.VB_HelpID = 2961
  957. Attribute ShowCursor.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  958.     Dim ret&
  959.     
  960.     ret& = apiShowCursor(bShow)
  961.     ShowCursor = ret&
  962. End Function
  963.  
  964. Public Sub SwapMouseButton(ByVal bSwap As Long)
  965. Attribute SwapMouseButton.VB_HelpID = 2757
  966. Attribute SwapMouseButton.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  967.     Dim ret&
  968.     
  969.     ret& = apiSwapMouseButton(bSwap)
  970. End Sub
  971.  
  972. Public Function GetKBCodePage() As Long
  973. Attribute GetKBCodePage.VB_HelpID = 2855
  974. Attribute GetKBCodePage.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  975.     GetKBCodePage = apiGetKBCodePage()
  976. End Function
  977.  
  978. #If FlagGlobalAlloc = True Then
  979. Public Function GlobalAlloc(ByVal fuFlags As Long, cBytes As Long) As dwGlobalMemory
  980. Attribute GlobalAlloc.VB_HelpID = 2108
  981. Attribute GlobalAlloc.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  982.     Dim newGMem As New dwGlobalMemory
  983. #If Win32 Then
  984.     Dim ret As Long
  985. #Else
  986.     Dim ret As Integer
  987. #End If
  988.     
  989.     ret = apiGlobalAlloc(fuFlags, cBytes)
  990.     If ret = 0 Then RaiseSysError
  991.     newGMem.InitializeGlobalMem ret
  992.     Set GlobalAlloc = newGMem
  993. End Function
  994. #End If ' FlagGlobalAlloc
  995.  
  996. Public Function GetTickCount() As Long
  997. Attribute GetTickCount.VB_HelpID = 2356
  998. Attribute GetTickCount.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  999.     GetTickCount = apiGetTickCount()
  1000. End Function
  1001.  
  1002.  
  1003. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  1004. ' The following is for compatibility with the API
  1005. ' Foundation Library Standard.  It is not a full
  1006. ' implementation, as this library was completed before
  1007. ' the final version of the standard was completed.
  1008. ' There are also a number of functions that are not
  1009. ' completed because of a lack of time or because adequate
  1010. ' documentation was not provided.  The standard
  1011. ' may change at any time after this libray is released,
  1012. ' so the functions below may not be correct.
  1013.  
  1014. ' The "Attach" functions are ways of setting up the
  1015. ' class.  Most of the functions below are the same
  1016. ' as the API functions above, but are renamed for
  1017. ' some reason.
  1018.  
  1019.  
  1020. Public Function ActiveWindow() As dwWindow
  1021. Attribute ActiveWindow.VB_HelpID = 2854
  1022. Attribute ActiveWindow.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  1023.     Set ActiveWindow = GetActiveWindow()
  1024. End Function
  1025.  
  1026. Public Function CaptureWindow() As dwWindow
  1027. Attribute CaptureWindow.VB_HelpID = 2871
  1028. Attribute CaptureWindow.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  1029.     Set CaptureWindow = GetCapture()
  1030. End Function
  1031.  
  1032. Public Function ComputerName() As String
  1033. Attribute ComputerName.VB_HelpID = 2412
  1034. Attribute ComputerName.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  1035.     ComputerName = GetComputerName()
  1036. End Function
  1037.  
  1038. Public Function CurrentDirectory()
  1039.  
  1040. End Function
  1041.  
  1042. Public Function CursorPosition() As dwPoint
  1043. Attribute CursorPosition.VB_HelpID = 2964
  1044. Attribute CursorPosition.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  1045.     Set CursorPosition = GetCursorPos()
  1046. End Function
  1047.  
  1048. Public Function DesktopWindow() As dwWindow
  1049. Attribute DesktopWindow.VB_HelpID = 2007
  1050. Attribute DesktopWindow.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  1051.     Set DesktopWindow = GetDesktopWindow()
  1052. End Function
  1053.  
  1054. Public Function FocusWindow() As dwWindow
  1055. Attribute FocusWindow.VB_HelpID = 2853
  1056. Attribute FocusWindow.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  1057.     Set FocusWindow = GetFocus()
  1058. End Function
  1059.  
  1060. Public Function ForegroundWindow() As dwWindow
  1061. Attribute ForegroundWindow.VB_HelpID = 2919
  1062. Attribute ForegroundWindow.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  1063.     Set ForegroundWindow = GetForegroundWindow()
  1064. End Function
  1065.  
  1066. Public Function MessageBox(label As String, Optional title As Variant, Optional Style As Variant) As Long
  1067.     Dim tmpTitle As String
  1068.     Dim tmpStyle As Integer
  1069.     
  1070.     If IsMissing(title) Then
  1071.         tmpTitle = ""
  1072.     Else
  1073.         tmpTitle = title
  1074.     End If
  1075.     
  1076.     If IsMissing(Style) Then
  1077.         tmpStyle = 0& ' MB_OK
  1078.     Else
  1079.         tmpStyle = Style
  1080.     End If
  1081.     MessageBox = apiMessageBox(0, label, tmpTitle, tmpStyle)
  1082. End Function
  1083.  
  1084. Public Function TickCount() As Long
  1085. Attribute TickCount.VB_HelpID = 2356
  1086. Attribute TickCount.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  1087.     TickCount = apiGetTickCount()
  1088. End Function
  1089.