From b56b10e4c20d29c3b33f29a5aabda502a8a2fea8 Mon Sep 17 00:00:00 2001 From: Clayton Arends Date: Sun, 20 Sep 2026 08:36:06 -0700 Subject: [PATCH 1/4] Add FBackgroundPrepared to cache and reuse the prepared background bitmap --- Source/VirtualTrees.BaseTree.pas | 35 +++++++++++++++++++++----------- 1 file changed, 23 insertions(+), 12 deletions(-) diff --git a/Source/VirtualTrees.BaseTree.pas b/Source/VirtualTrees.BaseTree.pas index 597f0f39..cda33ead 100644 --- a/Source/VirtualTrees.BaseTree.pas +++ b/Source/VirtualTrees.BaseTree.pas @@ -468,6 +468,7 @@ TBaseVirtualTree = class abstract(TVTBaseAncestor) FTempNodeCache: TNodeArray; // used at various places to hold temporarily a bunch of node refs. FTempNodeCount: Cardinal; // number of nodes in FTempNodeCache FBackground: TVTBackground; // A background image loadable at design and runtime. + FBackgroundPrepared: TBitmap; // Prepared background image. FBackgroundImageTransparent: Boolean; // By default, this is off. When switched on, will try to draw the image // transparent by using the color of the component as transparent color @@ -762,6 +763,7 @@ TBaseVirtualTree = class abstract(TVTBaseAncestor) function FindInPositionCache(Position: TDimension; var CurrentPos: TNodeHeight): PVirtualNode; overload; procedure FixupTotalCount(Node: PVirtualNode); procedure FixupTotalHeight(Node: PVirtualNode); + function GetBackgroundBitmap(Source: TVTBackground; aBkgColor: TColor): TBitmap; function GetBottomNode: PVirtualNode; function GetCheckState(Node: PVirtualNode): TCheckState; function GetCheckType(Node: PVirtualNode): TCheckType; @@ -2354,6 +2356,7 @@ destructor TBaseVirtualTree.Destroy(); Clear; FColors.Free; FBackground.Free; + FreeAndNil(FBackgroundPrepared); if CheckImageKind = ckSystemDefault then FCheckImages.Free; @@ -3337,6 +3340,22 @@ procedure TBaseVirtualTree.FixupTotalHeight(Node: PVirtualNode); //---------------------------------------------------------------------------------------------------------------------- +function TBaseVirtualTree.GetBackgroundBitmap(Source: TVTBackground; aBkgColor: TColor): TBitmap; + +// Prepares and returns the background bitmap ready to be drawn. Creates a new bitmap if it +// hasn't been created yet. + +begin + if Assigned(FBackgroundPrepared) then + Exit(FBackgroundPrepared); + + FBackgroundPrepared := TBitmap.Create; + PrepareBackGroundPicture(Source, FBackgroundPrepared, Source.Width, Source.Height, aBkgColor); + Result := FBackgroundPrepared; +end; + +//---------------------------------------------------------------------------------------------------------------------- + function TBaseVirtualTree.GetBottomNode: PVirtualNode; begin @@ -5777,8 +5796,6 @@ procedure TBaseVirtualTree.StaticBackground(Source: TVTBackground; Target: TCanv DrawRect: TRect; DrawingBitmap: TBitmap; begin - DrawingBitmap := TBitmap.Create; - try // clear background Target.Brush.Color := aBkgColor; Target.FillRect(R); @@ -5792,14 +5809,12 @@ procedure TBaseVirtualTree.StaticBackground(Source: TVTBackground; Target: TCanv // If picture falls in AreaRect, return intersection (DrawRect). if IntersectRect(DrawRect, PicRect, AreaRect) then begin - PrepareBackGroundPicture(Source, DrawingBitmap, Source.Width, Source.Height, aBkgColor); + DrawingBitmap := GetBackgroundBitmap(Source, aBkgColor); + // copy image to destination BitBlt(Target.Handle, DrawRect.Left - OffsetPosition.X, DrawRect.Top - OffsetPosition.Y, (DrawRect.Right - OffsetPosition.X) - (DrawRect.Left - OffsetPosition.X), (DrawRect.Bottom - OffsetPosition.Y) - (DrawRect.Top - OffsetPosition.Y) + R.Top, DrawingBitmap.Canvas.Handle, DrawRect.Left - PicRect.Left, DrawRect.Top - PicRect.Top, SRCCOPY); - end; - finally - DrawingBitmap.Free; end; end; @@ -5845,9 +5860,8 @@ procedure TBaseVirtualTree.TileBackground(Source: TVTBackground; Target: TCanvas DeltaY: TDimension; DrawingBitmap: TBitmap; begin - DrawingBitmap := TBitmap.Create; - try - PrepareBackGroundPicture(Source, DrawingBitmap, Source.Width, Source.Height, aBkgColor); + DrawingBitmap := GetBackgroundBitmap(Source, aBkgColor); + with Target do begin SourceY := (R.Top + Offset.Y + FBackgroundOffsetY) mod Source.Height; @@ -5878,9 +5892,6 @@ procedure TBaseVirtualTree.TileBackground(Source: TVTBackground; Target: TCanvas Inc(R.Top, Source.Height - SourceY); SourceY := 0; end; - end; - finally - DrawingBitmap.Free; end; end; From 14607f2ce6cf9c00b1e5c180eb5f76434425c009 Mon Sep 17 00:00:00 2001 From: Clayton Arends Date: Sun, 20 Sep 2026 08:38:35 -0700 Subject: [PATCH 2/4] Clear the prepared background bitmap if the background image changes --- Source/VirtualTrees.BaseTree.pas | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/Source/VirtualTrees.BaseTree.pas b/Source/VirtualTrees.BaseTree.pas index cda33ead..ef89eb12 100644 --- a/Source/VirtualTrees.BaseTree.pas +++ b/Source/VirtualTrees.BaseTree.pas @@ -749,6 +749,7 @@ TBaseVirtualTree = class abstract(TVTBaseAncestor) procedure CMParentDoubleBufferedChange(var Message: TMessage); message CM_PARENTDOUBLEBUFFEREDCHANGED; procedure AdjustTotalCount(Node: PVirtualNode; Value: Integer; relative: Boolean = False); + procedure BackgroundPictureChanged(Sender: TObject); function CalculateCacheEntryCount: Integer; procedure CalculateVerticalAlignments(var PaintInfo: TVTPaintInfo; var VButtonAlign: TDimension); function ChangeCheckState(Node: PVirtualNode; Value: TCheckState): Boolean; @@ -2295,6 +2296,8 @@ constructor TBaseVirtualTree.Create(AOwner: TComponent); FAutoScrollInterval := 1; FBackground := TVTBackground.Create; + FBackground.OnChange := BackgroundPictureChanged; + // Similar to the Transparent property of TImage, // this flag is Off by default. FBackGroundImageTransparent := False; @@ -2463,6 +2466,21 @@ procedure TBaseVirtualTree.AdjustTotalHeight(Node: PVirtualNode; Value: TNodeHei //---------------------------------------------------------------------------------------------------------------------- +procedure TBaseVirtualTree.BackgroundPictureChanged(Sender: TObject); + +// Invalidates the prepared background image whenever the background picture changes. + +// Note: If Background's bitmap pixels are modified directly (ScanLine, a raw HBITMAP/HDC, or any +// GDI call that bypasses TCanvas), OnChange is not called. The cached FBackgroundPrepared image +// will keep showing the previously prepared image. In such cases, reassign the Background to +// force an OnChange so it can be re-prepared. + +begin + FreeAndNil(FBackgroundPrepared); +end; + +//---------------------------------------------------------------------------------------------------------------------- + function TBaseVirtualTree.CalculateCacheEntryCount: Integer; // Calculates the size of the position cache. From 0be5179763ea825a0ba5054b03c5b5c4241cc002 Mon Sep 17 00:00:00 2001 From: Clayton Arends Date: Sun, 20 Sep 2026 08:56:30 -0700 Subject: [PATCH 3/4] Re-prepare the prepared background bitmap on settings changes --- Source/VirtualTrees.BaseTree.pas | 33 +++++++++++++++++++++++--------- 1 file changed, 24 insertions(+), 9 deletions(-) diff --git a/Source/VirtualTrees.BaseTree.pas b/Source/VirtualTrees.BaseTree.pas index ef89eb12..d9b188a5 100644 --- a/Source/VirtualTrees.BaseTree.pas +++ b/Source/VirtualTrees.BaseTree.pas @@ -408,6 +408,11 @@ TVTVirtualNodeEnumeration = record function GetNext(Node: PVirtualNode): PVirtualNode; end; + TVTPreparedBackground = record + Bitmap: TBitmap; + BackgroundColor: TColor; + Transparent: Boolean; + end; // ----- TBaseVirtualTree TBaseVirtualTree = class abstract(TVTBaseAncestor) @@ -468,7 +473,7 @@ TBaseVirtualTree = class abstract(TVTBaseAncestor) FTempNodeCache: TNodeArray; // used at various places to hold temporarily a bunch of node refs. FTempNodeCount: Cardinal; // number of nodes in FTempNodeCache FBackground: TVTBackground; // A background image loadable at design and runtime. - FBackgroundPrepared: TBitmap; // Prepared background image. + FBackgroundPrepared: TVTPreparedBackground; // Prepared background image and settings used when it was created. FBackgroundImageTransparent: Boolean; // By default, this is off. When switched on, will try to draw the image // transparent by using the color of the component as transparent color @@ -2359,7 +2364,7 @@ destructor TBaseVirtualTree.Destroy(); Clear; FColors.Free; FBackground.Free; - FreeAndNil(FBackgroundPrepared); + FreeAndNil(FBackgroundPrepared.Bitmap); if CheckImageKind = ckSystemDefault then FCheckImages.Free; @@ -2476,7 +2481,7 @@ procedure TBaseVirtualTree.BackgroundPictureChanged(Sender: TObject); // force an OnChange so it can be re-prepared. begin - FreeAndNil(FBackgroundPrepared); + FreeAndNil(FBackgroundPrepared.Bitmap); end; //---------------------------------------------------------------------------------------------------------------------- @@ -3361,15 +3366,25 @@ procedure TBaseVirtualTree.FixupTotalHeight(Node: PVirtualNode); function TBaseVirtualTree.GetBackgroundBitmap(Source: TVTBackground; aBkgColor: TColor): TBitmap; // Prepares and returns the background bitmap ready to be drawn. Creates a new bitmap if it -// hasn't been created yet. +// hasn't been created yet or if preparation settings have changed. + +var + bkgColor: TColor; begin - if Assigned(FBackgroundPrepared) then - Exit(FBackgroundPrepared); + bkgColor := ColorToRGB(aBkgColor); + if Assigned(FBackgroundPrepared.Bitmap) and + (FBackgroundPrepared.BackgroundColor = bkgColor) and + (FBackgroundPrepared.Transparent = FBackGroundImageTransparent) then + Exit(FBackgroundPrepared.Bitmap); + + FreeAndNil(FBackgroundPrepared.Bitmap); + FBackgroundPrepared.Bitmap := TBitmap.Create; - FBackgroundPrepared := TBitmap.Create; - PrepareBackGroundPicture(Source, FBackgroundPrepared, Source.Width, Source.Height, aBkgColor); - Result := FBackgroundPrepared; + PrepareBackGroundPicture(Source, FBackgroundPrepared.Bitmap, Source.Width, Source.Height, bkgColor); + FBackgroundPrepared.BackgroundColor := bkgColor; + FBackgroundPrepared.Transparent := FBackGroundImageTransparent; + Result := FBackgroundPrepared.Bitmap; end; //---------------------------------------------------------------------------------------------------------------------- From 1da02dfb29024321507211bb535ad7ff4cd4942d Mon Sep 17 00:00:00 2001 From: Clayton Arends Date: Sun, 20 Sep 2026 10:03:59 -0700 Subject: [PATCH 4/4] Clean up indentation --- Source/VirtualTrees.BaseTree.pas | 64 ++++++++++++++++---------------- 1 file changed, 32 insertions(+), 32 deletions(-) diff --git a/Source/VirtualTrees.BaseTree.pas b/Source/VirtualTrees.BaseTree.pas index d9b188a5..c4bfbe82 100644 --- a/Source/VirtualTrees.BaseTree.pas +++ b/Source/VirtualTrees.BaseTree.pas @@ -5829,9 +5829,9 @@ procedure TBaseVirtualTree.StaticBackground(Source: TVTBackground; Target: TCanv DrawRect: TRect; DrawingBitmap: TBitmap; begin - // clear background - Target.Brush.Color := aBkgColor; - Target.FillRect(R); + // clear background + Target.Brush.Color := aBkgColor; + Target.FillRect(R); // Picture rect in relation to client viewscreen. PicRect := Rect(FBackgroundOffsetX, FBackgroundOffsetY, FBackgroundOffsetX + Source.Width, FBackgroundOffsetY + Source.Height); @@ -5844,10 +5844,10 @@ procedure TBaseVirtualTree.StaticBackground(Source: TVTBackground; Target: TCanv begin DrawingBitmap := GetBackgroundBitmap(Source, aBkgColor); - // copy image to destination - BitBlt(Target.Handle, DrawRect.Left - OffsetPosition.X, DrawRect.Top - OffsetPosition.Y, (DrawRect.Right - OffsetPosition.X) - (DrawRect.Left - OffsetPosition.X), + // copy image to destination + BitBlt(Target.Handle, DrawRect.Left - OffsetPosition.X, DrawRect.Top - OffsetPosition.Y, (DrawRect.Right - OffsetPosition.X) - (DrawRect.Left - OffsetPosition.X), (DrawRect.Bottom - OffsetPosition.Y) - (DrawRect.Top - OffsetPosition.Y) + R.Top, DrawingBitmap.Canvas.Handle, DrawRect.Left - PicRect.Left, DrawRect.Top - PicRect.Top, - SRCCOPY); + SRCCOPY); end; end; @@ -5895,36 +5895,36 @@ procedure TBaseVirtualTree.TileBackground(Source: TVTBackground; Target: TCanvas begin DrawingBitmap := GetBackgroundBitmap(Source, aBkgColor); - with Target do - begin - SourceY := (R.Top + Offset.Y + FBackgroundOffsetY) mod Source.Height; - // Always wrap the source coordinates into positive range. - if SourceY < 0 then - SourceY := Source.Height + SourceY; + with Target do + begin + SourceY := (R.Top + Offset.Y + FBackgroundOffsetY) mod Source.Height; + // Always wrap the source coordinates into positive range. + if SourceY < 0 then + SourceY := Source.Height + SourceY; - // Tile image vertically until target rect is filled. - while R.Top < R.Bottom do - begin - SourceX := (R.Left + Offset.X + FBackgroundOffsetX) mod Source.Width; - // always wrap the source coordinates into positive range - if SourceX < 0 then - SourceX := Source.Width + SourceX; + // Tile image vertically until target rect is filled. + while R.Top < R.Bottom do + begin + SourceX := (R.Left + Offset.X + FBackgroundOffsetX) mod Source.Width; + // always wrap the source coordinates into positive range + if SourceX < 0 then + SourceX := Source.Width + SourceX; - TargetX := R.Left; - // height of strip to draw - DeltaY := Min(R.Bottom - R.Top, Source.Height - SourceY); + TargetX := R.Left; + // height of strip to draw + DeltaY := Min(R.Bottom - R.Top, Source.Height - SourceY); - // tile the image horizontally - while TargetX < R.Right do - begin - BitBlt(Handle, TargetX, R.Top, Min(R.Right - TargetX, Source.Width - SourceX), DeltaY, - DrawingBitmap.Canvas.Handle, SourceX, SourceY, SRCCOPY); - Inc(TargetX, Source.Width - SourceX); - SourceX := 0; - end; - Inc(R.Top, Source.Height - SourceY); - SourceY := 0; + // tile the image horizontally + while TargetX < R.Right do + begin + BitBlt(Handle, TargetX, R.Top, Min(R.Right - TargetX, Source.Width - SourceX), DeltaY, + DrawingBitmap.Canvas.Handle, SourceX, SourceY, SRCCOPY); + Inc(TargetX, Source.Width - SourceX); + SourceX := 0; end; + Inc(R.Top, Source.Height - SourceY); + SourceY := 0; + end; end; end;