unit wBitMapImage0;

{ Feel free to use this unit as you want.
  First developped by Bernard Gisin
  This unit uses object programming to simplify the developpment
  of programs.

  This unit help manipulating bitmaps
  It allow saving and loading bitmaps.
----------------------------------}

// To tell FreePascal that the application is a Graphical User Interface
// i.e. is running in windows, not in text mode.
{$APPTYPE GUI}

INTERFACE
//"""""""

uses wGlobals2, windows;

const
  // Error while trying to read a bitmap file.
  ERRBMPIsNotBMP        = 1001;
  ERRBMPNotEnoughMemory = 1002;
  ERRBMPOpenFile        = 1003;

type
  PBitMapImage0 = ^TBitMapImage0;
  TBitMapImage0 = object
  //"""""""""""""""
  rBMPInfoHeader : BITMAPINFOHEADER;
  // Information at the begining of the file, concerning the bitmap
  // Will be copied to  prBMPInfo^.bmiHeader

  prBMPInfo : ^BITMAPINFO;
  // prBMPInfo^.bmiHeader : BITMAPINFOHEADER contain header information
  //   its size is of 40 bytes
  // prBMPInfo^.bmiColors : RGBQUAD contain color palettes information
  //   If palettes are used, contain the color palettes.

  wSizeColorTable  : word;
  // Size of a color tablette, if one is specified.

  pBits : pointer;
  // Will contain the image.

  wSizeBits : word32;
  // Size of memory allocated for  pBits;

  rNameRec    : OpenFileName;
  // To open a bitmap file

  strPathName : ShortString;
  // complete name of the file from which the bitmap has been ridden

  constructor Init;
  // Call Init; at the beggining of a new Init constructor.

  destructor  Done; virtual;
  // Call Done; at the end of a new destructor.

  procedure GetBitmapHeader(var fIn:File; var wErrV:word32); virtual;
  // wErr = 0 => it has the signature of a bitmap file
  // wErr = IOResult => an error occured while trying to read the file
  // wErr = ERRBMPIsNotBMP => it is not a bitmap file

  procedure BitMapGetImage(var fIn:file; var wErrV:word32); virtual;
  // Load the image

  function BitMapFileLoad(var fIn:file; var wErrV:word32):HBitMap; virtual;
  // Load a bit map, from a given file : fIn

  function BitMapFileNameLoad(strFilePathP:ShortString; var wErrV:word32):HBitMap; virtual;
  // Load a bit map, from a given file : strFilePathP

  function BitMapLoadFromFile(var wWidthV,wHeightV,wErrV:word32):HBitMap; virtual;
  // Opens a dialog box, to ask for a .bmp file to be openend.
  // Return a handle on the corresponding bitmap, or an Error.
  // In case of Error, the handle returned is zero.
  // If the CANCEL button has been selected, then
  // wErrV = 0, but a zero handle is also returned.

  procedure BitMapFileSave(var fOut:file; hBMP:HBitMap; var wErrV:word32); virtual;
  // Save a bit map, to a given file : fOut

  procedure BitMapFileNameSave(strFilePathP:ShortString; hBMP:HBitMap; var wErrV:word32); virtual;
  // Save a bit map, to a given file : strFilePathP

  procedure BitMapSaveToFile(hBMP:HBitMap; var wErrV:word32); virtual;
  // Opens a dialog box, to ask in which .bmp file to save the bitmap
  // wErrV = 0 if no errors occured.

  end; // TBitMapImage0 = object
  TBitMapImage =  TBitMapImage0;
  PBitMapImage = ^TBitMapImage;

function CreateNewBitMapImage(hWinP:HWND; wWidthP,wHeightP:word32):HBitMap;
//=========================================================================
// Create a new image

function LoadImageFromMSG(wMsgNum:word32; hWinP:HWND; var wWidthV,wHeightV:word32):HBitMap;
//=========================================================================================
// From a coded image in a .msg file at number  wMsgNum, get an image.
// hWinP = handle off the window, for which the bitmap will be build.

IMPLEMENTATION
//""""""""""""

uses wWindowBase0, wHashTable2, wUtiles0, wMessages2, wErrors0, wDebug0;

var glnNotUsed : integer; // To avoid an error in the DevPascal 1.9 environment

function CreateNewBitMapImage(hWinP:HWND; wWidthP,wHeightP:word32):HBitMap;
//=========================================================================
// Create a new image
var
  hDCWinL,
  hDCMemL     : HDC;
  hBMAPL,
  hBMAPOldL   : HBitMap;
  rRec        : RECT;

