{ Example of program using the GAP library.
  This example is similar to tEx050.pp
  Zooming has been added + picking a color + using left and right 
  mouse button + Coding into a text file + loading from a text file.
  Its purpose is to code a small image (typically 20x20 or 32x32 pixels)
  into a text file, which can be saved in a .msg fle.
  The image can be rebuild from the description in the .msg file.
  This will be used to define images on buttons, either in a dialog box,
  or in a toolbar. See  tEx052.pp  for a demonstration

  Some images have been saved in the file  Images.msg,  and can be
  viewed easilly in the procedure  GetImageFromMSG.
  It correspond to menu  "&Get image from .msg".
  They will be used in a demo in  tEx052.pp

  I would like to capture the mouse for all aplications, set its cursor shape.
  But I don't know how to do it.

  SetWindowLong(hWin, GWL_STYLE, WS_EX_TOPMOST);
  Doesn't work, but SetWindowPos(...) can do the same, and works
  to keep the window over all other.
  --------------------------------------------}
program tEx051;

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

Uses
  wApplication0
 ,wWindow0
 ,wDialog0
 ,wComboBox0
 ,wBitMapImage0
 ,wWindowBase0
 ,wHashTable2
 ,wVariableNumLink2
 ,wDialogCreatorLOW2
// ,wUtiles0
 ,wMessages2
 ,wGlobals2
 ,wDebug0
 ,Windows;

type
  PMyWindow = ^TMyWindow;
  TMyWindow = object(TWindow0)
  //""""""""""""""""""""""""""

  hBMap : HBITMAP;
  // BitMap in which we will draw.

  wWidth,wHeight : word32;
  // Width and Height of the image

  fLButtonDown : boolean;
  // is the left button down ?

  fRButtonDown : boolean;
  // is the right button down ?

  fMouseCaptured : boolean;
  // has the mouse been captured ?

  hDcWin : HDC;
  // The device context of the client window, to draw on it.

  colPenL : word32;
  // Color of the line when drawing with the left button

  colPenR : word32;
  // Color of the line when drawing with the right button

  wCheckMarkColor : word32;
  // to remember wich menu has a check mark, corresponding to the
  // color.

  // This part is quite complicate, and will be simpler with the use
  // of the library.
  hPenWin, // A pen to choose the drawing color, size of the line and style.
  hPenOld  // to remeber the old pen used by window.
           : HPEN;

  strPathName : ShortString;
  // File under which the bitmap is saved, or
  // File name of the loaded bitmap

  wZoomFactor : word;
  // to zoom the image. Used specially for small images

  wCheckMarkZoom : word32;
  // to remember wich menu has a check mark, corresponding to the
  // zoom factor.

  wNumImage : word32;
  // image number wanted from the .msg file

  constructor Init(strWinTitlePrm:ShortString);
  destructor Done; virtual;

  procedure ChangeMenuColor(wMenuID:word32);
  // Change the painting color,
  // and put a check mark in the menu to tell which is the selected color.

  procedure ChangeMenuZoom(wMenuID:word32);
  // Change the zoom factor,
  // and put a check mark in the menu to tell which is the selected zoom factor.

  procedure MenuCreate; virtual;
  // Add a menu to the window

  procedure WinCreate(strWinClass:ShortString); virtual;
  // When creating the window, controls will be added.

  procedure InitDialogEnd(poDlg:PWindowBase0); virtual;
  // When a dialog box has been filled with its
  // Control windows, and is ready to be shown.
  // the dialog calls this method with a pointer on itself. (it's his parent method)
  // Its a good place to fill list boxes if wanted, or
  // modify any control after its creation of their window (handle).
  // Is destinated to be overriden, does nothing by default.

  procedure NewImage;

  procedure BitMapLoad;  // Load a bitmap image from a file

  procedure BitMapSave; // Save the bitmap in a file

//  procedure SelectColors; not implemented
  // Select the left and right buttons colors.

  procedure CodeImageInText;
  // Code the image in a  .msg  text file, to be used for buttons
  // with images on them

  procedure GetImageFromMSG;
  // From a coded image in a .msg file,
  // get an image.

  procedure CopyToMemoryBitMap; virtual;
  // Normally the  StretchBlt  should do what is done here.
  // But since it doesn't work as I understand, I
  // do a procedure which does what I want.
  // It copies the visible zoomed image into the memory bitmap

  procedure CtrlVarUpdate(poCtrl:PWindowBase0; pVar:pointer); virtual;
  // When a control changed its value and it is linked to a variable and
  // it belongs to a dialog belonging to a window, then
  // the control calls this method with a pointer on itself and
  // a pointer on the associated variable.
  // Either you know the type, or you can get it with
  // pControl(poCtrl)^.rVarLinkInfo.wVarType

  procedure ShowGrid(hDCPaint:HDC);
  // Show a grid on the bitmap

  procedure WMPaint; virtual;
  // the system want the program to repaint the client area.

  function WMCommand(wPar:WPARAM; lPar:LPARAM):LRESULT; virtual;
  // Handles the menu messages

  procedure WMLRButtonDown(wMsg:UINT; wPar:WPARAM; lPar:LPARAM);
  // The left or right button has been pressed

  procedure WMLRButtonUp(wMsg:UINT; wPar:WPARAM; lPar:LPARAM);
  // The left or right button has been released

  function WindowProc(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM):LRESULT; virtual;
  end; // TMyWindow = object(TWindow)

