paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-05 15:58:07 +02:00
Code Issues Packages Projects Releases Wiki Activity

TApplicationProperties: add OnActionExecute (Issue #36816) and OnActionUpdate.

Browse Source
This commit is contained in:
Bart 2023-02-11 18:40:55 +01:00
parent dddd7c85cd
commit 5160adcacc
3 changed files with 74 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
lcl/forms.pp
View File

@ -1332,7 +1332,9 @@ type
ahtHelp,
ahtHint,
ahtShowHint,
ahtGetMainFormHandle
ahtGetMainFormHandle,
ahtActionExecute,
ahtActionUpdate
);
PAsyncCallQueueItem = ^TAsyncCallQueueItem;
@ -1615,6 +1617,11 @@ type
procedure RemoveOnShowHintHandler(Handler: TShowHintEvent);
procedure AddOnGetMainFormHandleHandler(Handler: TGetHandleEvent; AsFirst: Boolean = True);
procedure RemoveOnGetMainFormHandleHandler(Handler: TGetHandleEvent);
procedure AddOnActionExecuteHandler(Handler: TActionEvent; AsFirst: Boolean = True);
procedure RemoveOnActionExecuteHandler(Handler: TActionEvent);
procedure AddOnActionUpdateHandler(Handler: TActionEvent; AsFirst: Boolean = True);
procedure RemoveOnActionUpdateHandler(Handler: TActionEvent);
procedure RemoveAllHandlersOfObject(AnObject: TObject); virtual;
procedure DoBeforeMouseMessage(CurMouseControl: TControl);
function IsShortcut(var Message: TLMKey): Boolean;
@ -1746,6 +1753,8 @@ type
FOnQueryEndSession : TQueryEndSessionEvent;
FOnMinimize : TNotifyEvent;
FOnRestore : TNotifyEvent;
FOnActionExecute: TActionEvent;
FOnActionUpdate: TActionEvent;
procedure SetExceptionDialog(AValue: TApplicationExceptionDlg);
protected
procedure SetCaptureExceptions(const AValue : Boolean);
@ -1779,6 +1788,8 @@ type
procedure SetOnHint(const AValue : TNotifyEvent);
procedure SetOnShowHint(const AValue : TShowHintEvent);
procedure SetOnUserInput(const AValue : TOnUserInputEvent);
procedure SetOnActionExecute(const AValue : TActionEvent);
procedure SetOnActionUpdate(const AValue : TActionEvent);
public
constructor Create(AOwner: TComponent); Override;
destructor Destroy; override;
@ -1817,6 +1828,8 @@ type
property OnHint: TNotifyEvent read FOnHint write SetOnHint;
property OnShowHint: TShowHintEvent read FOnShowHint write SetOnShowHint;
property OnUserInput: TOnUserInputEvent read FOnUserInput write SetOnUserInput;
property OnActionExecute: TActionEvent read FOnActionExecute write SetOnActionExecute;
property OnActionUpdate: TActionEvent read FOnActionUpdate write SetOnActionUpdate;
end;

38
lcl/include/application.inc
View File

@ -1931,6 +1931,28 @@ begin
RemoveHandler(ahtGetMainFormHandle,TMethod(Handler));
end;
procedure TApplication.AddOnActionExecuteHandler(Handler: TActionEvent;
AsFirst: Boolean);
begin
AddHandler(ahtActionExecute, TMethod(Handler), AsFirst);
end;
procedure TApplication.RemoveOnActionExecuteHandler(Handler: TActionEvent);
begin
RemoveHandler(ahtActionExecute, TMethod(Handler));
end;
procedure TApplication.AddOnActionUpdateHandler(Handler: TActionEvent;
AsFirst: Boolean);
begin
AddHandler(ahtActionUpdate, TMethod(Handler), AsFirst);
end;
procedure TApplication.RemoveOnActionUpdateHandler(Handler: TActionEvent);
begin
RemoveHandler(ahtActionUpdate, TMethod(Handler));
end;
procedure TApplication.RemoveAllHandlersOfObject(AnObject: TObject);
var
HandlerType: TApplicationHandlerType;
@ -2385,15 +2407,31 @@ begin
end;
function TApplication.ExecuteAction(ExeAction: TBasicAction): Boolean;
var
i: Integer;
begin
Result := False;
if Assigned(FOnActionExecute) then FOnActionExecute(ExeAction, Result);
if Result then Exit;
i:=FApplicationHandlers[ahtActionExecute].Count;
while FApplicationHandlers[ahtActionExecute].NextDownIndex(i) do begin
TActionEvent(FApplicationHandlers[ahtActionExecute][i])(ExeAction,Result);
if Result then exit;
end;
end;
function TApplication.UpdateAction(TheAction: TBasicAction): Boolean;
var
i: Integer;
begin
Result := False;
if Assigned(FOnActionUpdate) then FOnActionUpdate(TheAction, Result);
if Result then Exit;
i:=FApplicationHandlers[ahtActionUpdate].Count;
while FApplicationHandlers[ahtActionUpdate].NextDownIndex(i) do begin
TActionEvent(FApplicationHandlers[ahtActionUpdate][i])(TheAction,Result);
if Result then exit;
end;
end;
function TApplication.IsRTLLang(const ALang: String): Boolean;

22
lcl/include/applicationproperties.inc
View File

@ -315,6 +315,28 @@ begin
Application.AddOnUserInputHandler(FOnUserInput);
end;
procedure TApplicationProperties.SetOnActionExecute(const AValue: TActionEvent);
begin
if (TMethod(FOnActionExecute).Data = TMethod(AValue).Data) and
(TMethod(FOnActionExecute).Code = TMethod(AValue).Code) then exit;
if not (csDesigning in ComponentState) and Assigned(FOnActionExecute) then
Application.RemoveOnActionExecuteHandler(FOnActionExecute);
FOnActionExecute := AValue;
if not (csDesigning in ComponentState) and Assigned(FOnActionExecute) then
Application.AddOnActionExecuteHandler(FOnActionExecute);
end;
procedure TApplicationProperties.SetOnActionUpdate(const AValue: TActionEvent);
begin
if (TMethod(FOnActionUpdate).Data = TMethod(AValue).Data) and
(TMethod(FOnActionUpdate).Code = TMethod(AValue).Code) then exit;
if not (csDesigning in ComponentState) and Assigned(FOnActionUpdate) then
Application.RemoveOnActionUpdateHandler(FOnActionUpdate);
FOnActionUpdate := AValue;
if not (csDesigning in ComponentState) and Assigned(FOnActionUpdate) then
Application.AddOnActionUpdateHandler(FOnActionUpdate);
end;
constructor TApplicationProperties.Create(AOwner: TComponent);
begin
inherited Create(AOwner);