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

LCL: TApplicationProperties now uses handler lists instead of global events

Browse Source 
git-svn-id: trunk@13358 -
This commit is contained in:
mattias 2007-12-17 19:31:44 +00:00
parent b0034a4a02
commit 30a0f52908
3 changed files with 274 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
lcl/forms.pp
View File

@ -862,7 +862,7 @@ type
Result: LRESULT;
end;
TAppHintTimerType = (ahtNone, ahtShowHint, ahtHideHint, ahtReshowHint);
TAppHintTimerType = (ahttNone, ahttShowHint, ahttHideHint, ahttReshowHint);
TShowHintEvent = procedure (var HintStr: string; var CanShow: Boolean;
var HintInfo: THintInfo) of object;
@ -899,7 +899,16 @@ type
ahtKeyDownAfter, // after interface and LCL
ahtActivate,
ahtDeactivate,
ahtUserInput
ahtUserInput,
ahtException,
ahtEndSession,
ahtQueryEndSession,
ahtMinimize,
ahtRestore,
ahtDropFiles,
ahtHelp,
ahtHint,
ahtShowHint
);
PAsyncCallQueueItem = ^TAsyncCallQueueItem;
@ -1076,6 +1085,24 @@ type
procedure RemoveOnActivateHandler(Handler: TNotifyEvent);
procedure AddOnDeactivateHandler(Handler: TNotifyEvent; AsLast: Boolean=true);
procedure RemoveOnDeactivateHandler(Handler: TNotifyEvent);
procedure AddOnExceptionHandler(Handler: TExceptionEvent; AsLast: Boolean=true);
procedure RemoveOnExceptionHandler(Handler: TExceptionEvent);
procedure AddOnEndSessionHandler(Handler: TNotifyEvent; AsLast: Boolean=true);
procedure RemoveOnEndSessionHandler(Handler: TNotifyEvent);
procedure AddOnQueryEndSessionHandler(Handler: TQueryEndSessionEvent; AsLast: Boolean=true);
procedure RemoveOnQueryEndSessionHandler(Handler: TQueryEndSessionEvent);
procedure AddOnMinimizeHandler(Handler: TNotifyEvent; AsLast: Boolean=true);
procedure RemoveOnMinimizeHandler(Handler: TNotifyEvent);
procedure AddOnRestoreHandler(Handler: TNotifyEvent; AsLast: Boolean=true);
procedure RemoveOnRestoreHandler(Handler: TNotifyEvent);
procedure AddOnDropFilesHandler(Handler: TDropFilesEvent; AsLast: Boolean=true);
procedure RemoveOnDropFilesHandler(Handler: TDropFilesEvent);
procedure AddOnHelpHandler(Handler: THelpEvent; AsLast: Boolean=true);
procedure RemoveOnHelpHandler(Handler: THelpEvent);
procedure AddOnHintHandler(Handler: TNotifyEvent; AsLast: Boolean=true);
procedure RemoveOnHintHandler(Handler: TNotifyEvent);
procedure AddOnShowHintHandler(Handler: TShowHintEvent; AsLast: Boolean=true);
procedure RemoveOnShowHintHandler(Handler: TShowHintEvent);
procedure RemoveAllHandlersOfObject(AnObject: TObject); virtual;
procedure DoBeforeMouseMessage(CurMouseControl: TControl);
function IsShortcut(var Message: TLMKey): boolean;

161
lcl/include/application.inc
View File

