fix: next attempt to fix ERangeError crash in TBaseVirtualTree.UpdateVerticalRange

ansgarbecker · ansgarbecker · commit c8e8beddbf39 · 2026-01-20T19:30:47.000+01:00
- Moves call to FixVT from the often called ApplyFontToGrids to FormCreate. This hopefully heals the crash. - Fixes GetTextHeight to use the tree's font, not the one on MainForm. This was likely another culprit here. - Also moves code for setting IncrementalSearch on grids to FixVT Refs #2344
diff --git a/source/apphelpers.pas b/source/apphelpers.pas
@@ -368,7 +368,7 @@   TAppSettings = class(TObject)
   procedure StreamToClipboard(Text, HTML: TStream);
   function WideHexToBin(text: String): AnsiString;
   function BinToWideHex(bin: AnsiString): String;
-  procedure FixVT(VT: TVirtualStringTree; MultiLineCount: Word=1);
+  procedure FixVT(VT: TVirtualStringTree; IsResultGrid: Boolean=False);
   function GetTextHeight(Font: TFont): Integer;
   function ColorAdjustBrightness(Col: TColor; Shift: SmallInt): TColor;
   procedure DeInitializeVTNodes(Sender: TBaseVirtualTree);
@@ -1455,19 +1455,22 @@ procedure StreamToClipboard(Text, HTML: TStream);
 end;
 
 
-procedure FixVT(VT: TVirtualStringTree; MultiLineCount: Word=1);
+procedure FixVT(VT: TVirtualStringTree; IsResultGrid: Boolean=False);
 var
-  SingleLineHeight: Integer;
+  SingleLineHeight, MultiLineCount: Integer;
   Node: PVirtualNode;
 begin
-  // This is called either in some early stage, or from preferences dialog
+  // This is called either in some early stage (and probably from preferences/apply button?)
   SingleLineHeight := GetTextHeight(VT.Font) + 7;
   // Multiline nodes?
-  // Node height calculation has some hard to find bug, see issue #2344
-  // So we'll leave Header.MinHeight at its default value.
+  if IsResultGrid then
+    MultiLineCount := AppSettings.ReadInt(asGridRowLineCount)
+  else
+    MultiLineCount := 1;
+  // Issue #2344: TBaseVirtualTree.UpdateVerticalRange crashes with ERangeError, due to FRangeY/Cardinal
+  // getting a negative value
+  // Happening when DefaultNodeHeight is set after clearing nodes and then with 0 nodes
   VT.DefaultNodeHeight := SingleLineHeight * MultiLineCount;
-  //VT.Header.MinHeight := SingleLineHeight;
-  VT.Header.Height := SingleLineHeight;
   if MultiLineCount > 1 then begin
     VT.BeginUpdate;
     Node := VT.GetFirstInitialized;
@@ -1488,21 +1491,33 @@ procedure FixVT(VT: TVirtualStringTree; MultiLineCount: Word=1);
   VT.OnMouseWheel := MainForm.AnyGridMouseWheel;
   VT.ShowHint := True;
 
-  if toGridExtensions in VT.TreeOptions.MiscOptions then
-    VT.HintMode := hmHint // Show cell contents with linebreakds in datagrid and querygrid's
+  if IsResultGrid then begin
+    VT.HintMode := hmHint; // Show cell contents with linebreakds in datagrid and querygrid's
+    if AppSettings.ReadBool(asIncrementalSearch) then begin
+      // Apply case insensitive incremental search event
+      VT.IncrementalSearch := isInitializedOnly;
+      VT.OnIncrementalSearch := Mainform.AnyGridIncrementalSearch;
+    end
+    else begin
+      VT.IncrementalSearch := isNone;
+    end;
+  end
   else
     VT.HintMode := hmTooltip; // Just a quick tooltip for clipped nodes
-  // Apply case insensitive incremental search event
-  if VT.IncrementalSearch <> laz.VirtualTrees.isNone then
-    VT.OnIncrementalSearch := Mainform.AnyGridIncrementalSearch;
   VT.OnStartOperation := Mainform.AnyGridStartOperation;
   VT.OnEndOperation := Mainform.AnyGridEndOperation;
 end;
 
 
 function GetTextHeight(Font: TFont): Integer;
+var
+  Bmp: Graphics.TBitmap;
 begin
-  Result := MainForm.Canvas.TextHeight('�y');
+  Bmp := Graphics.TBitmap.Create;
+  Bmp.Canvas.Font.Name := Font.Name;
+  Bmp.Canvas.Font.Size := Font.Size;
+  Result := Bmp.Canvas.TextHeight('�y');
+  Bmp.Free;
 end;
 
 
diff --git a/source/main.pas b/source/main.pas
@@ -2085,6 +2085,7 @@ procedure TMainForm.FormCreate(Sender: TObject);
   FixVT(ListProcesses);
   FixVT(ListCommandStats);
   FixVT(ListTables);
+  FixVT(DataGrid, True);
   FixVT(treeQueryHelpers);
 
   // Set noderoot for query helpers box
@@ -9084,13 +9085,12 @@ procedure TMainForm.ApplyFontToGrids;
   QueryTab: TQueryTab;
   ResultTab: TResultTab;
   Grid: TVirtualStringTree;
-  IncrementalSearchActive: Boolean;
   AllGrids: TObjectList<TVirtualStringTree>;
 begin
-  // Apply changed settings to all existing data and query grids
+  // Apply (changed?) font setting to all data and query grids
+  // Do not change other things on the grid, or call FixVT here
   LogSQL('Apply grid settings...', lcDebug);
   AllGrids := TObjectList<TVirtualStringTree>.Create(False);
-  IncrementalSearchActive := AppSettings.ReadBool(asIncrementalSearch);
   AllGrids.Add(DataGrid); // Data tab grid
   AllGrids.Add(QueryGrid); // Mother query grid
   for QueryTab in QueryTabs do begin // Query tab child grids
@@ -9101,11 +9101,6 @@ procedure TMainForm.ApplyFontToGrids;
   for Grid in AllGrids do begin
     Grid.Font.Name := AppSettings.ReadString(asDataFontName);
     Grid.Font.Size := AppSettings.ReadInt(asDataFontSize);
-    FixVT(Grid, AppSettings.ReadInt(asGridRowLineCount));
-    if IncrementalSearchActive then
-      Grid.IncrementalSearch := isInitializedOnly
-    else
-      Grid.IncrementalSearch := isNone;
   end;
   AllGrids.Free;
 end;
@@ -15432,7 +15427,7 @@ constructor TResultTab.Create(AOwner: TQueryTab);
   Grid.OnNewText := OrgGrid.OnNewText;
   Grid.OnPaintText := OrgGrid.OnPaintText;
   Grid.OnStartOperation := OrgGrid.OnStartOperation;
-  FixVT(Grid, AppSettings.ReadInt(asGridRowLineCount));
+  FixVT(Grid, True);
   FTabIndex := QueryTab.ResultTabs.Count; // Will be 0 for the first one, even if we're already creating the first one here!
 end;
 