// var nNotUsed : integer; // only to avoid an error message while compliling in DevPascal 1.9

constructor TMyWindow.Init(strWinTitlePrm:ShortString);
//=====================================================
begin
inherited Init(strWinTitlePrm);

// This would make that the window stays over all others
// dwExStyle:=dwExStyle or WS_EX_TOPMOST;

Word32Field(101,wWidth);
Word32Field(102,wHeight);
Word32Field(103, wNumImage);
wNumImage:=1;

// As always, it is best to initialise the members (=properties)
fLButtonDown :=FALSE;
fRButtonDown :=FALSE;
fMouseCaptured :=FALSE;
hDcWin       :=0;
hPenWin      :=0; // for the moment there is no pen.
hPenOld      :=0;
colPenL      :=RGB(  0,  0,  0); // black by default.
colPenR      :=RGB(255,255,255); // white by default.
hBMAP        :=0;
wWidth       :=0;
wHeight      :=0;
wZoomFactor  :=10;

wCheckMarkColor   :=301; // menu corresponding to black.
wCheckMarkZoom    :=350 + wZoomFactor; // Menu corresponding to a zoom factor of wZoomFactor

strPathName  :='New.bmp';

new(poStatusLine, Init(@Self));
end;  // TMyWindow.Init

destructor TMyWindow.Done;
//========================
begin
// The bitmap must be deleted.
if (hBMAP <> 0) then DeleteObject(hBMAP);

inherited Done;
end;  // TMyWindow.Done

procedure TMyWindow.ChangeMenuColor(wMenuID:word32);
//==================================================
// Change the painting color,
// and put a check mark in the menu to tell which is the selected color.
begin
// remove the checkmark from the menu
CheckMenuItem(hMenuWin, wCheckMarkColor, MF_BYCOMMAND or MF_UNCHECKED);

// Set the new the checkmark
wCheckMarkColor:=wMenuID;
CheckMenuItem(hMenuWin, wCheckMarkColor, MF_BYCOMMAND or MF_CHECKED);

// change the pen color
case wMenuID of
   301 : colPenL:=RGB(  0,  0,  0);
   302 : colPenL:=RGB(255,  0,  0);
   303 : colPenL:=RGB(  0,255,  0);
   304 : colPenL:=RGB(  0,  0,255);
   305 : colPenL:=RGB(128,128,  0);
   306 : colPenL:=RGB(128,  0,128);
   307 : colPenL:=RGB(  0,128,128);
   308 : colPenL:=RGB(255,255,255);
   309 : colPenL:=RGB(255,255,  0);
   310 : colPenL:=RGB(192,192,192);
   311 : colPenL:=RGB(128,128,128);
   312 : colPenL:=RGB( 64, 64, 64);
   end;
end;  // TMyWindow.ChangeMenuColor

procedure TMyWindow.ChangeMenuZoom(wMenuID:word32);
//==================================================
// Change the zoom factor
// and put a check mark in the menu to tell which is the selected color.
begin
// remove the checkmark from the menu
CheckMenuItem(hMenuWin, wCheckMarkZoom, MF_BYCOMMAND or MF_UNCHECKED);

// Set the new the checkmark
wCheckMarkZoom:=wMenuID;
CheckMenuItem(hMenuWin, wCheckMarkZoom, MF_BYCOMMAND or MF_CHECKED);

// change the zoom factor
wZoomFactor:=wCheckMarkZoom - 350;

// Repaint the window
InvalidateRGN(hWin, 0, TRUE);
end;  // TMyWindow.ChangeMenuZoom

procedure TMyWindow.MenuCreate;
//=============================
begin
inherited MenuCreate;

// Set a checkmark corresponding to the black color
CheckMenuItem(hMenuWin, wCheckMarkColor, MF_BYCOMMAND or MF_CHECKED);

// Checkmark to the corresponding zoom factor
CheckMenuItem(hMenuWin, wCheckMarkZoom, MF_BYCOMMAND or MF_CHECKED);
end;  // TMyWindow.MenuCreate

