389 lines
9.6 KiB
ObjectPascal
389 lines
9.6 KiB
ObjectPascal
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;
|
||
|
||
|
||
//ToDO: exract
|
||
function ModuleServices: IOTAModuleServices;
|
||
begin
|
||
result := (BorlandIDEServices as IOTAModuleServices);
|
||
end;
|
||
|
||
|
||
function CurrentProject: IOTAProject;
|
||
var
|
||
services: IOTAModuleServices;
|
||
module: IOTAModule;
|
||
project: IOTAProject;
|
||
projectgroup: IOTAProjectGroup;
|
||
multipleprojects: Boolean;
|
||
i: Integer;
|
||
begin
|
||
result := nil;
|
||
|
||
multipleprojects := False;
|
||
services := ModuleServices;
|
||
|
||
if (services = nil) then Exit;
|
||
|
||
for I := 0 to (services.ModuleCount - 1) do begin
|
||
module := services.Modules[I];
|
||
if (module.QueryInterface(IOTAProjectGroup, ProjectGroup) = S_OK) then begin
|
||
result := ProjectGroup.ActiveProject;
|
||
Exit;
|
||
end
|
||
|
||
else if module.QueryInterface(IOTAProject, Project) = S_OK then begin
|
||
if (result = nil) then
|
||
result := Project // Found the first project, so save it
|
||
else
|
||
multipleprojects := True; // It doesn't look good, but keep searching for a project group
|
||
end;
|
||
end;
|
||
|
||
if multipleprojects then result := nil;
|
||
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.
|
||
|
||
|