{ Test of the unit wMenus0.pp
  While developping a new unit, it's a good idea to test it specially.
  The wMenus0.pp unit is an important one, which allows you to create
  menus very easilly, just from a description made in the
  text message files.

  Very short ...
  I used many DBW0(...) in the wMenus0.pp unit to test.
  Then I removed them.
  To study how it works, add DBW0(...) yourself.

  The next example, tEx030.pp will use the menu description in the
  message file. It's a stronger test.

  tEx031.pp and tEx032.pp  will show how simple it is to define a menu,
  with informations displayed in the status line.
  --------------------------------------------}
program tEx029;

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

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

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

  procedure TestMenu1;
  // First test of the hash table

  // 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);
end;  // TMyWindow.Init

procedure TMyWindow.MenuCreate;
//=============================
var
  hSubMenu    : HMenu;
begin
hMenuWin := CreateMenu;
hSubMenu := CreateMenu;
AppendMenu(hSubmenu,MF_STRING,101,'&1 Test 1 of the wMenus0.pp unit');

AppendMenu(hSubmenu,MF_SEPARATOR,0,Nil);
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...');
AppendMenu(hMenuWin, MF_POPUP, hSubMenu, '&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.TestMenu1;
//============================
// First test of the hash table
var
  oMenu       : TMenu;
  hMnu        : HMENU;
  fSuccess    : boolean;

begin
oMenu.Init(@Self);
hMnu:=oMenu.MenuMsgCreate(10000);

DBW0(1, 'hMnu=' + ITS(hMnu));

if (hMnu <> 0) then fSuccess:=SetMenu(hWin, hMnu);

DBW0(1, 'Success=' + ITS(ord(fSuccess)));

DrawMenuBar(hWin);

oMenu.Done;
end;  // TMyWindow.TestMenu1

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

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 : DBW0(0, '');  // just open the debugging window
   101 : TestMenu1;

   200 : PostMessage( hWin,WM_Close,0,0);
   401 : MessageBox( hWin,'Test the wMenus0.pp unit','Just a unit test.',
                     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_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('Example029');

// Creation of the main window
new(poMyMainWin, Init('tEx026. Test the wMenus0.pp unit'));

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