procedure TMyWindow.WinCreate(strWinClass:ShortString);
//=====================================================
// Creates a new window.
// with controls in it.
// All this will become simpler with dialog boxes and
// facilities to come.
var
  hDCMemL     : HDC;
  hBMAPOldL   : HBitMap;
  rRec        : RECT;
Begin
inherited WinCreate(strWinClass);

// Creates the Bitmap of a fixe size 400x300 pixels
wWidth       :=10;
wHeight      := 8;

// It will be used, remember what has been drawn.
hDCWin:=GetDC(hWin);
hBMAP:=CreateCompatibleBitmap(hDCWin, wWidth, wHeight);

// 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(hDCWin);
hBMAPOldL:=SelectObject(hDCMemL, hBMAP);

// Fill the bitmap with a white color
rRec.left:=0;  rRec.top:=0;  rRec.right:=wWidth; rRec.bottom:=wHeight;
FillRect(hDCMemL, rRec, GetStockObject(WHITE_BRUSH));
//FillRect(hDCMemL, rRec, GetStockObject(GRAY_BRUSH)); // Can be filled with gray also

// 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(hWin, hDCWin);
end;  // TMyWindow.WinCreate

procedure TMyWindow.InitDialogEnd(poDlg:PWindowBase0);
//====================================================
// Fill the choice list of the combo box
var
  wPosL       : word;
  strS        : ShortString;
//  wWidthL,wHeightL : word32;
  poComboL    : PComboBox;

begin
if (PDialog(poDlg)^.wMsgDescriptor <> 11299) then exit;

poComboL :=PComboBox(PDialog(poDlg)^.GetControlFromVar(wNumImage)); // We know it is a combo box
if (poComboL = NIL) then exit;

// Fill the combo box with image choices
strS:=GetMsg(3000000001); // First image in the  Images.msg  file
repeat
   // Look for the text defining the image
   wPosL:=1;
   while (wPosL < length(strS)) and (strS[wPosL] <> '"') do inc(wPosL);

   strS:=IntToStr(gglwMessages2LastNum-word32(3000000000),0) + ' = ' +
         Copy(strS, wPosL+1, length(strS)-wPosL-1);

   // Add a new choice in the combo list
   poComboL^.AddString(strS);

   strS:=GetMsgNextNum;
   until (gglwMessages2LastNum > 3100000000) or
         (not gglfMessages2LastFound);

// Select the right line in the combo box
with poComboL^ do begin
   strCtrlLabel[length(strCtrlLabel)+1]:=#0;
   SendMessage(hWin, CB_SELECTSTRING, -1, LPARAM(@strCtrlLabel[1]));
   end;

// To view the right image
CtrlVarUpdate(poComboL, @wNumImage);
end;  // TMyWindow.InitDialogEnd

procedure TMyWindow.NewImage;
//===========================
// Save the bitmap in a file
var
  wWidthL,
  wHeightL,
  wRep        : word32;
  hBMAPL      : HBitMap;

begin
// Use local variable, in case of failure.
Word32Field(201,wWidthL);
Word32Field(202,wHeightL);

wWidthL  :=wWidth;
wHeightL :=wHeight;

// Ask the sizes of the new image
wRep:=DialogExecMSG(11199, @Self);

if (wRep = IDOK) then begin
   // The bitmap will be used, remember what has been drawn.
   hBMAPL:=CreateNewBitMapImage(hWin, wWidthL, wHeightL);

   // Test if the bitmap could be created.
   if (hBMAPL = 0) then begin
      DBW(1, 'Error, bitmap not created');
      exit;
      end;

   // The old bitmap must be deleted.
   if (hBMAP <> 0) then DeleteObject(hBMAP);

   // New bitmap, new width, new height
   hBMAP:=hBMAPL;
   wWidth  :=wWidthL;
   wHeight :=wHeightL;

   // Repaint the window
   InvalidateRGN(hWin, 0, TRUE);
   end; // if (wRep = IDOK) then begin
end;  // TMyWindow.NewImage

procedure TMyWindow.BitMapLoad;
//=============================
// Try to load a bitmap from a file
var
  wWidthL,
  wHeightL,
  wErrL       : word32;
  oBML        : TBitMapImage;
  hBMPTemp    : HBitMap;

begin
oBML.Init;
hBMPTemp:=oBML.BitMapLoadFromFile(wWidthL, wHeightL, wErrL);

// put the filename in the status line
if (wErrL = 0) and (hBMPTemp <> 0) then begin
   poStatusLine^.SetStatusText(1, oBML.strPathName);
   strPathName:=oBML.strPathName;
   end;

oBML.Done;

if (wErrL <> 0) then begin
   DBW(1, 'Loading error=' + ITS(wErrL));
   DBW(1, 'Width =' + ITS5(wWidth));
   DBW(1, 'Height=' + ITS5(wHeight));
   exit;
   end;

