Bladeren bron

* Fix compilation

Michaël Van Canneyt 1 jaar geleden
bovenliggende
commit
d6f0cf6fd3
5 gewijzigde bestanden met toevoegingen van 153 en 252 verwijderingen
  1. 17 2
      src/base/fresnel.events.pas
  2. 102 15
      src/base/fresnel.forms.pas
  3. 19 226
      src/fresnel.app.pas
  4. 9 9
      src/gtk3/fresnel.gtk3.pas
  5. 6 0
      src/skia/fresnel.skiarenderer.pas

+ 17 - 2
src/base/fresnel.events.pas

@@ -54,7 +54,15 @@ Const
   evtAppMessages =  evtLastFormEvent + 1;
   evtAfterProcessMessages = evtAppMessages;
 
-  evtLastApplicationEvent = evtAfterProcessMessages;
+  evtIdle       = evtAppMessages + 1;
+  evtIdleEnd    = evtAppMessages + 2;
+  evtActivate   = evtAppMessages + 3;
+  evtDeactivate = evtAppMessages + 4;
+  evtMinimize   = evtAppMessages + 5;
+  evtMaximize   = evtAppMessages + 6;
+  evtRestore    = evtAppMessages + 7;
+
+  evtLastApplicationEvent = evtRestore;
 
   // Last
   evtLastEvent = evtLastApplicationEvent;
@@ -382,7 +390,14 @@ Const
     'Blur',
     'Create',
     'Destroy',
-    'AfterProcessMessages'
+    'AfterProcessMessages',
+    'Idle',
+    'IdleEnd',
+    'Activate',
+    'Deactivate',
+    'Minimize',
+    'Maximize',
+    'Restore'
   );
 
 { TFresnelWheelEvent }

+ 102 - 15
src/base/fresnel.forms.pas

@@ -125,7 +125,6 @@ type
   TFresnelFormCreateEvent = class(TFresnelFormEvent)
   Public
     Class Function FresnelEventID : TEventID; override;
-    class function EventName: TEventName; override;
   end;
 
   { TFresnelFormDestroyEvent }
@@ -133,7 +132,6 @@ type
   TFresnelFormDestroyEvent = class(TFresnelFormEvent)
   Public
     Class Function FresnelEventID : TEventID; override;
-    class function EventName: TEventName; override;
   end;
 
 
@@ -143,9 +141,62 @@ type
 
   TFresnelAfterProcessMessagesEvent = class(TFresnelApplicationEvent)
     Class Function FresnelEventID : TEventID; override;
-    class function EventName: TEventName; override;
   end;
 
+  (*
+  evtIdle       = evtAppMessages + 1;
+  evtIdleEnd    = evtAppMessages + 2;
+  evtActivate   = evtAppMessages + 3;
+  evtDeactivate = evtAppMessages + 4;
+  evtMinimize   = evtAppMessages + 5;
+  evtMaximize   = evtAppMessages + 6;
+  evtRestore    = evtAppMessages + 7;
+
+  *)
+
+  { TFresnelApplicationIdleEvent }
+
+  TFresnelApplicationIdleEvent = class(TFresnelApplicationEvent)
+    Class Function FresnelEventID : TEventID; override;
+  end;
+
+  { TFresnelApplicationIdleEndEvent }
+
+  TFresnelApplicationIdleEndEvent = class(TFresnelApplicationEvent)
+    Class Function FresnelEventID : TEventID; override;
+  end;
+
+  { TFresnelApplicationActivateEvent }
+
+  TFresnelApplicationActivateEvent = class(TFresnelApplicationEvent)
+    Class Function FresnelEventID : TEventID; override;
+  end;
+
+  { TFresnelApplicationDeActivateEvent }
+
+  TFresnelApplicationDeActivateEvent = class(TFresnelApplicationEvent)
+    Class Function FresnelEventID : TEventID; override;
+  end;
+
+  { TFresnelApplicationMinimizeEvent }
+
+  TFresnelApplicationMinimizeEvent = class(TFresnelApplicationEvent)
+    Class Function FresnelEventID : TEventID; override;
+  end;
+
+  { TFresnelApplicationMaximizeEvent }
+
+  TFresnelApplicationMaximizeEvent = class(TFresnelApplicationEvent)
+    Class Function FresnelEventID : TEventID; override;
+  end;
+
+  { TFresnelApplicationRestoreEvent }
+
+  TFresnelApplicationRestoreEvent = class(TFresnelApplicationEvent)
+    Class Function FresnelEventID : TEventID; override;
+  end;
+
+
   { TFresnelBaseApplication }
 
   { TFresnelFormManager }
