From 30a0f529087929dd7854f00c7b93ee1bc27f1a94 Mon Sep 17 00:00:00 2001 From: mattias Date: Mon, 17 Dec 2007 19:31:44 +0000 Subject: [PATCH] LCL: TApplicationProperties now uses handler lists instead of global events git-svn-id: trunk@13358 - --- lcl/forms.pp | 31 ++++- lcl/include/application.inc | 161 +++++++++++++++++++++++--- lcl/include/applicationproperties.inc | 157 +++++++++++++++---------- 3 files changed, 274 insertions(+), 75 deletions(-) diff --git a/lcl/forms.pp b/lcl/forms.pp index 084ce479d6..5658544d8d 100644 --- a/lcl/forms.pp +++ b/lcl/forms.pp @@ -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; diff --git a/lcl/include/application.inc b/lcl/include/application.inc index d9b29cc8fa..aebeac661c 100644 --- a/lcl/include/application.inc +++ b/lcl/include/application.inc @@ -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; {------------------------------------------------------------------------------ diff --git a/lcl/include/applicationproperties.inc b/lcl/include/applicationproperties.inc index 75947fcf9b..2f98d9c988 100644 --- a/lcl/include/applicationproperties.inc +++ b/lcl/include/applicationproperties.inc @@ -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;