begin
CreateNewBitMapImage:=0; // in case of errors

// Need a device context to create a compatible bit map
hDCWinL:=GetDC(hWinP);
hBMAPL:=CreateCompatibleBitmap(hDCWinL, wWidthP, wHeightP);

// Test if the bitmap could be created.
if (hBMAPL = 0) then begin
   ReleaseDC(hWinP, hDCWinL);
   exit;
   end;

// Select the bitmap, to draw on it.
// You can only paint on the bit map, if it is selected in a memory device context
// Selecting it in the Window Device context will not work.
hDCMemL:=CreateCompatibleDC(hDCWinL);
hBMAPOldL:=SelectObject(hDCMemL, hBMAPL);

// Fill the bitmap with a white color
rRec.left:=0;  rRec.top:=0;  rRec.right:=wWidthP; rRec.bottom:=wHeightP;
FillRect(hDCMemL, rRec, GetStockObject(WHITE_BRUSH));

// You must delete the created memory device context.
// But before, you must select the original bit map which was in it.
SelectObject(hDCMemL, hBMAPOldL);
DeleteDC(hDCMemL);

// Finally, the window device context must be released.
ReleaseDC(hWinP, hDCWinL);

CreateNewBitMapImage:=hBMAPL;
end; // CreateNewBitMapImage

function LoadImageFromMSG(wMsgNum:word32; hWinP:HWND; var wWidthV,wHeightV:word32):HBitMap;
//=========================================================================================
// From a coded image in a .msg file at number  wMsgNum, get an image.
// hWinP = handle off the window, for which the bitmap will be build.
// wWidthV,wHeightV are the width and height of the image in the .msg file
var
  oHT         : THashTableW2;
  strS        : ShortString;
  nEnd        : integer;
  wSecurity
              : word32;
  hDCWinL,
  hDCMemL     : HDC;
  hBMAPL,
  hBMAPOldL   : HBitMap;
  wPosL,      // position in the string
  wLetter,    // Letters coding colors
  wRedL,      // RGB color coding of the letters
  wGreenL,
  wBlueL,
  wX,wY       : word32;
  colPix      : COLORREF;

begin
LoadImageFromMSG:=0; // in case of errors

// Get the first line which code the width and height
strS:=GetMsg(wMsgNum);

wWidthV :=GetWordValue(1, strS, nEnd);
wHeightV:=GetWordValue(nEnd, strS, nEnd);

// verification.
if (wWidthV  = 0) or (wWidthV  > 120) or
   (wHeightV = 0) or (wHeightV > 200) then exit; // not a coded image.

// First get the colors corresponding to each letter
//""""""""""""""""""""""""""""""""""""""""""""""""""
oHT.Init(0);
wSecurity:=100;
strS:=GetMsg(msgNext);  strS[length(strS)+1]:=#0;
repeat
   wPosL:=1;

   // loop on one text line
   repeat
      while (strS[wPosL] = ' ') do inc(wPosL); // skip spaces

      wLetter:=ord(strS[wPosL]); // character coding for a color

      // RGB colors coded by the character
      wRedL:=GetIntValue(wPosL, strS, nEnd);
      wGreenL:=GetIntValue(nEnd, strS, nEnd);
      wBlueL:=GetIntValue(nEnd, strS, nEnd);
      if (nEnd > wPosL) then wPosL:=nEnd;

      // Correspondance, letter - color. Put it in the hash table
      colPix:=RGB(Byte(wRedL), Byte(wGreenL), Byte(wBlueL));
      oHT.AddPointerW2(wLetter, 0, colPix, NIL); // the pointer is not used

      // search next character color's definition
      while (wPosL < length(strS)) and (strS[wPosL] <> ';') do inc(wPosL);
      inc(wPosL); // skip the ';'
      until (wPosL >= length(strS));

   // next line coding for the image
   strS:=GetMsg(msgNext);
   dec(wSecurity);
   until (Copy(strS,1,3) = '---') or
         (strS = '...END') or
         (wSecurity = 0);

if (strS = '...END') or (wSecurity = 0) then exit; // not a valid image

// Create the new image
hDCWinL:=GetDC(hWinP);
hBMAPL:=CreateCompatibleBitmap(hDCWinL, wWidthV, wHeightV);

// Test if the bitmap could be created.
if (hBMAPL = 0) then begin
   ErrorComment(128, 'Error, bitmap not created');
   ReleaseDC(hWinP, hDCWinL);
   exit;
   end;

