Ver código fonte

demo/nativedesigner: replace TThread.Syncronize

martin 3 anos atrás
pai
commit
d8e433123c
1 arquivos alterados com 53 adições e 27 exclusões
  1. 53 27
      demo/webwidget/nativedesign/frmmain.pp

+ 53 - 27
demo/webwidget/nativedesign/frmmain.pp

@@ -68,20 +68,17 @@ type
     procedure FormCreate(Sender: TObject);
     procedure Panel1Resize(Sender: TObject);
   private
-    FChromiumLogMsg: String;
+    FFormClosing: Boolean;
     FClientID : Int64; // Just one for now
     FDesignCaption : String;
     FWebIDEIntf : TIDEServer;
     FWidgetCount : Integer;
     FWidgets : Array of String;
-    FURL : String;
-    FURLCount : Integer;
     FAllowGo: Boolean;
 {$IFDEF WINDOWS}
     procedure WMEnterMenuLoop(var aMessage: TMessage); message WM_ENTERMENULOOP;
     procedure WMExitMenuLoop(var aMessage: TMessage); message WM_EXITMENULOOP;
 {$ENDIF}
-    procedure DoChromiumLogMessage;
     function GetProjectURL: String;
     procedure DoAddWidget(Sender: TObject);
     procedure DoAction(Sender: TObject; aExchange: TIDEExchange);
@@ -89,7 +86,6 @@ type
     procedure DoClientLeft(Sender: TObject; aClient: TIDEClient);
     procedure DoLogRequest(Sender: TObject; aURL: String);
     procedure IsWidgetEnabled(Sender: TObject);
-    procedure LogRequest;
     Procedure RegisterWidgets;
     Procedure RegisterWidget(aWidget: String; aImageIndex : Integer);
   public
@@ -106,6 +102,41 @@ uses lclintf, fpmimetypes;
 
 {$R *.lfm}
 
+type
+
+  { TLogMsg }
+
+  TLogMsg = class
+  private
+    FMsg: String;
+  public
+    constructor Create(AMsg: String);
+    procedure DoBrowserMsg(Data: PtrInt);
+    procedure DoLog(Data: PtrInt);
+  end;
+
+
+{ TLogMsg }
+
+constructor TLogMsg.Create(AMsg: String);
+begin
+  FMsg := AMsg;
+end;
+
+procedure TLogMsg.DoBrowserMsg(Data: PtrInt);
+begin
+  if MainForm <> nil then
+    MainForm.BLog.Append(FMsg);
+  Free;
+end;
+
+procedure TLogMsg.DoLog(Data: PtrInt);
+begin
+  if MainForm <> nil then
+    MainForm.Log(FMsg);
+  Free;
+end;
+
 { TMainForm }
 
 procedure TMainForm.DEProjectEditingDone(Sender: TObject);
@@ -116,6 +147,7 @@ end;
 procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: boolean);
 begin
   FWebIDEIntf.Active:=False;
+  FFormClosing := True;
   BrowserWindow1.CloseBrowser(True);
   CanClose:=BrowserWindow1.IsClosed;
   Visible  := False;
@@ -172,17 +204,18 @@ begin
   FAllowGo:=True;
 end;
 
-procedure TMainForm.DoChromiumLogMessage;
-begin
-  BLog.Append(FChromiumLogMsg);
-end;
-
 procedure TMainForm.ChromiumConsoleMessage(Sender: TObject;
   const browser: ICefBrowser; level: TCefLogSeverity; const message,
   source: ustring; line: Integer; out Result: Boolean);
+var
+  m: TLogMsg;
 begin
-  FChromiumLogMsg := Format('%s [%s %d]', [message, source, line]);
-  TThread.Synchronize(nil, @DoChromiumLogMessage);
+  if FFormClosing then
+    exit;
+  m := TLogMsg.Create(Format('%s [%s %d]', [message, source, line]));
+  Application.QueueAsyncCall(@m.DoBrowserMsg, 0);
+  // Issue https://gitlab.com/freepascal.org/fpc/source/-/issues/39367
+  //Application.QueueAsyncCall(@TLogMsg.Create(Format('%s [%s %d]', [message, source, line])).DoBrowserMsg, 0);
 end;
 
 procedure TMainForm.FormCreate(Sender: TObject);
@@ -330,23 +363,16 @@ begin
     end;
 end;
 
-procedure TMainForm.LogRequest;
-
-begin
-  if (FURLCount=1) then // avoid excessive logging, command loop is on very short interval.
-    Log('Internal server request received: '+FURL);
-end;
-
 procedure TMainForm.DoLogRequest(Sender: TObject; aURL: String);
+var
+  m: TLogMsg;
 begin
-  if (aURL<>FURL) then
-    begin
-    FURLCount:=1;
-    FURL:=aURL
-    end
-  else
-    Inc(FURLCount);
-  TThread.Synchronize(TThread.CurrentThread,@LogRequest);
+  if FFormClosing then
+    exit;
+  m := TLogMsg.Create('Internal server request received: '+aURL);
+  Application.QueueAsyncCall(@m.DoLog, 0);
+  // Issue https://gitlab.com/freepascal.org/fpc/source/-/issues/39367
+  //Application.QueueAsyncCall(@TLogMsg.Create('Internal server request received: '+FURL).DoLog, 0);
 end;
 
 procedure TMainForm.IsWidgetEnabled(Sender: TObject);