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™'; 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('',[s]); {$ELSE} lPersonality := pDelphiWin32; fMenu.Items[0].Caption := Format('',[s]); {$ENDIF DELPHI9UP} end else begin lPersonality := pNone; fMenu.Items[0].Caption := ''; 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.