From 22a7a2f7b67a7ff81e41650288800d59a322daf6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Salvador=20D=C3=ADaz=20Fau?= Date: Wed, 8 Oct 2025 13:37:19 +0200 Subject: [PATCH] Workaround for issue #529. The PopupBrowser demo for Lazarus in Windows crashes at shutdown with CEF 128 --- .../PopupBrowser/uChildForm.lfm | 6 ++++ .../PopupBrowser/uChildForm.pas | 34 ++++++++++++------- .../PopupBrowser/uMainForm.lfm | 1 + .../PopupBrowser/uMainForm.pas | 21 +++++++----- update_CEF4Delphi.json | 2 +- 5 files changed, 43 insertions(+), 21 deletions(-) diff --git a/demos/Lazarus_Windows/PopupBrowser/uChildForm.lfm b/demos/Lazarus_Windows/PopupBrowser/uChildForm.lfm index f1857746..f841d4bb 100644 --- a/demos/Lazarus_Windows/PopupBrowser/uChildForm.lfm +++ b/demos/Lazarus_Windows/PopupBrowser/uChildForm.lfm @@ -59,4 +59,10 @@ object ChildForm: TChildForm Left = 24 Top = 56 end + object Timer1: TTimer + Enabled = False + OnTimer = Timer1Timer + Left = 127 + Top = 70 + end end diff --git a/demos/Lazarus_Windows/PopupBrowser/uChildForm.pas b/demos/Lazarus_Windows/PopupBrowser/uChildForm.pas index c35fab6b..1400ed8e 100644 --- a/demos/Lazarus_Windows/PopupBrowser/uChildForm.pas +++ b/demos/Lazarus_Windows/PopupBrowser/uChildForm.pas @@ -22,6 +22,9 @@ type TChildForm = class(TForm) chrmosr: TChromium; Panel1: TBufferPanel; + Timer1: TTimer; + + procedure Timer1Timer(Sender: TObject); procedure Panel1Enter(Sender: TObject); procedure Panel1Exit(Sender: TObject); @@ -124,7 +127,7 @@ function TChildForm.CreateClientHandler(var windowInfo : TCefWindowInfo; var client : ICefClient; const targetFrameName : ustring; const popupFeatures : TCefPopupFeatures) : boolean; -begin +begin Panel1.CreateIMEHandler; chrmosr.InitializeDragAndDrop(Panel1); @@ -149,8 +152,8 @@ end; procedure TChildForm.chrmosrBeforeClose(Sender: TObject; const browser: ICefBrowser); begin - FCanClose := True; - PostMessage(Handle, WM_CLOSE, 0, 0); + FCanClose := True; + Timer1.Enabled := True; // Workaround for an access violation in CallDefaultWindowProc (win32callback.inc) end; procedure TChildForm.Panel1UTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char); @@ -560,14 +563,15 @@ end; procedure TChildForm.FormCreate(Sender: TObject); begin - FPopUpBitmap := nil; - FPopUpRect := rect(0, 0, 0, 0); - FShowPopUp := False; - FResizing := False; - FPendingResize := False; - FCanClose := False; - FClosing := False; - FResizeCS := TCriticalSection.Create; + FPopUpBitmap := nil; + FPopUpRect := rect(0, 0, 0, 0); + FShowPopUp := False; + FResizing := False; + FPendingResize := False; + FCanClose := False; + FClosing := False; + FClientInitialized := False; + FResizeCS := TCriticalSection.Create; InitializeLastClick; end; @@ -580,7 +584,7 @@ begin if (FResizeCS <> nil) then FreeAndNil(FResizeCS); if FClientInitialized and MainForm.HandleAllocated then - PostMessage(MainForm.Handle, CEF_CHILDDESTROYED, 0, 0); + PostMessage(MainForm.Handle, CEF_CHILDDESTROYED, Tag, 0); end; procedure TChildForm.FormHide(Sender: TObject); @@ -761,6 +765,12 @@ begin Result := (targetDisposition in [CEF_WOD_NEW_FOREGROUND_TAB, CEF_WOD_NEW_BACKGROUND_TAB, CEF_WOD_NEW_POPUP, CEF_WOD_NEW_WINDOW]); end; +procedure TChildForm.Timer1Timer(Sender: TObject); +begin + Timer1.Enabled := False; + PostMessage(Handle, WM_CLOSE, 0, 0); +end; + procedure TChildForm.chrmosrCanFocus(Sender: TObject); begin // The browser required some time to create associated internal objects diff --git a/demos/Lazarus_Windows/PopupBrowser/uMainForm.lfm b/demos/Lazarus_Windows/PopupBrowser/uMainForm.lfm index 2273c540..2c5bf991 100644 --- a/demos/Lazarus_Windows/PopupBrowser/uMainForm.lfm +++ b/demos/Lazarus_Windows/PopupBrowser/uMainForm.lfm @@ -11,6 +11,7 @@ object MainForm: TMainForm Font.Height = -11 Font.Name = 'Tahoma' Position = poScreenCenter + LCLVersion = '4.2.0.0' OnCloseQuery = FormCloseQuery OnCreate = FormCreate OnDestroy = FormDestroy diff --git a/demos/Lazarus_Windows/PopupBrowser/uMainForm.pas b/demos/Lazarus_Windows/PopupBrowser/uMainForm.pas index 33725b91..4a64a34c 100644 --- a/demos/Lazarus_Windows/PopupBrowser/uMainForm.pas +++ b/demos/Lazarus_Windows/PopupBrowser/uMainForm.pas @@ -12,7 +12,7 @@ uses const CEF_CREATENEXTCHILD = WM_APP + $A50; - CEF_CHILDDESTROYED = WM_APP + $A51; + CEF_CHILDDESTROYED = WM_APP + $A51; type @@ -140,6 +140,7 @@ end; procedure TMainForm.FormCreate(Sender: TObject); begin + FChildForm := nil; FClosingChildren := False; FClosingMainForm := False; FCanClose := False; @@ -260,9 +261,9 @@ begin else FChildCounter := 1; - FChildForm := TChildForm.Create(self); - FChildForm.Name := 'ChildForm_' + IntToStr(FChildCounter); - FChildForm.Tag := FChildCounter; + FChildForm := TChildForm.Create(self); + FChildForm.Name := 'ChildForm_' + IntToStr(FChildCounter); + FChildForm.Tag := FChildCounter; end; procedure TMainForm.BrowserCreatedMsg(var aMessage : TMessage); @@ -336,28 +337,32 @@ procedure TMainForm.WMMove(var aMessage : TWMMove); begin inherited; - if (Chromium1 <> nil) then Chromium1.NotifyMoveOrResizeStarted; + if (Chromium1 <> nil) then + Chromium1.NotifyMoveOrResizeStarted; end; procedure TMainForm.WMMoving(var aMessage : TMessage); begin inherited; - if (Chromium1 <> nil) then Chromium1.NotifyMoveOrResizeStarted; + if (Chromium1 <> nil) then + Chromium1.NotifyMoveOrResizeStarted; end; procedure TMainForm.WMEnterMenuLoop(var aMessage: TMessage); begin inherited; - if (aMessage.wParam = 0) and (GlobalCEFApp <> nil) then GlobalCEFApp.OsmodalLoop := True; + if (aMessage.wParam = 0) and (GlobalCEFApp <> nil) then + GlobalCEFApp.OsmodalLoop := True; end; procedure TMainForm.WMExitMenuLoop(var aMessage: TMessage); begin inherited; - if (aMessage.wParam = 0) and (GlobalCEFApp <> nil) then GlobalCEFApp.OsmodalLoop := False; + if (aMessage.wParam = 0) and (GlobalCEFApp <> nil) then + GlobalCEFApp.OsmodalLoop := False; end; end. diff --git a/update_CEF4Delphi.json b/update_CEF4Delphi.json index ce401322..1f6a06db 100644 --- a/update_CEF4Delphi.json +++ b/update_CEF4Delphi.json @@ -2,7 +2,7 @@ "UpdateLazPackages" : [ { "ForceNotify" : true, - "InternalVersion" : 795, + "InternalVersion" : 796, "Name" : "cef4delphi_lazarus.lpk", "Version" : "140.1.14" }