Unit wMenus0;

{ Feel free to use this unit as you want.
  First developped by Bernard Gisin
  This unit serves to create a menu from a description in the
  message file.
  With the adjuction that to each menu line, correspond a text
  which will be displayed in the status line, if it exist.

  Menu number above 30'000 are reserved for the library.

----------------------------------}

INTERFACE
//"""""""

uses wWindowBase0, wHashTable2, wGlobals2, Windows;

Type
  // To strore the information of each line in a menu
  PRMenuLine = ^RMenuLine;
  RMenuLine = Record
//    We could memorise these info, but it's useless for the moment.
//    Maybe one day, it will have any use.
//    hMnu       : HMENU; // the handle of the menu
//    wId        : Word;  // the unique identifier of the menu line
    wRecSize  : word;  // size in bytes allocated on the heap for this record.
    wType     : Word;  // can be MF_POPUP, MF_STRING, MF_SEPARATOR
                       // If it is greater than 60000 then it's a popup menu
                       // and wType - 60000 will give its order, as
                       // given by window in the LoWord(wPar) of the
                       // WM_MENUSELECT message.
    prNext    : PRMenuLine; // Pointer on the next RMenuLine, with the same
                            // handle  'hMnu'. Used to delete all items
                            // with the same handle. Either all menu lines
                            // with the same handle are deleted, or none.
                            // The first one of a chain can be accessed with
                            // indexes = (hMnu, 2147483640).

    strInfo   : ShortString // text didslayed in the status bar, while
                            // the user is in the menu.
                            // Must be the last item of the record.
    end; // RMenuLine

Type
  PMenu = ^TMenu;
  TMenu = Object
  //============
  // Defines All the menus, with the popup menu.

  poOwner  : PWindowBase;
  // Who is the owner of the menu.
  // It is used to test if the owner must dispose the object menu.
  // Usually, the main window owns a menu.

  oHT      : THashTableW2;
  // The pointers in the table will pointers on  RMenuLine
  // The two indexes to get the corresponding pointer are : (hMnu, wId)
  // A special case is when the indexes are (hMnu, word32(-1))
  // This return the pointer on the first  RMenuLine of a chaine
  // having the same handle  hMnu.
  // This is usefull to delete the menu lines corresponding to the same handle.

  hMenuObj : HMENU;
  // The handle corresponding to the top menu created.

  hMenuPopupObj : HMENU;
  // The handle corresponding to a popup menu created temporarly

  Constructor Init(poOwnerP:PWindowBase);

  Destructor Done;  Virtual;

  procedure ExplodeMenuStr( strS:ShortString;
                            var wMenuType, wMenuLevel, wMenuId:word32;
                            var strMenuString, strMenuInfo:ShortString;
                            var wError:word32); virtual;
  // separates into different part of information, the menu line description 'strS'

  function MenuMsgCreateLocal(msgNum:word32; wFlagsP:word32):HMENU; virtual;
  // A big procedure to create a menu with sub menus,
  // from a description in the message file.
  // Either a normal menu, if wFlagsP = 0 or
  // a popup menu if wFlagsP =1
  // memorises the menu handle and the popup menu handle, to
  // destroy them when the object is destroyed.

  function MenuMsgCreate(msgNum:word32):HMENU; virtual;
  // From a reference in the text message file, creates a new menu
  // with sub popup menus.
  // Return the handle on the main menu

  function MenuPopupMsgCreate(msgNum:word32):HMENU; virtual;
  // A big procedure to create Popup a menu with sub menus,
  // from a description in the message file.

  function MenuPopupTrack(hWinP:HWND; msgNum:word32; lPar:LPARAM; wFlags:word32):boolean; virtual;
  // Opens a popup menu at the cursor position indicated in
  // X,Y = LoWord(lPar), HiWord(lPar)
  // Using the text description in the message file at number msgNum
  // hWinP is the handle of the window which will recive the menu message
  // in a WM_COMMAND.
  // wFlags can be  TPM_RIGHTALIGN or TPM_LEFTALIGN or TPM_CENTERALIGN
  //             or TPM_LEFTBUTTON or TPM_RIGHTBUTTON
  // As specified in the TrackPopupMenu function from Windows.
  // wFlags = 0 is OK for most purposes,
  // wFlags = TPM_RIGHTBUTTON  will be often a god choice.
  // Return TRUE if succeded, FALSE otherwise.

  procedure MenuPopupDestroy;
  // to release memory from the popup menu.

  function GetMenuFromHandle(hMnuP:HMenu; wIdP:word32):PRMenuLine ; Virtual;
  // From a handle and an ID, returns a pointer on the information
  // corresponding to this menu line.

  function CheckMenuItemID(wID,wState:word32):integer; virtual;
  // Check or uncheck a menu, given its ID
  // wState = MF_UNCHECKED (=0) => uncheck it
  // wState = MF_CHECKED (=8) => check it
  // wState = 4096 => change its state
  // Returns its previous state,  or -1 if  wID  not found.

  function EnableMenuItemID(wID,wState:word32):integer; virtual;
  // Enable or disable or gray a menu, given its ID
  // wState = MF_ENABLED (=0) => enable it
  // wState = MF_DISABLED (=2) => disable it
  // wState = MF_GRAYED (=1) => gray it
  // Returns its previous state,  or -1 if  wID  not found.

  function EnableMenuItemByPosition(wPos,wState:word32):integer; virtual;
  // For popup menus, one must use its position to access it
  // Not very satisfactory. See : EnableMenuItemByMsgNum,  which is much easier.
  // And for MDI, the position change it the child window is maximized !!!
  // Simplifications will come.
  // Enable or disable or gray a menu, given its Position
  // wState = MF_ENABLED (=0) => enable it
  // wState = MF_DISABLED (=2) => disable it
  // wState = MF_GRAYED (=1) => gray it
  // Returns its previous state,  or -1 if  wPos  not found.

  function EnableMenuItemByMsgNum(hMenuL:HMENU; wNum,wState:word32):integer; virtual;
  // hMenuL = menu to enable or disable
  // Enable or disable or gray a menu, given a number just preceding
  // the menu item in the message file
  // wState = MF_ENABLED (=0) => enable it
  // wState = MF_DISABLED (=2) => disable it
  // wState = MF_GRAYED (=1) => gray it
  // Returns its previous state,  or -1 if  wNum  not found.

  function EnableMenuItemByMsgNum(wNum,wState:word32):integer; virtual;
  // Working only for the main menu line !!!
  // Enable or disable or gray a menu, given a number just preceding
  // the menu item in the message file
  // wState = MF_ENABLED (=0) => enable it
  // wState = MF_DISABLED (=2) => disable it
  // wState = MF_GRAYED (=1) => gray it
  // Returns its previous state,  or -1 if  wNum  not found.
  // After it, you should call
  // DrawMenuBar(hWin);  where hWin is the handle of the menu owner
  // to redraw the menu.

  function GetPopupSubMenuByMsgNum(hMnuP:HMENU; wMsgNum:word32):HMENU; virtual;
  // From a menu handle (usually  hMenuObj  or  hMenuPopupObj)
  // Return the handle of the popup sub menu, just following the  wMsgNum
  // marker in the menu definition.
  // Return zero if not found