@ -395,6 +395,7 @@ function TApplication.InvokeHelp(Command: Word; Data: Longint): Boolean;
var
CallHelp: Boolean;
ActiveForm: TCustomForm;
i: LongInt;
begin
Result := False;
CallHelp := True;
@ -403,8 +404,12 @@ begin
{ let existing hooks get called, if any. }
if Assigned(ActiveForm) and Assigned(ActiveForm.FOnHelp) then
Result := ActiveForm.FOnHelp(Command, Data, CallHelp)
else if Assigned(FOnHelp) then
else if Assigned(FOnHelp) then begin
Result := FOnHelp(Command, Data, CallHelp);
i:=FApplicationHandlers[ahtHelp].Count;
while (not Result) and (FApplicationHandlers[ahtHelp].NextDownIndex(i)) do
Result:=THelpEvent(FApplicationHandlers[ahtHelp][i])(Command, Data, CallHelp);
end;
if CallHelp then begin
if Assigned(ActiveForm) and ActiveForm.HandleAllocated
@ -525,7 +530,7 @@ procedure TApplication.StopHintTimer;
begin
if FHintTimer <> nil then
FHintTimer.Enabled := false;
FHintTimerType := ahtNone;
FHintTimerType := ahttNone;
end;
{------------------------------------------------------------------------------
@ -596,15 +601,15 @@ begin
{$ifdef DebugHintWindow}
DebugLn('TApplication.DoOnMouseMove Info.ControlHasHint=',dbgs(Info.ControlHasHint),' Type=',dbgs(ord(FHintTimerType)),' FHintControl=',DbgSName(FHintControl),' Info.Control=',DbgSName(Info.Control));
{$endif}
if (FHintControl <> Info.Control) or (not (FHintTimerType in [ahtShowHint])) then
if (FHintControl <> Info.Control) or (not (FHintTimerType in [ahttShowHint])) then
begin
if Info.ControlHasHint then
begin
FHintControl := Info.Control;
case FHintTimerType of
ahtNone, ahtShowHint:
StartHintTimer(HintPause, ahtShowHint);
ahtHideHint:
ahttNone, ahttShowHint:
StartHintTimer(HintPause, ahttShowHint);
ahttHideHint:
ShowHintWindow(Info);
else
HideHint;
@ -630,6 +635,7 @@ var
CanShow: Boolean;
HintWinRect: TRect;
CurHeight: Integer;
i: LongInt;
begin
if not FShowHint or (FHintControl=nil) then
Exit;
@ -671,8 +677,13 @@ begin
or (not HintInfo.HintWindowClass.InheritsFrom(THintWindow)) then
HintInfo.HintWindowClass := HintWindowClass;
if CanShow and Assigned(FOnShowHint) then
i:=FApplicationHandlers[ahtShowHint].Count;
if CanShow
and (Assigned(FOnShowHint) or (i>0)) then begin
FOnShowHint(HintInfo.HintStr, CanShow, HintInfo);
while FApplicationHandlers[ahtShowHint].NextDownIndex(i) do
TShowHintEvent(FApplicationHandlers[ahtShowHint][i])(HintInfo.HintStr, CanShow, HintInfo);
end;
if CanShow and (FHintControl <> nil) and (HintInfo.HintStr <> '') then
begin
// create hint window
@ -719,7 +730,7 @@ begin
//debugln('TApplication.ShowHintWindow B HintWinRect=',dbgs(HintWinRect),' HintStr="',DbgStr(HintInfo.HintStr),'"');
FHintWindow.ActivateHint(HintWinRect,HintInfo.HintStr);
// start hide timer
StartHintTimer(HintHidePause,ahtHideHint);
StartHintTimer(HintHidePause,ahttHideHint);
end else
HideHint;
@ -766,7 +777,7 @@ begin
OldHintTimerType := FHintTimerType;
StopHintTimer;
case OldHintTimerType of
ahtShowHint:
ahttShowHint:
begin
Info := GetHintInfoAtMouse;
if Info.ControlHasHint then
@ -893,6 +904,8 @@ end;
------------------------------------------------------------------------------}
procedure TApplication.HandleException(Sender: TObject);
var
i: LongInt;
begin
if Self=nil then exit;
if AppHandlingException in FFlags then begin
@ -904,6 +917,7 @@ begin
Halt;
end;
Include(FFlags,AppHandlingException);
if StopOnException then
inherited Terminate;
if not (AppNoExceptionMessages in FFlags) then begin
@ -922,9 +936,13 @@ begin
// handle the exception
if ExceptObject is Exception then begin
if not (ExceptObject is EAbort) then
if Assigned(OnException) then
OnException(Sender, Exception(ExceptObject))
else
i:=FApplicationHandlers[ahtUserInput].Count;
if Assigned(OnException) or (i>0) then begin
if Assigned(OnException) then
OnException(Sender, Exception(ExceptObject));
while FApplicationHandlers[ahtException].NextDownIndex(i) do
TExceptionEvent(FApplicationHandlers[ahtException][i])(Self,Exception(ExceptObject));
end else
ShowException(Exception(ExceptObject));
end else
SysUtils.ShowException(ExceptObject, ExceptAddr);
@ -1150,9 +1168,10 @@ procedure TApplication.SetHint(const AValue: string);
begin
if FHint=AValue then exit;
FHint:=AValue;
if Assigned(FOnHint) then
FOnHint(Self)
else begin
if Assigned(FOnHint) or (FApplicationHandlers[ahtHint].Count>0) then begin
FOnHint(Self);
FApplicationHandlers[ahtHint].CallNotifyEvents(Self);
end else begin
// Send THintAction
with TCustomHintAction.Create(Self) do begin
Hint := FHint;
@ -1422,6 +1441,105 @@ begin
RemoveHandler(ahtDeactivate,TMethod(Handler));
end;
procedure TApplication.AddOnExceptionHandler(Handler: TExceptionEvent;
AsLast: Boolean);
begin
AddHandler(ahtException,TMethod(Handler),AsLast);
end;
procedure TApplication.RemoveOnExceptionHandler(Handler: TExceptionEvent);
begin
RemoveHandler(ahtException,TMethod(Handler));
end;
procedure TApplication.AddOnEndSessionHandler(Handler: TNotifyEvent;
AsLast: Boolean);
begin
AddHandler(ahtEndSession,TMethod(Handler),AsLast);
end;
procedure TApplication.RemoveOnEndSessionHandler(Handler: TNotifyEvent);
begin
RemoveHandler(ahtEndSession,TMethod(Handler));
end;
procedure TApplication.AddOnQueryEndSessionHandler(
Handler: TQueryEndSessionEvent; AsLast: Boolean);
begin
AddHandler(ahtQueryEndSession,TMethod(Handler),AsLast);
end;
procedure TApplication.RemoveOnQueryEndSessionHandler(
Handler: TQueryEndSessionEvent);
begin
RemoveHandler(ahtQueryEndSession,TMethod(Handler));
end;
procedure TApplication.AddOnMinimizeHandler(Handler: TNotifyEvent;
AsLast: Boolean);
begin
AddHandler(ahtMinimize,TMethod(Handler),AsLast);
end;
procedure TApplication.RemoveOnMinimizeHandler(Handler: TNotifyEvent);
begin
RemoveHandler(ahtMinimize,TMethod(Handler));
end;
procedure TApplication.AddOnRestoreHandler(Handler: TNotifyEvent;
AsLast: Boolean);
begin
AddHandler(ahtRestore,TMethod(Handler),AsLast);
end;
procedure TApplication.RemoveOnRestoreHandler(Handler: TNotifyEvent);
begin
RemoveHandler(ahtRestore,TMethod(Handler));
end;
procedure TApplication.AddOnDropFilesHandler(Handler: TDropFilesEvent;
AsLast: Boolean);
begin
AddHandler(ahtDropFiles,TMethod(Handler),AsLast);
end;
procedure TApplication.RemoveOnDropFilesHandler(Handler: TDropFilesEvent);
begin
RemoveHandler(ahtDropFiles,TMethod(Handler));
end;
procedure TApplication.AddOnHelpHandler(Handler: THelpEvent; AsLast: Boolean);
begin
AddHandler(ahtHelp,TMethod(Handler),AsLast);
end;
procedure TApplication.RemoveOnHelpHandler(Handler: THelpEvent);
begin
RemoveHandler(ahtHelp,TMethod(Handler));
end;
procedure TApplication.AddOnHintHandler(Handler: TNotifyEvent; AsLast: Boolean
);
begin
AddHandler(ahtHint,TMethod(Handler),AsLast);
end;
procedure TApplication.RemoveOnHintHandler(Handler: TNotifyEvent);
begin
RemoveHandler(ahtHint,TMethod(Handler));
end;
procedure TApplication.AddOnShowHintHandler(Handler: TShowHintEvent;
AsLast: Boolean);
begin
AddHandler(ahtShowHint,TMethod(Handler),AsLast);
end;
procedure TApplication.RemoveOnShowHintHandler(Handler: TShowHintEvent);
begin
RemoveHandler(ahtShowHint,TMethod(Handler));
end;
procedure TApplication.RemoveAllHandlersOfObject(AnObject: TObject);
var
HandlerType: TApplicationHandlerType;
@ -1437,14 +1555,20 @@ end;
procedure TApplication.IntfEndSession;
begin
if Assigned(FOnEndSession) then FOnEndSession(Self);
FApplicationHandlers[ahtEndSession].CallNotifyEvents(Self);
end;
{------------------------------------------------------------------------------
procedure TApplication.IntfQueryEndSession(var Cancel : Boolean);
------------------------------------------------------------------------------}
procedure TApplication.IntfQueryEndSession(var Cancel : Boolean);
var
i: LongInt;
begin
if Assigned(FOnQueryEndSession) then FOnQueryEndSession(Cancel);
i:=FApplicationHandlers[ahtQueryEndSession].Count;
while FApplicationHandlers[ahtQueryEndSession].NextDownIndex(i) do
TQueryEndSessionEvent(FApplicationHandlers[ahtQueryEndSession][i])(Cancel);
end;
{------------------------------------------------------------------------------
@ -1453,6 +1577,7 @@ end;
procedure TApplication.IntfAppMinimize;
begin
if Assigned(FOnMinimize) then FOnMinimize(Self);
FApplicationHandlers[ahtMinimize].CallNotifyEvents(Self);
end;
{------------------------------------------------------------------------------
@ -1461,6 +1586,7 @@ end;
procedure TApplication.IntfAppRestore;
begin
if Assigned(FOnRestore) then FOnRestore(Self);
FApplicationHandlers[ahtRestore].CallNotifyEvents(Self);
end;
{------------------------------------------------------------------------------
@ -1471,8 +1597,13 @@ end;
This function is called by the interface.
------------------------------------------------------------------------------}
procedure TApplication.IntfDropFiles(const FileNames: array of String);
var
i: LongInt;
begin
if Assigned(FOnDropFiles) then FOnDropFiles(Self, FileNames);
i:=FApplicationHandlers[ahtDropFiles].Count;
while FApplicationHandlers[ahtDropFiles].NextDownIndex(i) do
TDropFilesEvent(FApplicationHandlers[ahtDropFiles][i])(Self,Filenames);
end;
{------------------------------------------------------------------------------

157
lcl/include/applicationproperties.inc
View File

@ -107,107 +107,167 @@ end;
Procedure TApplicationProperties.SetOnException(Const AValue : TExceptionEvent);
begin
if (TMethod(FOnException).Data=TMethod(AValue).Data)
and (TMethod(FOnException).Code=TMethod(AValue).Code) then exit;
if not (csDesigning in ComponentState)
and Assigned(FOnException) then
Application.RemoveOnExceptionHandler(FOnException);
FOnException := AValue;
If not (csDesigning in ComponentState) then
Application.OnException := AValue;
if not (csDesigning in ComponentState)
and Assigned(FOnException) then
Application.AddOnExceptionHandler(FOnException);
end;
Procedure TApplicationProperties.SetOnIdle(Const AValue : TIdleEvent);
begin
if (TMethod(FOnIdle).Data=TMethod(AValue).Data)
and (TMethod(FOnIdle).Code=TMethod(AValue).Code) then exit;
if not (csDesigning in ComponentState)
and Assigned(FOnIdle) then
Application.RemoveOnIdleHandler(FOnIdle);
FOnIdle := AValue;
If not (csDesigning in ComponentState) then
Application.OnIdle := AValue;
if not (csDesigning in ComponentState)
and Assigned(FOnIdle) then
Application.AddOnIdleHandler(FOnIdle);
end;
Procedure TApplicationProperties.SetOnIdleEnd(Const AValue : TNotifyEvent);
begin
if (TMethod(FOnIdleEnd).Data=TMethod(AValue).Data)
and (TMethod(FOnIdleEnd).Code=TMethod(AValue).Code) then exit;
if not (csDesigning in ComponentState)
and Assigned(FOnIdleEnd) then
Application.RemoveOnIdleEndHandler(FOnIdleEnd);
FOnIdleEnd := AValue;
If not (csDesigning in ComponentState) then
Application.OnIdleEnd := AValue;
if not (csDesigning in ComponentState)
and Assigned(FOnIdleEnd) then
Application.AddOnIdleEndHandler(FOnIdleEnd);
end;
Procedure TApplicationProperties.SetOnEndSession(Const AValue : TNotifyEvent);
begin
if (TMethod(FOnEndSession).Data=TMethod(AValue).Data)
and (TMethod(FOnEndSession).Code=TMethod(AValue).Code) then exit;
if not (csDesigning in ComponentState)
and Assigned(FOnEndSession) then
Application.RemoveOnEndSessionHandler(FOnEndSession);
FOnEndSession := AValue;
If not (csDesigning in ComponentState) then
Application.OnEndSession := AValue;
if not (csDesigning in ComponentState)
and Assigned(FOnEndSession) then
Application.AddOnEndSessionHandler(FOnEndSession);
end;
Procedure TApplicationProperties.SetOnQueryEndSession(Const AValue : TQueryEndSessionEvent);
begin
if (TMethod(FOnQueryEndSession).Data=TMethod(AValue).Data)
and (TMethod(FOnQueryEndSession).Code=TMethod(AValue).Code) then exit;
if not (csDesigning in ComponentState)
and Assigned(FOnQueryEndSession) then
Application.RemoveOnQueryEndSessionHandler(FOnQueryEndSession);
FOnQueryEndSession := AValue;
If not (csDesigning in ComponentState) then
Application.OnQueryEndSession := AValue;
if not (csDesigning in ComponentState)
and Assigned(FOnQueryEndSession) then
Application.AddOnQueryEndSessionHandler(FOnQueryEndSession);
end;
procedure TApplicationProperties.SetOnMinimize(const AValue: TNotifyEvent);
begin
if (TMethod(FOnMinimize).Data=TMethod(AValue).Data)
and (TMethod(FOnMinimize).Code=TMethod(AValue).Code) then exit;
if not (csDesigning in ComponentState)
and Assigned(FOnMinimize) then
Application.RemoveOnMinimizeHandler(FOnMinimize);
FOnMinimize := AValue;
If not (csDesigning in ComponentState) then
Application.OnMinimize := AValue;
if not (csDesigning in ComponentState)
and Assigned(FOnMinimize) then
Application.AddOnMinimizeHandler(FOnMinimize);
end;
procedure TApplicationProperties.SetOnRestore(const AValue: TNotifyEvent);
begin
if (TMethod(FOnRestore).Data=TMethod(AValue).Data)
and (TMethod(FOnRestore).Code=TMethod(AValue).Code) then exit;
if not (csDesigning in ComponentState)
and Assigned(FOnRestore) then
Application.RemoveOnRestoreHandler(FOnRestore);
FOnRestore := AValue;
If not (csDesigning in ComponentState) then
Application.OnRestore := AValue;
if not (csDesigning in ComponentState)
and Assigned(FOnRestore) then
Application.AddOnRestoreHandler(FOnRestore);
end;
Procedure TApplicationProperties.SetOnDropFiles(const AValue: TDropFilesEvent);
begin
if (TMethod(FOnDropFiles).Data=TMethod(AValue).Data)
and (TMethod(FOnDropFiles).Code=TMethod(AValue).Code) then exit;
if not (csDesigning in ComponentState)
and Assigned(FOnDropFiles) then
Application.RemoveOnDropFilesHandler(FOnDropFiles);
FOnDropFiles := AValue;
If not (csDesigning in ComponentState) then
Application.OnDropFiles := AValue;
if not (csDesigning in ComponentState)
and Assigned(FOnDropFiles) then
Application.AddOnDropFilesHandler(FOnDropFiles);
end;
Procedure TApplicationProperties.SetOnHelp(Const AValue : THelpEvent);
begin
if (TMethod(FOnHelp).Data=TMethod(AValue).Data)
and (TMethod(FOnHelp).Code=TMethod(AValue).Code) then exit;
if not (csDesigning in ComponentState)
and Assigned(FOnHelp) then
Application.RemoveOnHelpHandler(FOnHelp);
FOnHelp := AValue;
If not (csDesigning in ComponentState) then
Application.OnHelp := AValue;
if not (csDesigning in ComponentState)
and Assigned(FOnHelp) then
Application.AddOnHelpHandler(FOnHelp);
end;
Procedure TApplicationProperties.SetOnHint(Const AValue : TNotifyEvent);
begin
if (TMethod(FOnHint).Data=TMethod(AValue).Data)
and (TMethod(FOnHint).Code=TMethod(AValue).Code) then exit;
if not (csDesigning in ComponentState)
and Assigned(FOnHint) then
Application.RemoveOnHintHandler(FOnHint);
FOnHint := AValue;
If not (csDesigning in ComponentState) then
Application.OnHint := AValue;
if not (csDesigning in ComponentState)
and Assigned(FOnHint) then
Application.AddOnHintHandler(FOnHint);
end;
Procedure TApplicationProperties.SetOnShowHint(Const AValue : TShowHintEvent);
begin
if (TMethod(FOnShowHint).Data=TMethod(AValue).Data)
and (TMethod(FOnShowHint).Code=TMethod(AValue).Code) then exit;
if not (csDesigning in ComponentState)
and Assigned(FOnShowHint) then
Application.RemoveOnShowHintHandler(FOnShowHint);
FOnShowHint := AValue;
If not (csDesigning in ComponentState) then
Application.OnShowHint := AValue;
if not (csDesigning in ComponentState)
and Assigned(FOnShowHint) then
Application.AddOnShowHintHandler(FOnShowHint);
end;
Procedure TApplicationProperties.SetOnUserInput(Const AValue : TOnUserInputEvent);
begin
if (TMethod(FOnUserInput).Data=TMethod(AValue).Data)
and (TMethod(FOnUserInput).Code=TMethod(AValue).Code) then exit;
if not (csDesigning in ComponentState)
and Assigned(FOnUserInput) then
Application.RemoveOnUserInputHandler(FOnUserInput);
FOnUserInput := AValue;
If not (csDesigning in ComponentState) then
Application.OnUserInput := AValue;
if not (csDesigning in ComponentState)
and Assigned(FOnUserInput) then
Application.AddOnUserInputHandler(FOnUserInput);
end;
constructor TApplicationProperties.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
If (csDesigning in ComponentState) then begin
if (csDesigning in ComponentState) then begin
FCaptureExceptions:=true;
FHintColor := DefHintColor;
FHintPause := DefHintPause;
@ -243,27 +303,8 @@ end;
destructor TApplicationProperties.Destroy;
begin
If not (csDesigning in ComponentState) then begin
if Application.OnException=FOnException then
Application.OnException:=nil;
if Application.OnIdle=FOnIdle then
Application.OnIdle:=nil;
if Application.OnIdleEnd=FOnIdleEnd then
Application.OnIdleEnd:=nil;
if Application.OnHelp=FOnHelp then
Application.OnHelp:=nil;
if Application.OnHint=FOnHint then
Application.OnHint:=nil;
if Application.OnShowHint=FOnShowHint then
Application.OnShowHint:=nil;
if Application.OnUserInput=FOnUserInput then
Application.OnUserInput:=nil;
if Application.OnEndSession=FOnEndSession then
Application.OnEndSession:=nil;
if Application.OnQueryEndSession=FOnQueryEndSession then
Application.OnQueryEndSession:=nil;
end;
If not (csDesigning in ComponentState) then
Application.RemoveAllHandlersOfObject(Self);
inherited Destroy;
end;