@@ -345,6 +345,14 @@ TfrmMain = class(TForm, IDragDrop)
345345 MousePos: TPoint; var Handled: Boolean);
346346 procedure FormClose (Sender: TObject; var Action: TCloseAction);
347347 procedure acZoomExecute (Sender: TObject);
348+ // Applies a net zoom delta to the HTML viewer (changes HTMLFontSize and
349+ // reloads). Guarded against re-entrancy (see ApplyViewerZoom body).
350+ procedure ApplyViewerZoom (const ADelta: Integer);
351+ // Deferred HTML-viewer zoom: reloading the viewer content cannot be done
352+ // inside the WM_MOUSEWHEEL handler (it rebuilds the viewer while the wheel
353+ // message is still being dispatched to it -> External Exception), so the
354+ // wheel handler posts this message and the zoom runs after the dispatch.
355+ procedure WMHtmlViewerZoom (var Message: TMessage); message WM_APP + 124 ;
348356 procedure acEditCopyUpdate (Sender: TObject);
349357 procedure acSaveHTMLFileExecute (Sender: TObject);
350358 procedure acSavePDFFileExecute (Sender: TObject);
@@ -845,7 +853,9 @@ procedure TfrmMain.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
845853 end
846854 else if CurrentEditFile.HTMLViewer.Focused then
847855 begin
848- acZoomOut.Execute;
856+ // Defer: reloading the viewer inside its own wheel message causes an
857+ // External Exception (see WMHtmlViewerZoom). WParam 0 = zoom out.
858+ PostMessage(Handle, WM_APP + 124 , 0 , 0 );
849859 Handled := True;
850860 end ;
851861 end ;
@@ -863,7 +873,9 @@ procedure TfrmMain.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
863873 end
864874 else if CurrentEditFile.HTMLViewer.Focused then
865875 begin
866- acZoomIn.Execute;
876+ // Defer: reloading the viewer inside its own wheel message causes an
877+ // External Exception (see WMHtmlViewerZoom). WParam 1 = zoom in.
878+ PostMessage(Handle, WM_APP + 124 , 1 , 0 );
867879 Handled := True;
868880 end ;
869881 end ;
@@ -2220,17 +2232,18 @@ procedure TfrmMain.actnPageSetupExecute(Sender: TObject);
22202232end ;
22212233
22222234procedure TfrmMain.SetEditorFontSize (const Value : Integer);
2223- var
2224- LScaleFactor: Single;
22252235begin
22262236 if (CurrentEditor <> nil ) and (Value >= MinfontSize) and (Value <= MaxfontSize) then
22272237 begin
2228- if FEditorFontSize <> 0 then
2229- LScaleFactor := CurrentEditor.Font.Height / FEditorFontSize
2230- else
2231- LScaleFactor := 1 ;
2238+ // Set the point size at the current monitor DPI and let TFont compute the
2239+ // pixel height (this matches how TSynEditorOptionsContainer.AssignTo applies
2240+ // the font). The previous code derived Font.Height multiplying by
2241+ // Self.ScaleFactor ON TOP of the DPI already encoded in the
2242+ // Font.Height/FEditorFontSize ratio, so on high-DPI monitors it produced a
2243+ // font scaled by ~ScaleFactor^2 - a giant font that flashed for a frame
2244+ // before the following AssignTo corrected it.
22322245 CurrentEditor.Font.PixelsPerInch := Self.PixelsPerInch;
2233- CurrentEditor.Font.Height := Round( Value * LScaleFactor * Self.ScaleFactor) ;
2246+ CurrentEditor.Font.Size := Value ;
22342247 FEditorSettings.MDFontSize := Value ;
22352248 end ;
22362249 FEditorFontSize := Value ;
@@ -2332,10 +2345,18 @@ procedure TfrmMain.UpdateEditorsOptions;
23322345 FEditorSettings.MDFontName := FEditorOptions.Font.Name ;
23332346 EditorFontSize := FEditorOptions.Font.Size;
23342347
2348+ // Apply the font to ALL editors FIRST, before touching any HTMLViewer.
2349+ // Updating a viewer (DefFontSize) can reload its images, and
2350+ // HtmlViewerImageRequest pumps the queue (Application.ProcessMessages):
2351+ // that repaints the visible editor. If its font were still the transient
2352+ // pre-AssignTo value, it would flash oversized for a frame. Setting every
2353+ // editor font up-front guarantees the editor is already final at that point.
2354+ for i := 0 to EditFileList.Count -1 do
2355+ FEditorOptions.AssignTo(TEditingFile(EditFileList.items[i]).SynEditor);
2356+
23352357 for i := 0 to EditFileList.Count -1 do
23362358 begin
23372359 EditingFile := TEditingFile(EditFileList.items[i]);
2338- FEditorOptions.AssignTo(EditingFile.SynEditor);
23392360 EditingFile.HTMLViewer.DefFontName := FEditorSettings.HTMLFontName;
23402361 EditingFile.HTMLViewer.DefFontSize := FEditorSettings.HTMLFontSize;
23412362 EditingFile.HTMLViewer.DefBackground := StyleServices.GetSystemColor(clWindow);
@@ -2512,17 +2533,55 @@ procedure TfrmMain.actnSaveAsExecute(Sender: TObject);
25122533 end ;
25132534end ;
25142535
2536+ procedure TfrmMain.ApplyViewerZoom (const ADelta: Integer);
2537+ begin
2538+ // Re-entrancy guard: ShowMarkDownAsHTML reloads the viewer, whose image
2539+ // loading pumps the message queue (Application.ProcessMessages in
2540+ // HtmlViewerImageRequest). A queued zoom (or a timer) must not re-enter the
2541+ // render, otherwise the shared, non-reentrant code-highlight emitter
2542+ // (TSynExporterHTML + cached highlighters) gets its highlighter freed while
2543+ // still in use -> Access/External Exception.
2544+ if (CurrentEditFile = nil ) or (ADelta = 0 ) or FProcessingFiles then
2545+ Exit;
2546+ FEditorSettings.HTMLFontSize := FEditorSettings.HTMLFontSize + ADelta;
2547+ if FEditorSettings.HTMLFontSize < 1 then
2548+ FEditorSettings.HTMLFontSize := 1 ;
2549+ UpdateCodeHighlightTheme;
2550+ FProcessingFiles := True;
2551+ try
2552+ CurrentEditFile.ShowMarkDownAsHTML(FEditorSettings, False, FCodeHighlightEmitter);
2553+ finally
2554+ FProcessingFiles := False;
2555+ end ;
2556+ end ;
2557+
25152558procedure TfrmMain.acZoomExecute (Sender: TObject);
2516- var
2517- LValue: Integer;
25182559begin
25192560 if Sender = acZoomIn then
2520- LValue := 1
2561+ ApplyViewerZoom( 1 )
25212562 else
2522- LValue := -1 ;
2523- FEditorSettings.HTMLFontSize := FEditorSettings.HTMLFontSize + LValue;
2524- UpdateCodeHighlightTheme;
2525- CurrentEditFile.ShowMarkDownAsHTML(FEditorSettings, False, FCodeHighlightEmitter);
2563+ ApplyViewerZoom(-1 );
2564+ end ;
2565+
2566+ procedure TfrmMain.WMHtmlViewerZoom (var Message: TMessage);
2567+ var
2568+ LMsg: TMsg;
2569+ LDelta: Integer;
2570+ begin
2571+ // Runs after the WM_MOUSEWHEEL dispatch has fully returned, so reloading the
2572+ // HTML viewer is now safe. Coalesce all the wheel notches still queued into a
2573+ // single net delta, so the expensive reload runs once instead of once per
2574+ // notch (and there is no queued zoom left to re-enter during image loading).
2575+ if Message.WParam <> 0 then
2576+ LDelta := 1
2577+ else
2578+ LDelta := -1 ;
2579+ while PeekMessage(LMsg, Handle, WM_APP + 124 , WM_APP + 124 , PM_REMOVE) do
2580+ if LMsg.wParam <> 0 then
2581+ Inc(LDelta)
2582+ else
2583+ Dec(LDelta);
2584+ ApplyViewerZoom(LDelta);
25262585end ;
25272586
25282587procedure TfrmMain.RecentPopupMenuPopup (Sender: TObject);
0 commit comments