//  function MenuAppend(...
//  Use : AppendMenu(hSubmenuL, MF_STRING, wID, @strS[1]);   strS:='a menu text' + #0;
//  Use : hSubmenuL:=GetPopupSubMenuByMsgNum(...  to get the menu handle of the popup menu

//  function MenuDelete(...
//  Use : DeleteMenu(hSubmenuL, nPos, MF_BYPOSITION);  or
//  Use : DeleteMenu(hSubmenuL, wID, MF_BYCOMMAND);
//  Use : hSubmenuL:=GetPopupSubMenuByMsgNum(...  to get the menu handle of the popup menu

//  function MenuInsert(...
//        strS:='a menu text' + #0;
//  Use : InsertMenu(hSubmenuL, nPos, MF_BYPOSITION or MF_STRING,
//                   wID, @strS[1]);      or
//  Use : InsertMenu(hSubmenuL, wIDPos, MF_BYCOMMAND or MF_STRING,
//                   wID, @strS[1]);
//  Use : hSubmenuL:=GetPopupSubMenuByMsgNum(...  to get the menu handle of the popup menu

//  function MenuChange(...
//  Delete a menu item and Insert another one or
//  Use : ModifyMenu( hSubmenuL, wIDPos, MF_BYCOMMAND or MF_STRING,
//                    wID, @strS[1]);

private
  procedure DisposeAll(hMnuP:HMENU); Virtual;
  // Delete all menus lines and free the corresponding allocated memory.
  // This is usually done once, at the end of the program.
  // Used to free all allocated memory to store information about the menu.

  End; // TMenu = Object

IMPLEMENTATION
//""""""""""""

Uses wVariableNumLink2, wMessages2, wUtiles0, wErrors2, wDebug0;