// No bitmap has been loaded. Maybe CANCEL has been selected.
if (hBMPTemp = 0) then exit;

// The bitmap must be deleted.
DeleteObject(hBMAP);

// New bitmap
hBMAP:=hBMPTemp;
wWidth  :=wWidthL;
wHeight :=wHeightL;

// Repaint the window
InvalidateRGN(hWin, 0, TRUE);
end;  // TMyWindow.BitMapLoad

procedure TMyWindow.BitMapSave;
//=============================
// Save the bitmap in a file
var
  wErrL       : word32;
  oBML        : TBitMapImage;

begin
oBML.Init;

// Set the default filename under which we save
oBML.strPathName:=strPathName;
oBML.BitMapSaveToFile(hBMap, wErrL);

// In case of success, remember the filename
if (wErrL = 0) then begin
   strPathName:=oBML.strPathName;
   poStatusLine^.SetStatusText(2, 'Saved');
   end;

oBML.Done;

if (wErrL <> 0) then begin
   DBW(1, 'Saving error =' + ITS(wErrL));
   exit;
   end;
end;  // TMyWindow.BitMapSave

procedure TMyWindow.CodeImageInText;
//==================================
// Code the image in a  .msg  text file, to be used for buttons
// with images on them.
// Suppose that only a few colors are used, thus code each color
// with a letter or a digit or a symbole
var
  oHT         : THashTableW2;
  hBMAPOldL   : HBitMap;
  hDCWinL,
  hDCMemL     : HDC;
  wLetter,    // Letters coding colors
  wCodeLetter, // Letter coding a pixel and a color
  wX,wY       : word32;
  colPix      : COLORREF;
  awColors    : array[33..255] of word32;
  // color corresponding to a letter
  strS        : ShortString; // to be written in the text file

begin
// Test that the image with is not too big
if (wWidth > 120) then exit;  // too large

// Initialise the hash table used to code the image
oHT.Init(0);

// Create a memory device context, to manipulate the memory image
hDCWinL:=GetDC(hWin);
hDCMemL:=CreateCompatibleDC(hDCWin);
ReleaseDC(hWin, hDCWinL);

// Select the memory bitmap in a memory device context
hBMAPOldL:=SelectObject(hDCMemL, hBMAP);

// Initialise the color table with impossible color codes
for wLetter:=33 to 255 do awColors[wLetter]:=16777216; // = 256^3

// colors are coded into letters
wLetter:=ord('a');

// First loop on the image, to set a letter for each colors
for wY:=0 to wHeight-1 do for wX:=0 to wWidth-1 do begin
   colPix:=GetPixel(hDCMemL, wX, wY);

   // Code in the hash table, the letter coding the pixel
   oHT.GetPointerW2(colPix, 0, wCodeLetter);

   if (wCodeLetter = 0) then begin
      // first time that this pixel appear
      // Assign a new letter for it
      oHT.AddPointerW2(colPix, 0, wLetter, NIL); // the pointer is not used

      // memorise the color associated to this pixel
      awColors[wLetter]:=colPix;

      // next letter or symbole
      if (wLetter = ord('z')) then wLetter:=ord('0')-1; // all lower caps letters have been used
      if (wLetter = ord('9')) then wLetter:=ord('A')-1; // all digits have been used
      if (wLetter = ord('Z')) then wLetter:=ord('$')-1; // all upper case letters have been used
      if (wLetter = ord('?')) then wLetter:=224-1; // nearly all symbols have been used
      if (wLetter = 255) then wLetter:=192-1; // all lower case letters with accent have been used
      if (wLetter = 223) then wLetter:=128-1; // it becomes complicate

      // If too much colors, colors will be lost
      if (wLetter <> 190) then inc(wLetter);
      end;
   // else do nothing
   end; // for

// Begin to store the correspondance between a character and a color
DBW(1, ''); // Skip a line

// Write the width and height of the image in the file
DBW(1, '3000000000 (' + IntToStr(wWidth,0) + ', ' + IntToStr(wHeight,0) + ')');
strS:='0 ';
for wLetter:=33 to 255 do begin
   if (awColors[wLetter] <> 16777216) then begin
      // this letter code for a color
      strS:=strS + char(wLetter) + '='
                 + IntToStr(aWColors[wLetter] mod 256, 3) + ',' // Red
                 + IntToStr((aWColors[wLetter] div 256) mod 256, 3) + ',' // Green
                 + IntToStr(aWColors[wLetter] div 65536, 3) // blue
                 + '; ';
      // If the sting is long enough, write it to the file
      if (length(strS) > 220) then begin
         DBW(1, strS);
         strS:='0 ';
         end;
      end; // if
   end; // for

// Last line of letter - color correspondence
if (length(strS) > 2) then DBW(1, strS);

