{ Example of program using the GAP library.
  This example shows how to draw lines, and memorise them in a bitmap.
  Thus when the window is painted, what we draw is still there.

  See  tEx019_b.pp  for more comments.
  Here we do nearly the same, but with remembering what has been drawn
  in a bitmap.

  I find it quite complicate to handle bit map!

  See  tEx051.pp  for a similar example, with the purpose to code in a text
  .msg file small images.

  There is a little interresting bug.
  If the window is smaller than the image size when you save,
  part of what is outside the window is also saved !
  --------------------------------------------}
program tEx050;

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

Uses
  Windows
 ,wGlobals2
 ,wApplication0
 ,wWindow0
 ,wBitMapImage0
 ,wVariableNumLink2
 ,wDialogCreatorLOW2
 ,wDebug0;

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 ?

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

  colPen : word32;
  // Color of the line when drawing

  wCheckMark : 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

  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 MenuCreate; virtual;
  // Add a menu to the window

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

  procedure NewImage;

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

  procedure BitMapSave; // Save the bitmap in a file

  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

  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);

Word32Field(101,wWidth);
Word32Field(102,wHeight);

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

wCheckMark   :=301; // menu corresponding to black.

strPathName  :='New.bmp';

// This line is all what is needed to have a status line.
new(poStatusLine, Init(@Self));
end;  // TMyWindow.Init

destructor TMyWindow.Done;
//========================
begin
// The bitmap must be deleted.
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, wCheckMark, MF_BYCOMMAND or MF_UNCHECKED);

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

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

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

// Set a checkmark corresponding to the black color
CheckMenuItem(hMenuWin, wCheckMark, 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       :=400;
wHeight      :=300;

// 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.NewImage;
//===========================
// Save the bitmap in a file
// Can be simpler by calling :
// hBMAPL:=CreateNewBitMapImage(hWin, wWidthL, wHeightL); in wBitMapImage0.pp
var
  wWidthL,
  wHeightL,
  wRep        : word32;
  hDCMemL     : HDC;
  hBMAPL,
  hBMAPOldL   : HBitMap;
  rRec        : RECT;

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.
   hDCWin:=GetDC(hWin);
   hBMAPL:=CreateCompatibleBitmap(hDCWin, wWidthL, wHeightL);

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

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

   // 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));

   // 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);

   // 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.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
BitBlt( 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, // width of destination rectangle
        wHeight, // 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
        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);

// 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;

   // Some colors to paint.
   301..350 : ChangeMenuColor(wNrMenu);
   else WMCommand:=inherited WMCommand(wPar, lPar);
   end;  // Case NrMenu Of
end;  // TMyWindow.WMCommand

function TMyWindow.WindowProc(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM):LRESULT;
//=======================================================================================
// All window messages are send here.
var
  hDCMemL     : HDC;
  hBMAPOldL   : HBitMap;
  rRec        : RECT;

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_LButtonDown : if (not fLButtonDown) then begin
      // the left button has been pressed.
      // the button was not down already, thus capture the mouse
      fLButtonDown:=TRUE;

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

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

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

      // creation of a Pen, to change its color, width, etc.
      hPenWin:=CreatePen(PS_SOLID, 1, colPen);
      // 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);
      end; // WM_LButtonDown

   WM_LButtonUp : if (fLButtonDown) then begin
      // the left 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 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);

      // Copy the bitmap in the window, into the memory bitmap
      BitBlt( 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
            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);

      // Must release the device context
      ReleaseDC(hWindow, hDcWin);

      fLButtonDown:=FALSE;

      // Indicate that the image has been modified.
      poStatusLine^.SetStatusText(2, 'Modified');
      end; // WM_LButtonUp

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

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

      // to make it less boring, let's make as if the line was shaked.
      LineTo(hDcWin, LoWord(lPar)+4, HiWord(lPar)+4);
      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('Example050');

// 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('tEx050. Playing with bitmaps.'));

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

