unit MenuClass;

interface

uses
  windows,
  messages,
  UtilFunc,
  UtilClass;

type

//-------------------- TMenuBase ------------------------------
TMenuBase = class(TSubClass)
private
  FHandle: HMENU;
protected
public
  function AppendString(st:string;mID:UINT):Boolean;
  function InsertString(position:integer;st:string;mID:UINT):Boolean;
  function Remove(mID:UINT):Boolean;
  property Handle: HMENU read FHandle;
end;

//--------------- TAMainMenu ----------------------------------
TAMainMenu = class(TMenuBase)
private
  FOnCommand: TNotifyMessage;
  FOnInitMenu: TNotifyMessage;
  FOnEnterLoop: TNotifyMessage;
  FOnExitLoop: TNotifyMessage;
public
  constructor Create(hParent:HWND);override;
  destructor Destroy; override;
  procedure DefaultHandler(var AMessage); override;
  function SetToParent:Boolean;
  property OnCommand: TNotifyMessage read FOnCommand write FOnCommand;
  property OnInitMenu: TNotifyMessage read FOnInitMenu write FOnInitMenu;
  property OnEnterLoop: TNotifyMessage read FOnEnterLoop write FOnEnterLoop;
  property OnExitLoop: TNotifyMessage read FOnExitLoop write FOnExitLoop;
end;

//--------------- TAPopupMenu ----------------------------------
TAPopupMenu = class(TMenuBase)
private
  FID: UINT;
  FAttachedMenu: HMENU;
  FOnInitPopup: TNotifyMessage;
  function GetChecked(mID:UINT):Boolean;
  procedure SetChecked(mID:UINT;value:Boolean);
  function GetEnabled(mID:UINT):Boolean;
  procedure SetEnabled(mID:UINT;value:Boolean);
protected
public
  constructor Create(hParent:HWND);override;
  destructor Destroy; override;
  procedure DefaultHandler(var AMessage); override;
  function AppendSeparator(mID:UINT):Boolean;
  function InsertSeparator(position:integer;mID:UINT):Boolean;
  function AppendRadio(st:string;mID:UINT):Boolean;
  function InsertRadio(position:integer;st:string;mID:UINT):Boolean;
  function AppendBitmap(hB:HBITMAP;mID:UINT):Boolean;
  function InsertBitmap(position:integer;hB:HBITMAP;mID:UINT):Boolean;
  function AttachMenu(Menu:TMenuBase;position:integer;st:string):Boolean;
  function DetachMenu: Boolean;
  function CheckRadio(First,Last,Check:UINT):Boolean;
  function ChangeBitmap(mID:UINT;hB:HBITMAP):Boolean;
  property ID: UINT read FID write FID;
  property AttachedMenu: HMENU read FAttachedMenu;
  property Checked[mID:UINT]:Boolean read GetChecked write SetChecked;
  property Enabled[mID:UINT]:Boolean read GetEnabled write SetEnabled;
  property OnInitPopup: TNotifyMessage read FOnInitPopup write FOnInitPopup;
end;

//---------------------------------------------------------------
function MakeMainMenu(hParent:HWND;sOnCommand:TNotifyMessage): TAMainMenu;
function MakePopupMenu(hParent:HWND;ID:UINT;
                                sOnInitPopup:TNotifyMessage): TAPopupMenu;

implementation

//-------------------- TMenuBase ------------------------------
function TMenuBase.AppendString(st:string;mID:UINT):Boolean;
begin
  result := AppendStringMenu(FHandle,st,mID);
end;

function TMenuBase.InsertString(position:integer;st:string;mID:UINT):Boolean;
begin
  result := InsertStringMenu(FHandle,position,st,mID);
end;

function TMenuBase.Remove(mID:UINT):Boolean;
begin
  result := Boolean(RemoveMenu(FHandle,mID,MF_BYCOMMAND));
end;

//--------------- TAMainMenu ----------------------------------
constructor TAMainMenu.Create(hParent:HWND);
begin
  inherited Create(hParent);

  FHandle := CreateMenu;
  Dispatcher.TrapMessage(WM_COMMAND,self);
  Dispatcher.TrapMessage(WM_INITMENU,self);
  Dispatcher.TrapMessage(WM_ENTERMENULOOP,self);
  Dispatcher.TrapMessage(WM_EXITMENULOOP,self);
end;

destructor TAMainMenu.Destroy;
var
  hM:HMENU;
begin
  hM := GetMenu(Parent);
  if hM <> FHandle then DestroyMenu(FHandle);

  inherited Destroy;
end;

procedure TAMainMenu.DefaultHandler(var AMessage);
var
  AMsg: TMessage;
begin
  AMsg := TMessage(AMessage);
  case AMsg.Msg of

    WM_COMMAND:begin
      if (AMsg.WParamHi+AMsg.LParam)=0 then begin
        AMsg.Msg := UINT(self);  // sender
        if Assigned(FOnCommand) then OnCommand(AMsg);
      end;
    end;

    WM_INITMENU:begin
      if AMsg.WParam = WPARAM(FHandle) then begin
        AMsg.Msg := UINT(self);  // sender
        if Assigned(FOnInitMenu) then OnInitMenu(AMsg);
      end;
    end;

    WM_ENTERMENULOOP:begin
      AMsg.Msg := UINT(self);  // sender
      if Assigned(FOnEnterLoop) then OnEnterLoop(AMsg);
    end;

    WM_EXITMENULOOP:begin
      AMsg.Msg := UINT(self);  // sender
      if Assigned(FOnExitLoop) then OnExitLoop(AMsg);
    end;
    
  end;
