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

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

@ -2,7 +2,7 @@ unit VirtualTrees;
{$mode delphi}{$H+} {$mode delphi}{$H+}
// Version 4.8.1 // Version 4.8.3
// //
// The contents of this file are subject to the Mozilla Public License // 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 // 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. // (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 // 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 // - 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 // (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 // - Bug fix: fixed an issue with TVTHeader.Assign that could lead to an access violation if the header is created at
@ -306,7 +315,7 @@ uses
const const
{$I lclconstants.inc} {$I lclconstants.inc}
VTVersion = '4.8.1'; VTVersion = '4.8.3';
VTTreeStreamVersion = 2; VTTreeStreamVersion = 2;
VTHeaderStreamVersion = 6; // The header needs an own stream version to indicate changes only relevant to the header. 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) 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. // and to allow for check of system dependent hint animation.
IsWinVistaOrAbove: Boolean;
{$MinEnumSize 1, make enumerations as small as possible} {$MinEnumSize 1, make enumerations as small as possible}
@ -522,6 +532,7 @@ type
hiNowhere, // no node is involved (possible only if the tree is not as tall as the client 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 hiOnItem, // on the bitmaps/buttons or label associated with an item
hiOnItemButton, // on the button 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 hiOnItemCheckbox, // on the checkbox if enabled
hiOnItemIndent, // in the indentation area in front of a node hiOnItemIndent, // in the indentation area in front of a node
hiOnItemLabel, // on the normal text area associated with an item hiOnItemLabel, // on the normal text area associated with an item
@ -652,7 +663,9 @@ type
toUseBlendedSelection, // Enable alpha blending for node selections. toUseBlendedSelection, // Enable alpha blending for node selections.
toStaticBackground, // Show simple static background instead of a tiled one. toStaticBackground, // Show simple static background instead of a tiled one.
toChildrenAbove, // Display child nodes above their parent. 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; TVTPaintOptions = set of TVTPaintOption;
@ -2074,6 +2087,8 @@ type
FLastStructureChangeNode, // dito FLastStructureChangeNode, // dito
FLastChangedNode, // used for delayed change event FLastChangedNode, // used for delayed change event
FCurrentHotNode: PVirtualNode; // Node over which the mouse is hovering. 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, FLastSelRect,
FNewSelRect: TRect; // used while doing draw selection FNewSelRect: TRect; // used while doing draw selection
FHotCursor: TCursor; // can be set to additionally indicate the current hot node FHotCursor: TCursor; // can be set to additionally indicate the current hot node
@ -2708,8 +2723,8 @@ type
procedure Paint; override; procedure Paint; override;
procedure PaintCheckImage(const PaintInfo: TVTPaintInfo); virtual; procedure PaintCheckImage(const PaintInfo: TVTPaintInfo); virtual;
procedure PaintImage(var PaintInfo: TVTPaintInfo; ImageInfoIndex: TVTImageInfoIndex; DoOverlay: Boolean); virtual; procedure PaintImage(var PaintInfo: TVTPaintInfo; ImageInfoIndex: TVTImageInfoIndex; DoOverlay: Boolean); virtual;
procedure PaintNodeButton(Canvas: TCanvas; Node: PVirtualNode; const R: TRect; ButtonX, ButtonY: Integer; procedure PaintNodeButton(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const R: TRect; ButtonX,
BidiMode: TBiDiMode); virtual; ButtonY: Integer; BidiMode: TBiDiMode); virtual;
procedure PaintTreeLines(const PaintInfo: TVTPaintInfo; VAlignment, IndentSize: Integer; procedure PaintTreeLines(const PaintInfo: TVTPaintInfo; VAlignment, IndentSize: Integer;
LineImage: TLineImage); virtual; LineImage: TLineImage); virtual;
procedure PaintSelectionRectangle(Target: TCanvas; WindowOrgX: Integer; const SelectionRect: TRect; 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.'; SCannotSetUserData = 'Cannot set initial user data because there is not enough user data space allocated.';
const const
TreeButtonSize = 9; //default size for tree buttons (minus/plus)
ClipboardStates = [tsCopyPending, tsCutPending]; ClipboardStates = [tsCopyPending, tsCutPending];
DefaultScrollUpdateFlags = [suoRepaintHeader, suoRepaintScrollbars, suoScrollClientArea, suoUpdateNCArea]; DefaultScrollUpdateFlags = [suoRepaintHeader, suoRepaintScrollbars, suoScrollClientArea, suoUpdateNCArea];
MinimumTimerInterval = 1; // minimum resolution for timeGetTime MinimumTimerInterval = 1; // minimum resolution for timeGetTime
@ -5965,12 +5979,16 @@ begin
if not (csLoading in ComponentState) and HandleAllocated then if not (csLoading in ComponentState) and HandleAllocated then
begin begin
{$ifdef ThemeSupport} {$ifdef ThemeSupport}
if toThemeAware in ToBeSet + ToBeCleared then if (toThemeAware in ToBeSet + ToBeCleared) or (toUseExplorerTheme in ToBeSet + ToBeCleared) then
begin begin
if (toThemeAware in ToBeSet) and ThemeServices.ThemesEnabled then if (toThemeAware in ToBeSet) and ThemeServices.ThemesEnabled then
DoStateChange([tsUseThemes]) DoStateChange([tsUseThemes])
else else if (toThemeAware in ToBeCleared) then
DoStateChange([], [tsUseThemes]); DoStateChange([], [tsUseThemes]);
if (tsUseThemes in FStates) and (toUseExplorerTheme in FOptions.FPaintOptions) and IsWinVistaOrAbove then
SetWindowTheme(Handle, 'explorer', nil);
PrepareBitmaps(True, False); PrepareBitmaps(True, False);
RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_VALIDATE or RDW_FRAME); RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_VALIDATE or RDW_FRAME);
end end
@ -13269,7 +13287,8 @@ begin
Logger.Send([lcPaintDetails],'Clearing Rectangle (R)', R); Logger.Send([lcPaintDetails],'Clearing Rectangle (R)', R);
if (poDrawSelection in PaintOptions) and (toFullRowSelect in FOptions.FSelectionOptions) and 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 begin
Logger.Send([lcPaintDetails, lcDrag], 'Draw the background of a selected node'); Logger.Send([lcPaintDetails, lcDrag], 'Draw the background of a selected node');
if toShowHorzGridLines in FOptions.PaintOptions then if toShowHorzGridLines in FOptions.PaintOptions then
@ -14061,7 +14080,8 @@ begin
SetLength(LineImage, X); SetLength(LineImage, X);
// Only use lines if requested. // 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 begin
if toChildrenAbove in FOptions.FPaintOptions then if toChildrenAbove in FOptions.FPaintOptions then
begin begin
@ -14117,7 +14137,8 @@ begin
end; end;
// Prepare root level. Run points at this stage to a top level node. // 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 begin
// Is the top node a root node? // Is the top node a root node?
if Run = Node then if Run = Node then
@ -14430,19 +14451,38 @@ const
var var
PatternBitmap: HBITMAP; PatternBitmap: HBITMAP;
Bits: Pointer; Bits: Pointer;
Size: TSize;
{$ifdef ThemeSupport} {$ifdef ThemeSupport}
Details: TThemedElementDetails; Details: TThemedElementDetails;
Theme: HTHEME;
R: TRect;
{$endif ThemeSupport} {$endif ThemeSupport}
begin 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 if NeedButtons then
begin begin
with FMinusBM, Canvas do with FMinusBM, Canvas do
begin begin
// box is always of odd size // box is always of odd size
//The TCanvas of VCL does not has width and height. It cause a conflict here //The TCanvas of VCL does not has width and height. It cause a conflict here
FMinusBM.Width := TreeButtonSize; FMinusBM.Width := Size.cx;
FMinusBM.Height := TreeButtonSize; FMinusBM.Height := Size.cy;
//Reset mask //Reset mask
MaskHandle := 0; MaskHandle := 0;
//todo: remove when transparency is fixed in gtk //todo: remove when transparency is fixed in gtk
@ -14451,13 +14491,13 @@ begin
{$else} {$else}
Brush.Color := Self.Color; Brush.Color := Self.Color;
{$endif} {$endif}
FillRect(Rect(0, 0, TreeButtonSize, TreeButtonSize)); FillRect(Rect(0, 0, Size.cx, Size.cy));
if FButtonStyle = bsTriangle then if FButtonStyle = bsTriangle then
begin begin
Brush.Color := clBlack; Brush.Color := clBlack;
Pen.Color := clBlack; Pen.Color := clBlack;
Polygon([Point(0, 2), Point(8, 2), Point(4, 6)]); 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 end
else else
begin begin
@ -14471,12 +14511,12 @@ begin
Brush.Color := clWindow; Brush.Color := clWindow;
end; end;
Pen.Color := FColors.TreeLineColor; Pen.Color := FColors.TreeLineColor;
Rectangle(0, 0, TreeButtonSize, TreeButtonSize); Rectangle(0, 0, Size.cx, Size.cy);
Pen.Color := Self.Font.Color; Pen.Color := Self.Font.Color;
MoveTo(2, TreeButtonSize div 2); MoveTo(2, Size.cy div 2);
LineTo(TreeButtonSize - 2 , TreeButtonSize div 2); LineTo(Size.cx - 2 , Size.cy div 2);
if FButtonFillMode = fmTransparent then if FButtonFillMode = fmTransparent then
MaskHandle := CreateBitmapMask(Handle, TreeButtonSize, TreeButtonSize, clFuchsia); MaskHandle := CreateBitmapMask(Handle, Size.cx, Size.cy, clFuchsia);
end end
else else
FMinusBM.LoadFromLazarusResource('VT_XPBUTTONMINUS'); FMinusBM.LoadFromLazarusResource('VT_XPBUTTONMINUS');
@ -14485,8 +14525,8 @@ begin
with FPlusBM, Canvas do with FPlusBM, Canvas do
begin begin
FPlusBM.Width := TreeButtonSize; FPlusBM.Width := Size.cx;
FPlusBM.Height := TreeButtonSize; FPlusBM.Height := Size.cy;
//Reset mask //Reset mask
MaskHandle := 0; MaskHandle := 0;
//todo: remove when transparency is fixed in gtk //todo: remove when transparency is fixed in gtk
@ -14495,13 +14535,13 @@ begin
{$else} {$else}
Brush.Color := Self.Color; Brush.Color := Self.Color;
{$endif} {$endif}
FillRect(Rect(0, 0, TreeButtonSize, TreeButtonSize)); FillRect(Rect(0, 0, Size.cx, Size.cy));
if FButtonStyle = bsTriangle then if FButtonStyle = bsTriangle then
begin begin
Brush.Color := clBlack; Brush.Color := clBlack;
Pen.Color := clBlack; Pen.Color := clBlack;
Polygon([Point(2, 0), Point(6, 4), Point(2, 8)]); 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 end
else else
begin begin
@ -14516,14 +14556,14 @@ begin
end; end;
Pen.Color := FColors.TreeLineColor; Pen.Color := FColors.TreeLineColor;
Rectangle(0, 0, TreeButtonSize, TreeButtonSize); Rectangle(0, 0, Size.cx, Size.cy);
Pen.Color := Self.Font.Color; Pen.Color := Self.Font.Color;
MoveTo(2, TreeButtonSize div 2); MoveTo(2, Size.cy div 2);
LineTo(TreeButtonSize - 2 , TreeButtonSize div 2); LineTo(Size.cx - 2 , Size.cy div 2);
MoveTo(TreeButtonSize div 2, 2); MoveTo(Size.cx div 2, 2);
LineTo(TreeButtonSize div 2, TreeButtonSize - 2); LineTo(Size.cx div 2, Size.cy - 2);
if FButtonFillMode = fmTransparent then if FButtonFillMode = fmTransparent then
MaskHandle := CreateBitmapMask(Handle, TreeButtonSize, TreeButtonSize, clFuchsia); MaskHandle := CreateBitmapMask(Handle, Size.cx, Size.cy, clFuchsia);
end end
else else
FPlusBM.LoadFromLazarusResource('VT_XPBUTTONPLUS'); FPlusBM.LoadFromLazarusResource('VT_XPBUTTONPLUS');
@ -14571,9 +14611,19 @@ procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX,
var var
TextColorBackup, TextColorBackup,
BackColorBackup: COLORREF; BackColorBackup: COLORREF;
FocusRect,
InnerRect: TRect; 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); procedure AlphaBlendSelection(Color: TColor);
@ -14595,12 +14645,36 @@ var
FSelectionBlendFactor, ColorToRGB(Color)); FSelectionBlendFactor, ColorToRGB(Color));
end; 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 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 with PaintInfo, Canvas do
begin begin
// Fill cell background if its color differs from tree background. // Fill cell background if its color differs from tree background.
with FHeader.FColumns do with FHeader.FColumns do
if poColumnColor in PaintOptions then if poColumnColor in PaintOptions then
@ -14614,8 +14688,6 @@ begin
InnerRect := ContentRect; InnerRect := ContentRect;
if (Column = FFocusedColumn) or (toFullRowSelect in FOptions.FSelectionOptions) then
begin
// The selection rectangle depends on alignment. // The selection rectangle depends on alignment.
if not (toGridExtensions in FOptions.FMiscOptions) then if not (toGridExtensions in FOptions.FMiscOptions) then
begin begin
@ -14638,6 +14710,8 @@ begin
end; end;
end; end;
if (Column = FFocusedColumn) or (toFullRowSelect in FOptions.FSelectionOptions) then
begin
// Fill the selection rectangle. // Fill the selection rectangle.
if poDrawSelection in PaintOptions then if poDrawSelection in PaintOptions then
begin begin
@ -14681,6 +14755,16 @@ begin
if (toGridExtensions in FOptions.FMiscOptions) or (toFullRowSelect in FOptions.FSelectionOptions) then if (toGridExtensions in FOptions.FMiscOptions) or (toFullRowSelect in FOptions.FSelectionOptions) then
InnerRect := CellRect; InnerRect := CellRect;
if not IsRectEmpty(InnerRect) then 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 if MMXAvailable and (toUseBlendedSelection in FOptions.PaintOptions) then
AlphaBlendSelection(Brush.Color) AlphaBlendSelection(Brush.Color)
else else
@ -14688,26 +14772,60 @@ begin
RoundRect(Left, Top, Right, Bottom, FSelectionCurveRadius, FSelectionCurveRadius); RoundRect(Left, Top, Right, Bottom, FSelectionCurveRadius, FSelectionCurveRadius);
end; end;
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 // draw focus rect
if (poDrawFocusRect in PaintOptions) and (Column = FFocusedColumn) and if (poDrawFocusRect in PaintOptions) and
(Focused or (toPopupMode in FOptions.FPaintOptions)) and (FFocusedNode = Node) then (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 begin
TextColorBackup := GetTextColor(Handle); TextColorBackup := GetTextColor(Handle);
SetTextColor(Handle, $FFFFFF); SetTextColor(Handle, $FFFFFF);
BackColorBackup := GetBkColor(Handle); BackColorBackup := GetBkColor(Handle);
SetBkColor(Handle, 0); SetBkColor(Handle, 0);
if toGridExtensions in FOptions.FMiscOptions then {$ifdef ThemeSupport}
LCLIntf.DrawFocusRect(Handle, CellRect) if not (toExtendedFocus in FOptions.FSelectionOptions) and (toFullRowSelect in FOptions.FSelectionOptions) and
(Theme <> 0) then
FocusRect := RowRect
else else
LCLIntf.DrawFocusRect(Handle, InnerRect); {$endif ThemeSupport}
if toGridExtensions in FOptions.FMiscOptions then
FocusRect := CellRect
else
FocusRect := InnerRect;
{$ifdef ThemeSupport}
if Theme <> 0 then
InflateRect(FocusRect, -1, -1);
{$endif ThemeSupport}
LCLIntf.DrawFocusRect(Handle, FocusRect);
SetTextColor(Handle, TextColorBackup); SetTextColor(Handle, TextColorBackup);
SetBkColor(Handle, BackColorBackup); SetBkColor(Handle, BackColorBackup);
end; end;
end; end;
end; end;
{$ifdef ThemeSupport}
if Theme <> 0 then
CloseThemeData(Theme);
{$endif ThemeSupport}
end; end;
//---------------------------------------------------------------------------------------------------------------------- //----------------------------------------------------------------------------------------------------------------------
@ -18768,7 +18886,11 @@ begin
{$ifdef ThemeSupport} {$ifdef ThemeSupport}
if ThemeServices.ThemesEnabled and (toThemeAware in TreeOptions.PaintOptions) then 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 else
{$endif ThemeSupport} {$endif ThemeSupport}
DoStateChange([], [tsUseThemes]); DoStateChange([], [tsUseThemes]);
@ -18925,6 +19047,8 @@ begin
// indentation level is accepted as button hit. // indentation level is accepted as button hit.
if Offset >= Indent - Integer(FIndent) then if Offset >= Indent - Integer(FIndent) then
Include(HitInfo.HitPositions, hiOnItemButton); Include(HitInfo.HitPositions, hiOnItemButton);
if Offset >= Indent - FPlusBM.Width then
Include(HitInfo.HitPositions, hiOnItemButtonExact);
end; end;
// no button hit so position is on indent // no button hit so position is on indent
if HitInfo.HitPositions = [] then if HitInfo.HitPositions = [] then
@ -19060,6 +19184,8 @@ begin
// indentation level is accepted as button hit. // indentation level is accepted as button hit.
if Offset <= Right + Integer(FIndent) then if Offset <= Right + Integer(FIndent) then
Include(HitInfo.HitPositions, hiOnItemButton); Include(HitInfo.HitPositions, hiOnItemButton);
if Offset <= Right + FPlusBM.Width then
Include(HitInfo.HitPositions, hiOnItemButtonExact);
end; end;
// no button hit so position is on indent // no button hit so position is on indent
if HitInfo.HitPositions = [] then if HitInfo.HitPositions = [] then
@ -21789,25 +21915,43 @@ procedure TBaseVirtualTree.HandleHotTrack(X, Y: Integer);
var var
HitInfo: THitInfo; HitInfo: THitInfo;
CheckPositions: THitPositions;
ButtonIsHit,
DoInvalidate: Boolean; DoInvalidate: Boolean;
begin begin
DoInvalidate := False;
// Get information about the hit. // Get information about the hit.
GetHitTestInfoAt(X, Y, True, HitInfo); GetHitTestInfoAt(X, Y, True, HitInfo);
// Only make the new node being "hot" if its label is hit or full row selection is enabled. // Only make the new node being "hot" if its label is hit or full row selection is enabled.
if ([hiOnItemLabel, hiOnItemCheckbox] * HitInfo.HitPositions = []) and CheckPositions := [hiOnItemLabel, hiOnItemCheckbox];
not (toFullRowSelect in FOptions.FSelectionOptions) then
// 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; HitInfo.HitNode := nil;
if HitInfo.HitNode <> FCurrentHotNode then if (HitInfo.HitNode <> FCurrentHotNode) or (HitInfo.HitColumn <> FCurrentHotColumn) then
begin begin
DoInvalidate := (toHotTrack in FOptions.PaintOptions) or (toCheckSupport in FOptions.FMiscOptions); DoInvalidate := (toHotTrack in FOptions.PaintOptions) or (toCheckSupport in FOptions.FMiscOptions);
DoHotChange(FCurrentHotNode, HitInfo.HitNode); DoHotChange(FCurrentHotNode, HitInfo.HitNode);
if Assigned(FCurrentHotNode) and DoInvalidate then if Assigned(FCurrentHotNode) and DoInvalidate then
InvalidateNode(FCurrentHotNode); InvalidateNode(FCurrentHotNode);
FCurrentHotNode := HitInfo.HitNode; FCurrentHotNode := HitInfo.HitNode;
if Assigned(FCurrentHotNode) and DoInvalidate then FCurrentHotColumn := HitInfo.HitColumn;
InvalidateNode(FCurrentHotNode);
end; 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; end;
//---------------------------------------------------------------------------------------------------------------------- //----------------------------------------------------------------------------------------------------------------------
@ -23698,12 +23842,23 @@ end;
//---------------------------------------------------------------------------------------------------------------------- //----------------------------------------------------------------------------------------------------------------------
procedure TBaseVirtualTree.PaintNodeButton(Canvas: TCanvas; Node: PVirtualNode; const R: TRect; ButtonX, procedure TBaseVirtualTree.PaintNodeButton(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const R: TRect;
ButtonY: Integer; BidiMode: TBiDiMode); ButtonX, ButtonY: Integer; BidiMode: TBiDiMode);
var var
Bitmap: TBitmap; Bitmap: TBitmap;
XPos: Integer; 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 begin
Logger.EnterMethod([lcPaintDetails],'PaintNodeButton'); Logger.EnterMethod([lcPaintDetails],'PaintNodeButton');
@ -23717,10 +23872,22 @@ begin
XPos := R.Left + ButtonX XPos := R.Left + ButtonX
else else
XPos := R.Right - ButtonX - Bitmap.Width; 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. // Need to draw this masked.
DirectMaskBlt(Canvas.Handle, XPos, R.Top + ButtonY, TreeButtonSize, TreeButtonSize, Bitmap.Canvas.Handle, DirectMaskBlt(Canvas.Handle, XPos, R.Top + ButtonY, Bitmap.Width, Bitmap.Height,
0, 0, Bitmap.MaskHandle); Bitmap.Canvas.Handle, 0, 0, Bitmap.MaskHandle);
Logger.ExitMethod([lcPaintDetails],'PaintNodeButton'); Logger.ExitMethod([lcPaintDetails],'PaintNodeButton');
end; end;
@ -29520,14 +29687,16 @@ begin
// Some parts are only drawn for the main column. // Some parts are only drawn for the main column.
if IsMainColumn then if IsMainColumn then
begin 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); 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 // 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. // nodes is visible or auto button hiding is disabled.
if (toShowButtons in FOptions.FPaintOptions) and (vsHasChildren in Node.States) and if (toShowButtons in FOptions.FPaintOptions) and (vsHasChildren in Node.States) and
not ((vsAllChildrenHidden in Node.States) and not ((vsAllChildrenHidden in Node.States) and
(toAutoHideButtons in TreeOptions.FAutoOptions)) then (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 if ImageInfo[iiCheck].Index > -1 then
PaintCheckImage(PaintInfo); PaintCheckImage(PaintInfo);
@ -32027,6 +32196,8 @@ begin
if (toHotTrack in FOptions.FPaintOptions) and (Node = FCurrentHotNode) then if (toHotTrack in FOptions.FPaintOptions) and (Node = FCurrentHotNode) then
begin begin
if not IsWinVistaOrAbove or not (tsUseThemes in FStates) or
not (toUseExplorerTheme in FOptions.FPaintOptions) then
Canvas.Font.Style := Canvas.Font.Style + [fsUnderline]; Canvas.Font.Style := Canvas.Font.Style + [fsUnderline];
Canvas.Font.Color := FColors.HotColor; Canvas.Font.Color := FColors.HotColor;
end; end;
@ -32038,13 +32209,17 @@ begin
begin begin
if Node = FDropTargetNode then if Node = FDropTargetNode then
begin 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; Canvas.Font.Color := clHighlightText;
end end
else else
if vsSelected in Node.States then if vsSelected in Node.States then
begin 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; Canvas.Font.Color := clHighlightText;
end; end;
end; end;
@ -32057,7 +32232,7 @@ end;
procedure TCustomVirtualStringTree.PaintNormalText(var PaintInfo: TVTPaintInfo; TextOutFlags: Integer; procedure TCustomVirtualStringTree.PaintNormalText(var PaintInfo: TVTPaintInfo; TextOutFlags: Integer;
Text: UTF8String); 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. // 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 // 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.). // the node rectangle. The clipping rectangle comprises the entire node (including tree lines, buttons etc.).