@@ -181,6 +232,7 @@ type
     class procedure RegisterApplicationEvents; virtual;
     procedure DoProcessMessages; virtual;
     procedure ShowMainForm;
+    Property AsyncCalls: TAsyncCallQueues Read FAsyncCall;
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
@@ -585,36 +637,71 @@ begin
   Result:=evtOnFormCreate;
 end;
 
-class function TFresnelFormCreateEvent.EventName: TEventName;
-begin
-  Result:='Create';
-end;
-
 { TFresnelFormDestroyEvent }
 
 class function TFresnelFormDestroyEvent.FresnelEventID: TEventID;
 begin
   Result:=evtOnFormDestroy;
+end;
+
+{ TFresnelAfterProcessMessagesEvent }
 
+class function TFresnelAfterProcessMessagesEvent.FresnelEventID: TEventID;
+begin
+  Result:=evtAfterProcessMessages;
 end;
 
-class function TFresnelFormDestroyEvent.EventName: TEventName;
+{ TFresnelApplicationIdleEvent }
+
+class function TFresnelApplicationIdleEvent.FresnelEventID: TEventID;
 begin
-  Result:='Destroy';
+  result:=evtIdle;
 end;
 
-{ TFresnelAfterProcessMessagesEvent }
 
-class function TFresnelAfterProcessMessagesEvent.FresnelEventID: TEventID;
+{ TFresnelApplicationIdleEndEvent }
+
+class function TFresnelApplicationIdleEndEvent.FresnelEventID: TEventID;
 begin
-  Result:=evtAfterProcessMessages;
+  result:=evtIdleEnd;
 end;
 
-class function TFresnelAfterProcessMessagesEvent.EventName: TEventName;
+{ TFresnelApplicationActivateEvent }
+
+class function TFresnelApplicationActivateEvent.FresnelEventID: TEventID;
 begin
-  Result:='AfterProcessMessages';
+  Result:=evtActivate;
 end;
 
+{ TFresnelApplicationDeActivateEvent }
+
+class function TFresnelApplicationDeActivateEvent.FresnelEventID: TEventID;
+begin
+  Result:=evtDeActivate;
+end;
+
+{ TFresnelApplicationMinimizeEvent }
+
+class function TFresnelApplicationMinimizeEvent.FresnelEventID: TEventID;
+begin
+  Result:=evtMinimize;
+end;
+
+{ TFresnelApplicationMaximizeEvent }
+
+class function TFresnelApplicationMaximizeEvent.FresnelEventID: TEventID;
+begin
+  Result:=evtMaximize;
+end;
+
+{ TFresnelApplicationRestoreEvent }
+
+class function TFresnelApplicationRestoreEvent.FresnelEventID: TEventID;
+begin
+  Result:=evtRestore;
+end;
+
+
 { TFresnelFormManager }
 
 procedure TFresnelFormManager.SetMainForm(AValue: TFresnelCustomForm);

+ 19 - 226
src/fresnel.app.pas

@@ -5,7 +5,7 @@ unit Fresnel.App;
 interface
 
 uses
-  Classes, SysUtils, CustApp, Fresnel.Forms, Fresnel.WidgetSet,
+  Classes, SysUtils, CustApp, Fresnel.Events, Fresnel.Forms, Fresnel.WidgetSet,
   LazMethodList, LazLoggerBase;
 
 type
@@ -19,21 +19,11 @@ type
     );
   TApplicationFlags = set of TApplicationFlag;
 
-  TApplicationHandlerType = (
-    ahtIdle,
-    ahtIdleEnd,
-    ahtActivate,
-    ahtDeactivate,
-    ahtMinimize,
-    ahtMaximize,
-    ahtRestore
-  );
 
   { TFresnelApplication }
 
