{ Example of program using the GAP library.
  This example show how to use timers.
  There are two ways. The simple way and the complicate one.
  I will show the simple way.

  Timers are not precise. They can skip a count.
  You have to use GetSystemTime or GetTickCount to get a precise time

  Push buttons and static texts will be used.
  --------------------------------------------}
program tEx018;

// 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
// ,wWindowBase0
 ,wWindow0
 ,wButtonPush0
 ,wStatic0
 ,wErrors0
 ,wDebug0;

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

  oButton1 : TButtonPush;
  // A push button used to start and stop timing

  oButtonQuit : TButtonPush;
  // A push button, will be used to quit the application.

  oStatic1 : TStatic;
  // to show one timer

  oStatic2 : TStatic;
  // to show another timer

  wTimer1ID : word32;
  // ID of the first timer
  // = 0 when stopped

  wTimer2ID : word32;
  // ID of the second timer
  // = 0 when stopped

  wNb_msStart : word32;
  // to set the starting time

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

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

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

  procedure WMTimer(wTimerID:WParam); virtual;
  // To handle the timer messages.

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

// Always have default initialisations.
oButton1.Init(@Self);
oButtonQuit.Init(@Self);
oStatic1.Init(@Self);
oStatic2.Init(@Self);

wTimer1ID:=0;
wTimer2ID:=0;
end;  // TMyWindow.Init

destructor TMyWindow.Done;
//========================
begin
inherited Done;
end;  // TMyWindow.Done

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, 401, 'Info &1...');
AppendMenu(hMenuWin, MF_POPUP, hSubMenu, '&Help');
end;  // TMyWindow.MenuCreate

procedure TMyWindow.WinCreate(strWinClass:ShortString);
//=====================================================
// Creates a new window.
// with controls in it.
Begin
inherited WinCreate(strWinClass);

// defines position, size, label, ID of the button
with oButton1 do begin
   vXPosMM    :=   3; // X position in milimeters in the parent window
   vYPosMM    :=   2; // Y position in milimeters in the parent window

   // It is a good idea to give the sizes in char "Ch" units.
   // Sizes are usually given only in "Ch" (=characters) units.
   // vXSizeCh  = 15 means about 15 character long.
   // vYSizeCh =  2 means the height of two characters.
   vXSizeCh   := 15; // in character width units
   vYSizeCh   :=  2; // in character height units

   strCtrlLabel  :='Start'; // Text on the button
   strCtrlHint   :='Click here to START the timer'; // default value = no hints by default.
   wCtrlID:=111; // identifier of the control

   // creates the button
   CtrlCreate;
   end; // with oButton1 do begin

// defines position, size, label, ID of the button
with oButtonQuit do begin
   // the default values are not shown again here.
   vXSizeCh   :=  10;  // 10 characters width
   vYSizeCh   :=   2; //   2 characters height, normal for buttons

   vXPosMM    :=  -2; // X position in milimeters in the parent window
   vYPosMM    :=  -2; // Y position in milimeters in the parent window

   vXPosCtrlRef :=1; // Position relative to the Right  of the control. 0=default
   vYPosCtrlRef :=1; // Position relative to the Bottom of the control. 0=default

   // Defines which point of the parent window is take as the origine
   vXPosParentRef :=1; // Position relative to the Right  of the parent window. 0=default
   vYPosParentRef :=1; // Position relative to the Bottom of the parent window. 0=default

   strCtrlLabel  :='Quit'; // Text on the button
   strCtrlHint   :='This is the ''quit'' button'; // default value = no hints by default.
   wCtrlID:=1134; // identifier of the control, any number

   // creates the button
   CtrlCreate;
   end; // with oButtonQuit do begin

// defines position, size, label, ID of the static text control.
with oStatic1 do begin
   // the default values are not shown again here.
   vXSizeCh   :=  20; // characters width
   vYSizeCh   := 1.5; // characters height

   vXPosMM    :=  oButton1.vXPosMM;
   vYPosMM    :=  oButton1.vYPosMM + 3;
   vYPosCh    :=  oButton1.vYSizeCh;

   strCtrlLabel  :='Static text'; // Text on the button
   strCtrlHint   :='A simple text'; // default value = no hints by default.
   wCtrlID:=1201; // identifier of the control, any number

   // Center the text in the place reserved for it
//   dwStyle:=dwStyle or SS_CENTER;

   colTextFont        :=RGB(  0,  0,  0);       // default = RGB(  0,  0,  0);
   colTextBack        :=RGB(192,255,255); // default = RGB(255,255,255);
   colTextTransp      :=OPAQUE;

   // creates the static text
   CtrlCreate;
   end; // with oStatic1 do begin