const
 // each line defining the menu consist of different parts, separated by ';'
 chLineSeparator   = ';'; // exampe : 2 Open...; 101; Open a text file.
 chMnuPopUp        = '>'; // Means that a popup menu follow
                          // example : 1 File; >; File loading, saving, printing etc.
 chMnuSeparator    = '-'; // Define a menu line separator
                          // examplde : 2 not used; -; not used

var nUnused : integer; // to avoid error in DevPascal while compiling

constructor TMenu.Init(poOwnerP:PWindowBase);
//===========================================
// Not much to do now
begin
// Initialised the Hash Table
oHT.Init(0);

hMenuObj      :=0;
hMenuPopupObj :=0;
poOwner:=poOwnerP;
end;  // TMenu.Init

destructor TMenu.Done;
//====================
begin
poOwner:=NIL; // it has been disposed, thus has no more owner.

// Frees the allocated memory
DisposeAll(hMenuObj);
DisposeAll(hMenuPopupObj);

oHT.Done;
end;  // TMenu.Done

procedure TMenu.DisposeAll(hMnuP:HMENU);  // private method called by the destructor
//======================================
// Delete all menus lines and free the corresponding allocated memory.
// This is called from the destructor Done.
// Used to free all allocated memory to store information about the menu.
var
  nCount      : integer; // security
  wInfoL      : word32;  // not used. But needed as a parameter.
  prMLNext,
  prML        : PRMenuLine;
  hSubMenu    : HMENU;

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

// From this first item, gets all record corresponding to the same menu handle
// and free the corresponding memory.
nCount:=0;
while (prML <> NIL) do begin
   // Get a pointer on the next record.
   prMLNext:=prML^.prNext;

   // free the memory allocated for this item
   FreeMem(prML, prML^.wRecSize);
//DBW0(1, 'Free :' + ITS(prML^.wRecSize) + prML^.strInfo);

   // treat the next record
   prML:=prMLNext;
   inc(nCount); // just to count how many items where freed
   end;
// The program will crash before it loops forever.
// This would be a programming error.

// Get the handle on the all sub menus of the menu, and call recursively
// this method, to dispose all sub-menu information.
nCount:=GetMenuItemCount(hMnuP);
if (nCount <= 0) then nCount:=1; // security.
repeat
   dec(nCount);
   // Get the popup sub menu nubmber (nCount+1).
   hSubMenu:=GetSubMenu(hMnuP, nCount);
   if (hSubMenu <> 0) then DisposeAll(hSubMenu); // recursive call

   until (nCount <= 0); // finished to scan all the sub menus.
                        // no more than 50 sub menus.

// If we destroyed the  hMenuPopupObj  menu, indicate it
if (hMenuPopupObj = hMnuP) then hMenuPopupObj:=0;

// If we destroyed the  hMenuObj  menu, indicate it
if (hMenuObj = hMnuP) then hMenuObj:=0;
end;  // TMenu.DisposeAll

procedure TMenu.ExplodeMenuStr( strS:ShortString;
{=============================} var wMenuType, wMenuLevel, wMenuId:word32;
                                var strMenuString, strMenuInfo:ShortString;
                                var wError:word32);
// separates into different part of information, the menu line description 'strS'
var
  nPos,      // position in the string strS being interpreted
  nEnd,      // to look for a token in the string. It will be
             // = strS[nPos..nEnd]
  nLen
              : integer;
begin
// initialises the variable, in case we return with an error and they have not been assigned.
wMenuType  :=0;
wMenuLevel :=0;
wMenuId    :=0;
wError     :=0; // no errors, we hope
strMenuString :='';
strMenuInfo   :='';

// this variable will be used in many error messages.
StrField(2000000001, strS, sizeOf(strS));

//-----------------------------------------------------
// look for the menu level
//-----------------------------------------------------

nLen:=length(strS);
// search the wMnuLevel
wMenuLevel:=GetIntValue(1, strS, nPos);

if (nPos = 0) then begin
   // error, no numbers in the description line
   wError:=2000006001;

   // displays the error message, only if the line has more than
   // one character.
   // this allows to put numbers as markers in the menu.
   if (length(strS) > 1) then ErrorWriteMsg(wError);
   exit;
   end;

//-----------------------------------------------------
// look for the menu label
//-----------------------------------------------------

nPos:=GetSkipSpacesPos(nPos, strS);

if (nPos >= nLen) then begin
   // error, description line too short
   wError:=2000006002;
   ErrorWriteMsg(wError);
   exit;
   end;

// look for the separator, to get the menu label
nEnd:=GetCharPos(nPos, chLineSeparator, strS);