// Select the bitmap, to draw on it.
// You can only paint on the bit map, if it is selected in a memory device context
// Selecting it in the Window Device context will not work.
hDCMemL:=CreateCompatibleDC(hDCWinL);
hBMAPOldL:=SelectObject(hDCMemL, hBMAPL);
ReleaseDC(hWinP, hDCWinL);

// Fills the memory bitmap image with the image coded in the .msg text
//""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
// loop on all the lines
for wY:=0 to wHeightV-1 do begin
   // Get one line of pixels
   strS:=GetMsg(msgNext);
   wPosL:=1;

   // loop on the pixels of a line
   for wX:=0 to wWidthV-1 do begin
      // Letter coding for a pixel
      wLetter:=ord(strS[wPosL]);
      oHT.GetPointerW2(wLetter, 0, colPix);

      // Set the color of the pixel
      SetPixel(hDCMemL, wX, wY, colPix);

      inc(wPosL,2);
      end; // for wX:=...
   end; // for wY:=...

oHT.Done;

// You must delete the created memory device context.
// But before, you must select the original bit map which was in it.
SelectObject(hDCMemL, hBMAPOldL);
DeleteDC(hDCMemL);

LoadImageFromMSG:=hBMAPL;
end;  // LoadImageFromMSG

//***************************************************
// TBitMapImage0 = object
//***************************************************

constructor TBitMapImage0.Init;
//========================
Const
  Filter : PChar = 'Bitmap files (*.bmp)'#0'*.bmp'#0+
                   'All files (*.*)'#0'*.*'#0#0;
  Ext    : PChar = 'bmp';
begin
wSizeColorTable :=0;
prBMPInfo      :=NIL;
wSizeBits      :=0;
pBits          :=NIL;


// Choose a file from a dialog box
FillChar(rNameRec,SizeOf(rNameRec),0);
strPathName[1] := #0;
With rNameRec Do Begin
   LStructSize := SizeOf(rNameRec);
   HWndOwner   := gglpoMainWindowCopy^.hWin;
   LpStrFilter := Filter;
   LpStrFile   := @strPathName[1];
   NMaxFile    := Max_Path;
   Flags       := OFN_Explorer Or OFN_HideReadOnly;
   LpStrDefExt := Ext;
   End; // with

end;  // TBitMapImage0.Init

destructor TBitMapImage0.Done;
//=======================
var
  wSizeAllocL : word32;
begin
if (pBits <> NIL) then FreeMem(pBits, wSizeBits);

wSizeAllocL:=SizeOf(BITMAPINFOHEADER) + wSizeColorTable;
if (prBMPInfo <> NIL) then FreeMem(prBMPInfo, wSizeAllocL);
end;  // TBitMapImage0.Done

procedure TBitMapImage0.GetBitmapHeader(var fIn:File; var wErrV:word32);
//================================================================
// wErr = 0 => it has the signature of a bitmap file
// wErr = IOResult => an error occured while trying to read the file
// wErr = ERRBMPIsNotBMP => it is not a bitmap file
type
// the 14 first bytes of the file give a first information.
TypeBitMapInfo = record
//"""""""""""""""""""""
   c1,c2            : char; // Must = 'BM' to be a valide signature
   lSizeFile        : int32;
   wReserved1,
   wReserved2       : word16;
   lImageBegin0     : int32;
   end; // record

var
  recFileHeader    : TypeBitMapInfo;
  wSizeAllocL,
  wResult          : word;
//  lImageBegin      : longint; // Indicate where the image data begins


begin // TBitMapImage0.GetBitmapHeader
// If memory has been allocated, desalocate it before allocating again.
if (prBMPInfo <> NIL) then FreeMem(prBMPInfo, SizeOf(BITMAPINFOHEADER) + wSizeColorTable);

{$i-}
// Read the signature and some info at the beginning of the file
BlockRead(fIn, recFileHeader, SizeOf(recFileHeader), wResult); // SizeOf(recFileHeader) = 14
wErrV:=IOResult;
if (wErrV <> 0) then exit; // Input / Output error

// Test that the signature is correct.
if (wResult <> SizeOf(recFileHeader)) or
   (recFileHeader.c1 <> 'B') or (recFileHeader.c2 <> 'M') then begin
   wErrV :=ERRBMPIsNotBMP;
   exit;
   end;

// Where does the image begin
//lImageBegin:=recFileHeader.lImageBegin0;