// defines position, size, label, ID of the static text control.
with oStatic2 do begin
   // the default values are not shown again here.
   vXSizeCh   := 70;  // characters width
   vYSizeCh   := 1.5; // characters height

   vXPosMM    := oStatic1.vXPosMM;
   vYPosMM    := oStatic1.vYPosMM + 3;
   vYPosCh    := oStatic1.vYPosCh + oStatic1.vYSizeCh;

   strCtrlLabel  :='Counter 2'; // Text on the button
   strCtrlHint   :=''; // default value = no hints by default.
   wCtrlID:=1202; // identifier of the control, any number

   // Center the text in the place reserved for it
//   dwStyle:=dwStyle or SS_CENTER;

   colTextFont        :=RGB(  0,  0,  0);       // default = RGB(  0,  0,  0);
   colTextBack        :=RGB(255,255,192); // default = RGB(255,255,255);
   colTextTransp      :=OPAQUE;

   // creates the static text
   CtrlCreate;
   end; // with oStatic2 do begin

End;  // TMyWindow.WinCreate

procedure TMyWindow.WMTimer(wTimerID:WParam);
//===========================================
// To handle the timer messages.
var
  wNb_ms      : word32;
  rSysTime    : SYSTEMTIME;

begin
if (wTimerID = 12) then begin
   // time in mili-seconds since Windows started minus the time when
   // the start button has been pressed.
   wNb_ms:=GetTickCount - wNb_msStart;

   oStatic1.strCtrlLabel:='Time = ' + IntToStr(wNb_ms div 1000, 4) + '.' +
                           + IntToStr((wNb_ms mod 1000) div 100, 1) + ' sec';
   oStatic1.NotifyChanges; // to change the text in it.
   end;

if (wTimerID = 11) then begin
   // time of the computer.
   GetSystemTime(@rSysTime);

   with rSysTime do begin
      oStatic2.strCtrlLabel:='Time = ' +
            IntToStr(wHour, 2) + ' ' +
            IntToStr(wMinute, 2) + ''' ' +
            IntToStr(wSecond, 2) + '.' +
            IntToStr(wMilliseconds div 100, 1) +
            ',   Year = ' + IntToStr(wYear, 4) +
            ',  Month = ' + IntToStr(wMonth, 2) +
            ',  Day = ' + IntToStr(wDay, 2) +
            ',  Day of week = ' + IntToStr(wDayOfWeek, 2);
      end;

   oStatic2.NotifyChanges; // to change the text in it.
   end;

end;  // TMyWindow.WMTimer

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 message from the menu then lPar = 0.
if (lPar > 0) and (wNotiCode = BN_CLICKED) then begin
   // Be carrefull,  BN_CLICKED = 0 = the value of wNotiCode for menus

   if (lPar = oButtonQuit.hWin) then begin
      PostQuitMessage (0); // Tells the application to quit.
      end;

   if (lPar = oButton1.hWin) then begin
      // Starts or stop the timer
      if (wTimer2ID = 0) then begin
         // Start the timer
         wTimer2ID:=SetTimer( hWin, 12, // 12 = a unique timer ID
                              100,  // timeout in mili-seconds
                               NIL);
         oButton1.strCtrlLabel:='Stop';
         oButton1.strCtrlHint   :='Click here to STOP the timer';
         oButton1.NotifyChanges; // to change the text in it

         // time when timer started to count
         wNb_msStart:=GetTickCount;
         end
      else begin
         // Stops the timer
         KillTimer(hWin, 12);
         wTimer2ID:=0;
         oButton1.strCtrlLabel:='Start';
         oButton1.strCtrlHint   :='Click here to START the timer';
         oButton1.NotifyChanges; // to change the text in it
         end;
     end;

   // call the parent WMCommand method, does nothing... maybe later.
   WMCommand:=inherited WMCommand(wPar, lPar);

   exit; // a button has been pressed
   end; // if (lPar > 0) and (wNotiCode = BN_CLICKED) then begin

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);
   401 : MessageBox( hWin,
       'See how easy it is to have timers',
       'You can see two timers acting.',
                     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
   // start a timer at the starting of the program,
   // will not stop during the program.
   WM_Activate : if (wTimer1ID = 0) then
                    SetTimer( hWin, 11, // 11 = a unique timer ID
                              100,  // timeout in mili-seconds
                               NIL);
   WM_Command : WindowProc:=WMCommand(wPar, lPar);
   WM_Timer   : WMTimer(wPar);
   WM_Size : begin
      oButtonQuit.NotifyParentResize(TRUE); // must replace the control in the window
      end;
   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('Example018');

// 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 Example018 (Ex018.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.