if (nEnd = 0) then begin
   // error, no separators  ;   found.
   wError:=2000006003;
   ErrorWriteMsg(wError);
   exit;
   end;

// Here : strS[nPos] = first non space after the menu level.
//        strS[nEnd] = ';'

// we got the menu label. = the text in the menu
strMenuString:=Copy(strS, nPos, nEnd-nPos);

// convert the '\t' into tabulators.
InterpretTabs(strMenuString);

//-----------------------------------------------------
// look for the menu ID
//-----------------------------------------------------

nPos:=GetSkipSpacesPos(nEnd+1, strS);

if (nPos > nLen) then begin
   // error, description line too short
   // The menu ID or type is missing.
   wError:=2000006004;
   ErrorWriteMsg(wError);
   exit;
   end;

// Menu type :
if (strS[nPos] = chMnuPopUp) then begin
   wMenuType := MF_POPUP; // its a popup menu
   wMenuId   := 0; // no id, it should be its position.
   end
else if (strS[nPos] = chMnuSeparator) then begin
   wMenuType := MF_SEPARATOR; // its a menu separator
   wMenuId   := 0; // no id, it should be its position.
   end
else begin
   wMenuType := MF_STRING; // its a menu which will send a WM_COMMAND
   wMenuID:=GetIntValue(nPos, strS, nPos);

   if (nPos = 0) then begin
      // error, no numbers in the description line
      wError:=2000006005;
      ErrorWriteMsg(wError);
      exit;
      end;
   end;

//-----------------------------------------------------
// look for the menu Info Line
//-----------------------------------------------------

// look for the separator, to get the menu InfoLine
nEnd:=GetCharPos(nPos, chLineSeparator, strS);

if (nEnd = 0) then exit; // There are simply no info line. It's not a problem

strMenuInfo:=Copy(strS, nEnd+1, 255); // Get the menu Info.

ClearField(2000000001);
end;  // TMenu.ExplodeMenuStr

Function TMenu.MenuMsgCreateLocal(msgNum:word32; wFlagsP:word32):HMENU;
//=====================================================================
// A big procedure to create a menu with sub menus,
// from a description in the message file.
// Either a normal menu, if wFlagsP = 0 or
// a popup menu if wFlagsP =1
// memorises the menu handle and the popup menu handle, to
// destroy them when the object is destroyed.
const MAXLEVEL = 10; // no more than 10 levels of sub menus.
var
  strS        : ShortString;
  wMenuType,  // Type of the menu, MF_POPUP, MF_STRING, MF_SEPARATOR
  wMenuLevel, // level, 1, 2, 3, ...
  wMenuId,    // Identificator of the menu. Which is received in the
              // LoWord(wPar) in a WM_COMMAND message
              // If the menu is a MS_POPUP, the it is its place.
              // 0 = first place, 1 = second place etc.

  wMenuLevelActual,
  // The acutal menu level. Start with 1, can increase by 1, if
  // a popup menu appear.
  // can decrease till the minimal value, which is 1.

  wLastMenuType,
  // Type of the last menu. Is used to verify that we can create a sub menu

  wError,     // Error notification, if the menu line description has an error
  wSecurity   // security to not loop forever.
              : word32;
  strMenuString, // text of the menu
  strMenuInfo    // Information at the bottom of the window, while being in the menu
              : ShortString;

  ahMenuL     : array[1..MAXLEVEL+1] of HMENU;
  // handle on menus and sub menus.

  aprML       : array[1..MAXLEVEL+1] of PRMenuLine;
  // to memorise the last record of info on a menu, in order
  // to chain all menu with the same handle.
  // It will be used at the destruction.

  awMenuPos  : array[1..MAXLEVEL+1] of word;
  // to code the position of menu item, relative to thoses with the same handle.

  wSizeAlloc  // To allocate size for the next PRMenuLine record.
              // It's size can change depending on the size of the Info Line (=InfoBarSrt)
              : word32;
//  prMLLast,
  prML        : PRMenuLine;

begin // MenuMsgCreateLocal
MenuMsgCreateLocal:=0; // in case of errors.

// Used in the error messages
StrField   (2000000002, strMenuString, SizeOf(strMenuString));
Word32Field(2000000011, msgNum);

// Test the existence of the line in the  .msg  file
// And go to the right position in the .msg file
if (not ExistMsgNumber(msgNum)) then begin
   // Write an error message. The line doesn't exist
   wError:=2000006010;
   ErrorWriteMsg(wError);
   exit;
   end;

