{ Example of program using the GAP library.
  This example shows how to draw text and pictures.
  Windows, as nearly any other Graphical User Interface, do not
  "remember" what was drawn or painted. Each time a window
  was hidden by another one, and comes in from again, the whole
  window must be repaint.

  What is called the Non Client area, i.e. the title on the top, the
  maximize, close etc. buttons, the frame around the window, the background
  of the window (white in general) are painted by windw.
  But the content of what is called the client area, typically where you
  enter a text, or do some drawings, is over your responsibility, or the
  responsibility of Controls.

  Text is never "written" but always "painted" (or "drawn", equivalent.)
  Thus when I say "paint", it includes text.

  If you want to paint directly on the client part of the window,
  there are two moment when it is done.
  First, if you draw directly something, you must draw it without delay.
  For this, you need to get a Device Context, usually with GetDC(hWin),
  then choose among :
  OBJ_BRUSH        Brush
  OBJ_PEN          Pen
  OBJ_FONT         Font
  OBJ_BITMAP       Bitmap
  OBJ_REGION       Region
  OBJ_EXTPEN       Extended pen
  OBJ_PAL          Palette
  and maybe other things like Metafiles.
  Then you can draw, then you have to close your device context.

  Secondly, if another window came over yours, and goes away,
  the system will send a WM_PAINT message wich tells your program it
  should paint again all your drawings.

  This means that the program must "remember" what has been painted directly
  in the client area, to be able to repaint it when receiving the
  WM_Paint message.
  It the program fails to "remember", the drawing will not reapear
  after another window went over the program's window.

  We will see the four things.
  1) Painting always a same text in the client window.
     (When receiving the WM_Paint message)
  2) Painting some figures done by a user and remembered.
     (When receiving the WM_Paint message)
  3) Drawing some figures, which will be memorised.
  4) Drawing free curves, which will not be memorised, and
     not redrawn when the WM_Paint message arrives.

  To see the evolution, various files will be written
  This one is the  tEx019_b.pp  example file.

  Drawing with the mouse, not remembering what has been drawn.

  We use also the menu, to have simple selection of some colors
  and put checkmarks on the corresponding menus.

  Later this will be simplified with the library.
  --------------------------------------------}
program tEx019_b;

// 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
 ,wErrors0
 ,wDebug0;

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

  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;

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

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

wCheckMark   :=301; // menu corresponding to black.
end;  // TMyWindow.Init

destructor TMyWindow.Done;
//========================
begin
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);
   end;
end;  // TMyWindow.ChangeMenuColor

procedure TMyWindow.MenuCreate;
//=============================
var
  hSubMenu    : HMENU;
begin
hMenuWin := CreateMenu;

hSubMenu := CreateMenu;
AppendMenu(hSubmenu,MF_STRING,100,'&Open debug window');
AppendMenu(hSubmenu,MF_SEPARATOR,0,Nil);
AppendMenu(hSubMenu,MF_String, 200, 'E&xit');
AppendMenu(hMenuWin, MF_POPUP, hSubMenu, '&File');

hSubMenu := CreateMenu;
AppendMenu(hSubmenu,MF_STRING, 301, '&Black');
AppendMenu(hSubmenu,MF_STRING, 302, '&Red');
AppendMenu(hSubmenu,MF_STRING, 303, '&Green');
AppendMenu(hSubmenu,MF_STRING, 304, '&Blue');
AppendMenu(hSubmenu,MF_STRING, 305, 'Br&own');
AppendMenu(hSubmenu,MF_STRING, 306, '&Magenta');
AppendMenu(hSubmenu,MF_STRING, 307, '&Cyan');
AppendMenu(hSubmenu,MF_STRING, 308, '&White');
AppendMenu(hMenuWin, MF_POPUP, hSubMenu, '&Colors');

hSubMenu := CreateMenu;
AppendMenu(hSubmenu,MF_STRING, 401, 'Info &1...');
AppendMenu(hMenuWin, MF_POPUP, hSubMenu, '&Help');

// Set a checkmark corresponding to the black color
CheckMenuItem(hMenuWin, wCheckMark, MF_BYCOMMAND or MF_CHECKED);
end;  // TMyWindow.MenuCreate

procedure TMyWindow.WMPaint;
//==========================
Var
  rRec        : rect;
  hDCPaint    : hdc;
  rPS         : paintstruct;
  strS        : string[100]; // to store the text to be drawn.
  nXPosPix,    // where should the text appear. in pixels
  nYPosPix
              : integer;
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);

// what is the size in pixels of the client area ?
// rRec.Left and rRec.Top will alway be zero with the GetClientRect function
GetClientRect(hWin, @rRec);

// Why not drawing the dimentions of the client rect.
// rRec.Left = rRec.Top = 0 always here.
strS:='The client dimensions are :  Width =' + IntToStr(rRec.Right,4) +
      '   Height =' + IntToStr(rRec.Bottom,4);

// For windows, must convert the pascal type string into a zero terminated string
strS[length(strS)+1]:=#0;

// 20 pixels from the left border. This will not be taken into account,
// since we ask the text to be centered. (With DT_CENTER)
nXPosPix:=10; // pixels from the left border.
nYPosPix:=10; // pixels from the upper border

// If we draw the text now, it would work, but not look very nice.
// We don't want to have a background color of the text.
SetTextColor(hDcPaint, RGB(  0,  0,  0)); // Black is the text color.
SetBkColor(hDcPaint, RGB(255,255,192)); // Yellow is the back color, if OPAQUE
SetBkMode(hDcPaint, TRANSPARENT); // OPAQUE would be the alternative.

// Now we paint the text.
TextOut(hDcPaint, nXPosPix, nYPosPix, @strS[1], length(strS));

// Another way to paint text is the following one :
// It draws (=paints) text, formated in the rectangle described by rRec.
// DrawText( hDcPaint, @strS[1],-1,@rRec, DT_SINGLELINE or DT_CENTER or DT_VCENTER);

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
   // these calls to DBW0 can be done from anywhere
   100 : DBW0(0, '');  // just open the debugging window

   200 : PostMessage( hWin,WM_Close,0,0);

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

   401 : MessageBox( hWin,
       'Nothing to say yet.',
       'No help for the moment',
                     MB_OK Or MB_IconInformation);
   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.
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);

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

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

      fLButtonDown:=FALSE;
      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('Example019_b');

// 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('Title of the Example019 B (Ex019_b.pp) Window'));

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

