{ Example of a program using the  wMenus0.pp  unit.
  This is the first example which uses really the Message file, and
  and a description of its menu in the message file.
  Do some tests on the menu.
  --------------------------------------------}
program tEx030;

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

type
  PMyWindow = ^TMyWindow;
  TMyWindow = object(TWindow)
  //"""""""""""""""""""""""""
  oMenu       : TMenu;

  oStatusL    : TStatusLine0; // Status line of the main window
  // A status line, to show the information associated with the menu

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

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

  procedure WinCreate(strWinClass:ShortString); virtual;
  // Set  strWinClass=''  to use the class defined in the application object

  procedure TestMenu1;
  // First test to see the number value a menu type can have.

  procedure ListAllSubMenus(hMenuP:HMENU);
  // This is Test2
  // List the liked list of correponding to the hMenuP
  // Then call recursively this method, to do the same with
  // All sub menus.
  // If it seems complicate to you, don't worry. Just ignore it.
  // The library does all the work. This is just a test.
  // But you will not need to know anything about it.
  // It's just for curiosity and testing.

  procedure TestMenu3;
  // Test to create a menu and then dispose it, just
  // to see with DBW0(...) debug informations displayed in the debug window,
  // if it works correctly.

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

// Initialise the object oStatusL
oStatusL.Init(@Self);

// Initialises the menu.
oMenu.Init(@self);

// The initialisation order is not important.
end;  // TMyWindow.Init

destructor TMyWindow.Done;
//========================
begin
// The menu is not a window, thus is must be disposed here
// Laster each window could have an associated menu,
// and disposal will be automatic.
oMenu.Done; // Free the memory allocated for the menu

//oStatusL.Done; useless, it's done in the parent window.

inherited Done;
end;  // TMyWindow.Done

procedure TMyWindow.MenuCreate;
//=============================
begin
// This single line creates the menu.
// Later it will even be in the library, thus only the
// menu description will have to be done in the message file.
hMenuWin:=oMenu.MenuMsgCreate(10000);
end;  // TMyWindow.MenuCreate

procedure TMyWindow.WinCreate(strWinClass:ShortString);
//=====================================================
// Create the window, and insert a status line in it.
begin
// here strWinClass=''.
inherited WinCreate(strWinClass);

oStatusL.statuscreate;
end;  // TMyWindow.WinCreate

procedure TMyWindow.TestMenu1;
//============================
// First test to see the number value a menu type can have.
begin
DBW0(1, 'MF_POPUP        = ' + ITS(MF_POPUP));
DBW0(1, 'MF_BITMAP       = ' + ITS(MF_BITMAP));
DBW0(1, 'MF_CHECKED      = ' + ITS(MF_CHECKED));
DBW0(1, 'MF_STRING       = ' + ITS(MF_STRING));
DBW0(1, 'MF_OWNERDRAW    = ' + ITS(MF_OWNERDRAW));
DBW0(1, 'MF_CHECKED      = ' + ITS(MF_CHECKED));
DBW0(1, 'MF_DISABLED     = ' + ITS(MF_DISABLED));
DBW0(1, 'MF_ENABLED      = ' + ITS(MF_ENABLED));
DBW0(1, 'MF_GRAYED       = ' + ITS(MF_GRAYED));
DBW0(1, 'MF_MENUBARBREAK = ' + ITS(MF_MENUBARBREAK));
DBW0(1, 'MF_MENUBREAK    = ' + ITS(MF_MENUBREAK));
DBW0(1, 'MF_OWNERDRAW    = ' + ITS(MF_OWNERDRAW));
DBW0(1, 'MF_SEPARATOR    = ' + ITS(MF_SEPARATOR));
DBW0(1, 'MF_UNCHECKED    = ' + ITS(MF_UNCHECKED));
{
MF_SEPARATOR    =       2048
MF_POPUP        =         16
MF_STRING       =          0
MF_OWNERDRAW    =        256
MF_MENUBREAK    =         64
MF_MENUBARBREAK =         32
MF_CHECKED      =          8
MF_BITMAP       =          4
MF_DISABLED     =          2
MF_GRAYED       =          1
MF_ENABLED      =          0
MF_UNCHECKED    =          0

This tells us that number above the sum of these numbers are not used
in the Menu Type. Thus it can be used for other information.
It will be used to remember the position of popup menus, since
it's the only way to identify them.
}
end;  // TMyWindow.TestMenu1

procedure TMyWindow.ListAllSubMenus(hMenuP:HMENU);
//================================================
// List the liked list of correponding to the hMenuP
// Then call recursively this method, to do the same with
// All sub menus.
// If it seems complicate to you, don't worry. Just ignore it.
// The library does all the work. This is just a test.
// But you will not need to know anything about it.
// It's just for curiosity and testing.
var
  wInfoL      : word32; // not used.
  prML        : PRMenuLine;
  hSubMenu    : HMENU;
  nCount      : integer; // just to count the number of chained items
  strS        : string[210];
  nLen        : integer;

begin
// From the handle on the  menu  hMenuP  get a pointer
// on the first item of a chainded list of records containing the
// information about the menu.
prML:=oMenu.oHT.GetPointerW2(hMenuP, 2147483640, wInfoL);

