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 WIN32 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
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 "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 wBytes 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 RasterIO As New LEADRasterIO
Dim cMsg
If RasterIO.SaveMemory(LEADRasterView1.Raster, hMem, FILE_BMP, 4, 0, 0, iSize) <> 0 Then
MsgBox ("Error calling SaveMemory")
GoTo quit_savememory
End If
If RasterIO.GetMemoryInfo(LEADRasterView1.Raster, hMem, 0, iSize) <> 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(RasterIO.InfoWidth) + " x " + Str(RasterIO.InfoHeight)
cMsg = cMsg + " x " + Str(RasterIO.InfoBits) + " BPP" + Chr(13)
cMsg = cMsg + "Size in memory: " + Str(RasterIO.InfoSizeMem) + Chr(13)
cMsg = cMsg + "Size on disk : " + Str(RasterIO.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("d:\temp\memsave.bmp", of, OF_CREATE)
If hf = -1 Then
GlobalUnlock (hMem)
GlobalFree (hMem)
MsgBox ("Error calling OpenFile")
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