VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "dwGlobalMemory"
Attribute VB_Creatable = True
Attribute VB_Exposed = True
Attribute VB_HelpID = 2171
Option Explicit

' Class dwGlobalMemory
' Global Memory Handle class
' Copyright (c) 1996 by Desaware Inc.
' Part of the Desaware API Classes Library

#If Win32 Then
Private iHGlobal&
#Else
Private iHGlobal%
#End If

#If Win32 Then
Private Declare Function apiGlobalAddAtom% Lib "kernel32" Alias "GlobalAddAtomA" (ByVal lpString As String)
Private Declare Function apiGlobalDeleteAtom% Lib "kernel32" Alias "GlobalDeleteAtom" (ByVal nAtom As Integer)
Private Declare Function apiGlobalFindAtom% Lib "kernel32" Alias "GlobalFindAtomA" (ByVal lpString As String)
Private Declare Function apiGlobalFlags& Lib "kernel32" Alias "GlobalFlags" (ByVal hGlobal As Long)
Private Declare Function apiGlobalFree& Lib "kernel32" Alias "GlobalFree" (ByVal hGlobal As Long)
Private Declare Function apiGlobalGetAtomName& Lib "kernel32" Alias "GlobalGetAtomNameA" (ByVal nAtom As Integer, ByVal lpBuffer As String, ByVal nSize As Long)
Private Declare Function apiGlobalHandle& Lib "kernel32" Alias "GlobalHandle" (wMem As Any)
Private Declare Function apiGlobalLock& Lib "kernel32" Alias "GlobalLock" (ByVal hGlobal As Long)
Private Declare Sub apiGlobalMemoryStatus Lib "kernel32" Alias "GlobalMemoryStatus" (lpBuffer As MEMORYSTATUS)
Private Declare Function apiGlobalReAlloc& Lib "kernel32" Alias "GlobalReAlloc" (ByVal hMem As Long, ByVal dwBytes As Long, ByVal wFlags As Long)
Private Declare Function apiGlobalSize& Lib "kernel32" Alias "GlobalSize" (ByVal hGlobal As Long)
Private Declare Function apiGlobalUnlock& Lib "kernel32" Alias "GlobalUnlock" (ByVal hGlobal As Long)
Private Declare Function apiSetMetafileBitsEx& Lib "gdi32" Alias "SetMetaFileBitsEx" (ByVal nSize As Long, ByVal hMem As Long)
#Else
Private Declare Function apiGlobalAddAtom% Lib "user" Alias "GlobalAddAtom" (ByVal lpString As String)
Private Declare Function apiGlobalDeleteAtom% Lib "user" Alias "GlobalDeleteAtom" (ByVal nAtom As Integer)
Private Declare Function apiGlobalFindAtom% Lib "user" Alias "GlobalFindAtom" (ByVal lpString As String)
Private Declare Function apiGlobalFlags% Lib "kernel" Alias "GlobalFlags" (ByVal hGlobal As Integer)
Private Declare Function apiGlobalFree% Lib "kernel" Alias "GlobalFree" (ByVal hGlobal As Integer)
Private Declare Function apiGlobalGetAtomName% Lib "user" Alias "GlobalGetAtomName" (ByVal nAtom As Integer, ByVal lpBuffer As String, ByVal nSize As Integer)
Private Declare Function apiGlobalHandle& Lib "kernel" Alias "GlobalHandle" (ByVal wMem As Integer)
Private Declare Function apiGlobalLock& Lib "kernel" Alias "GlobalLock" (ByVal hGlobal As Integer)
Private Declare Function apiGlobalReAlloc% Lib "kernel" Alias "GlobalReAlloc" (ByVal hMem As Integer, ByVal dwBytes As Long, ByVal wFlags As Integer)
Private Declare Function apiGlobalSize& Lib "kernel" Alias "GlobalSize" (ByVal hGlobal As Integer)
Private Declare Function apiGlobalUnlock% Lib "kernel" Alias "GlobalUnlock" (ByVal hGlobal As Integer)
Private Declare Function apiSetMetaFileBits% Lib "gdi" Alias "SetMetaFileBits" (ByVal hGlobal As Integer)
Private Declare Function apiSetMetaFileBitsBetter% Lib "gdi" Alias "SetMetaFileBitsBetter" (ByVal hGlobal As Integer)
#End If 'WIN32


Private Sub RaiseGMemError(Optional errval)
    If IsMissing(errval) Then
        RaiseGMemError DWERR_APIRESULT
    Else
        RaiseError errval, "dwGlobalMemory"
    End If
End Sub

Public Function SetMetafileBits() As dwMetaFile
Attribute SetMetafileBits.VB_HelpID = 2621
Attribute SetMetafileBits.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
#If Win32 Then
    Dim newmf As New dwMetaFile
    Dim length As Long
    Dim address As Long
    Dim ret&
    
    length = apiGlobalSize(iHGlobal)
    address = apiGlobalLock(iHGlobal)
    ret& = apiSetMetafileBitsEx(length, address)
    Call apiGlobalLock(iHGlobal)
    If ret& = 0 Then RaiseGMemError
    newmf.InitializeMetafile ret&, False
    Set SetMetafileBits = newmf
