SaveMemory example for Delphi
// You have to add LEADTyp, and LEADDef to the uses section of your project.
procedure TForm1.SaveMemory1Click(Sender: TObject);
var
hMem : L_HANDLE;
hf, iSize : integer;
lpMem : pointer;
cMsg, cTemp : string;
begin
hMem := 0;
If (Lead1.SaveMemory (hMem, FILE_CMP, 24, 2, iSize) <> SUCCESS) Then
begin
MessageDlg ('Error calling SaveMemory', mtError, [mbOK], 0);
Exit
end;
If Lead1.GetMemoryInfo (hMem, 0, iSize) <> SUCCESS Then
begin
GlobalFree (hMem);
Exit
end;
{ Ask for a confirmation to save this file}
cMsg := 'Write this file on disk ?' + Chr(13) + Chr(13) + 'File info:' + Chr(13);
Str(Lead1.InfoWidth:1, cTemp);
cMsg := cMsg + cTemp + ' x ';
Str(Lead1.InfoHeight:1, cTemp);
cMsg := cMsg + cTemp + ' x ';
Str(Lead1.InfoBits, cTemp);
cMsg := cMsg + cTemp + ' BPP' + Chr(13) + 'Size in memory: ';
Str(Lead1.InfoSizeMem, cTemp);
cMsg := cMsg + cTemp + Chr(13) + 'Size on disk : ';
Str(Lead1.InfoSizeDisk, cTemp);
cMsg := cMsg + cTemp + Chr(13);
If MessageDlg (cMsg, mtConfirmation, [mbYes, mbNo], 0) <> mrYes Then
begin
GlobalFree (hMem);
Exit
end;
lpMem := GlobalLock(hMem);
If lpMem = nil Then
begin
GlobalFree (hMem);
MessageDlg ('Error calling GlobalLock', mtError, [mbOK], 0);
Exit
end;
hf := FileCreate('c:\savemem.cmp');
If hf = -1 Then
begin
GlobalUnlock (hMem);
GlobalFree (hMem);
MessageDlg ('Error calling GlobalLock', mtError, [mbOK], 0);
Exit
end;
If FileWrite(hf, lpMem^, iSize) <> iSize Then
MessageDlg ('Error calling FileWrite', mtError, [mbOK], 0)
Else
MessageDlg ('The file was saved successfully on disk.', mtInformation, [mbOK], 0);
FileClose (hf);
GlobalUnlock (hMem);
GlobalFree (hMem);
end;