// Read the bitmap info header,
BlockRead(fIn, rBMPInfoHeader, SizeOf(BitmapInfoHeader), wResult);
wErrV:=IOResult;
if (wErrV <> 0) then exit; // IO error

// Test the coherence if the header.
if (wResult <> SizeOf(BitmapInfoHeader)) or
   (rBMPInfoHeader.biSize <> 40) or
   (not (rBMPInfoHeader.biBitCount in [1,4,8,24])) or
   (rBMPInfoHeader.biPlanes <> 1) then begin
   wErrV :=ERRBMPIsNotBMP;
   exit;
   end;

// If  rBMPInfoHeader.biClrUsed > 0  and  rBMPInfoHeader.biBitCount > 16  then
// a table follows with the color palettes
if (rBMPInfoHeader.biClrUsed > 0) then begin
   if (rBMPInfoHeader.biBitCount >= 16) then
      wSizeColorTable :=rBMPInfoHeader.biClrUsed * SizeOf(RGBQuad)
   else // if (rBMPInfoHeader.biBitCount <= 8) then
      wSizeColorTable := (1 shl rBMPInfoHeader.biBitCount) * SizeOf(RGBQuad)
   end
else wSizeColorTable:=0;

// Allocate memory for the header image information
wSizeAllocL:=SizeOf(BITMAPINFOHEADER) + wSizeColorTable;
GetMem(prBMPInfo, wSizeAllocL);
prBMPInfo^.bmiHeader :=rBMPInfoHeader;

// If a color tablette is given, read it.
if (wSizeColorTable <> 0) then begin
   BlockRead(fIn, prBMPInfo^.bmiColors, wSizeColorTable, wResult);

   wErrV:=IOResult;
   if (wErrV <> 0) then exit; // IO error

   // Coherence test
   if (wResult <> wSizeColorTable) then begin
      wErrV :=ERRBMPIsNotBMP;
      exit;
      end;
   end;
end;  //- TBitMapImage0.GetBitmapHeader

procedure TBitMapImage0.BitMapGetImage(var fIn:file; var wErrV:word32);
//================================================================
// Load the image
var
  wPixWidthL  : word32;

begin
with prBMPInfo^.bmiHeader do begin
   // Compute the size of memory which must be allocated.
   wPixWidthL := (((biWidth * biBitCount) + 31) div 32) * 4;
   biSizeImage := wPixWidthL * word32(biHeight);

   // Allocate memory, then load the image data.
   wSizeBits:=biSizeImage+32;
   GetMem(pBits, wSizeBits);

   // Test if we had enough memory.
   if (pBits = NIL) then begin
      wErrV:=ERRBMPNotEnoughMemory;
      exit;
      end;

   BlockRead(fIn, pBits^, wSizeBits);
   end; // with pBMPInfo^.BMIHeader do begin
end;  // TBitMapImage0.BitMapGetImage

function TBitMapImage0.BitMapFileLoad(var fIn:file; var wErrV:word32):HBitMap;
//=========================================================================
// Load a bit map, from the file fIn
var
  hDCScr      : HDC;
  // Device context of the screen, to create the handle on the bitmap
  hBMPL       : HBitMap;
  rSize       : SIZE; // to store the size of the bitmap

begin
BitMapFileLoad:=0; // in cse of errors

// Get the header information
GetBitmapHeader(fIn, wErrV);
if (wErrV <> 0) then exit;

// Get the image
BitMapGetImage(fIn, wErrV);
if (wErrV <> 0) then exit;

// Screen device context.
hDCScr := GetDC(0);

// Create the handle on the bitmap
hBMPL:= CreateDIBitmap( hDCScr, prBMPInfo^.bmiHeader, cbm_Init,
                        pBits,  prBMPInfo^,
                        DIB_RGB_COLORS);
BitMapFileLoad:=hBMPL;
ReleaseDC(0, hDCScr);

// Saves the dimensions in the bitmap, to retreive them easilly
rSize.cx:=prBMPInfo^.bmiHeader.biWidth;
rSize.cy:=prBMPInfo^.bmiHeader.biHeight;

// Suppose the bitmap is at resolution 300 dpi i.e.
// 1 pixel = 0.08466 milimeters = 8466/1000 [mm/100]
SetBitmapDimensionEx(hBMPL, word((prBMPInfo^.bmiHeader.biWidth  * 8466) div 1000),
                            word((prBMPInfo^.bmiHeader.biHeight * 8466) div 1000),
                            @rSize);
end;  // TBitMapImage0.BitMapFileLoad