// Separation
DBW(1, '0 ----------');

// Second loop, to store the code image in a text file
for wY:=0 to wHeight-1 do begin
   // each line of pixels is coded into a line of characters
   strS:='0 ';

   // loop over one line of pixels
   for wX:=0 to wWidth-1 do begin
      colPix:=GetPixel(hDCMemL, wX, wY);

      // Get the letter code of the pixel
      // Here it is impossible that wCodeLetter = 0
      oHT.GetPointerW2(colPix, 0, wCodeLetter);

      strS:=strS + char(wCodeLetter) + ' ';
      end; // for wX:=...

   DBW(1, strS);
   end; // for wY:=...

DBW(1, '0 ...END');

// We no longer need the memory device context, thus delete it.
// But before, the original bitmap must be given back.
SelectObject(hDCMemL, hBMAPOldL);
DeleteDC(hDCMemL);

oHT.Done;
end;  // TMyWindow.CodeImageInText

procedure TMyWindow.GetImageFromMSG;
//==================================
// From a coded image in a .msg file,
// get an image.
var
  wRepL,
  wWidthL,    // width and height of the image in the .msg file
  wHeightL    : word32;
  hBMAPL      : HBitMap;

begin
// Ask the sizes of the new image
wRepL:=DialogExecMSG(11299, @Self);

if (wRepL <> IDOK) then exit; // CANCELED the operation

hBMAPL:=LoadImageFromMSG(word32(3000000000) + wNumImage, hWin, wWidthL, wHeightL);

if (hBMAPL = 0) then exit; // error

// The old bitmap must be deleted.
if (hBMAP <> 0) then DeleteObject(hBMAP);

// New bitmap, new width, new height
hBMAP:=hBMAPL;
wWidth  :=wWidthL;
wHeight :=wHeightL;

// Repaint the window
InvalidateRGN(hWin, 0, TRUE);
end;  // TMyWindow.GetImageFromMSG

procedure TMyWindow.CopyToMemoryBitMap;
//=====================================
// Normally the  StretchBlt  should do what is done here.
// But since it doesn't work as I understand,
// I do a procedure which does what I want.
// It copies the visible zoomed image into the memory bitmap
// It seems very unefficient, but I don't know how to do it better.
var
  hDCMemL     : HDC;
  hBMAPOldL   : HBitMap;
  wWidthL,    // Width  of the visible part of the image
  wHeightL,   // Height of the visible part of the image
  wCenter,    // To get the pixel in the center of the zoomed pixel
  wX,wY       : word32;
  rRec        : RECT;
  colPix      : COLORREF;

begin
// Width and height of the image.
// The dimensions used can be smaller, if not all the image is visible.
wWidthL  :=wWidth-1;
wHeightL :=wHeight-1;

// To get the pixel in the center of each zoomed pixels
wCenter:=wZoomFactor div 2;

// Copy only the visible part of the image
GetClientRect(hWin, rRec);

if (rRec.bottom <=  wCenter + poStatusLine^.wHeight) then exit;
                                                    // No image is visible

// Limit the sizes if the visible part of the image is smaller than the image
if (wWidthL * wZoomFactor + wCenter >= rRec.right) then
    wWidthL := (word32(rRec.right) - wCenter-1) div wZoomFactor;

if (wHeightL * wZoomFactor + wCenter + poStatusLine^.wHeight >= rRec.bottom) then
    wHeightL := (word32(rRec.bottom) - wCenter-1 - poStatusLine^.wHeight) div wZoomFactor;

// Copy what is on the screen, to the memory bitmap
// First, must select the memory bitmap in a memory device context
hDCMemL:=CreateCompatibleDC(hDCWin);

// Select the bit map in the memory device context,
// to copy the screen on it.
hBMAPOldL:=SelectObject(hDCMemL, hBMAP);

// Get the image on the screen into an array of pixels.
for wX:=0 to wWidthL do for wY:=0 to wHeightL do begin
   colPix:=GetPixel(hDCWin, wX*wZoomFactor + wCenter, wY*wZoomFactor + wCenter);
   SetPixel(hDCMemL, wX, wY, colPix);
   end;

// We no longer need the memory device context, thus delete it.
// But before, the original bitmap must be given back.
SelectObject(hDCMemL, hBMAPOldL);
DeleteDC(hDCMemL);
end;  // TMyWindow.CopyToMemoryBitMap

procedure TMyWindow.CtrlVarUpdate(poCtrl:PWindowBase0; pVar:pointer);
//===================================================================
// a variable has changed in a dialog box.
// pVar = pointer on the variable
// poCtrl = pointer on the control linked to this variable
// poCtrl^.poParent = pointer on the dialog box
// PDialog(poCtrl^.poParent)^.wMsgDescriptor =
// = msg which generated the dialog box
var
  wWidthL,    // width and height of the image in the .msg file
  wHeightL    : word32;
  hBMAPL      : HBitMap;

