Componentes.Terceros.RemObjects/official/5.0.35.741/Everwood/Source/Delphi/uEWMenuManager_laz.pas

unit uEWMenuManager_laz;

{$I Everwood.inc}

interface

uses
  MenuIntf, IDECommands,
  Classes, Menus, ExtCtrls, Controls;

type
  TEWPersonality = (pAny, pNone, pUnknown, pDelphiWin32, pDelphiDotNet, pCSharpDotNet, pCppBuilderWin32, pVisualBasicDotNet, pLazarusWin, pLazarusUnix);
  TEWPersonalitySet = set of TEWPersonality;
  TEWMenu = class;

  TEWMenuItem = class(TIDEMenuCommand)
  private
    fPersonality: TEWPersonalitySet;
  public
    procedure SetGlyph(aImageList: TImageList; aIndex: integer);
    property Personality: TEWPersonalitySet read fPersonality write fPersonality;
  end;

  { TEWMenu }

  TEWMenu = class(TIDEMenuSection)
  private
    fOnPopup: TNotifyEvent;
    fCat : TIDECommandCategory;
    function GetOnPopup: TNotifyEvent;
    procedure SetOnPopup(const AValue: TNotifyEvent);
    procedure _OnPopup(aSender: TObject);
  public
    constructor Create(const aName: string);override;
    function CreateMenuItem(const aCaption: string; aImageIndex: integer; aPersonality: TEWPersonalitySet; AutoAdd: boolean = True): TEWMenuItem; overload;
    function DestroyMenuItem(var aMenu: TEWMenuItem): boolean;
    property OnPopup: TNotifyEvent read fOnPopup write fOnPopup;
    property CommandCategory: TIDECommandCategory read fCat;
  end;

  TEWMenuManager = class
  private
    fMenus: TStringList;
    procedure OnAboutClick(Sender: TObject);
  public
    constructor Create;
    Destructor Destroy; override;
    procedure Initialize;

    function CreateMenu(const aName: string): TEWMenu;
    function DestroyMenu(var aMenu: TEWMenu): boolean;
  end;

var
  MenuManager: TEWMenuManager;

procedure Register;
implementation

uses
  Forms, SysUtils, Dialogs, uEWAbout, Graphics, uEWOTAHelpers_laz,IDEImagesIntf;


procedure Register;
begin
  RegisterIDEMenuCommand(mnuHelp,'EverWood','About RemObjects Everwood',MenuManager.OnAboutClick)
end;

{ TEWMenuManager }

{ TODO: use

    procedure MenuBeginUpdate;
    procedure MenuEndUpdate;
}

constructor TEWMenuManager.Create;
begin
  fMenus := TStringList.Create();
end;

procedure TEWMenuManager.Initialize;
begin
  // nothing, for compatibility with Delphi version
end;

destructor TEWMenuManager.Destroy;
//var  i: Integer;
begin
(*  if Assigned(fMenus) then begin
    for i := 0 to fMenus.Count-1 do begin
      fMenus.Objects[i].Free();
      fMenus.Objects[i] := nil;
    end; { for }
  end;      *)
  FreeAndNil(fMenus);
//  FreeAndNil(fEWMenu);
end;

function TEWMenuManager.CreateMenu(const aName: string): TEWMenu;
var
  lIndex: integer;
begin
  Initialize();
  lIndex := fMenus.IndexOf(aName);
  if lIndex > -1 then begin
    Result := fMenus.Objects[lIndex] as TEWMenu
  end
  else begin
    // similar to RegisterIDESubMenu
    Result := TEWMenu.Create(aName);
    Result.ChildsAsSubMenu:=true;
    Result.SubMenuImages := IDEImages.Images_16;
    fMenus.AddObject(aName, result);
  end;
end;


function TEWMenuManager.DestroyMenu(var aMenu: TEWMenu): boolean;
{var   lIndex: integer;}
begin
  // only static packages in lazarus
  Result := (aMenu <> nil) and False;    // always false
 {
  Initialize();
  lIndex := fMenus.IndexOfObject(aMenu);
  if lIndex > -1 then begin
    dec(aMenu.fRefCount);
    if aMenu.fRefCount = 0 then begin
      fMenus.Delete(lIndex);
      aMenu.Free();
      result := true;
    end
    else begin
      result := false;
    end;
  end
  else
    result := false;
  aMenu := nil;
  }
end;

{ TEWMenu }

constructor TEWMenu.Create(const aName: string);
begin
  inherited Create(aName);
  Caption := aName;
  OnClick := _OnPopup;
  CreateMenuItem;
  mnuMain.Insert(mnuWindow.SectionIndex, self);
  fcat := RegisterIDECommandCategory(nil, Caption,'');
  with CreateMenuItem('NOOPTIONS', -1, [pAny]) do begin
    MenuItem.Enabled := false;
  end;
end;

function TEWMenu.CreateMenuItem(const aCaption: string; aImageIndex: integer; aPersonality: TEWPersonalitySet; AutoAdd: boolean = True): TEWMenuItem;
begin
  // same as RegisterIDEMenuCommand
  Result := TEWMenuItem.Create(aCaption);
  Result.Caption := aCaption;
  result.Personality := aPersonality;
  Result.CreateMenuItem;
  Result.MenuItem.ImageIndex:=aImageIndex;
  if AutoAdd then Self.AddLast(Result);
end;

function TEWMenu.DestroyMenuItem(var aMenu: TEWMenuItem): boolean;
begin
  result := (aMenu<> nil) and false;
end;

procedure TEWMenu._OnPopup(aSender: TObject);
var
  i: integer;
  lPersonality: TEWPersonality;
  lAnyMenusVisible: boolean;
begin
  if assigned(fOnPopup) then fOnPopup(aSender); // aSender = Self

  if CurrentProject <> nil then begin
  {$IFDEF MSWINDOWS}
    lPersonality := pLazarusWin;
  {$ELSE}
    lPersonality := pLazarusUnix;
  {$ENDIF}
    Items[0].Caption := '<No options available>';
  end
  else begin
    lPersonality := pNone;
    Items[0].Caption := '<No options available without open project>';
  end;

  lAnyMenusVisible := false;
  for i := 1 to Count-1 do begin
    if Items[i] is TEWMenuItem then begin
      with (Items[i] as TEWMenuItem) do begin
        Items[i].Visible := Visible and ((pAny in Personality) or (lPersonality in Personality));
        if Items[i].Visible then lAnyMenusVisible := true;
      end;
    end;
  end;

  Items[0].Visible := not lAnyMenusVisible;
end;

function TEWMenu.GetOnPopup: TNotifyEvent;
begin
  Result := OnClick;
end;

procedure TEWMenu.SetOnPopup(const AValue: TNotifyEvent);
begin
  OnClick := AValue;
end;

{ TEWMenuItem }


procedure TEWMenuManager.OnAboutClick(Sender: TObject);
begin
  with TAboutForm.Create(Application) do try
    Position := poScreenCenter;
    ShowModal();
  finally
    release();
  end;
end;

procedure TEWMenuItem.SetGlyph(aImageList: TImageList; aIndex: integer);
var
  lBitmap: TBitmap;
begin
  lBitmap := TBitmap.Create();
  try
    aImageList.GetBitmap(aIndex ,lBitmap);
    if Section.SubMenuImages <> nil then
      MenuItem.ImageIndex := Section.SubMenuImages.AddMasked(lBitmap, clFuchsia);
  finally
    lBitmap.Free();
  end;
end;

initialization
  MenuManager := TEWMenuManager.Create();
finalization
  FreeAndNil(MenuManager);
end.