pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

* Synchronize with main VTV repository up to svn rev 178

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@774 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
blikblum
2009-04-10 18:11:01 +00:00
parent ec85886930
commit 71288d8d81
1 changed files with 267 additions and 92 deletions
Download Patch File Download Diff File Expand all files Collapse all files

359
components/virtualtreeview-new/VirtualTrees.pas
View File

@ -2,7 +2,7 @@ unit VirtualTrees;
{$mode delphi}{$H+}
// Version 4.8.1
// Version 4.8.3
//
// The contents of this file are subject to the Mozilla Public License
// Version 1.1 (the "License"); you may not use this file except in compliance
@ -26,7 +26,16 @@ unit VirtualTrees;
// (C) 1999-2001 digital publishing AG. All Rights Reserved.
//----------------------------------------------------------------------------------------------------------------------
//
// March 2009
// - Improvement: extended hot node tracking to track the hot column too
// - Improvement: new THitPosition hiOnItemButtonExact used to draw hot buttons when using Windows Vista's Explorer
// theme
// - Improvement: new TVTPaintOption toHideTreeLinesIfThemed to consider toShowTreeLines only if running unthemed
// - Improvement: new TVTPaintOption toUseExplorerTheme to draw the tree like Windows Vista's Explorer treeview
// February 2009
// - Bug fix: reverted the implementation of DrawTextW back to the one prior to 4.8.1 as the line end detection
// lead to a compiler warning under Delphi 2009
// - Bug fix: corrected implementation of GetStringDrawRect to match its declaration (UnicodeString vs WideString)
// - Bug fix: the node focus will no longer change if a TVTMiscOption.toGridExtensions is set and one clicks right of
// (or left of, if right-to-left reading) the last column
// - Bug fix: fixed an issue with TVTHeader.Assign that could lead to an access violation if the header is created at
@ -34,7 +43,7 @@ unit VirtualTrees;
// - Bug fix: one can no longer change a node's height with the right mouse button even if toNodeHeightResize and
// toRightClickSelect are set
// - Improvement: TVTAutoOption.toDisableAutoScrollOnFocus now works for nodes too
// - Improvement: new property TBaseVirtualTree.SelectionLocked to disable changing the selection
// - Improvement: new property TBaseVirtualTree.SelectionLocked to disable changing the selection
// - Improvement: made the dual-scroll effect in TBaseVirtualTree.ToggleNode much smoother
// - Bug fix: removed off-by-1 errors in TBaseVirtualTree.ToggleNode
// - Bug fix: added a check for FUpdateCount to TBaseVirtualTree.SetUpdateState as otherwise every call to
@ -306,7 +315,7 @@ uses
const
{$I lclconstants.inc}
VTVersion = '4.8.1';
VTVersion = '4.8.3';
VTTreeStreamVersion = 2;
VTHeaderStreamVersion = 6; // The header needs an own stream version to indicate changes only relevant to the header.
@ -434,6 +443,7 @@ var // Clipboard format IDs used in OLE drag'n drop and clipboard transfers.
IsWinNT: Boolean; // Necessary to fix bugs in Win95/WinME (non-client area region intersection, edit resize)
// and to allow for check of system dependent hint animation.
IsWinVistaOrAbove: Boolean;
{$MinEnumSize 1, make enumerations as small as possible}
@ -517,22 +527,23 @@ type
// These flags are returned by the hit test method.
THitPosition = (
hiAbove, // above the client area (if relative) or the absolute tree area
hiBelow, // below the client area (if relative) or the absolute tree area
hiNowhere, // no node is involved (possible only if the tree is not as tall as the client area)
hiOnItem, // on the bitmaps/buttons or label associated with an item
hiOnItemButton, // on the button associated with an item
hiOnItemCheckbox, // on the checkbox if enabled
hiOnItemIndent, // in the indentation area in front of a node
hiOnItemLabel, // on the normal text area associated with an item
hiOnItemLeft, // in the area to the left of a node's text area (e.g. when right aligned or centered)
hiOnItemRight, // in the area to the right of a node's text area (e.g. if left aligned or centered)
hiOnNormalIcon, // on the "normal" image
hiOnStateIcon, // on the state image
hiToLeft, // to the left of the client area (if relative) or the absolute tree area
hiToRight, // to the right of the client area (if relative) or the absolute tree area
hiUpperSplitter, // in the upper splitter area of a node
hiLowerSplitter // in the lower splitter area of a node
hiAbove, // above the client area (if relative) or the absolute tree area
hiBelow, // below the client area (if relative) or the absolute tree area
hiNowhere, // no node is involved (possible only if the tree is not as tall as the client area)
hiOnItem, // on the bitmaps/buttons or label associated with an item
hiOnItemButton, // on the button associated with an item
hiOnItemButtonExact, // exactly on the button associated with an item
hiOnItemCheckbox, // on the checkbox if enabled
hiOnItemIndent, // in the indentation area in front of a node
hiOnItemLabel, // on the normal text area associated with an item
hiOnItemLeft, // in the area to the left of a node's text area (e.g. when right aligned or centered)
hiOnItemRight, // in the area to the right of a node's text area (e.g. if left aligned or centered)
hiOnNormalIcon, // on the "normal" image
hiOnStateIcon, // on the state image
hiToLeft, // to the left of the client area (if relative) or the absolute tree area
hiToRight, // to the right of the client area (if relative) or the absolute tree area
hiUpperSplitter, // in the upper splitter area of a node
hiLowerSplitter // in the lower splitter area of a node
);
THitPositions = set of THitPosition;
@ -652,7 +663,9 @@ type
toUseBlendedSelection, // Enable alpha blending for node selections.
toStaticBackground, // Show simple static background instead of a tiled one.
toChildrenAbove, // Display child nodes above their parent.
toFixedIndent // Draw the tree with a fixed indent.
toFixedIndent, // Draw the tree with a fixed indent.
toUseExplorerTheme, // Use the explorer theme if run under Windows Vista (or above)
toHideTreeLinesIfThemed // Do not show tree lines if theming is used
);
TVTPaintOptions = set of TVTPaintOption;
@ -2074,6 +2087,8 @@ type
FLastStructureChangeNode, // dito
FLastChangedNode, // used for delayed change event
FCurrentHotNode: PVirtualNode; // Node over which the mouse is hovering.
FCurrentHotColumn: TColumnIndex; // Column over which the mouse is hovering.
FHotNodeButtonHit: Boolean; // Indicates wether the mouse is hovering over the hot node's button.
FLastSelRect,
FNewSelRect: TRect; // used while doing draw selection
FHotCursor: TCursor; // can be set to additionally indicate the current hot node
@ -2708,8 +2723,8 @@ type
procedure Paint; override;
procedure PaintCheckImage(const PaintInfo: TVTPaintInfo); virtual;
procedure PaintImage(var PaintInfo: TVTPaintInfo; ImageInfoIndex: TVTImageInfoIndex; DoOverlay: Boolean); virtual;
procedure PaintNodeButton(Canvas: TCanvas; Node: PVirtualNode; const R: TRect; ButtonX, ButtonY: Integer;
BidiMode: TBiDiMode); virtual;
procedure PaintNodeButton(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const R: TRect; ButtonX,
ButtonY: Integer; BidiMode: TBiDiMode); virtual;
procedure PaintTreeLines(const PaintInfo: TVTPaintInfo; VAlignment, IndentSize: Integer;
LineImage: TLineImage); virtual;
procedure PaintSelectionRectangle(Target: TCanvas; WindowOrgX: Integer; const SelectionRect: TRect;
@ -3860,7 +3875,6 @@ resourcestring
SCannotSetUserData = 'Cannot set initial user data because there is not enough user data space allocated.';
const
TreeButtonSize = 9; //default size for tree buttons (minus/plus)
ClipboardStates = [tsCopyPending, tsCutPending];
DefaultScrollUpdateFlags = [suoRepaintHeader, suoRepaintScrollbars, suoScrollClientArea, suoUpdateNCArea];
MinimumTimerInterval = 1; // minimum resolution for timeGetTime
@ -5965,12 +5979,16 @@ begin
if not (csLoading in ComponentState) and HandleAllocated then
begin
{$ifdef ThemeSupport}
if toThemeAware in ToBeSet + ToBeCleared then
if (toThemeAware in ToBeSet + ToBeCleared) or (toUseExplorerTheme in ToBeSet + ToBeCleared) then
begin
if (toThemeAware in ToBeSet) and ThemeServices.ThemesEnabled then
DoStateChange([tsUseThemes])
else
else if (toThemeAware in ToBeCleared) then
DoStateChange([], [tsUseThemes]);
if (tsUseThemes in FStates) and (toUseExplorerTheme in FOptions.FPaintOptions) and IsWinVistaOrAbove then
SetWindowTheme(Handle, 'explorer', nil);
PrepareBitmaps(True, False);
RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_VALIDATE or RDW_FRAME);
end
@ -13269,7 +13287,8 @@ begin
Logger.Send([lcPaintDetails],'Clearing Rectangle (R)', R);
if (poDrawSelection in PaintOptions) and (toFullRowSelect in FOptions.FSelectionOptions) and
(vsSelected in Node.States) and not (toUseBlendedSelection in FOptions.PaintOptions) then
(vsSelected in Node.States) and not (toUseBlendedSelection in FOptions.PaintOptions) and not
((tsUseThemes in FStates) and (toUseExplorerTheme in FOptions.FPaintOptions) and IsWinVistaOrAbove) then
begin
Logger.Send([lcPaintDetails, lcDrag], 'Draw the background of a selected node');
if toShowHorzGridLines in FOptions.PaintOptions then
@ -14061,7 +14080,8 @@ begin
SetLength(LineImage, X);
// Only use lines if requested.
if toShowTreeLines in FOptions.FPaintOptions then
if (toShowTreeLines in FOptions.FPaintOptions) and
(not (toHideTreeLinesIfThemed in FOptions.FPaintOptions) or not (tsUseThemes in FStates)) then
begin
if toChildrenAbove in FOptions.FPaintOptions then
begin
@ -14117,7 +14137,8 @@ begin
end;
// Prepare root level. Run points at this stage to a top level node.
if (toShowRoot in FOptions.FPaintOptions) and (toShowTreeLines in FOptions.FPaintOptions) then
if (toShowRoot in FOptions.FPaintOptions) and ((toShowTreeLines in FOptions.FPaintOptions) and
(not (toHideTreeLinesIfThemed in FOptions.FPaintOptions) or not (tsUseThemes in FStates))) then
begin
// Is the top node a root node?
if Run = Node then
@ -14430,19 +14451,38 @@ const
var
PatternBitmap: HBITMAP;
Bits: Pointer;
Size: TSize;
{$ifdef ThemeSupport}
Details: TThemedElementDetails;
Theme: HTHEME;
R: TRect;
{$endif ThemeSupport}
begin
Size.cx := 9;
Size.cy := 9;
{$ifdef ThemeSupport}
// Under Windows Vista the size of the glyphs differ from 9x9 when the explorer theme is used. Since the
// glyphs are also partly transparent FPlusBM and FMinusBM are not used in that case, but for the sake of
// simplicity we set their size so that the positioning code for the glyps remains the same.
if IsWinVistaOrAbove and (tsUseThemes in FStates) and (toUseExplorerTheme in FOptions.FPaintOptions) then
begin
Theme := OpenThemeData(Handle, 'TREEVIEW');
R := Rect(0, 0, 100, 100);
GetThemePartSize(Theme, FPlusBM.Canvas.Handle, TVP_GLYPH, GLPS_OPENED, @R, TS_TRUE, Size);
CloseThemeData(Theme);
end;
{$endif ThemeSupport}
if NeedButtons then
begin
with FMinusBM, Canvas do
begin
// box is always of odd size
//The TCanvas of VCL does not has width and height. It cause a conflict here
FMinusBM.Width := TreeButtonSize;
FMinusBM.Height := TreeButtonSize;
FMinusBM.Width := Size.cx;
FMinusBM.Height := Size.cy;
//Reset mask
MaskHandle := 0;
//todo: remove when transparency is fixed in gtk
@ -14451,13 +14491,13 @@ begin
{$else}
Brush.Color := Self.Color;
{$endif}
FillRect(Rect(0, 0, TreeButtonSize, TreeButtonSize));
FillRect(Rect(0, 0, Size.cx, Size.cy));
if FButtonStyle = bsTriangle then
begin
Brush.Color := clBlack;
Pen.Color := clBlack;
Polygon([Point(0, 2), Point(8, 2), Point(4, 6)]);
MaskHandle := CreateBitmapMask(Handle, TreeButtonSize, TreeButtonSize, clFuchsia);
MaskHandle := CreateBitmapMask(Handle, Size.cx, Size.cy, clFuchsia);
end
else
begin
@ -14471,12 +14511,12 @@ begin
Brush.Color := clWindow;
end;
Pen.Color := FColors.TreeLineColor;
Rectangle(0, 0, TreeButtonSize, TreeButtonSize);
Rectangle(0, 0, Size.cx, Size.cy);
Pen.Color := Self.Font.Color;
MoveTo(2, TreeButtonSize div 2);
LineTo(TreeButtonSize - 2 , TreeButtonSize div 2);
MoveTo(2, Size.cy div 2);
LineTo(Size.cx - 2 , Size.cy div 2);
if FButtonFillMode = fmTransparent then
MaskHandle := CreateBitmapMask(Handle, TreeButtonSize, TreeButtonSize, clFuchsia);
MaskHandle := CreateBitmapMask(Handle, Size.cx, Size.cy, clFuchsia);
end
else
FMinusBM.LoadFromLazarusResource('VT_XPBUTTONMINUS');
@ -14485,8 +14525,8 @@ begin
with FPlusBM, Canvas do
begin
FPlusBM.Width := TreeButtonSize;
FPlusBM.Height := TreeButtonSize;
FPlusBM.Width := Size.cx;
FPlusBM.Height := Size.cy;
//Reset mask
MaskHandle := 0;
//todo: remove when transparency is fixed in gtk
@ -14495,13 +14535,13 @@ begin
{$else}
Brush.Color := Self.Color;
{$endif}
FillRect(Rect(0, 0, TreeButtonSize, TreeButtonSize));
FillRect(Rect(0, 0, Size.cx, Size.cy));
if FButtonStyle = bsTriangle then
begin
Brush.Color := clBlack;
Pen.Color := clBlack;
Polygon([Point(2, 0), Point(6, 4), Point(2, 8)]);
MaskHandle := CreateBitmapMask(Handle, TreeButtonSize, TreeButtonSize, clFuchsia);
MaskHandle := CreateBitmapMask(Handle, Size.cx, Size.cy, clFuchsia);
end
else
begin
@ -14516,14 +14556,14 @@ begin
end;
Pen.Color := FColors.TreeLineColor;
Rectangle(0, 0, TreeButtonSize, TreeButtonSize);
Rectangle(0, 0, Size.cx, Size.cy);
Pen.Color := Self.Font.Color;
MoveTo(2, TreeButtonSize div 2);
LineTo(TreeButtonSize - 2 , TreeButtonSize div 2);
MoveTo(TreeButtonSize div 2, 2);
LineTo(TreeButtonSize div 2, TreeButtonSize - 2);
MoveTo(2, Size.cy div 2);
LineTo(Size.cx - 2 , Size.cy div 2);
MoveTo(Size.cx div 2, 2);
LineTo(Size.cx div 2, Size.cy - 2);
if FButtonFillMode = fmTransparent then
MaskHandle := CreateBitmapMask(Handle, TreeButtonSize, TreeButtonSize, clFuchsia);
MaskHandle := CreateBitmapMask(Handle, Size.cx, Size.cy, clFuchsia);
end
else
FPlusBM.LoadFromLazarusResource('VT_XPBUTTONPLUS');
@ -14571,9 +14611,19 @@ procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX,
var
TextColorBackup,
BackColorBackup: COLORREF;
FocusRect,
InnerRect: TRect;
{$ifdef ThemeSupport}
RowRect: TRect;
Theme: HTHEME;
//--------------- local function --------------------------------------------
{$ifndef COMPILER_11_UP}
const
TREIS_HOTSELECTED = 6;
{$endif COMPILER_11_UP}
{$endif ThemeSupport}
//--------------- local functions -------------------------------------------
procedure AlphaBlendSelection(Color: TColor);
@ -14595,12 +14645,36 @@ var
FSelectionBlendFactor, ColorToRGB(Color));
end;
//--------------- end local function ----------------------------------------
//---------------------------------------------------------------------------
{$ifdef ThemeSupport}
procedure DrawBackground(State: Integer);
begin
with PaintInfo do
if (toGridExtensions in FOptions.FMiscOptions) or (toFullRowSelect in FOptions.FSelectionOptions) then
DrawThemeBackground(Theme, Canvas.Handle, TVP_TREEITEM, State, RowRect, @CellRect)
else
DrawThemeBackground(Theme, Canvas.Handle, TVP_TREEITEM, State, InnerRect, nil);
end;
{$endif ThemeSupport}
//--------------- end local functions ---------------------------------------
begin
{$ifdef ThemeSupport}
if IsWinVistaOrAbove and (tsUseThemes in FStates) and (toUseExplorerTheme in FOptions.FPaintOptions) then
begin
RowRect := Rect(0, PaintInfo.CellRect.Top, FRangeX, PaintInfo.CellRect.Bottom);
if toShowVertGridLines in FOptions.PaintOptions then
Dec(RowRect.Right);
Theme := OpenThemeData(Handle, 'TREEVIEW');
end
else
Theme := 0;
{$endif ThemeSupport}
with PaintInfo, Canvas do
begin
// Fill cell background if its color differs from tree background.
with FHeader.FColumns do
if poColumnColor in PaintOptions then
@ -14614,30 +14688,30 @@ begin
InnerRect := ContentRect;
// The selection rectangle depends on alignment.
if not (toGridExtensions in FOptions.FMiscOptions) then
begin
case Alignment of
taLeftJustify:
with InnerRect do
if Left + NodeWidth < Right then
Right := Left + NodeWidth;
taCenter:
with InnerRect do
if (Right - Left) > NodeWidth then
begin
Left := (Left + Right - NodeWidth) div 2;
Right := Left + NodeWidth;
end;
taRightJustify:
with InnerRect do
if (Right - Left) > NodeWidth then
Left := Right - NodeWidth;
end;
end;
if (Column = FFocusedColumn) or (toFullRowSelect in FOptions.FSelectionOptions) then
begin
// The selection rectangle depends on alignment.
if not (toGridExtensions in FOptions.FMiscOptions) then
begin
case Alignment of
taLeftJustify:
with InnerRect do
if Left + NodeWidth < Right then
Right := Left + NodeWidth;
taCenter:
with InnerRect do
if (Right - Left) > NodeWidth then
begin
Left := (Left + Right - NodeWidth) div 2;
Right := Left + NodeWidth;
end;
taRightJustify:
with InnerRect do
if (Right - Left) > NodeWidth then
Left := Right - NodeWidth;
end;
end;
// Fill the selection rectangle.
if poDrawSelection in PaintOptions then
begin
@ -14681,6 +14755,16 @@ begin
if (toGridExtensions in FOptions.FMiscOptions) or (toFullRowSelect in FOptions.FSelectionOptions) then
InnerRect := CellRect;
if not IsRectEmpty(InnerRect) then
{$ifdef ThemeSupport}
if Theme <> 0 then
begin
// If the node is also hot, its background will be drawn later.
if not (toHotTrack in FOptions.FPaintOptions) or (Node <> FCurrentHotNode) or
((Column <> FCurrentHotColumn) and not (toFullRowSelect in FOptions.FSelectionOptions)) then
DrawBackground(IfThen(Self.Focused, TREIS_SELECTED, TREIS_SELECTEDNOTFOCUS));
end
else
{$endif ThemeSupport}
if MMXAvailable and (toUseBlendedSelection in FOptions.PaintOptions) then
AlphaBlendSelection(Brush.Color)
else
@ -14688,26 +14772,60 @@ begin
RoundRect(Left, Top, Right, Bottom, FSelectionCurveRadius, FSelectionCurveRadius);
end;
end;
end;
{$ifdef ThemeSupport}
if (Theme <> 0) and (toHotTrack in FOptions.FPaintOptions) and (Node = FCurrentHotNode) and
((Column = FCurrentHotColumn) or (toFullRowSelect in FOptions.FSelectionOptions)) then
DrawBackground(IfThen((vsSelected in Node.States) and not (toAlwaysHideSelection in FOptions.FPaintOptions),
TREIS_HOTSELECTED, TREIS_HOT));
{$endif ThemeSupport}
if (Column = FFocusedColumn) or (toFullRowSelect in FOptions.FSelectionOptions) then
begin
// draw focus rect
if (poDrawFocusRect in PaintOptions) and (Column = FFocusedColumn) and
(Focused or (toPopupMode in FOptions.FPaintOptions)) and (FFocusedNode = Node) then
if (poDrawFocusRect in PaintOptions) and
(Focused or (toPopupMode in FOptions.FPaintOptions)) and (FFocusedNode = Node) and
( (Column = FFocusedColumn)
{$ifdef ThemeSupport} or
(not (toExtendedFocus in FOptions.FSelectionOptions) and
(toFullRowSelect in FOptions.FSelectionOptions) and
(Theme <> 0) )
{$endif ThemeSupport}
) then
begin
TextColorBackup := GetTextColor(Handle);
SetTextColor(Handle, $FFFFFF);
BackColorBackup := GetBkColor(Handle);
SetBkColor(Handle, 0);
{$ifdef ThemeSupport}
if not (toExtendedFocus in FOptions.FSelectionOptions) and (toFullRowSelect in FOptions.FSelectionOptions) and
(Theme <> 0) then
FocusRect := RowRect
else
{$endif ThemeSupport}
if toGridExtensions in FOptions.FMiscOptions then
LCLIntf.DrawFocusRect(Handle, CellRect)
FocusRect := CellRect
else
LCLIntf.DrawFocusRect(Handle, InnerRect);
FocusRect := InnerRect;
{$ifdef ThemeSupport}
if Theme <> 0 then
InflateRect(FocusRect, -1, -1);
{$endif ThemeSupport}
LCLIntf.DrawFocusRect(Handle, FocusRect);
SetTextColor(Handle, TextColorBackup);
SetBkColor(Handle, BackColorBackup);
end;
end;
end;
{$ifdef ThemeSupport}
if Theme <> 0 then
CloseThemeData(Theme);
{$endif ThemeSupport}
end;
//----------------------------------------------------------------------------------------------------------------------
@ -18768,7 +18886,11 @@ begin
{$ifdef ThemeSupport}
if ThemeServices.ThemesEnabled and (toThemeAware in TreeOptions.PaintOptions) then
DoStateChange([tsUseThemes])
begin
DoStateChange([tsUseThemes]);
if (toUseExplorerTheme in FOptions.FPaintOptions) and IsWinVistaOrAbove then
SetWindowTheme(Handle, 'explorer', nil);
end
else
{$endif ThemeSupport}
DoStateChange([], [tsUseThemes]);
@ -18925,6 +19047,8 @@ begin
// indentation level is accepted as button hit.
if Offset >= Indent - Integer(FIndent) then
Include(HitInfo.HitPositions, hiOnItemButton);
if Offset >= Indent - FPlusBM.Width then
Include(HitInfo.HitPositions, hiOnItemButtonExact);
end;
// no button hit so position is on indent
if HitInfo.HitPositions = [] then
@ -19060,6 +19184,8 @@ begin
// indentation level is accepted as button hit.
if Offset <= Right + Integer(FIndent) then
Include(HitInfo.HitPositions, hiOnItemButton);
if Offset <= Right + FPlusBM.Width then
Include(HitInfo.HitPositions, hiOnItemButtonExact);
end;
// no button hit so position is on indent
if HitInfo.HitPositions = [] then
@ -21789,25 +21915,43 @@ procedure TBaseVirtualTree.HandleHotTrack(X, Y: Integer);
var
HitInfo: THitInfo;
CheckPositions: THitPositions;
ButtonIsHit,
DoInvalidate: Boolean;
begin
DoInvalidate := False;
// Get information about the hit.
GetHitTestInfoAt(X, Y, True, HitInfo);
// Only make the new node being "hot" if its label is hit or full row selection is enabled.
if ([hiOnItemLabel, hiOnItemCheckbox] * HitInfo.HitPositions = []) and
not (toFullRowSelect in FOptions.FSelectionOptions) then
CheckPositions := [hiOnItemLabel, hiOnItemCheckbox];
// If running under Windows Vista using the explorer theme hitting the buttons makes the node hot, too.
if (IsWinVistaOrAbove and (tsUseThemes in FStates) and (toUseExplorerTheme in FOptions.FPaintOptions)) then
Include(CheckPositions, hiOnItemButtonExact);
if (CheckPositions * HitInfo.HitPositions = []) and not (toFullRowSelect in FOptions.FSelectionOptions) then
HitInfo.HitNode := nil;
if HitInfo.HitNode <> FCurrentHotNode then
if (HitInfo.HitNode <> FCurrentHotNode) or (HitInfo.HitColumn <> FCurrentHotColumn) then
begin
DoInvalidate := (toHotTrack in FOptions.PaintOptions) or (toCheckSupport in FOptions.FMiscOptions);
DoHotChange(FCurrentHotNode, HitInfo.HitNode);
if Assigned(FCurrentHotNode) and DoInvalidate then
InvalidateNode(FCurrentHotNode);
FCurrentHotNode := HitInfo.HitNode;
if Assigned(FCurrentHotNode) and DoInvalidate then
InvalidateNode(FCurrentHotNode);
FCurrentHotColumn := HitInfo.HitColumn;
end;
ButtonIsHit := hiOnItemButtonExact in HitInfo.HitPositions;
if Assigned(FCurrentHotNode) and ((FHotNodeButtonHit <> ButtonIsHit) or DoInvalidate) then
begin
FHotNodeButtonHit := ButtonIsHit and (toHotTrack in FOptions.FPaintOptions);
InvalidateNode(FCurrentHotNode);
end
else
if not Assigned(FCurrentHotNode) then
FHotNodeButtonHit := False;
end;
//----------------------------------------------------------------------------------------------------------------------
@ -23698,12 +23842,23 @@ end;
//----------------------------------------------------------------------------------------------------------------------
procedure TBaseVirtualTree.PaintNodeButton(Canvas: TCanvas; Node: PVirtualNode; const R: TRect; ButtonX,
ButtonY: Integer; BidiMode: TBiDiMode);
procedure TBaseVirtualTree.PaintNodeButton(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const R: TRect;
ButtonX, ButtonY: Integer; BidiMode: TBiDiMode);
var
Bitmap: TBitmap;
XPos: Integer;
{$ifdef ThemeSupport}
Theme: HTHEME;
Part,
State: Integer;
ButtonRect: TRect;
{$ifndef COMPILER_11_UP}
const
TVP_HOTGLYPH = 4;
{$endif COMPILER_11_UP}
{$endif ThemeSupport}
begin
Logger.EnterMethod([lcPaintDetails],'PaintNodeButton');
@ -23717,10 +23872,22 @@ begin
XPos := R.Left + ButtonX
else
XPos := R.Right - ButtonX - Bitmap.Width;
Logger.SendBitmap([lcPaintBitmap],'NodeButton',Bitmap);
{$ifdef ThemeSupport}
if IsWinVistaOrAbove and (tsUseThemes in FStates) and (toUseExplorerTheme in FOptions.FPaintOptions) then
begin
Theme := OpenThemeData(Handle, 'TREEVIEW');
Part := IfThen((Node = FCurrentHotNode)and FHotNodeButtonHit, TVP_HOTGLYPH, TVP_GLYPH);
State := IfThen(vsExpanded in Node.States, GLPS_OPENED, GLPS_CLOSED);
ButtonRect := Rect(XPos, R.Top + ButtonY, XPos + FPlusBM.Width, R.Top + ButtonY + FPlusBM.Height);
DrawThemeBackground(Theme, Canvas.Handle, Part, State, ButtonRect, nil);
CloseThemeData(Theme);
end
else
{$endif ThemeSupport}
// Need to draw this masked.
DirectMaskBlt(Canvas.Handle, XPos, R.Top + ButtonY, TreeButtonSize, TreeButtonSize, Bitmap.Canvas.Handle,
0, 0, Bitmap.MaskHandle);
DirectMaskBlt(Canvas.Handle, XPos, R.Top + ButtonY, Bitmap.Width, Bitmap.Height,
Bitmap.Canvas.Handle, 0, 0, Bitmap.MaskHandle);
Logger.ExitMethod([lcPaintDetails],'PaintNodeButton');
end;
@ -29520,14 +29687,16 @@ begin
// Some parts are only drawn for the main column.
if IsMainColumn then
begin
if toShowTreeLines in FOptions.FPaintOptions then
if (toShowTreeLines in FOptions.FPaintOptions) and
(not (toHideTreeLinesIfThemed in FOptions.FPaintOptions) or
not (tsUseThemes in FStates)) then
PaintTreeLines(PaintInfo, VAlign, IfThen(toFixedIndent in FOptions.FPaintOptions, 1, IndentSize), LineImage);
// Show node button if allowed, if there child nodes and at least one of the child
// nodes is visible or auto button hiding is disabled.
if (toShowButtons in FOptions.FPaintOptions) and (vsHasChildren in Node.States) and
not ((vsAllChildrenHidden in Node.States) and
(toAutoHideButtons in TreeOptions.FAutoOptions)) then
PaintNodeButton(Canvas, Node, CellRect, ButtonX, ButtonY, BidiMode);
PaintNodeButton(Canvas, Node, Column, CellRect, ButtonX, ButtonY, BidiMode);
if ImageInfo[iiCheck].Index > -1 then
PaintCheckImage(PaintInfo);
@ -32027,7 +32196,9 @@ begin
if (toHotTrack in FOptions.FPaintOptions) and (Node = FCurrentHotNode) then
begin
Canvas.Font.Style := Canvas.Font.Style + [fsUnderline];
if not IsWinVistaOrAbove or not (tsUseThemes in FStates) or
not (toUseExplorerTheme in FOptions.FPaintOptions) then
Canvas.Font.Style := Canvas.Font.Style + [fsUnderline];
Canvas.Font.Color := FColors.HotColor;
end;
@ -32038,13 +32209,17 @@ begin
begin
if Node = FDropTargetNode then
begin
if (FLastDropMode = dmOnNode) or (vsSelected in Node.States)then
if (FLastDropMode = dmOnNode) or (vsSelected in Node.States) and
(not IsWinVistaOrAbove or not (tsUseThemes in FStates) or
not (toUseExplorerTheme in FOptions.FPaintOptions)) then
Canvas.Font.Color := clHighlightText;
end
else
if vsSelected in Node.States then
begin
if Focused or (toPopupMode in FOptions.FPaintOptions) then
if (Focused or (toPopupMode in FOptions.FPaintOptions)) and
(not IsWinVistaOrAbove or not (tsUseThemes in FStates) or
not (toUseExplorerTheme in FOptions.FPaintOptions)) then
Canvas.Font.Color := clHighlightText;
end;
end;
@ -32057,7 +32232,7 @@ end;
procedure TCustomVirtualStringTree.PaintNormalText(var PaintInfo: TVTPaintInfo; TextOutFlags: Integer;
Text: UTF8String);
// This method is responsible for painting the given test to target canvas (under consideration of the given rectangles).
// This method is responsible for painting the given text to target canvas (under consideration of the given rectangles).
// The text drawn here is considered as the normal text in a node.
// Note: NodeWidth is the actual width of the text to be drawn. This does not necessarily correspond to the width of
// the node rectangle. The clipping rectangle comprises the entire node (including tree lines, buttons etc.).