begin
if (PDialog(poCtrl^.poParent)^.wMsgDescriptor = 11299) and
   (pVar = @wNumImage) then begin
   // the selected image changed in the dialog box, show it

   hBMAPL:=LoadImageFromMSG(word32(3000000000) + wNumImage, hWin, wWidthL, wHeightL);

   if (hBMAPL = 0) then exit; // error

   // The old bitmap must be deleted.
   if (hBMAP <> 0) then DeleteObject(hBMAP);

   // New bitmap, new width, new height
   hBMAP:=hBMAPL;
   wWidth  :=wWidthL;
   wHeight :=wHeightL;

   // Repaint the window
   InvalidateRGN(hWin, 0, TRUE);
   end; // if
end;  // TMyWindow.CtrlVarUpdate

procedure TMyWindow.ShowGrid(hDCPaint:HDC);
//========================================
// Show a grid on the bitmap
var
  wX,wY       : Word;
begin
if (wZoomFactor < 6) then exit;

// Vertical lines
for wX:=1 to wWidth-1 do begin
   MoveToEx(hDCPaint, wX * wZoomFactor, 0, NIL);
   LineTo(  hDCPaint, wX * wZoomFactor, wHeight * wZoomFactor);
   end;

// Horizontal lines
for wY:=1 to wHeight-1 do begin
   MoveToEx(hDCPaint,                    0, wY * wZoomFactor, NIL);
   LineTo(  hDCPaint, wWidth * wZoomFactor, wY * wZoomFactor);
   end;
end;  // TMyWindow.ShowGrid

procedure TMyWindow.WMPaint;
//==========================
Var
  hDCMemL,
  hDCPaint    : hdc;
  rPS         : paintstruct;
  hBMAPOldL   : HBitMap;

begin
// Get a device context.
// Here we have a facility, during the WMPaint, we must always
// begin with  "BeginPaint", which gives a Device Context to paint, and
// end with "EndPaint", to tell that the painting is done.
hDCPaint:=BeginPaint(hWin, @rPS);

// Copy the bitmap  hBMAP  in the  HDCPaint, to see it on the screen
// First, must select the bitmap in a memory device context
hDCMemL:=CreateCompatibleDC(hDCPaint);

// Select the bit map in the memory device context, to copy it in the paint deviec context.
hBMAPOldL:=SelectObject(hDCMemL, hBMAP);

// Copy the bit map, from the memory DC to the paint DC
StretchBlt( hDCPaint, // handle of destination device context
            0, // x-coordinate of destination rectangle's upper-left corner
            0, // y-coordinate of destination rectangle's upper-left corner
        wWidth * wZoomFactor, // width of destination rectangle
        wHeight * wZoomFactor, // height of destination rectangle
        hDCMemL, // handle of source device context
          0,  // x-coordinate of source rectangle's upper-left corner
          0, // y-coordinate of source rectangle's upper-left corner
        wWidth, // Width of source
        wHeight, // Width of source
        SRCCOPY // raster operation code  (there are many others possibilities)
        );

// We no longer need the memory device context, thus delete it.
// But before, the original bitmap must be given back.
SelectObject(hDCMemL, hBMAPOldL);
DeleteDC(hDCMemL);

// Show a grid over the image
ShowGrid(hDCPaint);

// Finished painting
EndPaint(hWin, rPS);
end;  // TMyWindow.WMPaint

function TMyWindow.WMCommand(wPar:WPARAM; lPar:LPARAM):LRESULT;
//=============================================================
// Handles the menu messages
Var
//  wNoticode,  // notification code, from a child window.
  wNrMenu     : word;

begin
WMCommand:=0; // default return value
// wNotiCode := HiWord(wPar);

{DBW0(64, DBNotifToStr(wNotiCode) + ITS(LoWord(wPar))); }

if (lPar <> 0) then begin
   // call the parent WMCommand method.
   WMCommand:=inherited WMCommand(wPar, lPar);
   exit;
   end;

// for the menus,  lPar = 0
//=========================
wNrMenu   := LoWord(wPar);
Case wNrMenu Of
   100 : NewImage;
   101 : BitMapLoad;
   102 : BitMapSave;
//   103 : SelectColors; not implemented since colors can be picked with shift click
   104 : CodeImageInText;
   105 : GetImageFromMSG;

   // Some colors to paint.
   301..350 : ChangeMenuColor(wNrMenu);

   // Some zoom factors.
   351..380 : ChangeMenuZoom(wNrMenu);

   // Help information
   401 : DialogExecMSG(14199, @Self);
   else WMCommand:=inherited WMCommand(wPar, lPar);
   end;  // Case NrMenu Of
