home *** CD-ROM | disk | FTP | other *** search
/ Master 95 #1 / MASTER95_1.iso / microsof / vbasic4 / vb4-6.cab / declares.bas < prev    next >
Encoding:
BASIC Source File  |  1995-07-26  |  9.0 KB  |  189 lines
  1. Attribute VB_Name = "Module1"
  2. Option Explicit
  3. Dim WinVersion As Integer, SoundAvailable As Integer
  4. Global VisibleFrame As Frame
  5.  
  6. Global Const TWIPS = 1
  7. Global Const PIXELS = 3
  8. Global Const RES_INFO = 2
  9. Global Const MINIMIZED = 1
  10.  
  11. Type Rect
  12.     Left As Integer
  13.     Top As Integer
  14.     Right As Integer
  15.     Bottom As Integer
  16. End Type
  17.  
  18.  
  19. 'begin conditional compile
  20.  
  21. #If Win32 Then              '32-bit declares
  22.  
  23.     Public Type SystemInfo
  24.         dwOemId As Long
  25.         dwPageSize As Long
  26.         lpMinimumApplicationAddress As Long
  27.         lpMaximumApplicationAddress As Long
  28.         dwActiveProcessorMask As Long
  29.         dwNumberOfProcessors As Long
  30.         dwProcessorType As Long
  31.         dwAllocationGranularity As Long
  32.         dwReserved As Long
  33.     End Type
  34.     
  35.     Public Type MemoryStatus
  36.         dwLength As Long
  37.         dwMemoryLoad As Long
  38.         dwTotalPhys As Long
  39.         dwAvailPhys As Long
  40.         dwTotalPageFile As Long
  41.         dwAvailPageFile As Long
  42.         dwTotalVirtual As Long
  43.         dwAvailVirtual As Long
  44.     End Type
  45.     
  46.     Declare Function GetFreeSpace Lib "kernel32" Alias "GetFreeSpaceA" (ByVal flag As Integer) As Long
  47.     Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
  48.     
  49.     'the GetSystemInfo sub (following) replaces the GetWinFlags function in the Win16 API
  50.     Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SystemInfo)
  51.         
  52.     'the GlobalMemoryStatus sub (following) substitutes for GetFreeSystemResources in the Win16 API
  53.     Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MemoryStatus)
  54.     
  55.     Declare Function GetVersion Lib "kernel32" () As Long
  56.     Declare Function GetSystemMetrics Lib "User32" (ByVal nIndex As Long) As Long
  57.     Declare Function GetDeviceCaps Lib "GDI32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
  58.     Declare Function GlobalCompact Lib "kernel32" (ByVal dwMinFree As Long) As Long
  59.     Declare Function TrackPopupMenu Lib "User32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal X As Long, ByVal Y As Long, ByVal nReserved As Long, ByVal hWnd As Long, lpReserved As Any) As Long
  60.     Declare Function GetMenu Lib "User32" (ByVal hWnd As Long) As Long
  61.     Declare Function GetSubMenu Lib "User32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
  62.     Declare Function InsertMenu Lib "User32" Alias "InsertMenuA" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
  63.     Declare Function GetSystemMenu Lib "User32" (ByVal hWnd As Long, ByVal bRevert As Long) As Long
  64.     Declare Function GetDesktopWindow Lib "User32" () As Long
  65.     Declare Function GetDC Lib "User32" (ByVal hWnd As Long) As Long
  66.     Declare Function ReleaseDC Lib "User32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
  67.     Declare Function BitBlt Lib "GDI32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop As Long) As Long
  68.     Declare Sub 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)
  69.     Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, lpKeyName As Any, ByVal lpDefault As String, ByVal lpRetunedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
  70.     Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" (ByVal lpAppName As String, lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long
  71.     Declare Function waveOutGetNumDevs Lib "winmm" () As Long
  72.     Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
  73.     Declare Function sndPlaySound Lib "winmm" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
  74.  
  75. #Else               '16-bit declares
  76.     
  77.     Declare Function GetPrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
  78.     Declare Function GetProfileString Lib "Kernel" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer) As Integer
  79.     Declare Sub SetWindowPos Lib "User" (ByVal h1%, ByVal h2%, ByVal X%, ByVal Y%, ByVal cx%, ByVal cy%, ByVal f%)
  80.     Declare Function GetDesktopWindow Lib "User" Alias "GetDeskTopWindow" () As Integer
  81.     Declare Function GetDC Lib "User" (ByVal hWnd%) As Integer
  82.     Declare Sub ReleaseDC Lib "User" (ByVal hWnd%, ByVal hDC%)
  83.     Declare Function BitBlt Lib "GDI" (ByVal destDC%, ByVal X%, ByVal Y%, ByVal w%, ByVal h%, ByVal srchDC%, ByVal srcX%, ByVal srcY%, ByVal rop&) As Integer
  84.     Declare Function TrackPopupMenu Lib "User" (ByVal hMenu%, ByVal wFlags%, ByVal X%, ByVal Y%, ByVal r2%, ByVal hWd%, R As Rect) As Integer
  85.     Declare Function GetMenu Lib "User" (ByVal hWd%) As Integer
  86.     Declare Function GetSubMenu Lib "User" (ByVal hMenu%, ByVal nPos%) As Integer
  87.     Declare Function InsertMenu Lib "User" (ByVal hMenu As Integer, ByVal nPosition As Integer, ByVal wFlags As Integer, ByVal wIDNewItem As Integer, ByVal lpNewItem As Any) As Integer
  88.     Declare Function GetSystemMenu Lib "User" (ByVal hWnd As Integer, ByVal bRevert As Integer) As Integer
  89.     Declare Function sndPlaySound Lib "MMSystem" (lpsound As Any, ByVal flag As Integer) As Integer
  90.     Declare Function waveOutGetNumDevs Lib "MMSystem" () As Integer
  91.     Declare Function GlobalCompact Lib "Kernel" (ByVal flag&) As Long
  92.     Declare Function GetFreeSpace Lib "Kernel" (ByVal flag%) As Long
  93.     
  94.     'there is no equivalent to GetFreeSystemResources (following) in the Win32 API
  95.     Declare Function GetFreeSystemResources Lib "User" (ByVal fuSysResource As Integer) As Integer
  96.     Declare Function GetDeviceCaps Lib "GDI" (ByVal hDC%, ByVal nIndex%) As Integer
  97.     Declare Function GetVersion Lib "Kernel" () As Long
  98.     Declare Function GetSystemMetrics Lib "User" (ByVal n As Integer) As Integer
  99.     Declare Function GetWindowsDirectory Lib "Kernel" (ByVal P$, ByVal S%) As Integer
  100.     Declare Function GetSystemDirectory Lib "Kernel" (ByVal P$, ByVal S%) As Integer
  101.     Declare Function GetWinFlags Lib "Kernel" () As Long
  102. #End If
  103. 'end conditional compile
  104.  
  105. Global Const WF_CPU286 = &H2&
  106. Global Const WF_CPU386 = &H4&
  107. Global Const WF_CPU486 = &H8&
  108. Global Const WF_STANDARD = &H10&
  109. Global Const WF_ENHANCED = &H20&
  110. Global Const WF_80x87 = &H400&
  111.  
  112. Global Const SM_MOUSEPRESENT = 19
  113.  
  114. Global Const GFSR_SYSTEMRESOURCES = &H0
  115. Global Const GFSR_GDIRESOURCES = &H1
  116. Global Const GFSR_USERRESOURCES = &H2
  117.  
  118. Global Const MF_POPUP = &H10
  119. Global Const MF_BYPOSITION = &H400
  120. Global Const MF_SEPARATOR = &H800
  121.  
  122. Global Const SRCCOPY = &HCC0020
  123. Global Const SRCERASE = &H440328
  124. Global Const SRCINVERT = &H660046
  125. Global Const SRCAND = &H8800C6
  126.  
  127. Global Const HWND_TOPMOST = -1
  128. Global Const HWND_NOTOPMOST = -2
  129. Global Const SWP_NOACTIVATE = &H10
  130. Global Const SWP_SHOWWINDOW = &H40
  131.  
  132.  
  133. Function DeviceColors(hDC As Integer) As Long
  134. Const PLANES = 14
  135. Const BITSPIXEL = 12
  136.     DeviceColors = GetDeviceCaps(hDC, PLANES) * 2 ^ GetDeviceCaps(hDC, BITSPIXEL)
  137. End Function
  138.  
  139. Function DosVersion()
  140. Dim Ver As Long, DosVer As Long
  141.     Ver = GetVersion()
  142.     DosVer = Ver \ &H10000
  143.     DosVersion = Format((DosVer \ 256) + ((DosVer Mod 256) / 100), "Fixed")
  144. End Function
  145.  
  146. Function GetSysIni(section, key)
  147. Dim retVal As String, AppName As String, worked As Integer
  148.     retVal = String$(255, 0)
  149.     worked = GetPrivateProfileString(section, key, "", retVal, Len(retVal), "System.ini")
  150.     If worked = 0 Then
  151.         GetSysIni = "unknown"
  152.     Else
  153.         GetSysIni = Left(retVal, InStr(retVal, Chr(0)) - 1)
  154.     End If
  155. End Function
  156.  
  157. Function GetWinIni(section, key)
  158. Dim retVal As String, AppName As String, worked As Integer
  159.     retVal = String$(255, 0)
  160.     worked = GetProfileString(section, key, "", retVal, Len(retVal))
  161.     If worked = 0 Then
  162.         GetWinIni = "unknown"
  163.     Else
  164.         GetWinIni = Left(retVal, InStr(retVal, Chr(0)) - 1)
  165.     End If
  166. End Function
  167.  
  168. Function SystemDirectory() As String
  169. Dim WinPath As String
  170.     WinPath = String(145, Chr(0))
  171.     SystemDirectory = Left(WinPath, GetSystemDirectory(WinPath, InStr(WinPath, Chr(0)) - 1))
  172. End Function
  173.  
  174. Function WindowsDirectory() As String
  175. Dim WinPath As String
  176. Dim temp
  177.     WinPath = String(145, Chr(0))
  178.     temp = GetWindowsDirectory(WinPath, 145)
  179.     WindowsDirectory = Left(WinPath, InStr(WinPath, Chr(0)) - 1)
  180. End Function
  181.  
  182. Function WindowsVersion()
  183. Dim Ver As Long, WinVer As Long
  184.     Ver = GetVersion()
  185.     WinVer = Ver And &HFFFF&
  186.     WindowsVersion = Format((WinVer Mod 256) + ((WinVer \ 256) / 100), "Fixed")
  187. End Function
  188.  
  189.