|
@@ -5,7 +5,7 @@ unit Fresnel.App;
|
|
interface
|
|
interface
|
|
|
|
|
|
uses
|
|
uses
|
|
- Classes, SysUtils, CustApp, Fresnel.Forms, Fresnel.WidgetSet,
|
|
|
|
|
|
+ Classes, SysUtils, CustApp, Fresnel.Events, Fresnel.Forms, Fresnel.WidgetSet,
|
|
LazMethodList, LazLoggerBase;
|
|
LazMethodList, LazLoggerBase;
|
|
|
|
|
|
type
|
|
type
|
|
@@ -19,21 +19,11 @@ type
|
|
);
|
|
);
|
|
TApplicationFlags = set of TApplicationFlag;
|
|
TApplicationFlags = set of TApplicationFlag;
|
|
|
|
|
|
- TApplicationHandlerType = (
|
|
|
|
- ahtIdle,
|
|
|
|
- ahtIdleEnd,
|
|
|
|
- ahtActivate,
|
|
|
|
- ahtDeactivate,
|
|
|
|
- ahtMinimize,
|
|
|
|
- ahtMaximize,
|
|
|
|
- ahtRestore
|
|
|
|
- );
|
|
|
|
|
|
|
|
{ TFresnelApplication }
|
|
{ TFresnelApplication }
|
|
|
|
|
|
- TFresnelApplication = class(TBaseFresnelApplication)
|
|
|
|
|
|
+ TFresnelApplication = class(TFresnelBaseApplication)
|
|
private
|
|
private
|
|
- FApplicationHandlers: array[TApplicationHandlerType] of TMethodList;
|
|
|
|
FCaptureExceptions: Boolean;
|
|
FCaptureExceptions: Boolean;
|
|
FComponentsToRelease: TFPList;
|
|
FComponentsToRelease: TFPList;
|
|
FComponentsReleasing: TFPList;
|
|
FComponentsReleasing: TFPList;
|
|
@@ -43,30 +33,10 @@ type
|
|
FOldExceptProc: TExceptProc;
|
|
FOldExceptProc: TExceptProc;
|
|
procedure Activate(Data: Pointer);
|
|
procedure Activate(Data: Pointer);
|
|
procedure Deactivate(Data: Pointer);
|
|
procedure Deactivate(Data: Pointer);
|
|
- procedure AddHandler(HandlerType: TApplicationHandlerType;
|
|
|
|
- const Handler: TMethod; AsFirst: Boolean);
|
|
|
|
- procedure RemoveHandler(HandlerType: TApplicationHandlerType;
|
|
|
|
- const Handler: TMethod);
|
|
|
|
procedure QueuedReleaseComponents(Data: Pointer);
|
|
procedure QueuedReleaseComponents(Data: Pointer);
|
|
protected
|
|
protected
|
|
- type
|
|
|
|
- PAsyncCallQueueItem = ^TAsyncCallQueueItem;
|
|
|
|
- TAsyncCallQueueItem = record
|
|
|
|
- Method: TDataEvent;
|
|
|
|
- Data: Pointer;
|
|
|
|
- NextItem, PrevItem: PAsyncCallQueueItem;
|
|
|
|
- end;
|
|
|
|
- TAsyncCallQueue = record
|
|
|
|
- Top, Last: PAsyncCallQueueItem;
|
|
|
|
- end;
|
|
|
|
- TAsyncCallQueues = record
|
|
|
|
- CritSec: TRTLCriticalSection;
|
|
|
|
- Cur: TAsyncCallQueue; // currently processing
|
|
|
|
- Next: TAsyncCallQueue; // new calls added to this queue
|
|
|
|
- end;
|
|
|
|
protected
|
|
protected
|
|
FFlags: TApplicationFlags;
|
|
FFlags: TApplicationFlags;
|
|
- FAsyncCall: TAsyncCallQueues;
|
|
|
|
procedure DoBeforeFinalization; virtual;
|
|
procedure DoBeforeFinalization; virtual;
|
|
procedure DoRun; override;
|
|
procedure DoRun; override;
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
@@ -79,6 +49,7 @@ type
|
|
procedure WSAppMinimize; virtual;
|
|
procedure WSAppMinimize; virtual;
|
|
procedure WSAppMaximize; virtual;
|
|
procedure WSAppMaximize; virtual;
|
|
procedure WSAppRestore; virtual;
|
|
procedure WSAppRestore; virtual;
|
|
|
|
+ procedure ReleaseComponent(aComponent : TComponent);
|
|
|
|
|
|
procedure ProcessAsyncCallQueue; virtual;
|
|
procedure ProcessAsyncCallQueue; virtual;
|
|
procedure ReleaseComponents; virtual;
|
|
procedure ReleaseComponents; virtual;
|
|
@@ -95,10 +66,6 @@ type
|
|
procedure HandleMessage; virtual;
|
|
procedure HandleMessage; virtual;
|
|
procedure ProcessMessages; virtual;
|
|
procedure ProcessMessages; virtual;
|
|
procedure Idle(Wait: Boolean); virtual;
|
|
procedure Idle(Wait: Boolean); virtual;
|
|
- procedure QueueAsyncCall(const AMethod: TDataEvent; Data: Pointer); override;
|
|
|
|
- procedure RemoveAsyncCalls(const AnObject: TObject); override;
|
|
|
|
- procedure RemoveAllHandlersOfObject(AnObject: TObject); override;
|
|
|
|
- procedure ReleaseComponent(AComponent: TComponent); override;
|
|
|
|
|
|
|
|
property CaptureExceptions: Boolean read FCaptureExceptions write SetCaptureExceptions;
|
|
property CaptureExceptions: Boolean read FCaptureExceptions write SetCaptureExceptions;
|
|
property FindGlobalComponentEnabled: Boolean read FFindGlobalComponentEnabled
|
|
property FindGlobalComponentEnabled: Boolean read FFindGlobalComponentEnabled
|
|
@@ -219,28 +186,12 @@ begin
|
|
if Data=nil then ;
|
|
if Data=nil then ;
|
|
end;
|
|
end;
|
|
|
|
|
|
-procedure TFresnelApplication.AddHandler(HandlerType: TApplicationHandlerType;
|
|
|
|
- const Handler: TMethod; AsFirst: Boolean);
|
|
|
|
-begin
|
|
|
|
- if Handler.Code=nil then
|
|
|
|
- raise Exception.Create('TApplication.AddHandler 20230913180016');
|
|
|
|
- if FApplicationHandlers[HandlerType]=nil then
|
|
|
|
- FApplicationHandlers[HandlerType]:=TMethodList.Create;
|
|
|
|
- FApplicationHandlers[HandlerType].Add(Handler,not AsFirst);
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
procedure TFresnelApplication.QueuedReleaseComponents(Data: Pointer);
|
|
procedure TFresnelApplication.QueuedReleaseComponents(Data: Pointer);
|
|
begin
|
|
begin
|
|
if Data=nil then ;
|
|
if Data=nil then ;
|
|
ReleaseComponents;
|
|
ReleaseComponents;
|
|
end;
|
|
end;
|
|
|
|
|
|
-procedure TFresnelApplication.RemoveHandler(HandlerType: TApplicationHandlerType;
|
|
|
|
- const Handler: TMethod);
|
|
|
|
-begin
|
|
|
|
- FApplicationHandlers[HandlerType].Remove(Handler);
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
procedure TFresnelApplication.DoBeforeFinalization;
|
|
procedure TFresnelApplication.DoBeforeFinalization;
|
|
var
|
|
var
|
|
i: Integer;
|
|
i: Integer;
|
|
@@ -269,61 +220,9 @@ end;
|
|
|
|
|
|
procedure TFresnelApplication.ProcessAsyncCallQueue;
|
|
procedure TFresnelApplication.ProcessAsyncCallQueue;
|
|
// Call all methods queued to be called (QueueAsyncCall)
|
|
// Call all methods queued to be called (QueueAsyncCall)
|
|
-var
|
|
|
|
- lItem: PAsyncCallQueueItem;
|
|
|
|
- Event: TDataEvent;
|
|
|
|
- Data: Pointer;
|
|
|
|
-begin
|
|
|
|
- with FAsyncCall do begin
|
|
|
|
- // move the items of NextQueue to CurQueue, keep the order
|
|
|
|
- System.EnterCriticalsection(CritSec);
|
|
|
|
- try
|
|
|
|
- if Next.Top<>nil then
|
|
|
|
- begin
|
|
|
|
- if Cur.Last<>nil then
|
|
|
|
- begin
|
|
|
|
- assert(Cur.Top <> nil, 'TApplication.ProcessAsyncCallQueue: Last entry found, while Top not assigned');
|
|
|
|
- Cur.Last^.NextItem:=Next.Top;
|
|
|
|
- Next.Top^.PrevItem:=Cur.Last;
|
|
|
|
- end else begin
|
|
|
|
- assert(Cur.Top = nil, 'TApplication.ProcessAsyncCallQueue: Last entry found, while Top not assigned');
|
|
|
|
- Cur.Top:=Next.Top;
|
|
|
|
- end;
|
|
|
|
- Cur.Last:=Next.Last;
|
|
|
|
- Next.Top:=nil;
|
|
|
|
- Next.Last:=nil;
|
|
|
|
- end;
|
|
|
|
- finally
|
|
|
|
- System.LeaveCriticalsection(CritSec);
|
|
|
|
- end;
|
|
|
|
|
|
|
|
- // process items from top to last in 'Cur' queue
|
|
|
|
- // this can create new items, which are added to the 'Next' queue
|
|
|
|
- // or it can call ProcessAsyncCallQueue, for example via calling
|
|
|
|
- // FresnelApplication.ProcesssMessages
|
|
|
|
- // Using a second queue avoids an endless loop, when an event adds a new event.
|
|
|
|
- repeat
|
|
|
|
- // remove top item from queue
|
|
|
|
- System.EnterCriticalSection(CritSec);
|
|
|
|
- try
|
|
|
|
- if Cur.Top=nil then exit;
|
|
|
|
- lItem:=Cur.Top;
|
|
|
|
- Cur.Top := lItem^.NextItem;
|
|
|
|
- if Cur.Top = nil then
|
|
|
|
- Cur.Last := nil
|
|
|
|
- else
|
|
|
|
- Cur.Top^.PrevItem := nil;
|
|
|
|
- // free item
|
|
|
|
- Event:=lItem^.Method;
|
|
|
|
- Data:=lItem^.Data;
|
|
|
|
- Dispose(lItem);
|
|
|
|
- finally
|
|
|
|
- System.LeaveCriticalSection(CritSec);
|
|
|
|
- end;
|
|
|
|
- // call event
|
|
|
|
- Event(Data);
|
|
|
|
- until false;
|
|
|
|
- end;
|
|
|
|
|
|
+begin
|
|
|
|
+ DoHandleAsyncCalls;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TFresnelApplication.ReleaseComponents;
|
|
procedure TFresnelApplication.ReleaseComponents;
|
|
@@ -353,7 +252,7 @@ begin
|
|
if IsReferenced then
|
|
if IsReferenced then
|
|
begin
|
|
begin
|
|
// add again to FComponentsToRelease
|
|
// add again to FComponentsToRelease
|
|
- ReleaseComponent(Component);
|
|
|
|
|
|
+ ReleaseComponent(Component);
|
|
end else begin
|
|
end else begin
|
|
// this might free some more components from FComponentsReleasing
|
|
// this might free some more components from FComponentsReleasing
|
|
Component.Free;
|
|
Component.Free;
|
|
@@ -380,7 +279,6 @@ begin
|
|
FresnelApplication:=Self;
|
|
FresnelApplication:=Self;
|
|
CustomApplication:=Self;
|
|
CustomApplication:=Self;
|
|
|
|
|
|
- System.InitCriticalSection(FAsyncCall.CritSec);
|
|
|
|
RegisterFindGlobalComponentProc(@FindApplicationComponent);
|
|
RegisterFindGlobalComponentProc(@FindApplicationComponent);
|
|
OnGetApplicationName := @GetApplicationName;
|
|
OnGetApplicationName := @GetApplicationName;
|
|
|
|
|
|
@@ -389,20 +287,16 @@ begin
|
|
end;
|
|
end;
|
|
|
|
|
|
destructor TFresnelApplication.Destroy;
|
|
destructor TFresnelApplication.Destroy;
|
|
-var
|
|
|
|
- HandlerType: TApplicationHandlerType;
|
|
|
|
|
|
+
|
|
begin
|
|
begin
|
|
ProcessAsyncCallQueue;
|
|
ProcessAsyncCallQueue;
|
|
UnregisterFindGlobalComponentProc(@FindApplicationComponent);
|
|
UnregisterFindGlobalComponentProc(@FindApplicationComponent);
|
|
|
|
|
|
- for HandlerType:=Low(TApplicationHandlerType) to High(TApplicationHandlerType) do
|
|
|
|
- FreeAndNil(FApplicationHandlers[HandlerType]);
|
|
|
|
|
|
|
|
inherited Destroy;
|
|
inherited Destroy;
|
|
|
|
|
|
Include(FFlags,AppDoNotCallAsyncQueue);
|
|
Include(FFlags,AppDoNotCallAsyncQueue);
|
|
ProcessAsyncCallQueue;
|
|
ProcessAsyncCallQueue;
|
|
- System.DoneCriticalSection(FAsyncCall.CritSec);
|
|
|
|
|
|
|
|
// restore exception handling
|
|
// restore exception handling
|
|
CaptureExceptions:=false;
|
|
CaptureExceptions:=false;
|
|
@@ -508,28 +402,24 @@ end;
|
|
|
|
|
|
procedure TFresnelApplication.NotifyActivateHandler;
|
|
procedure TFresnelApplication.NotifyActivateHandler;
|
|
begin
|
|
begin
|
|
- FApplicationHandlers[ahtActivate].CallNotifyEvents(Self);
|
|
|
|
|
|
+ EventDispatcher.DispatchEvent(evtActivate);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TFresnelApplication.NotifyDeactivateHandler;
|
|
procedure TFresnelApplication.NotifyDeactivateHandler;
|
|
begin
|
|
begin
|
|
- FApplicationHandlers[ahtDeactivate].CallNotifyEvents(Self);
|
|
|
|
|
|
+ EventDispatcher.DispatchEvent(evtDeActivate);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TFresnelApplication.NotifyIdleEndHandler;
|
|
procedure TFresnelApplication.NotifyIdleEndHandler;
|
|
begin
|
|
begin
|
|
- FApplicationHandlers[ahtIdleEnd].CallNotifyEvents(Self);
|
|
|
|
|
|
+ EventDispatcher.DispatchEvent(evtIdleEnd);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TFresnelApplication.NotifyIdleHandler(var Done: Boolean);
|
|
procedure TFresnelApplication.NotifyIdleHandler(var Done: Boolean);
|
|
-var
|
|
|
|
- i: LongInt;
|
|
|
|
|
|
+
|
|
begin
|
|
begin
|
|
- i:=FApplicationHandlers[ahtIdle].Count;
|
|
|
|
- while FApplicationHandlers[ahtIdle].NextDownIndex(i) do begin
|
|
|
|
- TIdleEvent(FApplicationHandlers[ahtIdle][i])(Self,Done);
|
|
|
|
- if not Done then exit;
|
|
|
|
- end;
|
|
|
|
|
|
+ // done ?
|
|
|
|
+ EventDispatcher.DispatchEvent(evtIdle);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TFresnelApplication.ProcessMessages;
|
|
procedure TFresnelApplication.ProcessMessages;
|
|
@@ -596,127 +486,30 @@ end;
|
|
|
|
|
|
procedure TFresnelApplication.WSAppMinimize;
|
|
procedure TFresnelApplication.WSAppMinimize;
|
|
begin
|
|
begin
|
|
- FApplicationHandlers[ahtMinimize].CallNotifyEvents(Self);
|
|
|
|
|
|
+ EventDispatcher.DispatchEvent(evtMinimize);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TFresnelApplication.WSAppMaximize;
|
|
procedure TFresnelApplication.WSAppMaximize;
|
|
begin
|
|
begin
|
|
- FApplicationHandlers[ahtMaximize].CallNotifyEvents(Self);
|
|
|
|
|
|
+ EventDispatcher.DispatchEvent(evtMaximize);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TFresnelApplication.WSAppRestore;
|
|
procedure TFresnelApplication.WSAppRestore;
|
|
begin
|
|
begin
|
|
//Screen.RestoreLastActive;
|
|
//Screen.RestoreLastActive;
|
|
- FApplicationHandlers[ahtRestore].CallNotifyEvents(Self);
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure TFresnelApplication.QueueAsyncCall(const AMethod: TDataEvent; Data: Pointer);
|
|
|
|
-var
|
|
|
|
- lItem: PAsyncCallQueueItem;
|
|
|
|
-begin
|
|
|
|
- if AppDoNotCallAsyncQueue in FFlags then
|
|
|
|
- raise Exception.Create('TApplication.QueueAsyncCall already shut down');
|
|
|
|
- New(lItem);
|
|
|
|
- lItem^.Method := AMethod;
|
|
|
|
- lItem^.Data := Data;
|
|
|
|
- lItem^.NextItem := nil;
|
|
|
|
- System.EnterCriticalsection(FAsyncCall.CritSec);
|
|
|
|
- try
|
|
|
|
- with FAsyncCall.Next do begin
|
|
|
|
- lItem^.PrevItem := Last;
|
|
|
|
- if Last<>nil then begin
|
|
|
|
- assert(Top <> nil, 'TApplication.QueueAsyncCall: Top entry missing (but last is assigned)');
|
|
|
|
- Last^.NextItem := lItem
|
|
|
|
- end else begin
|
|
|
|
- assert(Last = nil, 'TApplication.QueueAsyncCall: Last entry found, while Top not assigned');
|
|
|
|
- Top := lItem;
|
|
|
|
- end;
|
|
|
|
- Last := lItem;
|
|
|
|
- end;
|
|
|
|
- finally
|
|
|
|
- System.LeaveCriticalsection(FAsyncCall.CritSec);
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
- if Assigned(WakeMainThread) then
|
|
|
|
- WakeMainThread(nil);
|
|
|
|
|
|
+ EventDispatcher.DispatchEvent(evtRestore);
|
|
end;
|
|
end;
|
|
|
|
|
|
-procedure TFresnelApplication.RemoveAsyncCalls(const AnObject: TObject);
|
|
|
|
-
|
|
|
|
- procedure DoRemoveAsyncCalls(var AQueue: TAsyncCallQueue);
|
|
|
|
- var
|
|
|
|
- lItem, lItem2: PAsyncCallQueueItem;
|
|
|
|
- begin
|
|
|
|
- lItem := AQueue.Last;
|
|
|
|
- while lItem <> nil do begin
|
|
|
|
- if TMethod(lItem^.Method).Data = Pointer(AnObject) then begin
|
|
|
|
- if lItem^.NextItem <> nil then
|
|
|
|
- lItem^.NextItem^.PrevItem := lItem^.PrevItem;
|
|
|
|
- if lItem^.PrevItem <> nil then
|
|
|
|
- lItem^.PrevItem^.NextItem := lItem^.NextItem;
|
|
|
|
-
|
|
|
|
- if lItem = AQueue.Last then
|
|
|
|
- AQueue.Last := lItem^.PrevItem;
|
|
|
|
- if lItem = AQueue.Top then
|
|
|
|
- AQueue.Top := lItem^.NextItem;
|
|
|
|
-
|
|
|
|
- lItem2 := lItem;
|
|
|
|
- lItem := lItem^.PrevItem;
|
|
|
|
- Dispose(lItem2);
|
|
|
|
- end
|
|
|
|
- else
|
|
|
|
- lItem := lItem^.PrevItem;
|
|
|
|
- end;
|
|
|
|
- end;
|
|
|
|
|
|
+procedure TFresnelApplication.ReleaseComponent(aComponent: TComponent);
|
|
|
|
|
|
-begin
|
|
|
|
- if AppDoNotCallAsyncQueue in FFlags then
|
|
|
|
- raise Exception.Create('TApplication.QueueAsyncCall already shut down');
|
|
|
|
-
|
|
|
|
- System.EnterCriticalsection(FAsyncCall.CritSec);
|
|
|
|
- try
|
|
|
|
- DoRemoveAsyncCalls(FAsyncCall.Cur);
|
|
|
|
- DoRemoveAsyncCalls(FAsyncCall.Next);
|
|
|
|
- finally
|
|
|
|
- System.LeaveCriticalSection(FAsyncCall.CritSec);
|
|
|
|
- end;
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure TFresnelApplication.RemoveAllHandlersOfObject(AnObject: TObject);
|
|
|
|
-var
|
|
|
|
- HandlerType: TApplicationHandlerType;
|
|
|
|
-begin
|
|
|
|
- for HandlerType:=Low(TApplicationHandlerType) to High(TApplicationHandlerType) do
|
|
|
|
- FApplicationHandlers[HandlerType].RemoveAllMethodsOfObject(AnObject);
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure TFresnelApplication.ReleaseComponent(AComponent: TComponent);
|
|
|
|
-var
|
|
|
|
- IsFirstItem, IsReferenced: Boolean;
|
|
|
|
begin
|
|
begin
|
|
if csDestroying in AComponent.ComponentState then exit;
|
|
if csDestroying in AComponent.ComponentState then exit;
|
|
//DebugLn(['TApplication.ReleaseComponent ',DbgSName(AComponent)]);
|
|
//DebugLn(['TApplication.ReleaseComponent ',DbgSName(AComponent)]);
|
|
if csDesigning in ComponentState then begin
|
|
if csDesigning in ComponentState then begin
|
|
// free immediately
|
|
// free immediately
|
|
AComponent.Free;
|
|
AComponent.Free;
|
|
- end else begin
|
|
|
|
- // free later
|
|
|
|
- // => add to the FComponentsToRelease
|
|
|
|
- IsFirstItem:=FComponentsToRelease=nil;
|
|
|
|
- if IsFirstItem then
|
|
|
|
- FComponentsToRelease:=TFPList.Create
|
|
|
|
- else if FComponentsToRelease.IndexOf(AComponent)>=0 then
|
|
|
|
- exit;
|
|
|
|
- FComponentsToRelease.Add(AComponent);
|
|
|
|
- AComponent.FreeNotification(Self);
|
|
|
|
- if IsFirstItem then begin
|
|
|
|
- IsReferenced:=false;
|
|
|
|
- if IsReferenced then
|
|
|
|
- //OnDecLCLRefcountToZero := @DoDecLCLRefcountToZero
|
|
|
|
- else
|
|
|
|
- QueueAsyncCall(@QueuedReleaseComponents, nil);
|
|
|
|
- end;
|
|
|
|
- end;
|
|
|
|
|
|
+ end else
|
|
|
|
+ AsyncCalls.QueueAsyncCall(Nil,aComponent,True);
|
|
end;
|
|
end;
|
|
|
|
|
|
end.
|
|
end.
|