lazarus/lcl/interfaces/fpgui/fpguiwsmenus.pp

{ $Id: FpGuiwsmenus.pp 5319 2004-03-17 20:11:29Z marc $}
{
 *****************************************************************************
 *                               FpGuiWSMenus.pp                                * 
 *                               ------------                                * 
 *                                                                           *
 *                                                                           *
 *****************************************************************************

 *****************************************************************************
  This file is part of the Lazarus Component Library (LCL)

  See the file COPYING.LCL, included in this distribution,
  for details about the license.
 *****************************************************************************
}
unit FpGuiWSMenus;

{$mode delphi}{$H+}

interface

uses
  // LCL
  SysUtils, Menus, Forms,
  // widgetset
  WSMenus, WSLCLClasses, LCLType, fpguiobjects, fpguiwsprivate,
  // interface
  fpg_base, fpg_main, fpg_menu;

type

  { TFpGuiWSMenuItem }

  TFpGuiWSMenuItem = class(TWSMenuItem)
  private
  protected
  published
    class procedure AttachMenu(const AMenuItem: TMenuItem); override;
    class function CreateHandle(const AMenuItem: TMenuItem): HMENU; override;
    class procedure DestroyHandle(const AMenuItem: TMenuItem); override;
    class procedure SetCaption(const AMenuItem: TMenuItem; const ACaption: string); override;
//    class procedure SetShortCut(const AMenuItem: TMenuItem; const ShortCutK1, ShortCutK2: TShortCut); override;
    class procedure SetVisible(const AMenuItem: TMenuItem; const Visible: boolean); override;
    class function SetCheck(const AMenuItem: TMenuItem; const Checked: boolean): boolean; override;
    class function SetEnable(const AMenuItem: TMenuItem; const Enabled: boolean): boolean; override;
//    class function SetRadioItem(const AMenuItem: TMenuItem; const RadioItem: boolean): boolean; override;
//    class function SetRightJustify(const AMenuItem: TMenuItem; const Justified: boolean): boolean; override;
//    class procedure UpdateMenuIcon(const AMenuItem: TMenuItem; const HasIcon: Boolean; const AIcon: TBitmap); override;
  end;

  { TFpGuiWSMenu }

  TFpGuiWSMenu = class(TWSMenu)
  private
  protected
  published
    class function  CreateHandle(const AMenu: TMenu): HMENU; override;
//    class procedure SetBiDiMode(const AMenu: TMenu; UseRightToLeftAlign, UseRightToLeftReading : Boolean); override;
  end;

  { TFpGuiWSMainMenu }

  TFpGuiWSMainMenu = class(TWSMainMenu)
  private
  protected
  public
  end;

  { TFpGuiWSPopupMenu }

  TFpGuiWSPopupMenu = class(TWSPopupMenu)
  private
  protected
  published
    class procedure Popup(const APopupMenu: TPopupMenu; const X, Y: integer); override;
  end;


implementation

uses
  LCLMessageGlue;

{ TFpGuiWSMenuItem }

class procedure TFpGuiWSMenuItem.AttachMenu(const AMenuItem: TMenuItem);
begin

end;

{------------------------------------------------------------------------------
  Function: TFpGuiWSMenuItem.CreateHandle
  Params:  None
  Returns: Nothing

  Creates a Menu Item
 ------------------------------------------------------------------------------}
class function TFpGuiWSMenuItem.CreateHandle(const AMenuItem: TMenuItem): HMENU;
var
  Menu: TFPGUIPrivateMenuItem;
  AMenuName: string;
//  hotkeydef: string;
  { Possible parents }
  ParentPrivateItem: TFPGUIPrivateMenuItem;
  ParentMenuBar: TfpgMenuBar;
  ParentPrivatePopUp: TFPGUIPrivatePopUpMenu;
begin
  {$ifdef VerboseFPGUIIntf}
    WriteLn('trace:> [TFPGuiWSMenuItem.CreateHandle] Caption: ', AMenuItem.Caption,
     ' Subitems: ' + IntToStr(AMenuItem.Count));

    Write('trace:< [TFPGuiWSMenuItem.CreateHandle]');
  {$endif}

  {------------------------------------------------------------------------------
    Set's default values for variables used at several places bellow
   ------------------------------------------------------------------------------}
  AMenuName := AMenuItem.Caption;

  Menu := nil;

  {------------------------------------------------------------------------------
    This case should not happen. A menu item must have a parent, but it seams LCL
   will sometimes create a menu item prior to creating it's parent.
    So, if we arrive here, we must create this item as if it was a TMenu
   ------------------------------------------------------------------------------}
  if (not AMenuItem.HasParent) then
  begin
    {$ifdef VerboseFPGUIIntf}
      Write(' Parent: Menu without parent');
    {$endif}