strS:=GetMsg(msgNext); // The first line.
Interpret(strS); // Convert the @number into strings

// Starting with the lowest menu level.
// It's usually the main menu 'File  Edit  Search  ... Window  Help'
wMenuLevelActual:=1;

// At starting, the last menu was not a MF_POPUP
wLastMenuType :=MF_STRING;

if (wFlagsP = 0) then begin
   // Create at least one top level menu.
   ahMenuL[1] := CreateMenu;
   end
else begin
   // Create a Popup menu.
   ahMenuL[1] := CreatePopupMenu;
   end;

// Allocation of a first record infor, to point on the next one
// having the same handle.
wSizeAlloc:= SizeOf(RMenuLine) - SizeOf(ShortString);
GetMem(aprML[1], wSizeAlloc);  // no memory checking here. I'm lazy
aprML[1]^.wRecSize :=wSizeAlloc;
aprML[1]^.wType    :=0;     // not used
aprML[1]^.prNext   :=NIL;   // This will point on the next record with same handle.
oHT.AddPointerW2(ahMenuL[1], 2147483640, 0, aprML[1]);

// The first popup menu of a list has position 0.
awMenuPos[1]:=0;

// Enter the main loop of the interpretation of the menu descriptor,
// to create a menu.
wSecurity:=0;
repeat
   // Split the line description into its token.
   ExplodeMenuStr( strS, wMenuType, wMenuLevel, wMenuId,
                   strMenuString, strMenuInfo, wError);

   if (wError = 0) then begin
      // Test the validity of the description.
      if (wLastMenuType = MF_POPUP) and
         (wMenuLevel <> wMenuLevelActual+1) then begin
         // if last menu was a popup menu, the level must increase by one
         // just after if.
         wError:=2000006011;
         ErrorWriteMsg(wError);
         end;

      if (wLastMenuType <> MF_POPUP) and
         (wMenuLevel > wMenuLevelActual) then begin
         // A menu level cannot increase if it's not just preceded by
         // a popup menu
         wError:=2000006012;
         ErrorWriteMsg(wError);
         end;

      if (wMenuLevel < 1) or (wMenuLevel > 10) then begin
         // A menu level cannot increase if it's not just preceded by
         // a popup menu
         wError:=2000006013;
         ErrorWriteMsg(wError);
         end;
      end; // if (wError = 0) then begin

   if (wError = 0) then begin
      // No errors, we can remember which is the actual menu level
      wMenuLevelActual:=wMenuLevel;

      strMenuString[length(strMenuString)+1]:=#0; // used by Windows

      // Add the item in the menu
      if (wMenuType = MF_POPUP) then begin
         // It's a popup menu, create the SubMenu handle.
         ahMenuL[wMenuLevelActual+1] := CreateMenu;
         awMenuPos[wMenuLevelActual+1]:=0; // position of the popup menu

         // New menu handle => new chain of records memorising
         // information about the menu.
         wSizeAlloc:= SizeOf(RMenuLine) - SizeOf(ShortString);
         GetMem(aprML[wMenuLevelActual+1], wSizeAlloc);  // no memory checking here. I'm lazy
         aprML[wMenuLevelActual+1]^.wRecSize :=wSizeAlloc;
         aprML[wMenuLevelActual+1]^.wType    :=0;    // not used.
         aprML[wMenuLevelActual+1]^.prNext   :=NIL;  // This will point on the next record with same handle.
         oHT.AddPointerW2( ahMenuL[wMenuLevelActual+1], 2147483640, 0,
                           aprML[wMenuLevelActual+1]);

         // And append the SubMenu to the actual one.
         AppendMenu( ahMenuL[wMenuLevelActual],   MF_POPUP,
                     ahMenuL[wMenuLevelActual+1], @strMenuString[1]);

         // Popup have no ID, thus index it in the Hash table
         // with its position.
         wMenuId:=word32(65536) * awMenuPos[wMenuLevelActual];
         end
      else if (wMenuType = MF_SEPARATOR) then begin
         // We will not keep info about menu separators.
         AppendMenu(ahMenuL[wMenuLevelActual],MF_SEPARATOR,0,Nil);
         end
      else begin // it's a MF_STRING menu
         AppendMenu( ahMenuL[wMenuLevelActual],
                     MF_STRING, wMenuId, @strMenuString[1]);
         end;

      // Memorise which menu type we had at this level
      wLastMenuType:=wMenuType;

      if (wMenuType <> MF_SEPARATOR) then begin
         // don't remember any info about MF_SEPARATOR

         // Allocate memory to add the menu information in the hash table
         wSizeAlloc:= SizeOf(RMenuLine) - SizeOf(ShortString)
                    + length(strMenuInfo) +2;