function TBitMapImage0.BitMapFileNameLoad(strFilePathP:ShortString; var wErrV:word32):HBitMap;
//=====================================================================================
// Load a bit map, from a given file : strFilePathP
var
  fIn         : File;
  wSizeAllocL : word32;

begin
{$i-}
assign(fIn, strFilePathP);
FileMode:=0; // read only
reset(fIn, 1);
FileMode:=2; // read / write

BitMapFileNameLoad:=BitMapFileLoad(fIn, wErrV);

close(fIn);
IOResult; // clear any IO errors

// Release allocated memory, it is no more used.
if (pBits <> NIL) then FreeMem(pBits, wSizeBits);
pBits:=NIL;

wSizeAllocL:=SizeOf(BITMAPINFOHEADER) + wSizeColorTable;
if (prBMPInfo <> NIL) then FreeMem(prBMPInfo, wSizeAllocL);
prBMPInfo:=NIL;
end;  // TBitMapImage0.BitMapFileNameLoad

function TBitMapImage0.BitMapLoadFromFile(var wWidthV,wHeightV,wErrV:word32):HBitMap;
//==============================================================================
// Opens a dialog box, to ask for a .bmp file to be openend.
// Return a handle on the corresponding bitmap, or an Error.
// In case of Error, the handle returned is zero.
// If the CANCEL button has been selected, then
// wErrV = 0, but a zero handle is also returned.
var
  hBMAPL      : HBitMap;

begin
wWidthV  :=0;  // in case of error
wHeightV :=0;  // in case of error

// The file must exist to open it
rNameRec.Flags:=rNameRec.Flags or OFN_FileMustExist;

if (not GetOpenFileName(@rNameRec)) then begin
   // The CANCEL button has been choosen
   BitMapLoadFromFile:=0;
   wErrV:=0;
   exit;
   end;

// Convert null terminated string to ShortString
strPathName[0]:=Char(StrLen(@strPathName[1]));

// load the bitmap
hBMAPL:=BitMapFileNameLoad(strPathName, wErrV);
if (wErrV <> 0) then exit;

// Get the dimensions of the image
wWidthV  :=rBMPInfoHeader.biWidth;
wHeightV :=rBMPInfoHeader.biHeight;

wErrV:=0;
BitMapLoadFromFile:=hBMAPL;
end;  // TBitMapImage0.BitMapLoadFromFile

//**************************************************************************
// Saving in a bitmap file
//**************************************************************************

procedure TBitMapImage0.BitMapFileSave(var fOut:file; hBMP:HBitMap; var wErrV:word32);
//==============================================================================
// Save a bit map, to a given file : fOut
type
TypeBitMapInfo = record
//"""""""""""""""""""""
  c1,c2            : char;
  lSizeFile        : longint;
  wReserved1,
  wReserved2       : word;
  lImageBegin0     : longint;
  end; // record

var
  recBitMapInfo    : BitMap;
  nNbRead          : integer;
  wSizeAllocL      : word32;

  nbBitPerColor    : integer;
  wColorSize       : word;
  lBitMapSize      : int32;  // bitmap image information size
  hDCScr           : HDC;
//  hOldPalette      : HPalette;
  recFileHeader    : TypeBitMapInfo;
  lResult          : int32;

begin // TBitMapImage0.BitMapFileSave
{$i-}
// Get information on the bitmap
nNbRead:=GetObject(hBMP, SizeOf(recBitMapInfo), @recBitMapInfo);

// Test if the bitmap is valide
if (nNbRead = 0) then begin
   wErrV:=ERRBMPIsNotBMP;
   exit;
   end;

// Compute the info to put in the header
with recBitMapInfo do begin
    nbBitPerColor:=bmPlanes * bmBitsPixel;

    if (nbBitPerColor <> 24) then
         wColorSize:=(1 shl nbBitPerColor) * SizeOf(TRGBQUAD)
    else wColorSize:=0;

    lBitMapSize :=longint(((bmWidth * nbBitPerColor + 31) div 32) * 4) * bmHeight;
    end;

with recFileHeader do begin
   c1 :='B';
   c2 :='M';
   wReserved1:=0;
   wReserved2:=0;
   lImageBegin0 :=SizeOf(recFileHeader) + SizeOf(BitMapInfoHeader) + wColorSize;
   lSizeFile :=lImageBegin0 + lBitMapSize;
   end;

// Allocate memory to retrieve the image information
GetMem(pBits, lBitMapSize);

// Test if we had enough memory.
if (pBits = NIL) then begin
   wErrV:=ERRBMPNotEnoughMemory;
   exit;
   end;