-  TFresnelApplication = class(TBaseFresnelApplication)
+  TFresnelApplication = class(TFresnelBaseApplication)
   private
-    FApplicationHandlers: array[TApplicationHandlerType] of TMethodList;
     FCaptureExceptions: Boolean;
     FComponentsToRelease: TFPList;
     FComponentsReleasing: TFPList;
@@ -43,30 +33,10 @@ type
     FOldExceptProc: TExceptProc;
     procedure Activate(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);
   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
     FFlags: TApplicationFlags;
-    FAsyncCall: TAsyncCallQueues;
     procedure DoBeforeFinalization; virtual;
     procedure DoRun; override;
     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
@@ -79,6 +49,7 @@ type
     procedure WSAppMinimize; virtual;
     procedure WSAppMaximize; virtual;
     procedure WSAppRestore; virtual;
+    procedure ReleaseComponent(aComponent : TComponent);
 
     procedure ProcessAsyncCallQueue; virtual;
     procedure ReleaseComponents; virtual;
@@ -95,10 +66,6 @@ type
     procedure HandleMessage; virtual;
     procedure ProcessMessages; 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 FindGlobalComponentEnabled: Boolean read FFindGlobalComponentEnabled
@@ -219,28 +186,12 @@ begin
   if Data=nil then ;
 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);
 begin
   if Data=nil then ;
   ReleaseComponents;
 end;
 
-procedure TFresnelApplication.RemoveHandler(HandlerType: TApplicationHandlerType;
-  const Handler: TMethod);
-begin
-  FApplicationHandlers[HandlerType].Remove(Handler);
-end;
-
 procedure TFresnelApplication.DoBeforeFinalization;
 var
   i: Integer;
@@ -269,61 +220,9 @@ end;
 
 procedure TFresnelApplication.ProcessAsyncCallQueue;
 // 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;
 
 procedure TFresnelApplication.ReleaseComponents;
@@ -353,7 +252,7 @@ begin
         if IsReferenced then
         begin
           // add again to FComponentsToRelease
-          ReleaseComponent(Component);
+           ReleaseComponent(Component);
         end else begin
           // this might free some more components from FComponentsReleasing
           Component.Free;
@@ -380,7 +279,6 @@ begin
   FresnelApplication:=Self;
   CustomApplication:=Self;
 
-  System.InitCriticalSection(FAsyncCall.CritSec);
   RegisterFindGlobalComponentProc(@FindApplicationComponent);
   OnGetApplicationName := @GetApplicationName;
 
@@ -389,20 +287,16 @@ begin
 end;
 
 destructor TFresnelApplication.Destroy;
-var
-  HandlerType: TApplicationHandlerType;
+
 begin
   ProcessAsyncCallQueue;
   UnregisterFindGlobalComponentProc(@FindApplicationComponent);
 
-  for HandlerType:=Low(TApplicationHandlerType) to High(TApplicationHandlerType) do
-    FreeAndNil(FApplicationHandlers[HandlerType]);
 
   inherited Destroy;
 
   Include(FFlags,AppDoNotCallAsyncQueue);
   ProcessAsyncCallQueue;
-  System.DoneCriticalSection(FAsyncCall.CritSec);
 
   // restore exception handling
   CaptureExceptions:=false;
@@ -508,28 +402,24 @@ end;
 
 procedure TFresnelApplication.NotifyActivateHandler;
 begin
-  FApplicationHandlers[ahtActivate].CallNotifyEvents(Self);
+  EventDispatcher.DispatchEvent(evtActivate);
 end;
 
 procedure TFresnelApplication.NotifyDeactivateHandler;
 begin
-  FApplicationHandlers[ahtDeactivate].CallNotifyEvents(Self);
+  EventDispatcher.DispatchEvent(evtDeActivate);
 end;
 
 procedure TFresnelApplication.NotifyIdleEndHandler;
 begin
-  FApplicationHandlers[ahtIdleEnd].CallNotifyEvents(Self);
+  EventDispatcher.DispatchEvent(evtIdleEnd);
 end;
 
 procedure TFresnelApplication.NotifyIdleHandler(var Done: Boolean);