end;

function TAMainMenu.SetToParent:Boolean;
begin
  result := Boolean(SetMenu(Parent,FHandle));
end;

//--------------- TAPopupMenu ----------------------------------
constructor TAPopupMenu.Create(hParent:HWND);
begin
  inherited Create(hParent);

  FHandle := CreatePopupMenu;
  Dispatcher.TrapMessage(WM_INITMENUPOPUP,self);
end;

destructor TAPopupMenu.Destroy;
begin
  if FAttachedMenu = 0 then DestroyMenu(FHandle);

  inherited Destroy;
end;

procedure TAPopupMenu.DefaultHandler(var AMessage);
var
  AMsg: TMessage;
begin
  AMsg := TMessage(AMessage);
  if AMsg.Msg = WM_INITMENUPOPUP then
    if AMsg.WParam = WPARAM(FHandle) then begin
      AMsg.Msg := UINT(self);  // sender
      if Assigned(FOnInitPopup) then OnInitPopup(AMsg);
    end;
end;

function TAPopupMenu.AppendSeparator(mID:UINT):Boolean;
begin
  result := AppendSeparatorMenu(FHandle,mID);
end;

function TAPopupMenu.InsertSeparator(position:integer;mID:UINT):Boolean;
begin
  result := InsertSeparatorMenu(FHandle,position,mID);
end;

function TAPopupMenu.AppendRadio(st:string;mID:UINT):Boolean;
begin
  result := AppendRadioMenu(FHandle,st,mID);
end;

function TAPopupMenu.InsertRadio(position:integer;st:string;mID:UINT):Boolean;
begin
  result := InsertRadioMenu(FHandle,position,st,miD);
end;

function TAPopupMenu.AppendBitmap(hB:HBITMAP;mID:UINT):Boolean;
begin
  result := AppendBitmapMenu(FHandle,hB,mID);
end;

function TAPopupMenu.InsertBitmap(position:integer;hB:HBITMAP;mID:UINT):Boolean;
begin
  result := InsertBitmapMenu(FHandle,position,hB,mID);
end;

function TAPopupMenu.AttachMenu(Menu:TMenuBase;position:integer;st:string):Boolean;
begin
  if FAttachedMenu <> 0 then begin
    result := false;
    exit;
  end else begin
    result := InsertPopupMenu(Menu.FHandle,position,st,FHandle,FID);
    DrawMenuBar(Parent);
  end;
  if result then FAttachedMenu := Menu.FHandle;
end;

function TAPopupMenu.DetachMenu: Boolean;
begin
  if FAttachedMenu = 0 then begin
    result := false;
    exit;
  end else begin
    result := Boolean(RemoveMenu(FAttachedMenu,FID,MF_BYCOMMAND));
    DrawMenuBar(Parent);
  end;
  if result then FAttachedMenu := 0;
end;

function TAPopupMenu.CheckRadio(First,Last,Check:UINT):Boolean;
begin
  result := Boolean(CheckMenuRadioItem(FHandle,First,Last,Check,MF_BYCOMMAND));
end;

function TAPopupMenu.ChangeBitmap(mID:UINT;hB:HBITMAP):Boolean;
var
  MII:TMenuItemInfo;
begin
  FillChar(MII,SizeOf(TMenuItemInfo),0);
  with MII do begin
    cbSize := 44; // Required for Windows 95
    fMask := MIIM_TYPE;
    fType := MFT_BITMAP;
    dwTypeData := PChar(hB);
  end;
  result := Boolean(SetMenuItemInfo(FHandle,mID,false,MII));
end;

function TAPopupMenu.GetChecked(mID:UINT):Boolean;
begin
  result := IsMenuChecked(FHandle,mID);
end;

procedure TAPopupMenu.SetChecked(mID:UINT;value:Boolean);
begin
  SetMenuChecked(FHandle,mID,value);
end;

function TAPopupMenu.GetEnabled(mID:UINT):Boolean;
begin
  result := IsMenuEnabled(FHandle,mID);
end;

procedure TAPopupMenu.SetEnabled(mID:UINT;value:Boolean);
begin
  SetMenuEnabled(FHandle,mID,value);
end;

//---------------------------------------------------------------
function MakeMainMenu(hParent:HWND;sOnCommand:TNotifyMessage): TAMainMenu;
begin
  result := TAMainMenu.Create(hParent);
  result.FOnCommand := sOnCommand;
end;

function MakePopupMenu(hParent:HWND;ID:UINT;
                                sOnInitPopup:TNotifyMessage): TAPopupMenu;
begin
  result := TAPopupMenu.Create(hParent);
  result.FID := ID;
  result.FOnInitPopup := sOnInitPopup;
end;

end.