SaveMemory example for Access 95 and 97

This example uses SaveMemory to save a bitmap to a memory-resident file, uses GetMemoryInfo to examine the file size; then uses WIN16 API calls to save the file to disk and free the memory.

' Declare WIN32 API constants and functions in the Declarations module.
Private Const OF_READ = &H0
Private Const OF_CREATE = &H1000
Private Const SEEK_SET = 0  '  seek to an absolute position
Private Const SEEK_END = 2  '  seek relative to end of file
Private Const GMEM_MOVEABLE = &H2
Private Const OFS_MAXPATHNAME = 128
Private Type OFSTRUCT
        cBytes As Byte
        fFixedDisk As Byte
        nErrCode As Integer
        Reserved1 As Integer
        Reserved2 As Integer
        szPathName(OFS_MAXPATHNAME) As Byte
End Type

Private Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long
Private Declare Function hread Lib "kernel32" Alias "_hread" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal lBytes As Long) As Long
Private Declare Function hwrite Lib "kernel32" Alias "_hwrite" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal lBytes As Long) As Long
Private Declare Function lclose Lib "kernel32" Alias "_lclose" (ByVal hFile As Long) As Long
Private Declare Function llseek Lib "kernel32" Alias "_llseek" (ByVal hFile As Long, ByVal lOffset As Long, ByVal iOrigin As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long

' ---------------------- Code for SaveMemory (32 bit) -------------

Private Sub SaveMemory_Click()
   Dim hf       As Long
   Dim hMem     As Long
   Dim iSize    As Long
   Dim lpMem    As Long
   Dim of       As OFSTRUCT
   Dim cMsg     As String
   If Lead1.SaveMemory(hMem, FILE_CMP, 24, 2, iSize) <> 0 Then
      MsgBox ("Error calling SaveMemory")
      GoTo quit_savememory
   End If
   If Lead1.GetMemoryInfo(hMem, 0, iSize, 0) <> 0 Then
      GlobalFree (hMem)
      GoTo quit_savememory
   End If

   ' Ask for a confirmation to save this file
   cMsg = "File info:" + Chr(13)
   cMsg = cMsg + Str(Lead1.InfoWidth) + " x " + Str(Lead1.InfoHeight)
   cMsg = cMsg + " x " + Str(Lead1.InfoBits) + " BPP" + Chr(13)
   cMsg = cMsg + "Size in memory: " + Str(Lead1.InfoSizeMem) + Chr(13)
   cMsg = cMsg + "Size on disk : " + Str(Lead1.InfoSizeDisk)
   If MsgBox(cMsg, vbYesNo, "Write this file on disk ") = vbNo Then
      GlobalFree (hMem)
      GoTo quit_savememory
   End If
   lpMem = GlobalLock(hMem)
   If lpMem = 0 Then
      GlobalFree (hMem)
      MsgBox ("Error calling GlobalLock")
      GoTo quit_savememory
   End If
   hf = OpenFile("c:\lead\images\savemem.cmp", of, OF_CREATE)
   If hf = -1 Then
      GlobalUnlock (hMem)
      GlobalFree (hMem)
      MsgBox ("Error calling GlobalLock")
      GoTo quit_savememory
   End If
   If hwrite(hf, lpMem, iSize) <> iSize Then
      MsgBox ("Error calling hwrite")
   Else
      MsgBox ("The file was saved successfully on disk.")
   End If
   lclose (hf)
   GlobalUnlock (hMem)
   GlobalFree (hMem)
quit_savememory:

End Sub