end;  // TMyWindow.WMCommand

procedure TMyWindow.WMLRButtonDown(wMsg:UINT; wPar:WPARAM; lPar:LPARAM);
//======================================================================
// The left button has been pressed
var
  nShiftState : int16;
  hDCScr      : HDC; // a device context of the screen
  ptPoint     : POINT;
  rRec        : RECT;

begin
wPar:=wPar; // to avoid a Hint
// If any button is already pressed then do nothing
if (fLButtonDown) or (fRButtonDown) then exit;

// Test if the shift key is pressed
nShiftState:=GetAsyncKeyState(VK_SHIFT);

if (nShiftState < 0) then begin
   // the shift key is pressed
   // Open a device context of the screen, to pick a pixel color
   hDCScr:=CreateDC('DISPLAY', 0, 0, 0);

   // Get the position of the mouse cursor on the screen
   GetCursorPos(ptPoint);

   // Get the pixel color
   if (wMsg = WM_LButtonDown) then
        colPenL:=GetPixel(hDCScr, ptPoint.x, ptPoint.y)
   else colPenR:=GetPixel(hDCScr, ptPoint.x, ptPoint.y);

   // must delete the created screen device context
   DeleteDC(hDCScr);
   exit;
   end;


if (wMsg = WM_LButtonDown) then begin
   // the left button has been pressed.
   // the button was not down already, thus capture the mouse
   fLButtonDown:=TRUE;

   // creation of a Pen, to change its color, width, etc.
   hPenWin:=CreatePen(PS_SOLID, wZoomFactor, colPenL);
   end
else begin
   fRButtonDown:=TRUE;

   // creation of a Pen, to change its color, width, etc.
   hPenWin:=CreatePen(PS_SOLID, wZoomFactor, colPenR);
   end;

      // the mouse will belong to this application, where ever it is
      // no other applications will receive messages from the mouse.
      SetCapture(hWin);

      // get a device context to draw on the client window
      hDcWin:=GetDC(hWin);

      // We want to limit the region where we can paint
      GetClientRect(hWin, rRec);
      ExcludeClipRect(hDCWin, wWidth * wZoomFactor,   0, rRec.right, rRec.bottom);
      ExcludeClipRect(hDCWin,   0, wHeight * wZoomFactor, rRec.right, rRec.bottom);

      // Other first parameter could be :
      // PS_DASH, PS_DOT, PS_DASHDOT, PS_DASHDOTDOT, PS_NULL, PS_INSIDEFRAME

      // Use this pen in the device context and
      // remember the handle on the old pen.
      hPenOld:=SelectObject(hDcWin, hPenWin);

      // position the point to begin to draw at the coordinate
      // of the mouse. We could get these coordinates with :
      // GetCursorPos(@rPoint);, but here it is useless
      // since the positions are given in "lPar"
      MoveToEx(hDcWin, LoWord(lPar), HiWord(lPar), NIL);

      // To have a point, even if the mouse didn't move
      LineTo(hDcWin, LoWord(lPar), HiWord(lPar));
end;  // TMyWindow.WMLButtonDown

procedure TMyWindow.WMLRButtonUp(wMsg:UINT; wPar:WPARAM; lPar:LPARAM);
//====================================================================
// The left or right button has been released
begin
wMsg:=wMsg; wPar:=wPar; lPar:=lPar; // to avoid Hints
if fMouseCaptured then begin
   // If the shift key is released, release the mouse capture
   ReleaseCapture;
   fMouseCaptured:=FALSE;

//      SetCursor(hMouseCursorOld);

   // The window will not remain over all other
   SetWindowPos( hWin, HWND_NOTOPMOST, 0,0,0,0,
                 SWP_NOMOVE or SWP_NOSIZE or SWP_NOREDRAW);
   exit;
   end;

if not (fLButtonDown or fRButtonDown) then exit;

      // the left or right button has been released.
      // The button could have been set down outside of the window,
      // and be let UP in the window. Thus a WM_LButtonUp
      // message would be receivd, without the WM_LButtonDown one.
      ReleaseCapture;  // mouse messages are sended to the window under it.

      // must give back the old pen, before destroying the used pen.
      SelectObject(hDcWin, hPenOld);

      // Detroy the pen, to free resources.
      // If you forget to do this, Windows resources will go down,
      // and after a while, the complete system will crash.
      DeleteObject(hPenWin);

      // Copy the screen bitmap to the memory bitmap
      CopyToMemoryBitMap;

      // Copy the bitmap in the window, into the memory bitmap
{ This doesn't work the way it should
      StretchBlt( hDCMemL, // handle of destination device context
                  0, // x-coordinate of destination rectangle's upper-left corner
                  0, // y-coordinate of destination rectangle's upper-left corner
             wWidth, // width of destination rectangle
            wHeight, // height of destination rectangle
             hDCWin, // handle of source device context
                  0, // x-coordinate of source rectangle's upper-left corner
                  0, // y-coordinate of source rectangle's upper-left corner
            wWidth * wZoomFactor, // width of source rectangle
            wHeight * wZoomFactor, // height of source rectangle
            SRCCOPY // raster operation code  (there are many others possibilities)
            );
}
      // Must release the device context
      ReleaseDC(hWin, hDcWin);

      fLButtonDown:=FALSE;
      fRButtonDown:=FALSE;

      // Indicate that the image has been modified.
      poStatusLine^.SetStatusText(2, IntToStr(wWidth,0) + 'x' +
                                     IntToStr(wHeight,0));

      // Repaint the window
      InvalidateRGN(hWin, 0, TRUE);
