diff --git a/Source/VirtualTrees.BaseTree.pas b/Source/VirtualTrees.BaseTree.pas index 597f0f39..b03ebe75 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,8 +473,11 @@ 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: 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 + FCustomBackgroundChange: TNotifyEvent; // Chains a consumer's Background.OnChange handler if they overwrite + // our internal hook (see #1402), so their handler still fires. FMargin: TDimension; // horizontal distance to border and columns FTextMargin: TDimension; // space between the node's text and its horizontal bounds @@ -748,6 +756,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; @@ -762,6 +771,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; @@ -1909,6 +1919,16 @@ TToggleAnimationData = record //---------------------------------------------------------------------------------------------------------------------- +function IsSameMethod(const Method1, Method2: TNotifyEvent): Boolean; + +// Compare two methods for equality. This can be moved to a utility unit if needed in more areas. + +begin + Result := (TMethod(Method1).Code = TMethod(Method2).Code) and (TMethod(Method1).Data = TMethod(Method2).Data); +end; + +//---------------------------------------------------------------------------------------------------------------------- + function TreeFromNode(Node: PVirtualNode): TBaseVirtualTree; // Returns the tree the node currently belongs to or nil if the node is not attached to a tree. @@ -2293,6 +2313,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; @@ -2354,6 +2376,7 @@ destructor TBaseVirtualTree.Destroy(); Clear; FColors.Free; FBackground.Free; + FreeAndNil(FBackgroundPrepared.Bitmap); if CheckImageKind = ckSystemDefault then FCheckImages.Free; @@ -2460,6 +2483,27 @@ 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.Bitmap); + Invalidate; + + // Forward to a consumer's own OnChange handler that got chained in GetBackgroundBitmap() + // after they overwrote Background.OnChange themselves (see #1402). + if Assigned(FCustomBackgroundChange) then + FCustomBackgroundChange(Sender); +end; + +//---------------------------------------------------------------------------------------------------------------------- + function TBaseVirtualTree.CalculateCacheEntryCount: Integer; // Calculates the size of the position cache. @@ -3337,6 +3381,41 @@ 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 or if preparation settings have changed. + +var + bkgColor: TColor; + +begin + // A consumer may have reassigned Background.OnChange, replacing our hook; re-chain it so their + // handler still fires (see #1402). Checks FBackground specifically, not Source, since that's + // whose hook we're guarding, regardless of what's passed in. + if not IsSameMethod(FBackground.OnChange, BackgroundPictureChanged) then + begin + FCustomBackgroundChange := FBackground.OnChange; + FBackground.OnChange := BackgroundPictureChanged; + end; + + 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; + + PrepareBackGroundPicture(Source, FBackgroundPrepared.Bitmap, Source.Width, Source.Height, bkgColor); + FBackgroundPrepared.BackgroundColor := bkgColor; + FBackgroundPrepared.Transparent := FBackGroundImageTransparent; + Result := FBackgroundPrepared.Bitmap; +end; + +//---------------------------------------------------------------------------------------------------------------------- + function TBaseVirtualTree.GetBottomNode: PVirtualNode; begin @@ -5777,11 +5856,9 @@ 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); + // 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); @@ -5792,14 +5869,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); - // copy image to destination - BitBlt(Target.Handle, DrawRect.Left - OffsetPosition.X, DrawRect.Top - OffsetPosition.Y, (DrawRect.Right - OffsetPosition.X) - (DrawRect.Left - OffsetPosition.X), + 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; + SRCCOPY); end; end; @@ -5845,42 +5920,38 @@ procedure TBaseVirtualTree.TileBackground(Source: TVTBackground; Target: TCanvas DeltaY: TDimension; DrawingBitmap: TBitmap; begin - DrawingBitmap := TBitmap.Create; - try - PrepareBackGroundPicture(Source, DrawingBitmap, Source.Width, Source.Height, 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; + DrawingBitmap := GetBackgroundBitmap(Source, aBkgColor); - // 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; + 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; - TargetX := R.Left; - // height of strip to draw - DeltaY := Min(R.Bottom - R.Top, 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 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; + 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; end; - finally - DrawingBitmap.Free; end; end;