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

unit uEWMenuManager;

{$INCLUDE eDefines.inc}

interface

uses
  Classes, Menus, ToolsAPI, ExtCtrls, Controls;

const
  sPersonalityDelphiWin32  = 'Delphi.Personality';
  sPersonalityDelphiDotNet = 'DelphiDotNet.Personality';
  sPersonalityCSharpDotNet = 'CSharp.Personality';
  sPersonalityCppBuilderWin32 = 'CPlusPlusBuilder.Personality';
  sPersonalityVisualBasicDotNet = 'VB.Personality';

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

  TMenuItemEx = class;

  TEWMenuItem = class
  private
    fMenuItem: TMenuItemEx;
    fPersonality: TEWPersonalitySet;
    fVisible: boolean;
  public
    constructor Create(aMenuItem: TMenuItemEx);
    procedure SetGlyph(aImageList: TImageList; aIndex: integer);
    property MenuItem: TMenuItemEx read fMenuItem;
    property Personality: TEWPersonalitySet read fPersonality write fPersonality;
    property Visible: boolean read fVisible write fVisible;
  end;

  TMenuItemEx = class(TMenuItem)
  private
    fInfo: TEWMenuItem;
  public
    property Info: TEWMenuItem read fInfo write fInfo;
  end;

  TEWMenu = class
  private
    fName: string;
    fMenu: TMenuItem;
    fRefCount: integer;
    fOnPopup: TNotifyEvent;
    procedure _OnPopup(aSender: TObject);
  public
    constructor Create(const aName: string);
    destructor Destroy; override;

    function CreateMenuItem(const aCaption: string; aImageIndex: integer; aPersonality: TEWPersonalitySet): TEWMenuItem;
    function DestroyMenuItem(var aMenu: TEWMenuItem): boolean;

    property Name: string read fName;
    property Menu: TMenuItem read fMenu;

    property OnPopup: TNotifyEvent read fOnPopup write fOnPopup;

  end;

  TEWMenuManager = class
  private
    fMenus: TStringList;
    fEWMenu: TMenuItem;
    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;

implementation

uses
  {$IFDEF DELPHI5}DsgnIntf, Windows,{$ENDIF}
  {$IFDEF DELPHI6UP}DesignEditors, DesignIntf, ExtActns,{$ENDIF}
  Forms, SysUtils, Dialogs, uEWAbout, Graphics, uEWOTAHelpers;

{ TEWMenuManager }

{ TODO: use

    procedure MenuBeginUpdate;
    procedure MenuEndUpdate;
}

constructor TEWMenuManager.Create;
begin
  {fTimer := TTimer.Create(nil);
  fTimer.OnTimer := TimerInitialize;
  fTimer.Interval := 60000;
  fTimer.Enabled := true;
  ShowMessage('Create!');}
end;

procedure TEWMenuManager.Initialize;
var
  lMainMenu: TMainMenu;
  lHelpMenu: TMenuItem;
  lServices: INTAServices;
  i: integer;
begin
  if Assigned(fMenus) then exit;

  fMenus := TStringList.Create();

  //try

    if not Assigned(BorlandIDEServices) then
      raise Exception.Create('Cannot access BorlandIDEServices.');

    //{$IFDEF BDS}
    //lServices := BorlandIDEServices.GetService(INTAServices) as INTAServices;
    //{$ELSE}
    lServices := (BorlandIDEServices as INTAServices);
    //{$ENDIF}

    if not Assigned(lServices) then
      raise Exception.Create('Cannot access INTAServices.');

    lMainMenu := lServices.MainMenu;

    for i := 0 to lMainMenu.Items.Count-1 do begin

      if lMainMenu.Items[i].Name = 'HelpMenu' then begin
        lHelpMenu := lMainMenu.Items[i];

        fEWMenu := TMenuItem.Create(nil);
        fEWMenu.Caption := 'About RemObjects Everwood<6F>';
        fEWMenu.OnClick := OnAboutClick;

        lHelpMenu.Insert(lHelpMenu.Count-1, fEWMenu);
      end;
    end; { for }
  {except
    ShowMessage('Error getting Main Menu');
  end;}

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
    result := TEWMenu.Create(aName);
    fMenus.AddObject(aName, result);
  end;