//DBW0(1, 'Size Allocated = ' + ITS(wSizeAlloc));
         GetMem(prML, wSizeAlloc);  // no memory checking here. I'm lazy
         prML^.wRecSize :=wSizeAlloc;
         prML^.wType    :=wMenuType;
         prML^.prNext   :=NIL;         // For the moment, it is the last item of the chained list
         prML^.strInfo  :=strMenuInfo; // Memorise the infor displayed in the
                                       // Status line while being in the menu.

         if (wMenuType = MF_POPUP) then begin
            // code in the menu Type, its position. Only for popup windows.
            // Position = wMenu_Type - 60000;
            prML^.wType:=60000 + awMenuPos[wMenuLevelActual];
            end;

         // Position of next menu will be one more that this one.
         awMenuPos[wMenuLevelActual]:=awMenuPos[wMenuLevelActual] + 1;

         // Add the menu in the hash table
         oHT.AddPointerW2( ahMenuL[wMenuLevelActual], wMenuId, prML^.wType, prML);

         // Link the previous record with same handle to this one.
         aprML[wMenuLevelActual]^.prNext:=prML;
         aprML[wMenuLevelActual]:=prML; // to continue the link
         end; // if (wMenuType <> MF_SEPARATOR) then begin
      end; // if (wError = 0) then begin

   strS:=GetMsg(msgNext);
   Interpret(strS); // Convert the @number into strings

   inc(wSecurity);
   until (strS = ctestrLineEND) or (strS[1] = '?') or (wSecurity > 5000);

// The number 2000000002 is not more associated to a variable.
// ClearField(2000000002); not very usefull...

// Return the handle on the top menu.
// From this menu, all sub menus can be retrieved with
// MENU GetSubMenu(HMENU {handle of menu}, nPos:integer {menu item position});
// With HMENU GetMenu(hWindow : HWND {handle of window});
// You can get the menu handle of a window.

// Return a handle on the created menu
MenuMsgCreateLocal :=ahMenuL[1];
End;  // TMenu.MenuMsgCreateLocal

Function TMenu.MenuMsgCreate(msgNum:word32):HMENU;
//================================================
// A big procedure to create a menu with sub menus,
// from a description in the message file.
begin
// Must destroy the previous menu, if there is one.
// Usually there is only one main menu.
if (hMenuObj <> 0) then DisposeAll(hMenuObj);

// Remember the top level menu handle, to destroy it at the same time the
// object menu is destroyed, and return a handle on the created menu.
hMenuObj      :=MenuMsgCreateLocal(msgNum, 0);
MenuMsgCreate :=hMenuObj;
End;  // TMenu.MenuMsgCreate

Function TMenu.MenuPopupMsgCreate(msgNum:word32):HMENU;
//=====================================================
begin
// Must destroy the previous popup menu, if there is one.
if (hMenuPopupObj <> 0) then DisposeAll(hMenuPopupObj);

// Remember the popup menu handle, to destroy it at the same time the
// object menu is destroyed, and return a handle on the created menu.
hMenuPopupObj      :=MenuMsgCreateLocal(msgNum, 1);
MenuPopupMsgCreate :=hMenuPopupObj;
End;  // TMenu.MenuPopupMsgCreate

function TMenu.MenuPopupTrack(hWinP:HWND; msgNum:word32; lPar:LPARAM; wFlags:word32):boolean;
//===========================================================================================
// Opens a popup menu at the cursor position indicated in
// X,Y = LoWord(lPar), HiWord(lPar)
// Using the text description in the message file at number msgNum
// hWinP is the handle of the window which will recive the menu message
// in a WM_COMMAND.
// wFlags can be  TPM_RIGHTALIGN or TPM_LEFTALIGN or TPM_CENTERALIGN
//             or TPM_LEFTBUTTON or TPM_RIGHTBUTTON
// As specified in the TrackPopupMenu function from Windows.
// wFlags = 0 is OK for most purposes,
// wFlags = TPM_RIGHTBUTTON  will be often a god choice.
// Return TRUE if succeded, FALSE otherwise.
var
  rRec        : RECT;
begin
MenuPopupMsgCreate(msgNum);

