SaveMemory example for Visual Basic

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

' Declare WIN16 C DLL constants and functions in the Declarations module.

Private Const OF_READ = &H0
Private Const OF_CREATE = &H1000
Private Const SEEK_SET = 0
Private Const SEEK_END = 2
Private Const GMEM_MOVEABLE = &H2

Private Type OFSTRUCT
    cBytes As String * 1
    fFixedDisk As String * 1
    nErrCode As Integer
    reserved As String * 4
    szPathName As String * 128
End Type

Private Declare Function OpenFile Lib "kernel" (ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, ByVal wStyle As Integer) As Integer 

Private Declare Function hread Lib "kernel" Alias "_hread" (ByVal hFile As Integer, ByVal lpBuffer As Long, ByVal wBytes As Long) As Long 

Private Declare Function hwrite Lib "kernel" Alias "_hwrite" (ByVal hFile As Integer, ByVal lpBuffer As Long, ByVal lBytes As Long) As Long 

Private Declare Function lclose Lib "kernel" Alias "_lclose" (ByVal hFile As Integer) As Integer 

Private Declare Function llseek Lib "kernel" Alias "_llseek"(ByVal hFile As Integer, ByVal lOffset As Long, ByVal iOrigin As Integer) As Long

Private Declare Function GlobalAlloc Lib "kernel" (ByVal wFlags As Integer, ByVal dwBytes As Long) As Integer 

Private Declare Function GlobalFree Lib "kernel" (ByVal hMem As Integer) As Integer 

Private Declare Function GlobalLock Lib "kernel" (ByVal hMem As Integer) As Long  

Private Declare Function GlobalUnlock Lib "kernel" (ByVal hMem As Integer) As Integer

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

Private Sub SaveMemory_Click()
   Dim hf       As Integer    ' For WIN32 this would be declared as Long
   Dim hMem     As Integer    ' For WIN32 this would be declared as Long
   Dim iSize    As Long
   Dim lpMem    As Long
   Dim of       As OFSTRUCT

   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