#Else
    Dim newmf As New dwMetaFile
    Dim ret%

    ret% = apiSetMetaFileBitsBetter(iHGlobal)
    ' On 16 bits, ownership of iHGlobal is released
    iHGlobal = 0
    If ret% = 0 Then RaiseGMemError
    newmf.InitializeMetafile ret%, False
    Set SetMetafileBits = newmf
#End If
End Function

Public Sub GlobalFree()
Attribute GlobalFree.VB_HelpID = 2109
Attribute GlobalFree.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
    Dim ret&
    
    ret& = apiGlobalFree(iHGlobal)
    If ret& <> 0 Then RaiseGMemError
    iHGlobal = 0
End Sub

Public Function GlobalSize() As Long
Attribute GlobalSize.VB_HelpID = 2113
Attribute GlobalSize.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
    GlobalSize = apiGlobalSize(iHGlobal)
End Function

Public Function GlobalLock() As Long
Attribute GlobalLock.VB_HelpID = 2111
Attribute GlobalLock.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
    Dim ret&
    
    ret& = apiGlobalLock(iHGlobal)
    If ret& = 0 Then RaiseGMemError
    GlobalLock = ret&
End Function

Public Sub GlobalUnlock()
Attribute GlobalUnlock.VB_HelpID = 2114
Attribute GlobalUnlock.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
    Call apiGlobalUnlock(iHGlobal)
End Sub

Private Sub Class_Initialize()
    iHGlobal = 0
End Sub

Public Sub InitializeGlobalMem(ByVal hGlobal)
    iHGlobal = hGlobal
End Sub

Private Sub Class_Terminate()
    Cleanup
End Sub

Private Sub Cleanup()
    Dim ret&

    If iHGlobal = 0 Then Exit Sub
    
    ' Clear any locks on the memory handle
    While (apiGlobalFlags(iHGlobal) And GMEM_LOCKCOUNT) > 0
        Call apiGlobalUnlock(iHGlobal)
    Wend
    ret& = apiGlobalFree(iHGlobal)
End Sub

Public Function GlobalAddAtom(ByVal lpString As String) As Long
    Dim ret&
    
    ret& = apiGlobalAddAtom(lpString)
    If ret& = 0 Then RaiseGMemError
    GlobalAddAtom = ret&
End Function

Public Sub GlobalDeleteAtom(ByVal nAtom As Integer)
Attribute GlobalDeleteAtom.VB_HelpID = 2172
Attribute GlobalDeleteAtom.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
    Dim ret&
    
    ret& = apiGlobalDeleteAtom(nAtom)
    '0 means success
    If ret& <> 0 Then RaiseGMemError
End Sub

Public Function GlobalFindAtom(ByVal lpString As String) As Long
Attribute GlobalFindAtom.VB_HelpID = 2173
Attribute GlobalFindAtom.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
    Dim ret&
    
    ret& = apiGlobalFindAtom(lpString)
    If ret& = 0 Then RaiseGMemError
    GlobalFindAtom = ret&
End Function

Public Function GlobalFlags() As Long
Attribute GlobalFlags.VB_HelpID = 2115
Attribute GlobalFlags.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
    Dim ret&
    
    ret& = apiGlobalFlags(iHGlobal)
    If ret& = 0 Then RaiseGMemError
    GlobalFlags = ret&
End Function

Public Function GlobalGetAtomName(ByVal nAtom As Integer, ByVal lpBuffer As String, ByVal nSize As Long) As Long
Attribute GlobalGetAtomName.VB_HelpID = 2174
Attribute GlobalGetAtomName.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
    Dim ret&
        
    ret& = apiGlobalGetAtomName(nAtom, lpBuffer, nSize)
    If ret& = 0 Then RaiseGMemError
    GlobalGetAtomName = ret&
End Function

Public Sub GlobalMemoryStatus(lpBuffer As dwMemoryStatus)
Attribute GlobalMemoryStatus.VB_HelpID = 2116
Attribute GlobalMemoryStatus.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
#If Win32 Then
    Dim ret&
    Dim MemPoint As MEMORYSTATUS
    
    MemPoint.dwLength = LenB(MemPoint)
    apiGlobalMemoryStatus MemPoint
    lpBuffer.setMEMORYSTATUS MemPoint.dwLength, MemPoint.dwMemoryLoad, MemPoint.dwTotalPhys, MemPoint.dwAvailPhys, MemPoint.dwTotalPageFile, MemPoint.dwAvailPageFile, MemPoint.dwTotalVirtual, MemPoint.dwAvailVirtual
#Else
    RaiseGMemError DWERR_NOTINWIN16
#End If
End Sub

Public Function GlobalReAlloc(ByVal dwBytes As Long, ByVal wFlags As Long) As Long
Attribute GlobalReAlloc.VB_HelpID = 2112
Attribute GlobalReAlloc.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
    Dim ret&
    
    ret& = apiGlobalReAlloc(iHGlobal, dwBytes, wFlags)
    If ret& = 0 Then RaiseGMemError
    GlobalReAlloc = ret&
End Function

Public Property Get hGlobal()
    hGlobal = iHGlobal
End Property

Public Property Let hGlobal(vNewValue)
    iHGlobal = vNewValue
End Property