if (hMenuPopupObj <> 0) then begin
   rRec.Left:=0;   rRec.Top:=0;   rRec.Right:=0;   rRec.Bottom:=0;

   MenuPopupTrack:=TrackPopupMenu( hMenuPopupObj, wFlags,
                         LoWord(lPar), // horizontal position, in screen coordinates
                         HiWord(lPar), // vertical position, in screen coordinates
                                    0, // reserved, must be zero
                                hWinP, // handle of owner window
                                rRec);
   end
else MenuPopupTrack:=FALSE;

end;  // TMenu.MenuTrackPopup

procedure TMenu.MenuPopupDestroy;
//===============================
// to release memory from the popup menu.
begin
if (hMenuPopupObj <> 0) then DisposeAll(hMenuPopupObj);
//hMenuPopupObj:=0; // is done already in the DisposeAll
end;  // TMenu.MenuPopupDestroy

Function TMenu.GetMenuFromHandle(hMnuP:HMenu; wIdP:word32):PRMenuLine;
//====================================================================
// A little too simple
begin
GetMenuFromHandle:=oHT.GetPointerW2(hMnuP, wIdP, wIdP);
end;  // TMenu.GetMenuFromHandle

function TMenu.CheckMenuItemID(wID,wState:word32):integer;
//========================================================
// Check or uncheck a menu, given its ID
// wState = MF_UNCHECKED => uncheck it
// wState = MF_CHECKED   => check it
// wState = 8096 => change its state
// Returns its previous state,  or -1 if  wID  not found.
var
  wCheck      : word;
begin
if      (wState = MF_UNCHECKED) then wCheck:=MF_UNCHECKED
else if (wState = MF_CHECKED)   then wCheck:=MF_CHECKED
else begin
   // we want to toggle its state.
   // must set a check, to know it state
   wCheck:=CheckMenuItem(hMenuObj, wID, MF_BYCOMMAND or MF_CHECKED);
   if (wCheck = MF_UNCHECKED) then begin
      // The menu was unchecked, we checked it, thus ok finished
      CheckMenuItemID:=MF_UNCHECKED;
      exit;
      end;

   if (wCheck = MF_CHECKED) then begin
      // The menu was already checked, we must uncheck it.
      wCheck:=CheckMenuItem(hMenuObj, wID, MF_BYCOMMAND or MF_UNCHECKED);
      CheckMenuItemID:=MF_CHECKED;
      exit;
      end;

   // here we got an error, the id is probably not valid
   CheckMenuItemID:=-1;
   exit;
   end;

// Set the state as wanted, and get the stat it has before.
wCheck:=CheckMenuItem(hMenuObj, wID, MF_BYCOMMAND or wCheck);

if (wCheck = MF_UNCHECKED) or (wCheck = MF_CHECKED) then begin
   // no errors, we just return the state we actually set.
   CheckMenuItemID:=wCheck;
   end
else // here we got an error, the id is probably not valid
   CheckMenuItemID:=-1;

end;  // TMenu.CheckMenuItemID

function TMenu.EnableMenuItemID(wID,wState:word32):integer;
//=========================================================
// Enable or disable or gray a menu, given its ID
// wState = MF_ENABLED (=0) => enable it
// wState = MF_DISABLED (=2) => disable it
// wState = MF_GRAYED (=1) => gray it
// Returns its previous state,  or -1 if  wID  not found.
begin
wState:=word32(EnableMenuItem(hMenuObj, wID, MF_BYCOMMAND or wState));

if (wState > 8096) then EnableMenuItemID:=-1 // error
else EnableMenuItemID:=wState; // juste return the previous state.

end;  // TMenu.EnableMenuItemID

function TMenu.EnableMenuItemByPosition(wPos,wState:word32):integer;
//==================================================================
// For popup menus, one must use its position to access it
// Not very satisfactory,
// And for MDI, the position change it the child window is maximized !!!
// Simplifications will come.
// Enable or disable or gray a menu, given its ID
// wState = MF_ENABLED (=0) => enable it
// wState = MF_DISABLED (=2) => disable it
// wState = MF_GRAYED (=1) => gray it
// Returns its previous state,  or -1 if  wPos  not found.
begin
wState:=word32(EnableMenuItem(hMenuObj, wPos, MF_BYPOSITION	 or wState));

if (wState > 8096) then EnableMenuItemByPosition:=-1 // error
else EnableMenuItemByPosition:=wState; // juste return the previous state.
end;  // TMenu.EnableMenuItemByPosition