end;


function TEWMenuManager.DestroyMenu(var aMenu: TEWMenu): boolean;
var
  lIndex: integer;
begin
  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);
var
  lMainMenu: TMainMenu;
begin
  inherited Create();
  fName := aName;
  fRefCount := 1;

  fMenu := TMenuItem.Create(nil);
  fMenu.Caption := aName;
  fMenu.OnClick := _OnPopup;

  lMainMenu := (BorlandIDEServices as INTAServices).MainMenu;
  lMainMenu.Items.Insert(lMainMenu.Items.Count-2, fMenu);

  with CreateMenuItem('NOOPTIONS', -1, [pAny]) do begin
    MenuItem.Enabled := false;
  end;

end;

function TEWMenu.CreateMenuItem(const aCaption: string; aImageIndex: integer; aPersonality: TEWPersonalitySet): TEWMenuItem;
var
  lMenuItem: TMenuItemEx;
begin
  lMenuItem := TMenuItemEx.Create(fMenu);
  lMenuItem.Caption := aCaption;
  lMenuItem.ImageIndex := aImageIndex;
  result := TEWMenuItem.Create(lMenuItem);
  result.Personality := aPersonality;
  lMenuItem.Info := result;
  fMenu.Add(lMenuItem);
end;

destructor TEWMenu.Destroy;
begin
  FreeAndNil(fMenu);
  inherited;
end;

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

procedure TEWMenu._OnPopup(aSender: TObject);
var
  i: integer;
  s: string;
  lPersonality: TEWPersonality;
  lAnyMenusVisible: boolean;
begin
  if assigned(OnPopup) then OnPopup(self);

  //ToDo: optimize 2 calls to CurrentProject
  if CurrentProject <> nil then begin
    {$IFDEF DELPHI9UP}
    s := CurrentProject.Personality;

    if SameText(s, sPersonalityDelphiWin32) then
      lPersonality := pDelphiWin32
    else if SameText(s, sPersonalityDelphiDotNet) then
      lPersonality := pDelphiDotNet
    else if SameText(s, sPersonalityDelphiDotNet) then
      lPersonality := pDelphiDotNet
    else if SameText(s, sPersonalityCSharpDotNet) then
      lPersonality := pCSharpDotNet
    else if SameText(s, sPersonalityVisualBasicDotNet) then
      lPersonality := pVisualBasicDotNet
    else if SameText(s, sPersonalityCppBuilderWin32) then
      lPersonality := pCppBuilderWin32
    else
      lPersonality := pUnknown;

    s := LanguageFromPersonality(CurrentProject);

    fMenu.Items[0].Caption := Format('<No options available for %s Projects>',[s]);
    {$ELSE}
    lPersonality := pDelphiWin32;
    fMenu.Items[0].Caption := Format('<No options available>',[s]);
    {$ENDIF DELPHI9UP}
  end
  else begin
    lPersonality := pNone;
    fMenu.Items[0].Caption := '<No options available without open project>';
  end;

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

      end;
    end;
  end;

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

end;

{ TEWMenuItem }

constructor TEWMenuItem.Create(aMenuItem: TMenuItemEx);
begin
  inherited Create();
  fMenuItem := aMenuItem;
  fVisible := true;
end;

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

procedure TEWMenuItem.SetGlyph(aImageList: TImageList; aIndex: integer);
var
  lBitmap: TBitmap;
begin
  lBitmap := TBitmap.Create();
  try
    aImageList.GetBitmap(aIndex ,lBitmap);
    MenuItem.ImageIndex := (BorlandIDEServices as INTAServices).AddMasked(lBitmap, clFuchsia);
  finally
    lBitmap.Free();
  end;
end;

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