end;  // TMyWindow.WMLRButtonUp

function TMyWindow.WindowProc(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM):LRESULT;
//=======================================================================================
// All window messages are send here.
const hMouseCursorOld : HCursor = 0;
var
  hMouseCursor : HCursor;

Begin
WindowProc := 0; // Default return value when processing a message

{ if (wMsg <> WM_MouseMove)   and (wMsg <> WM_NCMouseMove) and
   (wMsg <> WM_MENUSELECT )   and (wMsg <> WM_ENTERIDLE ) and
   (wMsg <> WM_SetCursor)   and (wMsg <> WM_NCHittest) and
   (wMsg <> WM_SetFocus) and (wMsg <> WM_KillFocus) and
   (wMsg <> WM_KEYDOWN) and (wMsg <> WM_KEYUP) and
   (wMsg <> WM_Move)        and (wMsg <> WM_NCActivate) then
   DBW0(32, DBMsgToStr(wMsg) + ITS(wPar) + ITS(lPar)); }

Case wMsg Of
   WM_Paint   : WMPaint; // must redraw the client area part.
   WM_Command : WindowProc:=WMCommand(wPar, lPar);

   WM_KEYDOWN :  if (not fLButtonDown) and (not fRButtonDown) and
                    (wPar = VK_SHIFT) and (not fMouseCaptured) then begin
      // If the shift key is pressed, capture the mouse
      SetCapture(hWindow);
      fMouseCaptured:=TRUE;

      hMouseCursor:=GetCursor;
      hMouseCursorOld:=SetCursor(hMouseCursor);

      // The window will remain over all other
      SetWindowPos( hWin, HWND_TOPMOST, 0,0,0,0,
                    SWP_NOMOVE or SWP_NOSIZE or SWP_NOREDRAW);

      // This doesn't work !
      // nRep:= SetWindowLong(hWindow, GWL_EXSTYLE, WS_EX_TOPMOST);
      end; // WM_KEYDOWN

   WM_KEYUP : if fMouseCaptured then begin
      // If the shift key is released, release the mouse capture
      ReleaseCapture;
      fMouseCaptured:=FALSE;

      // Set back the cursor shape
      SetCursor(hMouseCursorOld);

      // The window will not remain over all other
      SetWindowPos( hWin, HWND_NOTOPMOST, 0,0,0,0,
                    SWP_NOMOVE or SWP_NOSIZE or SWP_NOREDRAW);
      end; // WM_KEYUP

   WM_LButtonDown,
   WM_RButtonDown : WMLRButtonDown(wMsg, wPar, lPar);

   WM_LButtonUp,
   WM_RButtonUp : WMLRButtonUp(wMsg, wPar, lPar);

   WM_MouseMove : if (fLButtonDown or fRButtonDown) then begin
      // The mouse is mooving while the left or right button are dawn. => Draw.

      // Draw a line from the last position to the position of the mouse.
      LineTo(hDcWin, LoWord(lPar), HiWord(lPar));
      end; // WM_MouseMove : begin

   else begin // Case wMsg Of
      // Default processing of the messages.
      WindowProc:=inherited WindowProc(hWindow, wMsg, wPar, lPar);
      end; // Case wMsg Of
   End; // Case wMsg Of

End;  // TMyWindow.WindowProc

var
  oApp        : TApplication0;
  poMyMainWin : PMyWindow;

Begin // MAIN ******
// Name under which the main window is registered. Spaces are not allowed
oApp.Init('Example051');

// Change the color of the background of the main window.
// to have the desktop color
oApp.WindowClass.hbrBackground :=COLOR_BACKGROUND+1;

// Creation of the main window
new(poMyMainWin, Init('tEx051. Coding bitmaps in a .msg file.'));

// The App.WindowClass can be modified here, if wanted. (Not usual)
oApp.Run;
oApp.Done;  // The main window object is disposed here.
End.

