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 / dwgmem.cls < prev    next >
Encoding:
Text File  |  1996-04-05  |  8.7 KB  |  226 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "dwGlobalMemory"
  6. Attribute VB_Creatable = True
  7. Attribute VB_Exposed = True
  8. Attribute VB_HelpID = 2171
  9. Option Explicit
  10.  
  11. ' Class dwGlobalMemory
  12. ' Global Memory Handle class
  13. ' Copyright (c) 1996 by Desaware Inc.
  14. ' Part of the Desaware API Classes Library
  15.  
  16. #If Win32 Then
  17. Private iHGlobal&
  18. #Else
  19. Private iHGlobal%
  20. #End If
  21.  
  22. #If Win32 Then
  23. Private Declare Function apiGlobalAddAtom% Lib "kernel32" Alias "GlobalAddAtomA" (ByVal lpString As String)
  24. Private Declare Function apiGlobalDeleteAtom% Lib "kernel32" Alias "GlobalDeleteAtom" (ByVal nAtom As Integer)
  25. Private Declare Function apiGlobalFindAtom% Lib "kernel32" Alias "GlobalFindAtomA" (ByVal lpString As String)
  26. Private Declare Function apiGlobalFlags& Lib "kernel32" Alias "GlobalFlags" (ByVal hGlobal As Long)
  27. Private Declare Function apiGlobalFree& Lib "kernel32" Alias "GlobalFree" (ByVal hGlobal As Long)
  28. Private Declare Function apiGlobalGetAtomName& Lib "kernel32" Alias "GlobalGetAtomNameA" (ByVal nAtom As Integer, ByVal lpBuffer As String, ByVal nSize As Long)
  29. Private Declare Function apiGlobalHandle& Lib "kernel32" Alias "GlobalHandle" (wMem As Any)
  30. Private Declare Function apiGlobalLock& Lib "kernel32" Alias "GlobalLock" (ByVal hGlobal As Long)
  31. Private Declare Sub apiGlobalMemoryStatus Lib "kernel32" Alias "GlobalMemoryStatus" (lpBuffer As MEMORYSTATUS)
  32. Private Declare Function apiGlobalReAlloc& Lib "kernel32" Alias "GlobalReAlloc" (ByVal hMem As Long, ByVal dwBytes As Long, ByVal wFlags As Long)
  33. Private Declare Function apiGlobalSize& Lib "kernel32" Alias "GlobalSize" (ByVal hGlobal As Long)
  34. Private Declare Function apiGlobalUnlock& Lib "kernel32" Alias "GlobalUnlock" (ByVal hGlobal As Long)
  35. Private Declare Function apiSetMetafileBitsEx& Lib "gdi32" Alias "SetMetaFileBitsEx" (ByVal nSize As Long, ByVal hMem As Long)
  36. #Else
  37. Private Declare Function apiGlobalAddAtom% Lib "user" Alias "GlobalAddAtom" (ByVal lpString As String)
  38. Private Declare Function apiGlobalDeleteAtom% Lib "user" Alias "GlobalDeleteAtom" (ByVal nAtom As Integer)
  39. Private Declare Function apiGlobalFindAtom% Lib "user" Alias "GlobalFindAtom" (ByVal lpString As String)
  40. Private Declare Function apiGlobalFlags% Lib "kernel" Alias "GlobalFlags" (ByVal hGlobal As Integer)
  41. Private Declare Function apiGlobalFree% Lib "kernel" Alias "GlobalFree" (ByVal hGlobal As Integer)
  42. Private Declare Function apiGlobalGetAtomName% Lib "user" Alias "GlobalGetAtomName" (ByVal nAtom As Integer, ByVal lpBuffer As String, ByVal nSize As Integer)
  43. Private Declare Function apiGlobalHandle& Lib "kernel" Alias "GlobalHandle" (ByVal wMem As Integer)
  44. Private Declare Function apiGlobalLock& Lib "kernel" Alias "GlobalLock" (ByVal hGlobal As Integer)
  45. Private Declare Function apiGlobalReAlloc% Lib "kernel" Alias "GlobalReAlloc" (ByVal hMem As Integer, ByVal dwBytes As Long, ByVal wFlags As Integer)
  46. Private Declare Function apiGlobalSize& Lib "kernel" Alias "GlobalSize" (ByVal hGlobal As Integer)
  47. Private Declare Function apiGlobalUnlock% Lib "kernel" Alias "GlobalUnlock" (ByVal hGlobal As Integer)
  48. Private Declare Function apiSetMetaFileBits% Lib "gdi" Alias "SetMetaFileBits" (ByVal hGlobal As Integer)
  49. Private Declare Function apiSetMetaFileBitsBetter% Lib "gdi" Alias "SetMetaFileBitsBetter" (ByVal hGlobal As Integer)
  50. #End If 'WIN32
  51.  
  52.  
  53. Private Sub RaiseGMemError(Optional errval)
  54.     If IsMissing(errval) Then
  55.         RaiseGMemError DWERR_APIRESULT
  56.     Else
  57.         RaiseError errval, "dwGlobalMemory"
  58.     End If
  59. End Sub
  60.  
  61. Public Function SetMetafileBits() As dwMetaFile
  62. Attribute SetMetafileBits.VB_HelpID = 2621
  63. Attribute SetMetafileBits.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  64. #If Win32 Then
  65.     Dim newmf As New dwMetaFile
  66.     Dim length As Long
  67.     Dim address As Long
  68.     Dim ret&
  69.     
  70.     length = apiGlobalSize(iHGlobal)
  71.     address = apiGlobalLock(iHGlobal)
  72.     ret& = apiSetMetafileBitsEx(length, address)
  73.     Call apiGlobalLock(iHGlobal)
  74.     If ret& = 0 Then RaiseGMemError
  75.     newmf.InitializeMetafile ret&, False
  76.     Set SetMetafileBits = newmf
  77. #Else
  78.     Dim newmf As New dwMetaFile
  79.     Dim ret%
  80.  
  81.     ret% = apiSetMetaFileBitsBetter(iHGlobal)
  82.     ' On 16 bits, ownership of iHGlobal is released
  83.     iHGlobal = 0
  84.     If ret% = 0 Then RaiseGMemError
  85.     newmf.InitializeMetafile ret%, False
  86.     Set SetMetafileBits = newmf
  87. #End If
  88. End Function
  89.  
  90. Public Sub GlobalFree()
  91. Attribute GlobalFree.VB_HelpID = 2109
  92. Attribute GlobalFree.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  93.     Dim ret&
  94.     
  95.     ret& = apiGlobalFree(iHGlobal)
  96.     If ret& <> 0 Then RaiseGMemError
  97.     iHGlobal = 0
  98. End Sub
  99.  
  100. Public Function GlobalSize() As Long
  101. Attribute GlobalSize.VB_HelpID = 2113
  102. Attribute GlobalSize.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  103.     GlobalSize = apiGlobalSize(iHGlobal)
  104. End Function
  105.  
  106. Public Function GlobalLock() As Long
  107. Attribute GlobalLock.VB_HelpID = 2111
  108. Attribute GlobalLock.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  109.     Dim ret&
  110.     
  111.     ret& = apiGlobalLock(iHGlobal)
  112.     If ret& = 0 Then RaiseGMemError
  113.     GlobalLock = ret&
  114. End Function
  115.  
  116. Public Sub GlobalUnlock()
  117. Attribute GlobalUnlock.VB_HelpID = 2114
  118. Attribute GlobalUnlock.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  119.     Call apiGlobalUnlock(iHGlobal)
  120. End Sub
  121.  
  122. Private Sub Class_Initialize()
  123.     iHGlobal = 0
  124. End Sub
  125.  
  126. Public Sub InitializeGlobalMem(ByVal hGlobal)
  127.     iHGlobal = hGlobal
  128. End Sub
  129.  
  130. Private Sub Class_Terminate()
  131.     Cleanup
  132. End Sub
  133.  
  134. Private Sub Cleanup()
  135.     Dim ret&
  136.  
  137.     If iHGlobal = 0 Then Exit Sub
  138.     
  139.     ' Clear any locks on the memory handle
  140.     While (apiGlobalFlags(iHGlobal) And GMEM_LOCKCOUNT) > 0
  141.         Call apiGlobalUnlock(iHGlobal)
  142.     Wend
  143.     ret& = apiGlobalFree(iHGlobal)
  144. End Sub
  145.  
  146. Public Function GlobalAddAtom(ByVal lpString As String) As Long
  147.     Dim ret&
  148.     
  149.     ret& = apiGlobalAddAtom(lpString)
  150.     If ret& = 0 Then RaiseGMemError
  151.     GlobalAddAtom = ret&
  152. End Function
  153.  
  154. Public Sub GlobalDeleteAtom(ByVal nAtom As Integer)
  155. Attribute GlobalDeleteAtom.VB_HelpID = 2172
  156. Attribute GlobalDeleteAtom.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  157.     Dim ret&
  158.     
  159.     ret& = apiGlobalDeleteAtom(nAtom)
  160.     '0 means success
  161.     If ret& <> 0 Then RaiseGMemError
  162. End Sub
  163.  
  164. Public Function GlobalFindAtom(ByVal lpString As String) As Long
  165. Attribute GlobalFindAtom.VB_HelpID = 2173
  166. Attribute GlobalFindAtom.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  167.     Dim ret&
  168.     
  169.     ret& = apiGlobalFindAtom(lpString)
  170.     If ret& = 0 Then RaiseGMemError
  171.     GlobalFindAtom = ret&
  172. End Function
  173.  
  174. Public Function GlobalFlags() As Long
  175. Attribute GlobalFlags.VB_HelpID = 2115
  176. Attribute GlobalFlags.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  177.     Dim ret&
  178.     
  179.     ret& = apiGlobalFlags(iHGlobal)
  180.     If ret& = 0 Then RaiseGMemError
  181.     GlobalFlags = ret&
  182. End Function
  183.  
  184. Public Function GlobalGetAtomName(ByVal nAtom As Integer, ByVal lpBuffer As String, ByVal nSize As Long) As Long
  185. Attribute GlobalGetAtomName.VB_HelpID = 2174
  186. Attribute GlobalGetAtomName.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  187.     Dim ret&
  188.         
  189.     ret& = apiGlobalGetAtomName(nAtom, lpBuffer, nSize)
  190.     If ret& = 0 Then RaiseGMemError
  191.     GlobalGetAtomName = ret&
  192. End Function
  193.  
  194. Public Sub GlobalMemoryStatus(lpBuffer As dwMemoryStatus)
  195. Attribute GlobalMemoryStatus.VB_HelpID = 2116
  196. Attribute GlobalMemoryStatus.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  197. #If Win32 Then
  198.     Dim ret&
  199.     Dim MemPoint As MEMORYSTATUS
  200.     
  201.     MemPoint.dwLength = LenB(MemPoint)
  202.     apiGlobalMemoryStatus MemPoint
  203.     lpBuffer.setMEMORYSTATUS MemPoint.dwLength, MemPoint.dwMemoryLoad, MemPoint.dwTotalPhys, MemPoint.dwAvailPhys, MemPoint.dwTotalPageFile, MemPoint.dwAvailPageFile, MemPoint.dwTotalVirtual, MemPoint.dwAvailVirtual
  204. #Else
  205.     RaiseGMemError DWERR_NOTINWIN16
  206. #End If
  207. End Sub
  208.  
  209. Public Function GlobalReAlloc(ByVal dwBytes As Long, ByVal wFlags As Long) As Long
  210. Attribute GlobalReAlloc.VB_HelpID = 2112
  211. Attribute GlobalReAlloc.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  212.     Dim ret&
  213.     
  214.     ret& = apiGlobalReAlloc(iHGlobal, dwBytes, wFlags)
  215.     If ret& = 0 Then RaiseGMemError
  216.     GlobalReAlloc = ret&
  217. End Function
  218.  
  219. Public Property Get hGlobal()
  220.     hGlobal = iHGlobal
  221. End Property
  222.  
  223. Public Property Let hGlobal(vNewValue)
  224.     iHGlobal = vNewValue
  225. End Property
  226.