{ ***************************************************************************** See the file COPYING.modifiedLGPL.txt, included in this distribution, for details about the license. ***************************************************************************** Author: Mattias Gaertner Abstract: Interface to the IDE menus. } unit MenuIntf; {$mode objfpc}{$H+} {off $DEFINE VerboseMenuIntf} interface uses Classes, SysUtils, LCLType, LCLProc, Menus, ImgList, Graphics, IDECommands, IDEImagesIntf; type TIDEMenuItem = class; TIDEMenuSection = class; TAddMenuItemProc = function (const NewCaption: string; const NewEnabled: boolean; const NewOnClick: TNotifyEvent): TIDEMenuItem of object; { TIDEMenuItem A menu item in one of the IDE's menus. This is only the base class for TIDEMenuSection and TIDEMenuCommand } { TIDEMenuItem } TIDEMenuItem = class(TPersistent) private FAutoFreeMenuItem: boolean; FBitmap: TBitmap; FCaption: string; FEnabled: Boolean; FHint: string; FImageIndex: Integer; FMenuItem: TMenuItem; FMenuItemClass: TMenuItemClass; FName: string; FOnClickMethod: TNotifyEvent; FOnClickProc: TNotifyProcedure; FResourceName: String; FSection: TIDEMenuSection; FSectionIndex: Integer; FSize: integer; FTag: Integer; FUserTag: PtrUInt; FVisible: Boolean; FLastVisibleActive: boolean; procedure MenuItemDestroy(Sender: TObject); procedure BitmapChange(Sender: TObject); protected procedure MenuItemClick(Sender: TObject); virtual; function GetBitmap: TBitmap; virtual; function GetCaption: string; virtual; function GetHint: String; virtual; procedure SetBitmap(const AValue: TBitmap); virtual; procedure SetCaption(const AValue: string); virtual; procedure SetEnabled(const AValue: Boolean); virtual; procedure SetHint(const AValue: String); virtual; procedure SetImageIndex(const AValue: Integer); virtual; procedure SetMenuItem(const AValue: TMenuItem); virtual; procedure SetName(const AValue: string); virtual; procedure SetOnClickMethod(const AValue: TNotifyEvent); virtual; procedure SetOnClickProc(const AValue: TNotifyProcedure); virtual; procedure SetResourceName(const AValue: String); virtual; procedure SetSection(const AValue: TIDEMenuSection); virtual; procedure SetVisible(const AValue: Boolean); virtual; procedure ClearMenuItems; virtual; public constructor Create(const TheName: string); virtual; destructor Destroy; override; function GetImageList: TCustomImageList; virtual; function HasBitmap: Boolean; procedure CreateMenuItem; virtual; function GetPath: string; function GetRoot: TIDEMenuItem; function VisibleActive: boolean; virtual; function GetContainerSection: TIDEMenuSection; function GetContainerMenuItem: TMenuItem; function Size: integer; virtual; function HasAsParent(Item: TIDEMenuItem): boolean; procedure WriteDebugReport(const Prefix: string; MenuItemDebugReport: boolean); virtual; procedure ConsistencyCheck; virtual; procedure TriggerClick; public property Name: string read FName write SetName; property Bitmap: TBitmap read GetBitmap write SetBitmap; property Hint: String read GetHint write SetHint; property ImageIndex: Integer read FImageIndex write SetImageIndex; property Visible: Boolean read FVisible write SetVisible; property OnClick: TNotifyEvent read FOnClickMethod write SetOnClickMethod; property OnClickProc: TNotifyProcedure read FOnClickProc write SetOnClickProc; property Caption: string read GetCaption write SetCaption; property Section: TIDEMenuSection read FSection write SetSection; property Enabled: Boolean read FEnabled write SetEnabled; property MenuItem: TMenuItem read FMenuItem write SetMenuItem; property MenuItemClass: TMenuItemClass read FMenuItemClass write FMenuItemClass; property SectionIndex: Integer read FSectionIndex; property AutoFreeMenuItem: boolean read FAutoFreeMenuItem write FAutoFreeMenuItem; property ResourceName: String read FResourceName write SetResourceName; property Tag: Integer read FTag write FTag; property UserTag: PtrUInt read FUserTag write FUserTag; end; TIDEMenuItemClass = class of TIDEMenuItem; { TIDEMenuSection An TIDEMenuItem with children, either in a sub menu or separated with separators. If no children are visible, the section will not be visible. } { TIDEMenuSection } TIDEMenuSectionState = ( imssClearing ); TIDEMenuSectionStates = set of TIDEMenuSectionState; TIDEMenuSectionHandlerType = ( imshtOnShow // called before showing. Use this to enable/disable context sensitive items. ); TIDEMenuSection = class(TIDEMenuItem) private FBottomSeparator: TMenuItem; FChildMenuItemsCreated: boolean; FChildsAsSubMenu: boolean; FInvalidChildEndIndex: Integer; FInvalidChildStartIndex: Integer; FItems: TFPList; FNeedBottomSeparator: boolean; FNeedTopSeparator: boolean; FSectionHandlers: array[TIDEMenuSectionHandlerType] of TMethodList; FStates: TIDEMenuSectionStates; FSubMenuImages: TCustomImageList; FTopSeparator: TMenuItem; FUpdateLock: Integer; FVisibleCount: integer; function GetItems(Index: Integer): TIDEMenuItem; procedure SeparatorDestroy(Sender : TObject); procedure FreeSeparators; procedure AddHandler(HandlerType: TIDEMenuSectionHandlerType; const AMethod: TMethod; AsLast: boolean = false); procedure RemoveHandler(HandlerType: TIDEMenuSectionHandlerType; const AMethod: TMethod); protected procedure MenuItemClick(Sender: TObject); override; procedure SetMenuItem(const AValue: TMenuItem); override; procedure SetChildsAsSubMenu(const AValue: boolean); virtual; procedure SetSubMenuImages(const AValue: TCustomImageList); virtual; procedure ClearMenuItems; override; procedure ItemVisibleActiveChanged(AnItem: TIDEMenuItem); procedure UpdateChildsIndex(StartIndex: Integer); procedure UpdateMenuStructure; procedure UpdateSize(Diff: integer); procedure Invalidate(FromIndex, ToIndex: integer); public constructor Create(const TheName: string); override; destructor Destroy; override; procedure Clear; function Count: Integer; procedure AddFirst(AnItem: TIDEMenuItem); procedure AddLast(AnItem: TIDEMenuItem); procedure Insert(Index: Integer; AnItem: TIDEMenuItem); procedure Remove(AnItem: TIDEMenuItem); procedure CreateMenuItem; override; function GetContainerIndex(BehindSeparator: boolean): Integer; function GetChildContainerIndex(Index: integer): Integer; function IndexOf(AnItem: TIDEMenuItem): Integer; function IndexByName(const AName: string): Integer; function FindByName(const AName: string): TIDEMenuItem; function CreateUniqueName(const AName: string): string; function VisibleActive: boolean; override; function Size: integer; override; procedure BeginUpdate; procedure EndUpdate; procedure NotifySubSectionOnShow(Sender: TObject; WithChilds: Boolean = true); virtual; procedure RemoveAllHandlersOfObject(AnObject: TObject); procedure AddHandlerOnShow(const OnShowEvent: TNotifyEvent; AsLast: boolean = false); procedure RemoveHandlerOnShow(const OnShowEvent: TNotifyEvent); procedure WriteDebugReport(const Prefix: string; MenuItemDebugReport: boolean); override; procedure ConsistencyCheck; override; public property ChildsAsSubMenu: boolean read FChildsAsSubMenu write SetChildsAsSubMenu default true; property SubMenuImages: TCustomImageList read FSubMenuImages write SetSubMenuImages; property Items[Index: Integer]: TIDEMenuItem read GetItems; default; property TopSeparator: TMenuItem read FTopSeparator; property BottomSeparator: TMenuItem read FBottomSeparator; property NeedTopSeparator: boolean read FNeedTopSeparator; property NeedBottomSeparator: boolean read FNeedBottomSeparator; property VisibleCount: integer read FVisibleCount; // without grandchilds property States: TIDEMenuSectionStates read FStates; end; TIDEMenuSectionClass = class of TIDEMenuSection; { TIDEMenuCommand A leaf menu item. No children. Hint: The shortcut is defined via the Command property. } TIDEMenuCommand = class(TIDEMenuItem) private FAutoCheck: boolean; FChecked: Boolean; FCommand: TIDECommand; FDefault: Boolean; FGroupIndex: Byte; FRadioItem: Boolean; FRightJustify: boolean; FShowAlwaysCheckable: boolean; protected procedure MenuItemClick(Sender: TObject); override; procedure SetAutoCheck(const AValue: boolean); virtual; procedure SetChecked(const AValue: Boolean); virtual; procedure SetDefault(const AValue: Boolean); virtual; procedure SetGroupIndex(const AValue: Byte); virtual; procedure SetRadioItem(const AValue: Boolean); virtual; procedure SetRightJustify(const AValue: boolean); virtual; procedure SetShowAlwaysCheckable(const AValue: boolean); virtual; procedure SetCommand(const AValue: TIDECommand); virtual; procedure SetMenuItem(const AValue: TMenuItem); override; procedure SetOnClickMethod(const AValue: TNotifyEvent); override; procedure SetOnClickProc(const AValue: TNotifyProcedure); override; procedure CommandChanged(Sender: TObject); public property Command: TIDECommand read FCommand write SetCommand; property AutoCheck: boolean read FAutoCheck write SetAutoCheck default False; property Checked: Boolean read FChecked write SetChecked default False; property Default: Boolean read FDefault write SetDefault default False; property GroupIndex: Byte read FGroupIndex write SetGroupIndex default 0; property RadioItem: Boolean read FRadioItem write SetRadioItem; property RightJustify: boolean read FRightJustify write SetRightJustify; property ShowAlwaysCheckable: boolean read FShowAlwaysCheckable write SetShowAlwaysCheckable; end; TIDEMenuCommandClass = class of TIDEMenuCommand; { TIDEMenuRoots These are the top level menu items of the IDE. } TIDEMenuRoots = class(TPersistent) private FItems: TFPList;// list of TIDEMenuSection function GetItems(Index: integer): TIDEMenuSection; public constructor Create; destructor Destroy; override; procedure RegisterMenuRoot(Section: TIDEMenuSection); procedure UnregisterMenuRoot(Section: TIDEMenuSection); function Count: Integer; procedure Clear; procedure Delete(Index: Integer); function IndexByName(const Name: string): Integer; function FindByName(const Name: string): TIDEMenuSection; function CreateUniqueName(const Name: string): string; function FindByPath(const Path: string; ErrorOnNotFound: boolean): TIDEMenuItem; public property Items[Index: integer]: TIDEMenuSection read GetItems; default; end; var IDEMenuRoots: TIDEMenuRoots = nil;// created by the IDE // IDE MainMenu mnuMain: TIDEMenuSection = nil; // file menu mnuFile: TIDEMenuSection; itmFileNew: TIDEMenuSection; itmFileOpenSave: TIDEMenuSection; itmFileRecentOpen: TIDEMenuSection; itmFileDirectories: TIDEMenuSection; itmFileIDEStart: TIDEMenuSection; // edit menu mnuEdit: TIDEMenuSection; itmEditReUndo: TIDEMenuSection; itmEditClipboard: TIDEMenuSection; itmEditSelect: TIDEMenuSection; itmEditBlockActions: TIDEMenuSection; itmEditInsertions: TIDEMenuSection; // search menu mnuSearch: TIDEMenuSection; itmSearchFindReplace: TIDEMenuSection; itmJumpings: TIDEMenuSection; itmBookmarks: TIDEMenuSection; itmCodeToolSearches: TIDEMenuSection; // view menu mnuView: TIDEMenuSection; itmViewMainWindows: TIDEMenuSection; itmViewDesignerWindows: TIDEMenuSection; itmViewSecondaryWindows: TIDEMenuSection; itmViewDebugWindows: TIDEMenuSection; itmViewIDEInternalsWindows: TIDEMenuSection; // source menu mnuSource: TIDEMenuSection; itmSourceBlockActions: TIDEMenuSection; itmSourceCodeToolChecks: TIDEMenuSection; itmSourceRefactor: TIDEMenuSection; itmRefactorCodeTools: TIDEMenuSection; itmRefactorAdvanced: TIDEMenuSection; itmRefactorTools: TIDEMenuSection; itmSourceInsertions: TIDEMenuSection; itmSourceInsertCVSKeyWord: TIDEMenuSection; itmSourceInsertGeneral: TIDEMenuSection; itmSourceTools: TIDEMenuSection; // project menu mnuProject: TIDEMenuSection; itmProjectNewSection: TIDEMenuSection; itmProjectOpenSection: TIDEMenuSection; itmProjectRecentOpen: TIDEMenuSection; itmProjectSaveSection: TIDEMenuSection; itmProjectWindowSection: TIDEMenuSection; itmProjectAddRemoveSection: TIDEMenuSection; // run menu mnuRun: TIDEMenuSection; itmRunBuilding: TIDEMenuSection; itmRunnning: TIDEMenuSection; itmRunBuildingFile: TIDEMenuSection; itmRunDebugging: TIDEMenuSection; itmRunMenuAddBreakpoint: TIDEMenuSection; // package menu mnuPackage: TIDEMenuSection; mnuComponent: TIDEMenuSection; // = mnuPackage, for compatibility with older lazarus versions itmPkgOpening: TIDEMenuSection; itmPkgOpenRecent: TIDEMenuSection; itmPkgUnits: TIDEMenuSection; itmPkgGraphSection: TIDEMenuSection; // tools menu mnuTools: TIDEMenuSection; itmOptionsDialogs: TIDEMenuSection; itmCustomTools: TIDEMenuSection; itmSecondaryTools: TIDEMenuSection; itmDelphiConversion: TIDEMenuSection; itmBuildingLazarus: TIDEMenuSection; // windows menu mnuWindow: TIDEMenuSection; itmWindowManagers: TIDEMenuSection; itmWindowLists: TIDEMenuSection; itmCenterWindowLists: TIDEMenuSection; itmTabLists: TIDEMenuSection; itmTabListProject: TIDEMenuSection; itmTabListOther: TIDEMenuSection; itmTabListPackage: TIDEMenuSection; // help menu mnuHelp: TIDEMenuSection; itmOnlineHelps: TIDEMenuSection; itmInfoHelps: TIDEMenuSection; itmHelpTools: TIDEMenuSection; // Source Editor's tab: Popupmenu SourceTabMenuRoot: TIDEMenuSection = nil; SrcEditMenuSectionPages: TIDEMenuSection; SrcEditSubMenuMovePage: TIDEMenuSection; SrcEditMenuSectionEditors: TIDEMenuSection; // Source Editor(s): Popupmenu SourceEditorMenuRoot: TIDEMenuSection = nil; // Source Editor: First dynamic section for often used context sensitive stuff // The items are cleared automatically after each popup. SrcEditMenuSectionFirstDynamic: TIDEMenuSection; SrcEditMenuSectionClipboard: TIDEMenuSection; SrcEditMenuSectionFirstStatic: TIDEMenuSection; SrcEditSubMenuFind: TIDEMenuSection; SrcEditMenuSectionFiles: TIDEMenuSection; SrcEditSubMenuOpenFile: TIDEMenuSection; // Source Editor: File Specific dynamic section // The items are cleared automatically after each popup. SrcEditMenuSectionFileDynamic: TIDEMenuSection; SrcEditMenuSectionMarks: TIDEMenuSection; SrcEditSubMenuGotoBookmarks: TIDEMenuSection; SrcEditSubMenuToggleBookmarks: TIDEMenuSection; SrcEditMenuSectionDebug: TIDEMenuSection; SrcEditSubMenuDebug: TIDEMenuSection; SrcEditSubMenuSource: TIDEMenuSection; SrcEditSubMenuRefactor: TIDEMenuSection; SrcEditSubMenuFlags: TIDEMenuSection; SrcEditSubMenuHighlighter: TIDEMenuSection; SrcEditSubMenuLineEnding: TIDEMenuSection; SrcEditSubMenuEncoding: TIDEMenuSection; // Messages window popupmenu MessagesMenuRoot: TIDEMenuSection = nil; // CodeExplorer window popupmenu CodeExplorerMenuRoot: TIDEMenuSection = nil; // Code templates popupmenu CodeTemplatesMenuRoot: TIDEMenuSection = nil; // Designer: Popupmenu DesignerMenuRoot: TIDEMenuSection = nil; // Designer: Dynamic section for component editor DesignerMenuSectionComponentEditor: TIDEMenuSection; // Designer: custom dynamic section DesignerMenuSectionCustomDynamic: TIDEMenuSection; DesignerMenuSectionAlign: TIDEMenuSection; DesignerMenuSectionOrder: TIDEMenuSection; DesignerMenuSectionZOrder: TIDEMenuSection; DesignerMenuSectionClipboard: TIDEMenuSection; DesignerMenuSectionMisc: TIDEMenuSection; DesignerMenuSectionOptions: TIDEMenuSection; // Package editor(s) PackageEditorMenuRoot: TIDEMenuSection = nil; PkgEditMenuSectionFiles: TIDEMenuSection; // e.g. sort files, clean up files PkgEditMenuSectionUse: TIDEMenuSection; // e.g. install, add to project PkgEditMenuSectionSave: TIDEMenuSection; // e.g. save as, revert, publish PkgEditMenuSectionCompile: TIDEMenuSection; // e.g. build clean, create Makefile PkgEditMenuSectionAddRemove: TIDEMenuSection; // e.g. add unit, add dependency PkgEditMenuSectionMisc: TIDEMenuSection; // e.g. options PackageEditorMenuFilesRoot: TIDEMenuSection = nil; PkgEditMenuSectionFile: TIDEMenuSection; // e.g. open file, remove file, move file up/down PkgEditMenuSectionDirectory: TIDEMenuSection; // e.g. change all properties of all files in a directory and ub directories moved .. PkgEditMenuSectionDependency: TIDEMenuSection; // e.g. open package, remove dependency function RegisterIDEMenuRoot(const Name: string; MenuItem: TMenuItem = nil ): TIDEMenuSection; function RegisterIDEMenuSection(Parent: TIDEMenuSection; const Name: string): TIDEMenuSection; overload; function RegisterIDEMenuSection(const Path, Name: string): TIDEMenuSection; overload; function RegisterIDESubMenu(Parent: TIDEMenuSection; const Name, Caption: string; const OnClickMethod: TNotifyEvent = nil; const OnClickProc: TNotifyProcedure = nil; const ResourceName: String = '' ): TIDEMenuSection; overload; function RegisterIDESubMenu(const Path, Name, Caption: string; const OnClickMethod: TNotifyEvent = nil; const OnClickProc: TNotifyProcedure = nil; const ResourceName: String = '' ): TIDEMenuSection; overload; function RegisterIDEMenuCommand(Parent: TIDEMenuSection; const Name, Caption: string; const OnClickMethod: TNotifyEvent = nil; const OnClickProc: TNotifyProcedure = nil; const Command: TIDECommand = nil; const ResourceName: String = ''; const UserTag: PtrUint = 0 ): TIDEMenuCommand; overload; function RegisterIDEMenuCommand(const Path, Name, Caption: string; const OnClickMethod: TNotifyEvent = nil; const OnClickProc: TNotifyProcedure = nil; const Command: TIDECommand = nil; const ResourceName: String = ''; const UserTag: PtrUInt = 0 ): TIDEMenuCommand; overload; implementation function RegisterIDEMenuRoot(const Name: string; MenuItem: TMenuItem ): TIDEMenuSection; begin //debugln('RegisterIDEMenuRoot Name="',Name,'"'); Result:=TIDEMenuSection.Create(Name); IDEMenuRoots.RegisterMenuRoot(Result); Result.MenuItem:=MenuItem; end; function RegisterIDEMenuSection(Parent: TIDEMenuSection; const Name: string ): TIDEMenuSection; begin Result:=TIDEMenuSection.Create(Name); Result.ChildsAsSubMenu:=false; Parent.AddLast(Result); end; function RegisterIDEMenuSection(const Path, Name: string): TIDEMenuSection; var Parent: TIDEMenuSection; begin //debugln('RegisterIDEMenuSection Path="',Path,'" Name="',Name,'"'); Parent:=IDEMenuRoots.FindByPath(Path,true) as TIDEMenuSection; Result:=RegisterIDEMenuSection(Parent,Name); end; function RegisterIDESubMenu(Parent: TIDEMenuSection; const Name, Caption: string; const OnClickMethod: TNotifyEvent; const OnClickProc: TNotifyProcedure; const ResourceName: String): TIDEMenuSection; begin Result := TIDEMenuSection.Create(Name); Result.ChildsAsSubMenu := True; Result.Caption := Caption; Result.OnClick := OnClickMethod; Result.OnClickProc := OnClickProc; Result.ResourceName := ResourceName; Parent.AddLast(Result); end; function RegisterIDESubMenu(const Path, Name, Caption: string; const OnClickMethod: TNotifyEvent; const OnClickProc: TNotifyProcedure; const ResourceName: String): TIDEMenuSection; var Parent: TIDEMenuSection; begin //debugln('RegisterIDESubMenu Path="',Path,'" Name="',Name,'"'); Parent := IDEMenuRoots.FindByPath(Path,true) as TIDEMenuSection; Result := RegisterIDESubMenu(Parent, Name, Caption, OnClickMethod, OnClickProc, ResourceName); end; function RegisterIDEMenuCommand(Parent: TIDEMenuSection; const Name, Caption: string; const OnClickMethod: TNotifyEvent = nil; const OnClickProc: TNotifyProcedure = nil; const Command: TIDECommand = nil; const ResourceName: String = ''; const UserTag: PtrUInt = 0 ): TIDEMenuCommand; var s: String; begin Result := TIDEMenuCommand.Create(Name); s:=Caption; if (s='') and (Command<>nil) then s:=Command.LocalizedName; Result.Caption := s; Result.OnClick := OnClickMethod; Result.OnClickProc := OnClickProc; Result.Command := Command; Result.ResourceName := ResourceName; Result.UserTag := UserTag; Parent.AddLast(Result); end; function RegisterIDEMenuCommand(const Path, Name, Caption: string; const OnClickMethod: TNotifyEvent = nil; const OnClickProc: TNotifyProcedure = nil; const Command: TIDECommand = nil; const ResourceName: String = ''; const UserTag: PtrUInt = 0 ): TIDEMenuCommand; var Parent: TIDEMenuSection; begin //debugln('RegisterIDEMenuCommand Path="',Path,'" Name="',Name,'"'); Parent := IDEMenuRoots.FindByPath(Path,true) as TIDEMenuSection; Result := RegisterIDEMenuCommand(Parent, Name, Caption, OnClickMethod, OnClickProc, Command, ResourceName, UserTag); end; { TIDEMenuItem } procedure TIDEMenuItem.MenuItemClick(Sender: TObject); begin if Assigned(OnClick) then OnClick(Self); if Assigned(OnClickProc) then OnClickProc(Self); end; procedure TIDEMenuItem.MenuItemDestroy(Sender: TObject); begin FMenuItem:=nil; FAutoFreeMenuItem:=false; end; procedure TIDEMenuItem.BitmapChange(Sender: TObject); begin if MenuItem<>nil then MenuItem.Bitmap:=Bitmap; end; procedure TIDEMenuItem.SetOnClickProc(const AValue: TNotifyProcedure); begin FOnClickProc := AValue; end; procedure TIDEMenuItem.SetResourceName(const AValue: String); begin if FResourceName = AValue then exit; FResourceName := AValue; if MenuItem <> nil then if AValue <> '' then MenuItem.ImageIndex := IDEImages.LoadImage(16, FResourceName) else MenuItem.ImageIndex := -1; end; procedure TIDEMenuItem.SetOnClickMethod(const AValue: TNotifyEvent); begin FOnClickMethod := AValue; end; procedure TIDEMenuItem.SetEnabled(const AValue: Boolean); begin if FEnabled=AValue then exit; FEnabled:=AValue; if MenuItem<>nil then MenuItem.Enabled:=Enabled; end; function TIDEMenuItem.GetBitmap: TBitmap; begin if FBitmap=nil then begin FBitmap:=TBitmap.Create; FBitmap.OnChange:=@BitmapChange; end; FBitmap.Transparent:=True; Result:=FBitmap; end; function TIDEMenuItem.GetCaption: string; begin if FCaption<>'' then Result:=FCaption else Result:=FName; end; function TIDEMenuItem.GetHint: String; begin Result:=FHint; end; procedure TIDEMenuItem.SetBitmap(const AValue: TBitmap); begin if FBitmap=AValue then exit; if AValue<>nil then Bitmap.Assign(AValue) else FBitmap.Free; if MenuItem<>nil then MenuItem.Bitmap:=FBitmap; end; procedure TIDEMenuItem.SetCaption(const AValue: string); begin FCaption:=AValue; if MenuItem<>nil then MenuItem.Caption:=Caption; end; procedure TIDEMenuItem.SetHint(const AValue: String); begin FHint:=AValue; if MenuItem<>nil then MenuItem.Hint:=Hint; end; procedure TIDEMenuItem.SetImageIndex(const AValue: Integer); begin if FImageIndex=AValue then exit; FImageIndex:=AValue; if MenuItem<>nil then MenuItem.ImageIndex:=ImageIndex; end; procedure TIDEMenuItem.SetMenuItem(const AValue: TMenuItem); begin if FMenuItem = AValue then exit; if FMenuItem <> nil then ClearMenuItems; FMenuItem := AValue; AutoFreeMenuItem := False; if MenuItem <> nil then begin MenuItem.AddHandlerOnDestroy(@MenuItemDestroy); MenuItem.Caption := Caption; MenuItem.Bitmap := FBitmap; MenuItem.Hint := Hint; MenuItem.ImageIndex := ImageIndex; MenuItem.Visible := Visible; MenuItem.Enabled := Enabled; MenuItem.OnClick := @MenuItemClick; if ResourceName <> '' then MenuItem.ImageIndex := IDEImages.LoadImage(16, ResourceName); end else if Section<>nil then Section.Invalidate(SectionIndex,SectionIndex); end; procedure TIDEMenuItem.SetName(const AValue: string); begin if FName=AValue then exit; FName:=AValue; end; procedure TIDEMenuItem.SetSection(const AValue: TIDEMenuSection); var OldSection: TIDEMenuSection; begin if FSection=AValue then exit; OldSection:=FSection; ClearMenuItems; if OldSection<>nil then OldSection.Remove(Self); FSection:=nil; if FSection<>nil then FSection.AddLast(Self); end; procedure TIDEMenuItem.SetVisible(const AValue: Boolean); var OldVisibleActive: Boolean; begin if FVisible=AValue then exit; OldVisibleActive:=VisibleActive; FVisible:=AValue; if MenuItem<>nil then MenuItem.Visible:=Visible; if (VisibleActive<>OldVisibleActive) and (Section<>nil) then Section.ItemVisibleActiveChanged(Self); end; procedure TIDEMenuItem.ClearMenuItems; begin if FMenuItem <> nil then begin FMenuItem.OnClick := nil; FMenuItem.RemoveHandlerOnDestroy(@MenuItemDestroy); end; if AutoFreeMenuItem then begin FAutoFreeMenuItem:=false; FMenuItem.Free; end; FMenuItem:=nil; if Section<>nil then Section.Invalidate(SectionIndex,SectionIndex); end; constructor TIDEMenuItem.Create(const TheName: string); begin inherited Create; FSize:=1; FName:=TheName; FEnabled:=true; FVisible:=true; FMenuItemClass:=TMenuItem; FSectionIndex:=-1; FImageIndex:=-1; {$IFDEF VerboseMenuIntf} //debugln('TIDEMenuItem.Create ',dbgsName(Self),' Name="',Name,'"'); {$ENDIF} end; destructor TIDEMenuItem.Destroy; begin if Section<>nil then Section.Remove(Self); FreeAndNil(FBitmap); if FMenuItem<>nil then begin if FAutoFreeMenuItem then FreeAndNil(FMenuItem) else FMenuItem.RemoveAllHandlersOfObject(Self); end; inherited Destroy; end; function TIDEMenuItem.GetImageList: TCustomImageList; var CurSection: TIDEMenuSection; AMenu: TMenu; begin Result:=nil; CurSection:=Section; while CurSection<>nil do begin Result:=CurSection.SubMenuImages; if Result<>nil then exit; if (CurSection.Section=nil) then begin if CurSection.MenuItem<>nil then begin AMenu:=CurSection.MenuItem.GetParentMenu; if AMenu<>nil then Result:=AMenu.Images; end; exit; end; CurSection:=CurSection.Section; end; end; function TIDEMenuItem.HasBitmap: Boolean; begin Result:=(FBitmap<>nil) or ((ImageIndex>=0) and (GetImageList<>nil)); end; procedure TIDEMenuItem.CreateMenuItem; begin if FMenuItem<>nil then exit; {$IFDEF VerboseMenuIntf} //debugln('TIDEMenuItem.CreateMenuItem ',dbgsName(Self),' Name="',Name,'"'); {$ENDIF} MenuItem:=MenuItemClass.Create(nil); AutoFreeMenuItem:=true; end; function TIDEMenuItem.GetPath: string; var Item: TIDEMenuItem; begin Result:=Name; Item:=Section; while Item<>nil do begin Result:=Item.Name+'/'+Result; Item:=Item.Section; end; end; function TIDEMenuItem.GetRoot: TIDEMenuItem; begin Result:=Self; while Result.Section<>nil do Result:=Result.Section; end; function TIDEMenuItem.VisibleActive: boolean; // true if Visible=true and not hidden // false if menu item is hidden (e.g. due to no context, see TIDEMenuSection) begin Result:=Visible; end; function TIDEMenuItem.GetContainerSection: TIDEMenuSection; begin if Self is TIDEMenuSection then Result:=TIDEMenuSection(Self) else Result:=Section; while (Result<>nil) and (not Result.ChildsAsSubMenu) do Result:=Result.Section; end; function TIDEMenuItem.GetContainerMenuItem: TMenuItem; var ASection: TIDEMenuSection; begin ASection:=GetContainerSection; if (ASection<>nil) then Result:=ASection.MenuItem else Result:=nil; end; function TIDEMenuItem.Size: integer; begin Result:=FSize; end; function TIDEMenuItem.HasAsParent(Item: TIDEMenuItem): boolean; var CurItem: TIDEMenuSection; begin CurItem:=Section; while CurItem<>nil do begin if CurItem=Item then exit(true); CurItem:=CurItem.Section; end; Result:=false; end; procedure TIDEMenuItem.WriteDebugReport(const Prefix: string; MenuItemDebugReport: boolean); begin debugln([Prefix,'SectionIndex=',dbgs(SectionIndex),' Name="',DbgStr(Name),'"', ' VisibleActive=',dbgs(VisibleActive),' Handle=',((MenuItem<>nil) and (MenuItem.HandleAllocated))]); if MenuItemDebugReport and (MenuItem<>nil) then MenuItem.WriteDebugReport(Prefix); end; procedure TIDEMenuItem.ConsistencyCheck; procedure RaiseError; var s: String; begin s:='TIDEMenuItem.ConsistencyCheck Name="'+Name+'" Caption="'+DbgStr(Caption)+'"'; debugln(s); RaiseGDBException(s); end; procedure RaiseBitmapError; var s: String; begin s:='TIDEMenuItem.ConsistencyCheck Name="'+Name+'" Caption="'+DbgStr(Caption)+'"'; debugln(s); debugln(['RaiseBitmapError HasBitmap=',HasBitmap,' MenuItem.HasBitmap=',MenuItem.HasBitmap]); debugln(['RaiseBitmapError ImageIndex=',ImageIndex,' MenuItem.ImageIndex=',MenuItem.ImageIndex]); debugln(['RaiseBitmapError ImageList=',dbgsname(GetImageList),' MenuItem.ImageIndex=',DbgSName(MenuItem.GetImageList)]); RaiseError; end; begin if MenuItem<>nil then begin if MenuItem.HasBitmap<>HasBitmap then RaiseBitmapError; if MenuItem.Enabled<>Enabled then RaiseError; if MenuItem.Visible<>Visible then RaiseError; if MenuItem.Caption<>Caption then RaiseError; if MenuItem.ImageIndex<>ImageIndex then RaiseError; if MenuItem.Hint<>Hint then RaiseError; end; if (Section=nil) then begin if SectionIndex<>-1 then RaiseError; end else begin if SectionIndex<0 then RaiseError; end; end; procedure TIDEMenuItem.TriggerClick; begin MenuItemClick(Self); end; { TIDEMenuSection } procedure TIDEMenuSection.SetSubMenuImages(const AValue: TCustomImageList); begin if FSubMenuImages=AValue then exit; FSubMenuImages:=AValue; if MenuItem<>nil then MenuItem.SubMenuImages:=SubMenuImages; end; procedure TIDEMenuSection.ClearMenuItems; var i: Integer; begin FreeSeparators; for i:=0 to Count-1 do Items[i].ClearMenuItems; inherited ClearMenuItems; Invalidate(0,Count-1); end; procedure TIDEMenuSection.UpdateChildsIndex(StartIndex: Integer); var i: LongInt; begin for i:=StartIndex to FItems.Count-1 do Items[i].FSectionIndex:=i; end; procedure TIDEMenuSection.UpdateMenuStructure; // updates all FNeedBottomSeparator and FNeedTopSeparator var ContainerMenuItem: TMenuItem; ContainerMenuIndex: integer; Item: TIDEMenuItem; CurSection: TIDEMenuSection; procedure UpdateNeedTopSeparator; // a separator at top is needed, if // - this section is embedded (not ChildsAsSubMenu) // - and this section is visible // - and this section has visible children // - and there is a visible menu item in front var i: Integer; NewNeedTopSeparator: Boolean; begin NewNeedTopSeparator:=false; if (not ChildsAsSubMenu) and (Section<>nil) and VisibleActive then begin // check for any visible item in front i:=SectionIndex-1; while i>=0 do begin if Section[i].VisibleActive then begin // there is a visible menu item in front // => the Top separator is needed //debugln('TIDEMenuSection.UpdateNeedTopSeparator Name="',Name,'" ItemInFront="',Section[i].Name,'" '); NewNeedTopSeparator:=true; break; end; dec(i); end; end; if NewNeedTopSeparator<>FNeedTopSeparator then begin FNeedTopSeparator:=NewNeedTopSeparator; if FNeedTopSeparator then UpdateSize(1) else UpdateSize(-1); end; if ContainerMenuItem=nil then exit; if FNeedTopSeparator<>(TopSeparator<>nil) then begin // FNeedTopSeparator has changed if TopSeparator<>nil then begin // TopSeparator is not needed anymore FreeAndNil(FTopSeparator); {$IFDEF VerboseMenuIntf} debugln('TIDEMenuSection.UpdateMenuStructure FREE TopSeparator Name="',Name,'"'); {$ENDIF} end else begin // TopSeparator is needed FTopSeparator:=TMenuItem.Create(nil); FTopSeparator.AddHandlerOnDestroy(@SeparatorDestroy); FTopSeparator.Caption:='-'; {$IFDEF VerboseMenuIntf} debugln('TIDEMenuSection.UpdateNeedTopSeparator CREATE TopSeparator Name="',Name,'" ContainerMenuIndex=',dbgs(ContainerMenuIndex),' ContainerMenuItem.Count=',dbgs(ContainerMenuItem.Count)); {$ENDIF} if ContainerMenuIndex>ContainerMenuItem.Count then begin {$IFDEF VerboseMenuIntf} debugln('TIDEMenuSection.UpdateNeedTopSeparator CREATE TopSeparator Name="',Name,'" ContainerMenuIndex=',dbgs(ContainerMenuIndex),' ContainerMenuItem.Count=',dbgs(ContainerMenuItem.Count)); GetRoot.WriteDebugReport(' Top ',true); debugln('TIDEMenuSection.UpdateNeedTopSeparator CREATE TopSeparator Name="',Name,'" ContainerMenuIndex ** FORCED VALUE ** FROM ContainerMenuItem.Count=',dbgs(ContainerMenuItem.Count)); {$ENDIF} // there's no yet available room for new FTopSeparator.fixes #17321. ContainerMenuIndex := ContainerMenuItem.Count; end; ContainerMenuItem.Insert(ContainerMenuIndex,FTopSeparator); end; end; end; procedure UpdateNeedBottomSeparator; // a separator at bottom is needed, if // - this section is imbedded (not ChildsAsSubMenu) // - and this section is visible // - and this section has visible children // - and there is a visible menu item behind and it has no top separator var ItemBehind: TIDEMenuItem; i: Integer; NewNeedBottomSeparator: Boolean; begin NewNeedBottomSeparator:=false; //debugln('TIDEMenuSection.UpdateNeedBottomSeparator Name="',Name,'" ChildsAsSubMenu=',dbgs(ChildsAsSubMenu),' Section=',dbgs(Section<>nil),' VisibleActive=',dbgs(VisibleActive)); if (not ChildsAsSubMenu) and (Section<>nil) and VisibleActive then begin // check for any visible item in front i:=SectionIndex+1; while i nil) and not Section.Visible then exit; if (FInvalidChildStartIndex>FInvalidChildEndIndex) then exit; if FUpdateLock>0 then begin exit; end; if FInvalidChildStartIndex<0 then FInvalidChildStartIndex:=0; if (Section<>nil) and (not Section.ChildsAsSubMenu) and (Section.FInvalidChildStartIndex<=SectionIndex) then begin // the sections in front need update too // => start the update in front {$IFDEF VerboseMenuIntf} debugln('TIDEMenuSection.UpdateMenuStructure Front Section="',Section.Name,'" Name="',Name,'" Section.Invalid=',dbgs(Section.FInvalidChildStartIndex),'..',dbgs(Section.FInvalidChildEndIndex),' Count=',dbgs(Count),' SectionIndex=',dbgs(SectionIndex)); {$ENDIF} Section.UpdateMenuStructure; end else if FInvalidChildStartIndex0) and NowVisibleActive then dec(FromIndex); if (ToIndexnil) and (OldVisibleActive<>VisibleActive) then Section.ItemVisibleActiveChanged(Self); EndUpdate; end; function TIDEMenuSection.Count: Integer; begin Result:=FItems.Count; end; procedure TIDEMenuSection.AddFirst(AnItem: TIDEMenuItem); begin Insert(0,AnItem); end; procedure TIDEMenuSection.AddLast(AnItem: TIDEMenuItem); begin Insert(Count,AnItem); end; procedure TIDEMenuSection.Insert(Index: Integer; AnItem: TIDEMenuItem); begin AnItem.fName:=CreateUniqueName(AnItem.Name); FItems.Insert(Index,AnItem); UpdateChildsIndex(Index); UpdateSize(AnItem.Size); AnItem.FSection:=Self; if AnItem.VisibleActive then ItemVisibleActiveChanged(AnItem); {$IFDEF VerboseMenuIntf} ConsistencyCheck; {$ENDIF} end; procedure TIDEMenuSection.Remove(AnItem: TIDEMenuItem); var OldVisibleActive: Boolean; begin if not (imssClearing in FStates) then begin OldVisibleActive:=AnItem.VisibleActive; FItems.Delete(AnItem.SectionIndex); UpdateChildsIndex(AnItem.SectionIndex); end; UpdateSize(-AnItem.Size); AnItem.FSection:=nil; if not (imssClearing in FStates) then begin if OldVisibleActive then ItemVisibleActiveChanged(AnItem); // set the Index as last AnItem.FSectionIndex:=0; end; end; procedure TIDEMenuSection.CreateMenuItem; begin if ChildsAsSubMenu then inherited CreateMenuItem; end; function TIDEMenuSection.GetContainerIndex(BehindSeparator: boolean): Integer; var SiblingIndex: Integer; begin Result:=0; if (Section=nil) then exit; // get the start of the parent Section if not Section.ChildsAsSubMenu then inc(Result,Section.GetContainerIndex(true)); // add all siblings in front SiblingIndex:=0; while (Section[SiblingIndex]<>Self) do begin if Section[SiblingIndex].Visible then inc(Result,Section[SiblingIndex].Size); inc(SiblingIndex); end; // add separator if BehindSeparator and NeedTopSeparator then inc(Result); end; function TIDEMenuSection.GetChildContainerIndex(Index: integer): Integer; var i: Integer; begin if ChildsAsSubMenu then Result:=0 else Result:=GetContainerIndex(true); for i:=0 to Index-1 do inc(Result,Items[i].Size); end; function TIDEMenuSection.IndexOf(AnItem: TIDEMenuItem): Integer; begin Result:=FItems.IndexOf(AnItem); end; function TIDEMenuSection.IndexByName(const AName: string): Integer; begin Result:=Count-1; while (Result>=0) and (CompareText(AName,Items[Result].Name)<>0) do dec(Result); end; function TIDEMenuSection.FindByName(const AName: string): TIDEMenuItem; var i: LongInt; begin i:=IndexByName(AName); if i>=0 then Result:=Items[i] else Result:=nil; end; function TIDEMenuSection.CreateUniqueName(const AName: string): string; begin Result:=AName; if IndexByName(Result)<0 then exit; Result:=CreateFirstIdentifier(Result); while IndexByName(Result)>=0 do Result:=CreateNextIdentifier(Result); end; function TIDEMenuSection.VisibleActive: boolean; begin Result:=Visible and (VisibleCount>0); end; function TIDEMenuSection.Size: integer; begin if ChildsAsSubMenu then Result:=1 else Result:=inherited Size; end; procedure TIDEMenuSection.BeginUpdate; begin inc(FUpdateLock); end; procedure TIDEMenuSection.EndUpdate; begin if FUpdateLock<=0 then RaiseGDBException('TIDEMenuSection.EndUpdate'); dec(FUpdateLock); if FUpdateLock=0 then UpdateMenuStructure; end; procedure TIDEMenuSection.RemoveAllHandlersOfObject(AnObject: TObject); var HandlerType: TIDEMenuSectionHandlerType; begin for HandlerType:=Low(TIDEMenuSectionHandlerType) to High(TIDEMenuSectionHandlerType) do FSectionHandlers[HandlerType].RemoveAllMethodsOfObject(AnObject); end; procedure TIDEMenuSection.AddHandlerOnShow(const OnShowEvent: TNotifyEvent; AsLast: boolean); begin AddHandler(imshtOnShow,TMethod(OnShowEvent),AsLast); end; procedure TIDEMenuSection.RemoveHandlerOnShow(const OnShowEvent: TNotifyEvent); begin RemoveHandler(imshtOnShow,TMethod(OnShowEvent)); end; procedure TIDEMenuSection.WriteDebugReport(const Prefix: string; MenuItemDebugReport: boolean); var i: Integer; begin debugln([Prefix,'SectionIndex=',SectionIndex,' Name="',DbgStr(Name),'"', ' VisibleActive=',VisibleActive, ' ChildsAsSubMenu=',ChildsAsSubMenu, ' ContainerIndex=',GetContainerIndex(false), ' NeedSep:Top=',NeedTopSeparator,',Bottom=',NeedBottomSeparator, ' Size=',dbgs(Size)]); for i:=0 to Count-1 do Items[i].WriteDebugReport(Prefix+' ',false); if MenuItemDebugReport and (MenuItem<>nil) then MenuItem.WriteDebugReport(Prefix); end; procedure TIDEMenuSection.ConsistencyCheck; var i: Integer; Item: TIDEMenuItem; RealVisibleCount: Integer; begin inherited ConsistencyCheck; RealVisibleCount:=0; for i:=0 to Count-1 do begin Item:=Items[i]; Item.ConsistencyCheck; if Item.SectionIndex<>i then RaiseGDBException(''); if Item.VisibleActive then inc(RealVisibleCount); end; if RealVisibleCount<>VisibleCount then RaiseGDBException(''); end; function TIDEMenuSection.GetItems(Index: Integer): TIDEMenuItem; begin Result:=TIDEMenuItem(FItems[Index]); end; procedure TIDEMenuSection.SeparatorDestroy(Sender: TObject); begin if Sender=FTopSeparator then FTopSeparator:=nil; if Sender=FBottomSeparator then FBottomSeparator:=nil; end; procedure TIDEMenuSection.FreeSeparators; begin if FNeedTopSeparator then begin UpdateSize(-1); FNeedTopSeparator:=false; end; FreeAndNil(FTopSeparator); if FNeedBottomSeparator then begin UpdateSize(-1); FNeedBottomSeparator:=false; end; FreeAndNil(FBottomSeparator); end; procedure TIDEMenuSection.AddHandler(HandlerType: TIDEMenuSectionHandlerType; const AMethod: TMethod; AsLast: boolean); begin if FSectionHandlers[HandlerType]=nil then FSectionHandlers[HandlerType]:=TMethodList.Create; FSectionHandlers[HandlerType].Add(AMethod,AsLast); end; procedure TIDEMenuSection.RemoveHandler( HandlerType: TIDEMenuSectionHandlerType; const AMethod: TMethod); begin FSectionHandlers[HandlerType].Remove(AMethod); end; procedure TIDEMenuSection.MenuItemClick(Sender: TObject); begin inherited MenuItemClick(Sender); NotifySubSectionOnShow(Sender); end; procedure TIDEMenuSection.SetMenuItem(const AValue: TMenuItem); begin if MenuItem=AValue then exit; inherited SetMenuItem(AValue); Invalidate(0,Count-1); {$IFDEF VerboseMenuIntf} debugln('TIDEMenuSection.SetMenuItem Name="',Name,'"'); {$ENDIF} UpdateMenuStructure; end; procedure TIDEMenuSection.SetChildsAsSubMenu(const AValue: boolean); begin if FChildsAsSubMenu=AValue then exit; FChildsAsSubMenu:=AValue; ClearMenuItems; if Section<>nil then begin Section.Invalidate(SectionIndex,SectionIndex); {$IFDEF VerboseMenuIntf} debugln('TIDEMenuSection.SetChildsAsSubMenu Name="',Name,'"'); {$ENDIF} if AValue then Section.UpdateSize(1) else Section.UpdateSize(-1); Section.UpdateMenuStructure; end; end; { TIDEMenuCommand } procedure TIDEMenuCommand.CommandChanged(Sender: TObject); begin //DebugLn('TIDEMenuCommand.CommandChanged ',Name); if MenuItem<>nil then if FCommand<>nil then begin MenuItem.ShortCut:=KeyToShortCut(FCommand.ShortcutA.Key1,FCommand.ShortcutA.Shift1); MenuItem.ShortCutKey2:=KeyToShortCut(FCommand.ShortcutA.Key2,FCommand.ShortcutA.Shift2); end else begin MenuItem.ShortCut:=0; MenuItem.ShortCutKey2:=0; end; end; procedure TIDEMenuCommand.MenuItemClick(Sender: TObject); begin inherited MenuItemClick(Sender); // do not execute if something is already executed //debugln(['TIDEMenuCommand.MenuItemClick ',Assigned(OnClick),' ',Assigned(OnClickProc),' ',Assigned(Command),' ',(Command<>nil) and (Command.OnExecuteProc<>nil)]); if (not Assigned(OnClick)) and (not Assigned(OnClickProc)) and Assigned(Command) then Command.Execute(Sender); end; procedure TIDEMenuCommand.SetAutoCheck(const AValue: boolean); begin if FAutoCheck=AValue then exit; FAutoCheck:=AValue; if MenuItem<>nil then MenuItem.AutoCheck:=AutoCheck; end; procedure TIDEMenuCommand.SetChecked(const AValue: Boolean); begin if FChecked=AValue then exit; FChecked:=AValue; if MenuItem<>nil then MenuItem.Checked:=Checked; end; procedure TIDEMenuCommand.SetDefault(const AValue: Boolean); begin if FDefault=AValue then exit; FDefault:=AValue; if MenuItem<>nil then MenuItem.Default:=Default; end; procedure TIDEMenuCommand.SetGroupIndex(const AValue: Byte); begin if FGroupIndex=AValue then exit; FGroupIndex:=AValue; if MenuItem<>nil then MenuItem.GroupIndex:=GroupIndex; end; procedure TIDEMenuCommand.SetRadioItem(const AValue: Boolean); begin if FRadioItem=AValue then exit; FRadioItem:=AValue; if MenuItem<>nil then MenuItem.RadioItem:=RadioItem; end; procedure TIDEMenuCommand.SetRightJustify(const AValue: boolean); begin if FRightJustify=AValue then exit; FRightJustify:=AValue; if MenuItem<>nil then MenuItem.RightJustify:=RightJustify; end; procedure TIDEMenuCommand.SetShowAlwaysCheckable(const AValue: boolean); begin if FShowAlwaysCheckable=AValue then exit; FShowAlwaysCheckable:=AValue; if MenuItem<>nil then MenuItem.ShowAlwaysCheckable:=ShowAlwaysCheckable; end; procedure TIDEMenuCommand.SetCommand(const AValue: TIDECommand); begin if FCommand = AValue then Exit; if FCommand <> nil then begin //DebugLn('TIDEMenuCommand.SetCommand OLD ',ShortCutToText(FCommand.AsShortCut),' FCommand.Name=',FCommand.Name,' Name=',Name,' FCommand=',dbgs(Pointer(FCommand))); FCommand.OnChange := nil; if FCommand.OnExecute=OnClick then FCommand.OnExecute:=nil; if FCommand.OnExecuteProc=OnClickProc then FCommand.OnExecuteProc:=nil; end; FCommand := AValue; if FCommand <> nil then begin if FCommand.OnExecute = nil then FCommand.OnExecute := OnClick; if FCommand.OnExecuteProc = nil then FCommand.OnExecuteProc := OnClickProc; FCommand.OnChange := @CommandChanged; //DebugLn('TIDEMenuCommand.SetCommand NEW ',ShortCutToText(FCommand.AsShortCut),' FCommand.Name=',FCommand.Name,' Name=',Name,' FCommand=',dbgs(Pointer(FCommand))); end; CommandChanged(nil); end; procedure TIDEMenuCommand.SetMenuItem(const AValue: TMenuItem); begin inherited SetMenuItem(AValue); if MenuItem<>nil then begin MenuItem.AutoCheck:=AutoCheck; MenuItem.Checked:=Checked; MenuItem.Default:=Default; MenuItem.RadioItem:=RadioItem; MenuItem.RightJustify:=RightJustify; MenuItem.ShowAlwaysCheckable:=ShowAlwaysCheckable; if FCommand<>nil then begin MenuItem.ShortCut:=KeyToShortCut(FCommand.ShortcutA.Key1,FCommand.ShortcutA.Shift1); MenuItem.ShortCutKey2:=KeyToShortCut(FCommand.ShortcutA.Key2,FCommand.ShortcutA.Shift2); end else begin MenuItem.ShortCut:=0; MenuItem.ShortCutKey2:=0; end; MenuItem.GroupIndex:=GroupIndex; end; end; procedure TIDEMenuCommand.SetOnClickMethod(const AValue: TNotifyEvent); var OldClick: TNotifyEvent; begin OldClick:=OnClick; inherited SetOnClickMethod(AValue); if Assigned(Command) and (Command.OnExecute = OldClick) then Command.OnExecute := OnClick; end; procedure TIDEMenuCommand.SetOnClickProc(const AValue: TNotifyProcedure); var OldClick: TNotifyProcedure; begin OldClick:=OnClickProc; inherited SetOnClickProc(AValue); if Assigned(Command) and (Command.OnExecuteProc = OldClick) then Command.OnExecuteProc := OnClickProc; end; { TIDEMenuRoots } function TIDEMenuRoots.GetItems(Index: integer): TIDEMenuSection; begin Result:=TIDEMenuSection(FItems[Index]); end; constructor TIDEMenuRoots.Create; begin FItems:=TFPList.Create; end; destructor TIDEMenuRoots.Destroy; begin Clear; FItems.Free; inherited Destroy; end; procedure TIDEMenuRoots.RegisterMenuRoot(Section: TIDEMenuSection); begin Section.FName:=CreateUniqueName(Section.Name); FItems.Add(Section); end; procedure TIDEMenuRoots.UnregisterMenuRoot(Section: TIDEMenuSection); begin FItems.Remove(Section); end; function TIDEMenuRoots.Count: Integer; begin Result:=FItems.Count; end; procedure TIDEMenuRoots.Clear; var i: Integer; begin for i:=FItems.Count-1 downto 0 do begin Items[i].ClearMenuItems; Items[i].Free; end; FItems.Clear; end; procedure TIDEMenuRoots.Delete(Index: Integer); var OldItem: TIDEMenuSection; begin OldItem:=Items[Index]; UnregisterMenuRoot(OldItem); OldItem.Free; end; function TIDEMenuRoots.IndexByName(const Name: string): Integer; begin Result:=Count-1; while (Result>=0) and (CompareText(Name,Items[Result].Name)<>0) do dec(Result); end; function TIDEMenuRoots.FindByName(const Name: string): TIDEMenuSection; var i: LongInt; begin i:=IndexByName(Name); if i>=0 then Result:=Items[i] else Result:=nil; end; function TIDEMenuRoots.CreateUniqueName(const Name: string): string; begin Result:=Name; if IndexByName(Result)<0 then exit; Result:=CreateFirstIdentifier(Result); while IndexByName(Result)>=0 do Result:=CreateNextIdentifier(Result); end; function TIDEMenuRoots.FindByPath(const Path: string; ErrorOnNotFound: boolean): TIDEMenuItem; var StartPos: Integer; EndPos: LongInt; Name: String; begin Result:=nil; StartPos:=1; while StartPos<=length(Path) do begin EndPos:=StartPos; while (EndPos<=length(Path)) and (Path[EndPos]<>'/') do inc(EndPos); if EndPos>StartPos then begin Name:=copy(Path,StartPos,EndPos-StartPos); if Result=nil then // search root Result:=FindByName(Name) else if Result is TIDEMenuSection then // search child Result:=TIDEMenuSection(Result).FindByName(Name) else // path too long -> we are already at a leaf Result:=nil; if Result=nil then break; end; StartPos:=EndPos+1; end; if Result=nil then begin if ErrorOnNotFound then begin raise Exception.Create('IDE Menu path not found: '+Path); end; end; end; end.