{ Third example of program using the units
  wApplication0.pp  and  wWindow0.pp
  This example show how to create a menu.
  --------------------------------------------}
program tEx003;

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

type
  PMyWindow = ^TMyWindow;
  TMyWindow = object(TWindow)
  //"""""""""""""""""""""""""
  constructor Init(strWinTitlePrm:ShortString);

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

  procedure WMPaint; virtual;

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

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

{ You could change the default position and size of the window here,
  but it is not a good idea, since position and size will be the
  same as they were when the windo was closed
// To change the default position and size of the window when created.
nLeft   :=5;
nTop    :=50;
nWidth  :=400;
nHeight :=200;
---------------}
end;  // TMyWindow.Init

procedure TMyWindow.MenuCreate;
//=============================
var
  hSubMenu    : HMenu;
begin
hMenuWin := CreateMenu;
hSubMenu := CreateMenu;
AppendMenu(hSubmenu,MF_STRING,100,'&Open debug window');
AppendMenu(hSubmenu,MF_STRING,101,'&1 A debug msg');
AppendMenu(hSubmenu,MF_STRING,102,'&2 A 2nd debug msg');
AppendMenu(hSubmenu,MF_STRING,103,'&3 A 3rd debug msg');
AppendMenu(hSubmenu,MF_STRING,104,'&4 A 4th debug msg');
AppendMenu(hSubmenu,MF_STRING,105,'&5 A 5th debug msg');
AppendMenu(hSubmenu,MF_STRING,106,'&6 A 6th debug msg');
AppendMenu(hSubmenu,MF_STRING,107,'&7 A 7th debug msg');
AppendMenu(hSubmenu,MF_STRING,108,'&8 A 8th debug msg');
AppendMenu(hSubmenu,MF_SEPARATOR,0,Nil);
AppendMenu(hSubMenu,MF_String, 200, 'E&xit');
AppendMenu(hMenuWin, MF_POPUP, hSubMenu, '&File');

// this is not a good example, normally a top menu should have a sub-menu
AppendMenu(hMenuWin, MF_STRING, 401, '&Help');

// usually hWin = 0 here, and the menu is set into the window
// at the creation of the window
if (hWin <> 0) then SetMenu(hWin, hMenuWin);
end;  // TMyWindow.MenuCreate

procedure TMyWindow.WMPaint;
//==========================
Var
  rRec        : rect;
  dc          : hdc;
  ps          : paintstruct;

begin
dc:=BeginPaint(hWin, @ps);
GetClientRect(hWin, @rRec);
DrawText( dc, 'Example 003 using wApplication and wWindow',-1,@rRec,
          DT_SINGLELINE or DT_CENTER or DT_VCENTER);
rRec.Top :=rRec.top    + 50;
DrawText( dc, 'With a menu',-1,@rRec,
          DT_SINGLELINE or DT_CENTER or DT_VCENTER);
EndPaint(hWin, ps);
end;  // TMyWindow.WMPaint

function TMyWindow.WMCommand(wPar:WPARAM; lPar:LPARAM):LRESULT;
//=============================================================
// Handles the menu messages
Var
  wNotiCode,
  wNrMenu     : word;
begin
WMCommand := 0; // Default return value when processing a message
wNotiCode := HiWord(wPar);

if (wNotiCode <> 0) then begin
   WMCommand:=inherited WMCommand(wPar, lPar);
   exit;
   end;

// for the menu, the wNotiCode is 0
wNrMenu   := LoWord(wPar);
Case wNrMenu Of
   // these calls to DBW0 can be done from anywhere
   100 : DBW0(0, '');  // just open the debugging window
   101 : DBW0(   1,'1 -> a debugging message');
   102 : DBW0(   2,'2 -> another debugging message');
   103 : DBW0(   4,'3 -> A third debugging message');
   104 : DBW0(   8,'4 -> A fourth debugging message');
   105 : DBW0(  16,'5 -> A fifth debugging message');
   106 : DBW0(  32,'6 -> A sixth debugging message');
   107 : DBW0(  64,'7 -> A seventh debugging message');
   108 : DBW0( 128,'8 -> An eigth debugging message');

   200 : PostMessage( hWin,WM_Close,0,0);
   401 : MessageBox( hWin,'Help','Not implemented',
                     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

Case wMsg Of
   WM_paint : WMPaint;
//   WM_Close : Destroy the window by default
//   WM_Destroy : PostQuitMessage (0); // This is the default behaviour.
//              This should not be treated here, or at least the
//              inherited WindowProc should be called.
//              This allows to save the window position and size in a file
   WM_Command : WindowProc:=WMCommand(wPar, lPar);

   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        : TApplication;
  poMyMainWin : PMyWindow;

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

// Creation of the main window
new(poMyMainWin, Init('Title of the Example003 (Ex003.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.