-var
-  i: LongInt;
+
 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;
 
 procedure TFresnelApplication.ProcessMessages;
@@ -596,127 +486,30 @@ end;
 
 procedure TFresnelApplication.WSAppMinimize;
 begin
-  FApplicationHandlers[ahtMinimize].CallNotifyEvents(Self);
+  EventDispatcher.DispatchEvent(evtMinimize);
 end;
 
 procedure TFresnelApplication.WSAppMaximize;
 begin
-  FApplicationHandlers[ahtMaximize].CallNotifyEvents(Self);
+  EventDispatcher.DispatchEvent(evtMaximize);
 end;
 
 procedure TFresnelApplication.WSAppRestore;
 begin
   //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;
 
-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
   if csDestroying in AComponent.ComponentState then exit;
   //DebugLn(['TApplication.ReleaseComponent ',DbgSName(AComponent)]);
   if csDesigning in ComponentState then begin
     // free immediately
     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.

+ 9 - 9
src/gtk3/fresnel.gtk3.pas

@@ -34,9 +34,9 @@ type
   TGtk3WSForm = class(TFresnelWSForm)
   private
     FClientRect: TRect;
-    FForm: TCustomFresnelForm;
+    FForm: TFresnelCustomForm;
     FWindow: PGtkWindow;
-    procedure SetForm(const AValue: TCustomFresnelForm);
+    procedure SetForm(const AValue: TFresnelCustomForm);
   protected
     procedure Notification(AComponent: TComponent; Operation: TOperation);
       override;
@@ -70,7 +70,7 @@ type
     function GetWindowState: TGdkWindowState; virtual;
     property Window: PGtkWindow read FWindow;
 
-    property Form: TCustomFresnelForm read FForm write SetForm;
+    property Form: TFresnelCustomForm read FForm write SetForm;
   end;
 
   { TGtk3WidgetSet }
@@ -289,16 +289,16 @@ end;
 constructor TGtk3WSForm.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
-  FRenderer:=TGtk3Renderer.Create(Self);
+  SetRenderer(TGtk3Renderer.Create(Self));
 end;
 
 destructor TGtk3WSForm.Destroy;
 begin
-  FreeAndNil(FRenderer);
+  SetRenderer(Nil);
   inherited Destroy;
 end;
 
-procedure TGtk3WSForm.SetForm(const AValue: TCustomFresnelForm);
+procedure TGtk3WSForm.SetForm(const AValue: TFresnelCustomForm);
 begin
   if FForm=AValue then Exit;
   FForm:=AValue;
@@ -729,12 +729,12 @@ end;
 
 procedure TGtk3WidgetSet.CreateWSForm(aFresnelForm: TFresnelComponent);
 var
-  aForm: TCustomFresnelForm;
+  aForm: TFresnelCustomForm;
   aWSForm: TGtk3WSForm;
 begin
-  if not (aFresnelForm is TCustomFresnelForm) then
+  if not (aFresnelForm is TFresnelCustomForm) then
     raise Exception.Create('TGtk3WidgetSet.CreateWSForm '+DbgSName(aFresnelForm));
-  aForm:=TCustomFresnelForm(aFresnelForm);
+  aForm:=TFresnelCustomForm(aFresnelForm);
   aForm.FontEngine:=FontEngineGtk3;
 
   aWSForm:=TGtk3WSForm.Create(aForm);

+ 6 - 0
src/skia/fresnel.skiarenderer.pas

@@ -50,6 +50,7 @@ type
     function TextSizeMaxWidth(const aText: string; MaxWidth: TFresnelLength
       ): TFresnelPoint; virtual;
     function GetTool: TObject;
+    function GetDescription : string;
     property TypeFace: TFresnelSkiaTypeFace read FTypeFace write SetTypeFace;
   end;
 
@@ -240,6 +241,11 @@ begin
   Result:=Self;
 end;
 
+function TFresnelSkiaFont.GetDescription: string;
+begin
+  Result:=GetFamily;
+end;
+
 { TFresnelSkiaFontEngine }
 
 procedure TFresnelSkiaFontEngine.TypeFaceRefCount0(