// Allocate memory for the image header
wSizeAllocL:=SizeOf(BITMAPINFOHEADER) + wSizeColorTable;
GetMem(prBMPInfo, wSizeAllocL);

// image header information
prBMPInfo^.bmiHeader.biSize         :=SizeOf(BITMAPINFOHEADER);
prBMPInfo^.bmiHeader.biWidth        :=recBitMapInfo.bmWidth;
prBMPInfo^.bmiHeader.biHeight       :=recBitMapInfo.bmHeight;
prBMPInfo^.bmiHeader.biPlanes       :=recBitMapInfo.bmPlanes;
prBMPInfo^.bmiHeader.biBitCount     :=recBitMapInfo.bmBitsPixel;
prBMPInfo^.bmiHeader.biCompression  :=BI_RGB; // uncompressed
prBMPInfo^.bmiHeader.biSizeImage    :=lBitMapSize;
prBMPInfo^.bmiHeader.biXPelsPerMeter:=11811; // for 300 DPI, number of pixels in one meter
prBMPInfo^.bmiHeader.biYPelsPerMeter:=11811; // for 300 DPI, number of pixels in one meter
prBMPInfo^.bmiHeader.biClrUsed      :=0;     // used only for less than 16 colors
prBMPInfo^.bmiHeader.biClrImportant :=0;     // All colors are important

hDCScr:=GetDC(0);
{
if (hLPalette <> 0) then begin
   hOldPalette := SelectPalette(hDCScr, hLPalette, FALSE);
   RealizePalette(hDCScr);
   end;
}

// Transfert the image header and data from the image handle to
// the header buffer and the image buffer
// Return the number of lines copied.
// the recBitMapInfo.bmHeight doesn't seem to modify the number of
// lines effectively copied.
GetDIBits( hDCScr, hBMP, 0, recBitMapInfo.bmHeight, pBits, prBMPInfo,
                    dib_RGB_Colors);


// if (hLPalette <> 0) then SelectPalette(hDCScr, hOldPalette, False);

ReleaseDC(0, hDCScr);

// Save the file header
BlockWrite(fOut, recFileHeader, SizeOf(recFileHeader), lResult);

// Save the image header
BlockWrite(fOut, prBMPInfo^, SizeOf(BitMapInfoHeader) + wColorSize, lResult);

//DBW(1, 'IORES=' + ITS(IOResult) + ITS(lResult));

// Save the image
BlockWrite(fOut, pBits^, lBitMapSize, lResult);

//DBW(1, 'IORES=' + ITS(IOResult) + ITS(lResult) + ITS(lBitMapSize));

// Return the Input Output error
wErrV:=IOResult;

// Memorised the image header
if (wErrV = 0) then rBMPInfoHeader:=prBMPInfo^.bmiHeader;

// Free the allocated memory
wSizeAllocL:=SizeOf(BITMAPINFOHEADER) + wSizeColorTable;
FreeMem(prBMPInfo, wSizeAllocL);
prBMPInfo:=NIL;

FreeMem(pBits, lBitMapSize);
pBits:=NIL;
end;  // TBitMapImage0.BitMapFileSave

procedure TBitMapImage0.BitMapFileNameSave(strFilePathP:ShortString; hBMP:HBitMap; var wErrV:word32);
//=============================================================================================
// Save a bit map, to a given file : strFilePathP
var
  fOut        : File;

begin
{$i-}
assign(fOut, strFilePathP);
FileMode:=2; // read / write
rewrite(fOut, 1);

BitMapFileSave(fOut, hBMP, wErrV);

close(fOut);
IOResult; // clear any IO errors
end;  // TBitMapImage0.BitMapFileNameSave

procedure TBitMapImage0.BitMapSaveToFile(hBMP:HBitMap; var wErrV:word32);
//==================================================================
// Opens a dialog box, to ask in which .bmp file to save the bitmap
// wErrV = 0 if no errors occured.
begin
//
rNameRec.Flags:=rNameRec.Flags and (not OFN_FileMustExist);

if (not GetSaveFileName(@rNameRec)) then begin
   // The CANCEL button has been choosen
   wErrV:=0;
   exit;
   end;

// Convert null terminated string to ShortString
strPathName[0]:=Char(StrLen(@strPathName[1]));

// save the bitmap
BitMapFileNameSave(strPathName, hBMP, wErrV);
if (wErrV <> 0) then exit;
end;  // TBitMapImage0.BitMapSaveToFile

end.  // unit wBitMapImage0;

