paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-05 01:41:35 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDEIntf: TIDEMenuCommand now connects events to commands automatically

Browse Source 
git-svn-id: trunk@17875 -
This commit is contained in:
mattias 2008-12-21 09:27:27 +00:00
parent a04b1b2626
commit 9679ef7abb
1 changed files with 53 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
ideintf/menuintf.pas
View File

@ -72,6 +72,8 @@ type
procedure SetImageIndex(const AValue: Integer); virtual; procedure SetImageIndex(const AValue: Integer); virtual;
procedure SetMenuItem(const AValue: TMenuItem); virtual; procedure SetMenuItem(const AValue: TMenuItem); virtual;
procedure SetName(const AValue: string); virtual; procedure SetName(const AValue: string); virtual;
procedure SetOnClickMethod(const AValue: TNotifyEvent); virtual;
procedure SetOnClickProc(const AValue: TNotifyProcedure); virtual;
procedure SetSection(const AValue: TIDEMenuSection); virtual; procedure SetSection(const AValue: TIDEMenuSection); virtual;
procedure SetVisible(const AValue: Boolean); virtual; procedure SetVisible(const AValue: Boolean); virtual;
procedure ClearMenuItems; virtual; procedure ClearMenuItems; virtual;
@ -95,8 +97,8 @@ type
property Hint: String read GetHint write SetHint; property Hint: String read GetHint write SetHint;
property ImageIndex: Integer read FImageIndex write SetImageIndex; property ImageIndex: Integer read FImageIndex write SetImageIndex;
property Visible: Boolean read FVisible write SetVisible; property Visible: Boolean read FVisible write SetVisible;
property OnClick: TNotifyEvent read FOnClickMethod write FOnClickMethod; property OnClick: TNotifyEvent read FOnClickMethod write SetOnClickMethod;
property OnClickProc: TNotifyProcedure read FOnClickProc write FOnClickProc; property OnClickProc: TNotifyProcedure read FOnClickProc write SetOnClickProc;
property Caption: string read GetCaption write SetCaption; property Caption: string read GetCaption write SetCaption;
property Section: TIDEMenuSection read FSection write SetSection; property Section: TIDEMenuSection read FSection write SetSection;
property Enabled: Boolean read FEnabled write SetEnabled; property Enabled: Boolean read FEnabled write SetEnabled;
@ -231,6 +233,8 @@ type
procedure SetShowAlwaysCheckable(const AValue: boolean); virtual; procedure SetShowAlwaysCheckable(const AValue: boolean); virtual;
procedure SetCommand(const AValue: TIDECommand); virtual; procedure SetCommand(const AValue: TIDECommand); virtual;
procedure SetMenuItem(const AValue: TMenuItem); override; procedure SetMenuItem(const AValue: TMenuItem); override;
procedure SetOnClickMethod(const AValue: TNotifyEvent); override;
procedure SetOnClickProc(const AValue: TNotifyProcedure); override;
procedure SetResourceName(const AValue: String); procedure SetResourceName(const AValue: String);
procedure CommandChanged(Sender: TObject); procedure CommandChanged(Sender: TObject);
public public
@ -537,6 +541,16 @@ begin
if MenuItem<>nil then MenuItem.Bitmap:=Bitmap; if MenuItem<>nil then MenuItem.Bitmap:=Bitmap;
end; end;
procedure TIDEMenuItem.SetOnClickProc(const AValue: TNotifyProcedure);
begin
FOnClickProc := AValue;
end;
procedure TIDEMenuItem.SetOnClickMethod(const AValue: TNotifyEvent);
begin
FOnClickMethod := AValue;
end;
procedure TIDEMenuItem.SetEnabled(const AValue: Boolean); procedure TIDEMenuItem.SetEnabled(const AValue: Boolean);
begin begin
if FEnabled=AValue then exit; if FEnabled=AValue then exit;
@ -1557,14 +1571,25 @@ end;
procedure TIDEMenuCommand.SetCommand(const AValue: TIDECommand); procedure TIDEMenuCommand.SetCommand(const AValue: TIDECommand);
begin begin
if FCommand=AValue then exit; if FCommand = AValue then
if FCommand<>nil then begin Exit;
if FCommand <> nil then
begin
//DebugLn('TIDEMenuCommand.SetCommand OLD ',ShortCutToText(FCommand.AsShortCut),' FCommand.Name=',FCommand.Name,' Name=',Name,' FCommand=',dbgs(Pointer(FCommand))); //DebugLn('TIDEMenuCommand.SetCommand OLD ',ShortCutToText(FCommand.AsShortCut),' FCommand.Name=',FCommand.Name,' Name=',Name,' FCommand=',dbgs(Pointer(FCommand)));
FCommand.OnChange:=nil; FCommand.OnChange := nil;
if FCommand.OnExecute=OnClick then
FCommand.OnExecute:=nil;
if FCommand.OnExecuteProc=OnClickProc then
FCommand.OnExecuteProc:=nil;
end; end;
FCommand:=AValue; FCommand := AValue;
if FCommand<>nil then begin if FCommand <> nil then
FCommand.OnChange:=@CommandChanged; 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))); //DebugLn('TIDEMenuCommand.SetCommand NEW ',ShortCutToText(FCommand.AsShortCut),' FCommand.Name=',FCommand.Name,' Name=',Name,' FCommand=',dbgs(Pointer(FCommand)));
end; end;
CommandChanged(nil); CommandChanged(nil);
@ -1590,6 +1615,26 @@ begin
end; end;
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 } { TIDEMenuRoots }
function TIDEMenuRoots.GetItems(Index: integer): TIDEMenuSection; function TIDEMenuRoots.GetItems(Index: integer): TIDEMenuSection;