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 := ''; end else begin lPersonality := pNone; Items[0].Caption := ''; 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.