// Get the first record corresponding to a menu item
//if (prML <> NIL) then prML:=prML^.prNext;

// First scan all chained menu, corresponding to the same menu handle.
// From this first item, gets all record corresponding to the same menu handle
nCount:=0;
DBW0(1, '');
while (prML <> NIL) do begin
   inc(nCount);
   if (prML^.wType >= 60000) then begin
      // It's a popup menu
        nLen:=GetMenuString(hMenuP, prML^.wType-60000, @strS[1], 200, MF_BYPOSITION);

      // convert the string to a pascal string
      strS[0]:=char(nLen);
      if (nLen <= 0) then DBW0(1, 'Error getting the menu string ??????');
      end
   else begin
      // We didn't memorise the ID of the menu item, thus we cannot
      // get the label of the menu.
      // But I think I don't need it.
//      nLen:=GetMenuString(hMenuP, ID not known, @strS[1], 200, MF_BYCOMMAND);
      strS:='';
      end;

   DBW0(1, IntToStr(nCount,2) + ') ' + strS + ' ---------------' + ITS(hMenuP));
   DBW0(1, 'Allocated size = ' + ITS(prML^.wRecSize));
   DBW0(1, 'Menu type      = ' + ITS(prML^.wType));
   DBW0(1, 'Info Line      = ' + prML^.strInfo);

   // Get the next chainded item.
   prML:=prML^.prNext;
   end; // while (prML <> NIL) do begin

// Then, we call this same procedure recursively for all sub-menus.
// Get the handle on the all sub menus of the menu, and call recursively
// this method, to show all linked lists.
nCount:=GetMenuItemCount(hMenuP);
if (nCount <= 0) then nCount:=1; // security.
repeat
   dec(nCount);
   // Get the popup sub menu nubmber (nCount+1).
   hSubMenu:=GetSubMenu(hMenuP, nCount);
DBW0(1, 'hSubMenu=' + ITS(hSubMenu));
   if (hSubMenu <> 0) then ListAllSubMenus(hSubMenu); // recursive call
   until (nCount <= 0); // finished to scan all the sub menus.


// It's done !  Simple, not ?
end;  // TMyWindow.ListAllSubMenus

procedure TMyWindow.TestMenu3;
//============================
// Test to create a menu and then dispose it, just
// to see with DBW0(...) debug informations displayed in the debug window,
// if it works correctly.
var
  oMenuL      : TMenu;
  hMenuMem    : HMENU;
  // to test the heap level,
  nMem1,      // before allocation memory for the menu
  nMem2,      // after allocation memory but before freeing the memory
  nMem3,      // after freeing the memory
  nMem4       // after destroying the menu
              // pMem3 should return to the same value as pMem1
              : int32;
begin
nMem1:=MemAvail; DBW0(1, 'nMem1=' + ITS(nMem1));
oMenuL.Init(@Self);

// creates the menu, juste to dispose it right after.
hMenuMem:=oMenuL.MenuMsgCreate(10000);

nMem2:=MemAvail; DBW0(1, 'nMem2=' + ITS(nMem2));

// This should free the memory.
oMenuL.Done;

nMem3:=MemAvail; DBW0(1, 'nMem3=' + ITS(nMem3));

DestroyMenu(hMenuMem);

nMem4:=MemAvail; DBW0(1, 'nMem4=' + ITS(nMem4));

DBW0(1, 'Since nMem4 = nMem1 =' + ITS(nMem1) + ' =' + ITS(nMem4) +
        '  all the memory was correctly disposed.');
end;  // TMyWindow.TestMenu3

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
   // these calls to DBW0 can be done from anywhere
   101 : TestMenu1;
   102 : ListAllSubMenus(hMenuWin);
   103 : TestMenu3;

   401 : MessageBox( hWin,'Test the wHashTableW2.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.
const
  strMem      : ShortString = ''; // to memorise what was in the status line
  // must be a 'const' to be saved between two calls at the WindowProc method.
  // It could also be a global variable, or
  // better, be a member of the TMyWindow object.
var
  // Information stored in the Hash table created with the menu
  prML        : PRMenuLine;
  wInfoL      : word32;  // not used 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_Command : WindowProc:=WMCommand(wPar, lPar);
   WM_MENUSELECT : begin
      DBW0(32, DBMsgToStr(wMsg) + ITS(LoWord(wPar)) + ITS(HiWord(wPar)) + ITS(lPar));
      // This will come in the library.
      // display an info in the status line.
      if ((HiWord(wPar) and MF_POPUP) = MF_POPUP) then
           prML:=oMenu.oHt.GetPointerW2(lPar, word32(65536)*LoWord(wPar), wInfoL)
      else prML:=oMenu.oHt.GetPointerW2(lPar, LoWord(wPar), wInfoL);

      if (prML <> NIL) then oStatusL.SetStatusText(0, prML^.strInfo);
                            // display the info in the status line

      end; // WM_MENUSELECT : begin

   WM_EXITMENULOOP  : oStatusL.SetStatusText(0, strMem);
                     // set back what was in the status line.
   WM_ENTERMENULOOP : strMem:=oStatusL.GetStatusText(0);
                    // Before changing the status line, memorise what was in it.

   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('Example030');

// Creation of the main window
new(poMyMainWin, Init('tEx030. First example using the message file to create its menu'));

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