//    Result := TQtWSMenu.CreateHandle(AMenuItem.GetParentMenu);
  end
  {------------------------------------------------------------------------------
    If the parent has no parent, then this item is directly owned by a TMenu
    In this case we have to detect if the parent is a TMainMenu or a TPopUpMenu
   because TMainMenu uses the special Handle TfpgMenuBar
   ------------------------------------------------------------------------------}
  else
  if AMenuItem.Parent.HasParent then begin
    {------------------------------------------------------------------------------
      If the parent has a parent, then that item's Handle is necessarely a TFPGUIPrivateMenuItem
     ------------------------------------------------------------------------------}
    Menu := TFPGUIPrivateMenuItem.Create;
    Menu.LCLMenuItem := AMenuItem;
    ParentPrivateItem := TFPGUIPrivateMenuItem(AMenuItem.Parent.Handle);
    Menu.MenuItem := ParentPrivateItem.MenuItem.SubMenu.AddMenuItem(AMenuName, '', Menu.HandleOnClick);
    Result := HMENU(Menu);
  end else if (AMenuItem.GetParentMenu is TMainMenu) then begin
    Menu := TFPGUIPrivateMenuItem.Create;
    Menu.LCLMenuItem := AMenuItem;
    ParentMenuBar := TfpgMenuBar(AMenuItem.GetParentMenu.Handle);
    Menu.MenuItem := ParentMenuBar.AddMenuItem(AMenuName, Menu.HandleOnClick);
    Result := HMENU(Menu);
  end else begin
    Menu := TFPGUIPrivateMenuItem.Create;
    Menu.LCLMenuItem := AMenuItem;
    ParentPrivatePopUp := TFPGUIPrivatePopUpMenu(AMenuItem.GetParentMenu.Handle);
    Menu.MenuItem := ParentPrivatePopUp.PopUpMenu.AddMenuItem(AMenuName,'',Menu.HandleOnClick);
    Result := HMENU(Menu);
  end;

  {------------------------------------------------------------------------------
    If the menuitem has submenus, create a popupmenu for the submenu
   ------------------------------------------------------------------------------}
  if AMenuItem.Count > 0 then
  begin
    Menu.MenuItem.SubMenu := TfpgPopupMenu.Create(Menu.MenuItem);
  end;

  {$ifdef VerboseFPGUIIntf}
    WriteLn(' Result: ', IntToStr(Result));
  {$endif}
end;

class procedure TFpGuiWSMenuItem.DestroyHandle(const AMenuItem: TMenuItem);
begin
  TFPGUIPrivateMenuItem(AMenuItem.Handle).Free;
  AMenuItem.Handle:=0;
end;

class procedure TFpGuiWSMenuItem.SetCaption(const AMenuItem: TMenuItem;
  const ACaption: string);
var
  APrivate: TfpgMenuItem;
begin
  APrivate:=TfpgMenuItem(AMenuItem.Handle);
  APrivate.Text:=ACaption;
end;

class procedure TFpGuiWSMenuItem.SetVisible(const AMenuItem: TMenuItem;
  const Visible: boolean);
var
  APrivate: TfpgMenuItem;
begin
  APrivate:=TfpgMenuItem(AMenuItem.Handle);
  APrivate.Visible:=Visible;
end;

class function TFpGuiWSMenuItem.SetCheck(const AMenuItem: TMenuItem;
  const Checked: boolean): boolean;
begin
  Result:=false; //Default by now
end;

class function TFpGuiWSMenuItem.SetEnable(const AMenuItem: TMenuItem;
  const Enabled: boolean): boolean;
begin
  Result:=false; //Default by now
end;

{ TFpGuiWSMenu }

class function TFpGuiWSMenu.CreateHandle(const AMenu: TMenu): HMENU;
var
  MenuBar: TfpgMenuBar;
  Menu: TFPGUIPrivatePopUpMenu;
  msg: TfpgMessageParams;
begin
  {------------------------------------------------------------------------------
    If the menu is a main menu, there is no need to create a handle for it.
    It's already created on the window
   ------------------------------------------------------------------------------}
  if (AMenu is TMainMenu) and (AMenu.Owner is TCustomForm) then
  begin
    MenuBar := TFPGUIPrivateWindow(TCustomForm(AMenu.Owner).Handle).MenuBar;
    MenuBar.Visible := True;
    MenuBar.Align := alTop;
    
    Result := HMENU(MenuBar);
    //Notify LCL to repaint because MainMenu changes NCBorders
    msg.rect:=MenuBar.Parent.GetBoundsRect;
    fpgSendMessage(MenuBar,MenuBar.Parent,FPGM_RESIZE,msg);
  end
  {------------------------------------------------------------------------------
    The menu is a popup menu
   ------------------------------------------------------------------------------}
  else if (AMenu is TPopUpMenu) then
  begin
    Menu := TFPGUIPrivatePopUpMenu.Create(TPopUpMenu(AMenu), AMenu.Items);

    Result := HMENU(Menu);
  end
  else
    Result := HMENU(0);

  {$ifdef VerboseFPGUIIntf}
    Write('[TFpGuiWSMenu.CreateHandle] ');

    if (AMenu is TMainMenu) then Write('IsMainMenu ');

    WriteLn(' Handle: ', IntToStr(Result), ' Name: ', AMenu.Name);
  {$endif}
end;

{ TFpGuiWSPopupMenu }

class procedure TFpGuiWSPopupMenu.Popup(const APopupMenu: TPopupMenu; const X, Y: integer);
begin
  TFPGUIPrivatePopUpMenu(APopUpMenu.Handle).PopUp(X, Y);
end;

end.