function TMenu.EnableMenuItemByMsgNum(hMenuL:HMENU; wNum,wState:word32):integer;
//==============================================================================
// hMenuL = menu to enable or disable
// Enable or disable or gray a menu, given a number just preceding
// the menu item in the message file
// wState = MF_ENABLED (=0) => enable it
// wState = MF_DISABLED (=2) => disable it
// wState = MF_GRAYED (=1) => gray it
// Returns its previous state,  or -1 if  wNum  not found.
var
   strS,      // string returned from the menu
   strMsg     : ShortString;
   nLen,      // length of text returned by Windows when reading the menu label
   nPos       // to scan the text of all positions
              : integer;

  // not used, but are parameters that must be sended
  wError,
  wMenuType,  // Type of the menu, MF_POPUP, MF_STRING, MF_SEPARATOR
  wMenuLevel, // level, 1, 2, 3, ...
  wMenuId     // Identificator of the menu.
              : word32;
begin
// To find the position corresponding to the number,
// get the label of the menu and compare it to the label
// in the message file.
strMsg:=GetMsg(wNum);
strMsg:=GetMsg(MsgNext);  // get the text of the menu in the .msg file

// to get just the menu label.  strMsg  will be the label
ExplodeMenuStr( strMsg, wMenuType, wMenuLevel, wMenuId,
                   strMsg, strS, wError);

nPos:=GetMenuItemCount(hMenuL); // number of sub-menus
if (nPos > 100) then nPos:=100; // security, not more than 100 sub-menus are allowed
repeat
   dec(nPos);
   nLen:=GetMenuString(hMenuL, nPos, @strS[1], 200, MF_BYPOSITION);
   strS[0]:=char(nLen); // convert to pascal string.
   until (nPos <= 0) or (strS = strMsg);

wState:=word32(EnableMenuItem(hMenuL, nPos, MF_BYPOSITION or wState));

if (wState > 8096) then EnableMenuItemByMsgNum:=-1 // error
else begin
   // the menu must be redrawn.
//   DrawMenuBar(hWindow);  // the problem is that we don't know the window's
                            // handle of the menu owner

   EnableMenuItemByMsgNum:=wState; // juste return the previous state.
   end;
end;  // TMenu.EnableMenuItemByMsgNum

function TMenu.EnableMenuItemByMsgNum(wNum,wState:word32):integer;
//================================================================
// Working only for the main menu line !!!
// Enable or disable or gray a menu, given a number just preceding
// the menu item in the message file
// wState = MF_ENABLED (=0) => enable it
// wState = MF_DISABLED (=2) => disable it
// wState = MF_GRAYED (=1) => gray it
// Returns its previous state,  or -1 if  wNum  not found.
begin
EnableMenuItemByMsgNum:=EnableMenuItemByMsgNum(hMenuObj, wNum, wState);
end;  // TMenu.EnableMenuItemByMsgNum  Second definition

function TMenu.GetPopupSubMenuByMsgNum(hMnuP:HMENU; wMsgNum:word32):HMENU;
//========================================================================
// From a menu handle (usually  hMenuObj  or  hMenuPopupObj)
// Return the handle of the popup sub menu, just following the  wMsgNum
// marker in the menu definition.
// Return zero if not found
var
   strS,      // string returned from the menu
   strMsg     : ShortString;
   nLen,      // length of text returned by Windows when reading the menu label
   nPos       // to scan the text of all positions
              : integer;

  // not used, but are parameters that must be sended
  wError,
  wMenuType,  // Type of the menu, MF_POPUP, MF_STRING, MF_SEPARATOR
  wMenuLevel, // level, 1, 2, 3, ...
  wMenuId     // Identificator of the menu.
              : word32;
begin
// To find the position corresponding to the number,
// get the label of the menu and compare it to the label
// in the message file.
strMsg:=GetMsg(wMsgNum);
strMsg:=GetMsg(MsgNext);  // get the text of the menu in the .msg file

// to get just the menu label.  strMsg  will be the label
ExplodeMenuStr( strMsg, wMenuType, wMenuLevel, wMenuId,
                   strMsg, strS, wError);

nPos:=GetMenuItemCount(hMnuP); // number of sub-menus
if (nPos > 100) then nPos:=100; // security, not more than 100 sub-menus are allowed
repeat
   dec(nPos);
   nLen:=GetMenuString(hMnuP, nPos, @strS[1], 200, MF_BYPOSITION);
   strS[0]:=char(nLen); // convert to pascal string.
   until (nPos <= 0) or (strS = strMsg);

if (strS = strMsg) then GetPopupSubMenuByMsgNum:=GetSubMenu(hMnuP, nPos)
else                    GetPopupSubMenuByMsgNum:=0;
end;  // TMenu.GetPopupSubMenuByMsgNum


END. // Unit wMenus0;
