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

* Synchronize with main VTV repository up to svn rev 531

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3408 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
blikblum
2014-08-02 21:35:16 +00:00
parent b824d4854b
commit 70d9caa591
2 changed files with 229 additions and 126 deletions
Download Patch File Download Diff File Expand all files Collapse all files

344
components/virtualtreeview-new/trunk/VirtualTrees.pas
View File

@ -102,8 +102,8 @@ const
{$endif}
VTMajorVersion = 5;
VTMinorVersion = 1;
VTReleaseVersion = 4;
VTMinorVersion = 2;
VTReleaseVersion = 0;
VTTreeStreamVersion = 2;
VTHeaderStreamVersion = 6; // The header needs an own stream version to indicate changes only relevant to the header.
@ -994,6 +994,8 @@ type
procedure GetAbsoluteBounds(var Left, Right: Integer);
function GetDisplayName: string; override;
function GetOwner: TVirtualTreeColumns; reintroduce;
property HasImage: Boolean read fHasImage;
property ImageRect: TRect read fImageRect;
public
constructor Create(Collection: TCollection); override;
destructor Destroy; override;
@ -1029,7 +1031,7 @@ type
property MinWidth: Integer read FMinWidth write SetMinWidth default 10;
property Options: TVTColumnOptions read FOptions write SetOptions default DefaultColumnOptions;
property Position: TColumnPosition read FPosition write SetPosition;
property Spacing: Integer read FSpacing write SetSpacing default 4;
property Spacing: Integer read FSpacing write SetSpacing default 3;
property Style: TVirtualTreeColumnStyle read FStyle write SetStyle default vsText;
property Tag: Integer read FTag write FTag default 0;
property Text: String read FText write SetText;
@ -1089,8 +1091,11 @@ type
property HeaderBitmap: TBitmap read FHeaderBitmap;
property PositionToIndex: TIndexArray read FPositionToIndex;
property HoverIndex: TColumnIndex read FHoverIndex;
property DownIndex: TColumnIndex read FDownIndex;
property CheckBoxHit: Boolean read FCheckBoxHit;
public
constructor Create(AOwner: TVTHeader);
constructor Create(AOwner: TVTHeader); virtual;
destructor Destroy; override;
function Add: TVirtualTreeColumn; virtual;
@ -1318,12 +1323,11 @@ type
published
property AutoSizeIndex: TColumnIndex read FAutoSizeIndex write SetAutoSizeIndex;
property Background: TColor read FBackground write SetBackground default clBtnFace;
property Columns: TVirtualTreeColumns read FColumns write SetColumns stored False; // Stored by the owner tree to
// support VFI.
property DefaultHeight: Integer read FDefaultHeight write SetDefaultHeight default 17;
property Columns: TVirtualTreeColumns read FColumns write SetColumns stored False; // Stored by the owner tree to support VFI.
property DefaultHeight: Integer read FDefaultHeight write SetDefaultHeight default 19;
property Font: TFont read FFont write SetFont stored IsFontStored;
property FixedAreaConstraints: TVTFixedAreaConstraints read FFixedAreaConstraints write FFixedAreaConstraints;
property Height: Integer read FHeight write SetHeight default 17;
property Height: Integer read FHeight write SetHeight default 19;
property Images: TCustomImageList read FImages write SetImages;
property MainColumn: TColumnIndex read GetMainColumn write SetMainColumn default 0;
property MaxHeight: Integer read FMaxHeight write SetMaxHeight default 10000;
@ -1430,7 +1434,6 @@ type
tsMouseCheckPending, // A check operation is under way, initiated by a mouse click. Ignore space key.
tsMiddleButtonDown, // Set when the middle mouse button is down.
tsMiddleDblClick, // Set when the middle mouse button was doubly clicked.
tsNeedScale, // On next ChangeScale scale the default node height.
tsNeedRootCountUpdate, // Set if while loading a root node count is set.
tsOLEDragging, // OLE dragging in progress.
tsOLEDragPending, // User has requested to start delayed dragging.
@ -1852,6 +1855,11 @@ type
// operations
TVTOperationEvent = procedure(Sender: TBaseVirtualTree; OperationKind: TVTOperationKind) of object;
TVTHintKind = (vhkText, vhkOwnerDraw);
TVTHintKindEvent = procedure(sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var Kind: TVTHintKind) of object;
TVTDrawHintEvent = procedure(Sender: TBaseVirtualTree; HintCanvas: TCanvas; Node: PVirtualNode; R: TRect; Column: TColumnIndex) of object;
TVTGetHintSizeEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var R: TRect) of object;
// miscellaneous
TVTBeforeDrawLineImageEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Level: Integer; var PosX: Integer) of object;
TVTGetNodeDataSizeEvent = procedure(Sender: TBaseVirtualTree; var NodeDataSize: Integer) of object;
@ -2115,6 +2123,7 @@ type
FDropTargetNode: PVirtualNode; // node currently selected as drop target
FLastDropMode: TDropMode; // set while dragging and used to track changes
FDragSelection: TNodeArray; // temporary copy of FSelection used during drag'n drop
FLastDragEffect: LongWord; // The last executed drag effect
FDragType: TVTDragType; // used to switch between OLE and VCL drag'n drop
FDragImage: TVTDragImage; // drag image management
FDragWidth,
@ -2311,7 +2320,12 @@ type
// search, sort
FOnCompareNodes: TVTCompareEvent; // used during sort
FOnDrawHint: TVTDrawHintEvent;
FOnGetHintSize: TVTGetHintSizeEvent;
fOnGetHintKind: TVTHintKindEvent;
FOnIncrementalSearch: TVTIncrementalSearchEvent; // triggered on every key press (not key down)
FOnMouseEnter: TNotifyEvent;
FOnMouseLeave: TNotifyEvent;
// operations
FOnStartOperation: TVTOperationEvent; // Called when an operation starts
@ -2452,6 +2466,7 @@ type
//procedure CMDrag(var Message: TCMDrag); message CM_DRAG;
procedure CMFontChanged(var Message: TLMessage); message CM_FONTCHANGED;
procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
procedure CMMouseEnter(var Message: TLMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TLMessage); message CM_MOUSELEAVE;
procedure CMMouseWheel(var Message: TLMMouseEvent); message LM_MOUSEWHEEL;
{$ifdef EnableNativeTVM}
@ -2584,10 +2599,13 @@ type
var Effect: LongWord): Boolean; virtual;
procedure DoDragDrop(Source: TObject; DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState; const Pt: TPoint;
var Effect: LongWord; Mode: TDropMode); virtual;
procedure DoDrawHint(Canvas: TCanvas; Node: PVirtualNode; R: TRect; Column:
TColumnIndex);
procedure DoEdit; virtual;
procedure DoEndDrag(Target: TObject; X, Y: Integer); override;
function DoEndEdit: Boolean; virtual;
procedure DoEndOperation(OperationKind: TVTOperationKind); virtual;
procedure DoEnter(); override;
procedure DoExpanded(Node: PVirtualNode); virtual;
function DoExpanding(Node: PVirtualNode): Boolean; virtual;
procedure DoFocusChange(Node: PVirtualNode; Column: TColumnIndex); virtual;
@ -2598,6 +2616,10 @@ type
CellContentMarginType: TVTCellContentMarginType = ccmtAllSides; Canvas: TCanvas = nil): TPoint; virtual;
procedure DoGetCursor(var Cursor: TCursor); virtual;
procedure DoGetHeaderCursor(var Cursor: HCURSOR); virtual;
procedure DoGetHintSize(Node: PVirtualNode; Column: TColumnIndex; var R:
TRect); virtual;
procedure DoGetHintKind(Node: PVirtualNode; Column: TColumnIndex; var Kind:
TVTHintKind);
function DoGetImageIndex(Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
var Ghosted: Boolean; var Index: Integer): TCustomImageList; virtual;
procedure DoGetImageText(Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
@ -2627,6 +2649,8 @@ type
function DoKeyAction(var CharCode: Word; var Shift: TShiftState): Boolean; virtual;
procedure DoLoadUserData(Node: PVirtualNode; Stream: TStream); virtual;
procedure DoMeasureItem(TargetCanvas: TCanvas; Node: PVirtualNode; var NodeHeight: Integer); virtual;
procedure DoMouseEnter(); virtual;
procedure DoMouseLeave(); virtual;
procedure DoNodeCopied(Node: PVirtualNode); virtual;
function DoNodeCopying(Node, NewParent: PVirtualNode): Boolean; virtual;
procedure DoNodeClick(const HitInfo: THitInfo); virtual;
@ -2677,10 +2701,12 @@ type
class function GetCheckImageListFor(Kind: TCheckImageKind): TCustomImageList; virtual;
function GetClientRect: TRect; override;
function GetColumnClass: TVirtualTreeColumnClass; virtual;
function GetDefaultHintKind: TVTHintKind; virtual;
function GetHeaderClass: TVTHeaderClass; virtual;
function GetHintWindowClass: THintWindowClass; virtual;
procedure GetImageIndex(var Info: TVTPaintInfo; Kind: TVTImageKind; InfoIndex: TVTImageInfoIndex;
DefaultImages: TCustomImageList); virtual;
function GetNodeImageSize(Node: PVirtualNode): TSize; virtual;
function GetMaxRightExtend: Cardinal; virtual;
procedure GetNativeClipboardFormats(var Formats: TFormatEtcArray); virtual;
function GetOperationCanceled: Boolean;
@ -2784,12 +2810,14 @@ type
property ClipboardFormats: TClipboardFormats read FClipboardFormats write SetClipboardFormats;
property Colors: TVTColors read FColors write SetColors;
property CustomCheckImages: TBitmap read FCustomCheckImages write SetCustomCheckImages;
property DefaultHintKind: TVTHintKind read GetDefaultHintKind;
property DefaultNodeHeight: Cardinal read FDefaultNodeHeight write SetDefaultNodeHeight default 18;
property DefaultPasteMode: TVTNodeAttachMode read FDefaultPasteMode write FDefaultPasteMode default amAddChildLast;
property DragHeight: Integer read FDragHeight write FDragHeight default 350;
property DragImageKind: TVTDragImageKind read FDragImageKind write FDragImageKind default diComplete;
property DragOperations: TDragOperations read FDragOperations write FDragOperations default [doCopy, doMove];
property DragSelection: TNodeArray read FDragSelection;
property LastDragEffect: LongWord read FLastDragEffect;
property DragType: TVTDragType read FDragType write FDragType default dtOLE;
property DragWidth: Integer read FDragWidth write FDragWidth default 200;
property DrawSelectionMode: TVTDrawSelectionMode read FDrawSelectionMode write FDrawSelectionMode
@ -2887,6 +2915,7 @@ type
property OnDragAllowed: TVTDragAllowedEvent read FOnDragAllowed write FOnDragAllowed;
property OnDragOver: TVTDragOverEvent read FOnDragOver write FOnDragOver;
property OnDragDrop: TVTDragDropEvent read FOnDragDrop write FOnDragDrop;
property OnDrawHint: TVTDrawHintEvent read FOnDrawHint write FOnDrawHint;
property OnEditCancelled: TVTEditCancelEvent read FOnEditCancelled write FOnEditCancelled;
property OnEditing: TVTEditChangingEvent read FOnEditing write FOnEditing;
property OnEdited: TVTEditChangeEvent read FOnEdited write FOnEdited;
@ -2900,6 +2929,10 @@ type
property OnGetCursor: TVTGetCursorEvent read FOnGetCursor write FOnGetCursor;
property OnGetHeaderCursor: TVTGetHeaderCursorEvent read FOnGetHeaderCursor write FOnGetHeaderCursor;
property OnGetHelpContext: TVTHelpContextEvent read FOnGetHelpContext write FOnGetHelpContext;
property OnGetHintSize: TVTGetHintSizeEvent read FOnGetHintSize write
FOnGetHintSize;
property OnGetHintKind: TVTHintKindEvent read fOnGetHintKind write
fOnGetHintKind;
property OnGetImageIndex: TVTGetImageEvent read FOnGetImage write FOnGetImage;
property OnGetImageIndexEx: TVTGetImageExEvent read FOnGetImageEx write FOnGetImageEx;
property OnGetImageText: TVTGetImageTextEvent read FOnGetImageText write FOnGetImageText;
@ -2931,6 +2964,8 @@ type
property OnLoadNode: TVTSaveNodeEvent read FOnLoadNode write FOnLoadNode;
property OnLoadTree: TVTSaveTreeEvent read FOnLoadTree write FOnLoadTree;
property OnMeasureItem: TVTMeasureItemEvent read FOnMeasureItem write FOnMeasureItem;
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
property OnNodeClick: TVTNodeClickEvent read FOnNodeClick write FOnNodeClick;
property OnNodeCopied: TVTNodeCopiedEvent read FOnNodeCopied write FOnNodeCopied;
property OnNodeCopying: TVTNodeCopyingEvent read FOnNodeCopying write FOnNodeCopying;
@ -2955,10 +2990,6 @@ type
property OnUpdating: TVTUpdatingEvent read FOnUpdating write FOnUpdating;
public
constructor Create(AOwner: TComponent); override;
{$ifdef VCLStyleSupport}
class constructor Create;
class destructor Destroy;
{$ifend}
destructor Destroy; override;
function AbsoluteIndex(Node: PVirtualNode): Cardinal;
@ -3047,6 +3078,7 @@ type
function GetNextVisibleNoInit(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = True): PVirtualNode;
function GetNextVisibleSibling(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode;
function GetNextVisibleSiblingNoInit(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode;
function GetNodeAt(const P: TPoint): PVirtualNode; overload; inline;
function GetNodeAt(X, Y: Integer): PVirtualNode; overload;
function GetNodeAt(X, Y: Integer; Relative: Boolean; var NodeTop: Integer): PVirtualNode; overload;
function GetNodeData(Node: PVirtualNode): Pointer;
@ -3465,6 +3497,7 @@ type
public
property Canvas;
property RangeX;
property LastDragEffect;
published
{$ifdef EnableAccessible}
property AccessibleName;
@ -3602,6 +3635,7 @@ type
property OnDragAllowed;
property OnDragOver;
property OnDragDrop;
property OnDrawHint;
property OnDrawText;
property OnEditCancelled;
property OnEdited;
@ -3622,6 +3656,8 @@ type
property OnGetText;
property OnPaintText;
property OnGetHelpContext;
property OnGetHintKind;
property OnGetHintSize;
property OnGetImageIndex;
property OnGetImageIndexEx;
property OnGetImageText;
@ -3659,6 +3695,8 @@ type
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
property OnMouseEnter;
property OnMouseLeave;
property OnNewText;
property OnNodeClick;
property OnNodeCopied;
@ -3690,15 +3728,11 @@ type
//property OnCanResize;
end;
TVTDrawHintEvent = procedure(Sender: TBaseVirtualTree; HintCanvas: TCanvas; Node: PVirtualNode; const R: TRect;
Column: TColumnIndex) of object;
TVTDrawNodeEvent = procedure(Sender: TBaseVirtualTree; const PaintInfo: TVTPaintInfo) of object;
TVTGetCellContentMarginEvent = procedure(Sender: TBaseVirtualTree; HintCanvas: TCanvas; Node: PVirtualNode;
Column: TColumnIndex; CellContentMarginType: TVTCellContentMarginType; var CellContentMargin: TPoint) of object;
TVTGetNodeWidthEvent = procedure(Sender: TBaseVirtualTree; HintCanvas: TCanvas; Node: PVirtualNode;
Column: TColumnIndex; var NodeWidth: Integer) of object;
TVTGetHintSizeEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
var R: TRect) of object;
// Tree descendant to let an application draw its stuff itself.
TCustomVirtualDrawTree = class(TBaseVirtualTree)
@ -3706,20 +3740,15 @@ type
FOnDrawNode: TVTDrawNodeEvent;
FOnGetCellContentMargin: TVTGetCellContentMarginEvent;
FOnGetNodeWidth: TVTGetNodeWidthEvent;
FOnGetHintSize: TVTGetHintSizeEvent;
FOnDrawHint: TVTDrawHintEvent;
protected
procedure DoDrawHint(Canvas: TCanvas; Node: PVirtualNode; const R: TRect; Column: TColumnIndex);
function DoGetCellContentMargin(Node: PVirtualNode; Column: TColumnIndex;
CellContentMarginType: TVTCellContentMarginType = ccmtAllSides; Canvas: TCanvas = nil): TPoint; override;
procedure DoGetHintSize(Node: PVirtualNode; Column: TColumnIndex; var R: TRect); virtual;
function DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): Integer; override;
procedure DoPaintNode(var PaintInfo: TVTPaintInfo); override;
function GetDefaultHintKind: TVTHintKind; override;
property OnDrawHint: TVTDrawHintEvent read FOnDrawHint write FOnDrawHint;
property OnDrawNode: TVTDrawNodeEvent read FOnDrawNode write FOnDrawNode;
property OnGetCellContentMargin: TVTGetCellContentMarginEvent read FOnGetCellContentMargin write FOnGetCellContentMargin;
property OnGetHintSize: TVTGetHintSizeEvent read FOnGetHintSize write FOnGetHintSize;
property OnGetNodeWidth: TVTGetNodeWidthEvent read FOnGetNodeWidth write FOnGetNodeWidth;
end;
@ -3731,6 +3760,7 @@ type
function GetOptionsClass: TTreeOptionsClass; override;
public
property Canvas;
property LastDragEffect;
published
property Action;
property Align;
@ -3880,6 +3910,7 @@ type
property OnGetCursor;
property OnGetHeaderCursor;
property OnGetHelpContext;
property OnGetHintKind;
property OnGetHintSize;
property OnGetImageIndex;
property OnGetImageIndexEx;
@ -5213,7 +5244,7 @@ begin
{$ifdef EnableOLE}
// Initialize OLE subsystem for drag'n drop and clipboard operations.
//todo: replace by Suceeded (see in windows unit)
NeedToUnitialize := OleInitialize(nil) in [S_FALSE,S_OK];
NeedToUnitialize := not IsLibrary and (OleInitialize(nil) in [S_FALSE,S_OK]);
{$endif}
// Register the tree reference clipboard format. Others will be handled in InternalClipboarFormats.
CF_VTREFERENCE := ClipboardRegisterFormat(CFSTR_VTREFERENCE);
@ -5242,6 +5273,7 @@ begin
// Predefined clipboard formats. Just add them to the internal list.
RegisterVTClipboardFormat(CF_TEXT, TCustomVirtualStringTree, 100);
RegisterVTClipboardFormat(CF_UNICODETEXT, TCustomVirtualStringTree, 95);
{$ifdef VCLStyleSupport}TCustomStyleEngine.RegisterStyleHook(TBaseVirtualTree, TVclStyleScrollBarsHook);{$ifend}
end;
//----------------------------------------------------------------------------------------------------------------------
@ -5255,6 +5287,8 @@ begin
if NeedToUnitialize then
OleUninitialize;
{$ifdef VCLStyleSupport}TCustomStyleEngine.UnRegisterStyleHook(TBaseVirtualTree, TVclStyleScrollBarsHook);{$ifend}
end;
//----------------- TWorkerThread --------------------------------------------------------------------------------------
@ -6598,7 +6632,7 @@ begin
FMaxWidth := 10000;
FImageIndex := -1;
FMargin := 4;
FSpacing := 4;
FSpacing := 3;
FText := '';
FOptions := DefaultColumnOptions;
FAlignment := taLeftJustify;
@ -7182,7 +7216,7 @@ begin
begin
R := Client;
if FCaptionText = '' then
FCaptionText := FText;
FCaptionText := WrapString(DC, FText, R, DT_RTLREADING and DrawFormat <> 0, DrawFormat);
GetStringDrawRect(DC, FCaptionText, R, DrawFormat);
TextSize.cx := Client.Right - Client.Left;
@ -9428,8 +9462,8 @@ begin
inherited Create;
FOwner := AOwner;
FColumns := GetColumnsClass.Create(Self);
FHeight := 17;
FDefaultHeight := 17;
FHeight := 19;
FDefaultHeight := 19;
FMinHeight := 10;
FMaxHeight := 10000;
FFont := TFont.Create;
@ -9475,8 +9509,28 @@ end;
//----------------------------------------------------------------------------------------------------------------------
procedure TVTHeader.FontChanged(Sender: TObject);
var
i: Integer;
lMaxHeight: Integer;
begin
if toAutoChangeScale in Treeview.TreeOptions.AutoOptions then begin
// Find the largest Columns[].Spacing
lMaxHeight := 0;
for i:= 0 to Self.Columns.Count - 1 do
lMaxHeight := Max(lMaxHeight, Columns[i].Spacing);
// Calculate the required size based on the font, this is important as the use migth just vave increased the size of the icon font
With TBitmap.Create do
try
Canvas.Font.Assign(FFont);
lMaxHeight := lMaxHeight {top spacing} + (lMaxHeight div 2) {minimum bottom spacing} + Canvas.TextHeight('Q');
finally
Free;
end;
// Get the maximum of the scaled original value an
lMaxHeight := Max(lMaxHeight, fHeight);
// Set the calculated size
Self.SetHeight(lMaxHeight);
end;
Invalidate(nil);
end;
@ -9785,7 +9839,11 @@ end;
procedure TVTHeader.ChangeScale(M, D: Integer);
begin
// This method is only executed if toAutoChangeScale is set
if not ParentFont then
FFont.Size := MulDiv(FFont.Size, M, D);
Self.Height := MulDiv(fHeight, M, D);
//TODO: We should consider also scaling column width here
end;
//----------------------------------------------------------------------------------------------------------------------
@ -10356,6 +10414,8 @@ begin
// WM_NCLBUTTONDBLCLK
Button := mbLeft;
end;
if Button = mbLeft then
Columns.AdjustDownColumn(P);
FColumns.HandleClick(P, Button, True, True);
end;
end;
@ -11806,6 +11866,7 @@ begin
FDefaultPasteMode := amAddChildLast;
FMargin := 4;
FTextMargin := 4;
FLastDragEffect := DROPEFFECT_NONE;
FDragType := dtOLE;
FDragHeight := 350;
FDragWidth := 200;
@ -12025,7 +12086,7 @@ begin
if ShowImages or ShowStateImages then
begin
if ShowImages then
VAlign := FImages.Height
VAlign := GetNodeImageSize(Node).cy
else
VAlign := FStateImages.Height;
VAlign := MulDiv((Integer(NodeHeight[Node]) - VAlign), Node.Align, 100) + VAlign div 2;
@ -12216,7 +12277,6 @@ var
NodeWidth,
Dummy: Integer;
MinY, MaxY: Integer;
ImageOffset,
StateImageOffset: Integer;
IsInOldRect,
IsInNewRect: Boolean;
@ -12242,10 +12302,6 @@ begin
WithCheck := (toCheckSupport in FOptions.FMiscOptions) and Assigned(FCheckImages);
// Don't check the events here as descendant trees might have overriden the DoGetImageIndex method.
WithImages := Assigned(FImages);
if WithImages then
ImageOffset := FImages.Width + 2
else
ImageOffset := 0;
WithStateImages := Assigned(FStateImages);
if WithStateImages then
StateImageOffset := FStateImages.Width + 2
@ -12278,10 +12334,9 @@ begin
if WithCheck and (Run.CheckType <> ctNone) then
Inc(TextLeft, CheckOffset);
if WithImages and HasImage(Run, ikNormal, MainColumn) then
Inc(TextLeft, ImageOffset);
Inc(TextLeft, GetNodeImageSize(run).cx + 2);
if WithStateImages and HasImage(Run, ikState, MainColumn) then
Inc(TextLeft, StateImageOffset);
// Ensure the node's height is determined.
MeasureItemHeight(Canvas, Run);
@ -12403,7 +12458,6 @@ var
NodeWidth,
Dummy: Integer;
MinY, MaxY: Integer;
ImageOffset,
StateImageOffset: Integer;
IsInOldRect,
IsInNewRect: Boolean;
@ -12431,10 +12485,6 @@ begin
WithCheck := (toCheckSupport in FOptions.FMiscOptions) and Assigned(FCheckImages);
// Don't check the events here as descendant trees might have overriden the DoGetImageIndex method.
WithImages := Assigned(FImages);
if WithImages then
ImageOffset := FImages.Width + 2
else
ImageOffset := 0;
WithStateImages := Assigned(FStateImages);
if WithStateImages then
StateImageOffset := FStateImages.Width + 2
@ -12467,7 +12517,7 @@ begin
if WithCheck and (Run.CheckType <> ctNone) then
Dec(TextRight, CheckOffset);
if WithImages and HasImage(Run, ikNormal, MainColumn) then
Dec(TextRight, ImageOffset);
Dec(TextRight, GetNodeImageSize(run).cx + 2);
if WithStateImages and HasImage(Run, ikState, MainColumn) then
Dec(TextRight, StateImageOffset);
@ -14194,7 +14244,6 @@ begin
Value := 18;
if FDefaultNodeHeight <> Value then
begin
DoStateChange([tsNeedScale]);
Inc(Integer(FRoot.TotalHeight), Integer(Value) - Integer(FDefaultNodeHeight));
Inc(SmallInt(FRoot.NodeHeight), Integer(Value) - Integer(FDefaultNodeHeight));
FDefaultNodeHeight := Value;
@ -15328,7 +15377,7 @@ var
ParentForm: TCustomForm;
BottomRightCellContentMargin: TPoint;
DummyLineBreakStyle: TVTTooltipLineBreakStyle;
HintKind: TVTHintKind;
begin
with Message do
begin
@ -15394,19 +15443,19 @@ begin
begin
if Assigned(HitInfo.HitNode) and (HitInfo.HitColumn > InvalidColumn) then
begin
// A draw tree should only display a hint when at least its OnGetHintSize
// event handler is assigned.
if Self is TCustomVirtualDrawTree then
begin
// An owner-draw tree should only display a hint when at least
// its OnGetHintSize event handler is assigned.
DoGetHintKind(HitInfo.HitNode, HitInfo.HitColumn, HintKind);
FHintData.HintRect := Rect(0, 0, 0, 0);
with Self as TCustomVirtualDrawTree do
if (HintKind = vhkOwnerDraw) then
begin
DoGetHintSize(HitInfo.HitNode, HitInfo.HitColumn, FHintData.HintRect);
ShowOwnHint := not IsRectEmpty(FHintData.HintRect);
end
else
// For string trees a decision about showing the hint or not is based
// For trees displaying text hints, a decision about showing the hint or not is based
// on the hint string (if it is empty then no hint is shown).
ShowOwnHint := True;
ShowOwnHint := true;
if ShowOwnHint then
begin
@ -15549,6 +15598,13 @@ end;
//----------------------------------------------------------------------------------------------------------------------
procedure TBaseVirtualTree.CMMouseEnter(var Message: TLMessage);
begin
DoMouseEnter();
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TBaseVirtualTree.CMMouseLeave(var Message: TLMessage);
var
@ -15582,7 +15638,7 @@ begin
Header.FColumns.FHoverIndex := NoColumn;
Header.FColumns.FCheckBoxHit := False;
end;
DoMouseLeave();
inherited CMMouseLeave(Message);
{$ifdef DEBUG_VTV}Logger.ExitMethod([lcMessages],'CMMouseLeave');{$endif}
end;
@ -16125,7 +16181,7 @@ begin
FCheckNode := nil;
end;
if CharCode in [VK_HOME, VK_END, VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT, VK_BACK, VK_TAB] then
if (CharCode in [VK_HOME, VK_END, VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT, VK_BACK, VK_TAB]) and (RootNode.FirstChild<>nil) then
begin
HandleMultiSelect := (ssShift in Shift) and (toMultiSelect in FOptions.FSelectionOptions) and not IsEditing;
@ -17820,25 +17876,15 @@ end;
procedure TBaseVirtualTree.ChangeScale(M, D: Integer);
var
DoScale: Boolean;
begin
inherited;
if (M <> D) and (toAutoChangeScale in FOptions.FAutoOptions) then
begin
if (csLoading in ComponentState) then
DoScale := tsNeedScale in FStates
else
DoScale := True;
if DoScale then
begin
SetDefaultNodeHeight(MulDiv(FDefaultNodeHeight, M, D));
FHeader.ChangeScale(M, D);
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
@ -18017,18 +18063,6 @@ end;
//----------------------------------------------------------------------------------------------------------------------
{$ifdef VCLStyleSupport}
class constructor TBaseVirtualTree.Create;
begin
TCustomStyleEngine.RegisterStyleHook(TBaseVirtualTree, TVclStyleScrollBarsHook);
end;
class destructor TBaseVirtualTree.Destroy;
begin
TCustomStyleEngine.UnRegisterStyleHook(TBaseVirtualTree, TVclStyleScrollBarsHook);
end;
{$ifend}
procedure TBaseVirtualTree.CreateParams(var Params: TCreateParams);
const
@ -18314,7 +18348,7 @@ begin
else
begin
if Assigned(FImages) and HasImage(HitInfo.HitNode, ikNormal, HitInfo.HitColumn) then
Inc(ImageOffset, FImages.Width + 2);
Inc(ImageOffset, GetNodeImageSize(HitInfo.HitNode).cx + 2);
if Offset < ImageOffset then
Include(HitInfo.HitPositions, hiOnNormalIcon)
else
@ -18451,7 +18485,7 @@ begin
else
begin
if Assigned(FImages) and HasImage(HitInfo.HitNode, ikNormal, HitInfo.HitColumn) then
Dec(ImageOffset, FImages.Width + 2);
Dec(ImageOffset, GetNodeImageSize(HitInfo.HitNode).cx + 2);
if Offset > ImageOffset then
Include(HitInfo.HitPositions, hiOnNormalIcon)
else
@ -19123,7 +19157,7 @@ procedure TBaseVirtualTree.DoDragging(P: TPoint);
//--------------- end local function ----------------------------------------
var
DragEffect, AllowedEffects: LongWord;
AllowedEffects: LongWord;
DragObject: TDragObject;
DataObject: IDataObject;
@ -19166,10 +19200,10 @@ begin
FLastDropMode := dmOnNode;
// Don't forget to initialize the result. It might never be touched.
DragEffect := DROPEFFECT_NONE;
FLastDragEffect := DROPEFFECT_NONE;
AllowedEffects := GetDragOperations;
try
DragAndDrop(AllowedEffects, DataObject, DragEffect);
DragAndDrop(AllowedEffects, DataObject, FLastDragEffect);
VTVDragManager.ForceDragLeave;
finally
GetCursorPos(P);
@ -19179,7 +19213,7 @@ begin
FDragImage.EndDrag;
// Finish the operation.
if (DragEffect = DROPEFFECT_MOVE) and (toAutoDeleteMovedNodes in TreeOptions.AutoOptions) then
if (FLastDragEffect = DROPEFFECT_MOVE) and (toAutoDeleteMovedNodes in TreeOptions.AutoOptions) then
begin
// The operation was a move so delete the previously selected nodes.
DeleteSelectedNodes;
@ -19324,6 +19358,17 @@ end;
//----------------------------------------------------------------------------------------------------------------------
procedure TBaseVirtualTree.DoEnter();
begin
inherited;
// Always select a node if the control gets the focus, #237
if FocusedNode = nil then begin
FocusedNode := Self.GetFirstVisible();
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TBaseVirtualTree.DoExpanded(Node: PVirtualNode);
begin
@ -19774,6 +19819,19 @@ end;
//----------------------------------------------------------------------------------------------------------------------
procedure TBaseVirtualTree.DoMouseEnter();
begin
if Assigned(FOnMouseEnter) then
FOnMouseEnter(Self);
end;
procedure TBaseVirtualTree.DoMouseLeave;
begin
if Assigned(FOnMouseLeave) then
FOnMouseLeave(Self);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TBaseVirtualTree.DoNodeCopied(Node: PVirtualNode);
begin
@ -21211,6 +21269,23 @@ end;
//----------------------------------------------------------------------------------------------------------------------
function TBaseVirtualTree.GetNodeImageSize(Node: PVirtualNode): TSize;
// Returns the size of an image
// Override if you need different sized images for certain nodes.
begin
if Assigned(fImages) then begin
Result.cx := fImages.Width;
Result.cy := FImages.Height;
end
else begin
Result.cx := 0;
Result.cy := 0;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
function TBaseVirtualTree.GetMaxRightExtend: Cardinal;
// Determines the maximum with of the currently visible part of the tree, depending on the length
@ -21733,7 +21808,7 @@ var
// helper variables to shorten boolean equations/expressions
AutoDrag, // automatic (or allowed) drag start
IsHit, // the node's caption or images are hit
IsLabelHit, // the node's caption or images are hit
IsCellHit, // for grid extension or full row select (but not check box, button)
IsAnyHit, // either IsHit or IsCellHit
IsHeightTracking, // height tracking
@ -21816,13 +21891,13 @@ begin
// Various combinations determine what states the tree enters now.
// We initialize shorthand variables to avoid the following expressions getting too large
// and to avoid repeative expensive checks.
IsHit := not AltPressed and not (toSimpleDrawSelection in FOptions.FSelectionOptions) and
IsLabelHit := not AltPressed and not (toSimpleDrawSelection in FOptions.FSelectionOptions) and
((hiOnItemLabel in HitInfo.HitPositions) or (hiOnNormalIcon in HitInfo.HitPositions));
IsCellHit := not AltPressed and not IsHit and Assigned(HitInfo.HitNode) and
IsCellHit := not AltPressed and not IsLabelHit and Assigned(HitInfo.HitNode) and
([hiOnItemButton, hiOnItemCheckBox] * HitInfo.HitPositions = []) and
((toFullRowSelect in FOptions.FSelectionOptions) or
((toGridExtensions in FOptions.FMiscOptions) and (HitInfo.HitColumn > NoColumn)));
IsAnyHit := IsHit or IsCellHit;
IsAnyHit := IsLabelHit or IsCellHit;
MultiSelect := toMultiSelect in FOptions.FSelectionOptions;
ShiftEmpty := ShiftState = [];
NodeSelected := IsAnyHit and (vsSelected in HitInfo.HitNode.States);
@ -21839,7 +21914,7 @@ begin
// Query the application to learn if dragging may start now (if set to dmManual).
if Assigned(HitInfo.HitNode) and not AutoDrag and (DragMode = dmManual) then
AutoDrag := DoBeforeDrag(HitInfo.HitNode, Column) and (IsAnyHit or FullRowDrag);
AutoDrag := DoBeforeDrag(HitInfo.HitNode, Column) and (FullRowDrag or IsLabelHit);
// handle node height tracking
if IsHeightTracking then
@ -21905,7 +21980,7 @@ begin
(not (tsRightButtonDown in FStates) or not HasPopupMenu(HitNode, HitColumn, Point(XPos, YPos)));
// User starts a selection with a selection rectangle.
if not (toDisableDrawSelection in FOptions.FSelectionOptions) and not (IsHit or FullRowDrag) and MultiSelect then
if not (toDisableDrawSelection in FOptions.FSelectionOptions) and not (IsLabelHit or FullRowDrag) and MultiSelect then
begin
SetCapture(Handle);
DoStateChange([tsDrawSelPending]);
@ -21952,7 +22027,7 @@ begin
(hiOnItem in HitInfo.HitPositions))) and NodeSelected and not NewColumn and ShiftEmpty then
DoStateChange([tsEditPending]);
if not (toDisableDrawSelection in FOptions.FSelectionOptions) and not (IsHit or FullRowDrag) and MultiSelect then
if not (toDisableDrawSelection in FOptions.FSelectionOptions) and not (IsLabelHit or FullRowDrag) and MultiSelect then
begin
// The original code here was moved up to fix issue #187.
// In order not to break the semantics of this procedure, we are leaving these if statements here
@ -21964,7 +22039,8 @@ begin
FLastClickPos := Point(Message.XPos, Message.YPos);
// Handle selection and node focus change.
if IsAnyHit and FocusCanChange then
if (IsLabelHit or IsCellHit) and
DoFocusChanging(FFocusedNode, HitInfo.HitNode, FFocusedColumn, Column) then
begin
if NewColumn then
begin
@ -22082,7 +22158,7 @@ begin
(toEditOnClick in FOptions.FMiscOptions) and CanEdit(FFocusedNode, HitInfo.HitColumn) then
begin
FEditColumn := FFocusedColumn;
SetTimer(Handle, EditTimer, FEditDelay, nil);
DoEdit;
end
else
DoStateChange([], [tsEditPending]);
@ -26223,7 +26299,7 @@ begin
if Assigned(FStateImages) and HasImage(Node, ikState, Column) then
Inc(Offset, FStateImages.Width + 2);
if Assigned(FImages) and HasImage(Node, ikNormal, Column) then
Inc(Offset, FImages.Width + 2);
Inc(Offset, GetNodeImageSize(Node).cx + 2);
// Offset contains now the distance from the left or right border of the rectangle (depending on bidi mode).
// Now consider the alignment too and calculate the final result.
@ -27053,11 +27129,10 @@ var
NodeLeft,
TextLeft,
CurrentWidth: Integer;
AssumeImage: Boolean;
WithCheck,
WithImages,
WithStateImages: Boolean;
CheckOffset,
ImageOffset,
StateImageOffset: Integer;
begin
@ -27075,12 +27150,6 @@ begin
if Assigned(FOnBeforeGetMaxColumnWidth) then
FOnBeforeGetMaxColumnWidth(FHeader, Column, UseSmartColumnWidth);
// Don't check the event here as descendant trees might have overriden the DoGetImageIndex method.
WithImages := Assigned(FImages);
if WithImages then
ImageOffset := FImages.Width + 2
else
ImageOffset := 0;
WithStateImages := Assigned(FStateImages);
if WithStateImages then
StateImageOffset := FStateImages.Width + 2
@ -27125,13 +27194,16 @@ begin
else
LastNode := nil;
AssumeImage := False;
while Assigned(Run) and not OperationCanceled do
begin
TextLeft := NodeLeft;
if WithCheck and (Run.CheckType <> ctNone) then
Inc(TextLeft, CheckOffset);
if WithImages and HasImage(Run, ikNormal, Column) then
Inc(TextLeft, ImageOffset);
if Assigned(fImages) and (AssumeImage or HasImage(Run, ikNormal, Column)) then begin
TextLeft := TextLeft + GetNodeImageSize(Run).cx + 2;
AssumeImage := True;// From now on, assume that the nodes do ave an image
end;
if WithStateImages and HasImage(Run, ikState, Column) then
Inc(TextLeft, StateImageOffset);
@ -27759,6 +27831,11 @@ begin
Result := GetNodeAt(X, Y, True, Dummy);
end;
function TBaseVirtualTree.GetNodeAt(const P: TPoint): PVirtualNode;
begin
Result := GetNodeAt(P.X, P.Y);
end;
//----------------------------------------------------------------------------------------------------------------------
function TBaseVirtualTree.GetNodeAt(X, Y: Integer; Relative: Boolean; var NodeTop: Integer): PVirtualNode;
@ -29738,7 +29815,7 @@ begin
begin
GetImageIndex(PaintInfo, ImageKind[vsSelected in Node.States], iiNormal, FImages);
if ImageInfo[iiNormal].Index > -1 then
AdjustImageBorder(FImages.Width, FImages.Height, BidiMode, VAlign, ContentRect, ImageInfo[iiNormal]);
AdjustImageBorder(ImageInfo[iiNormal].Images, BidiMode, VAlign, ContentRect, ImageInfo[iiNormal]);
end
else
ImageInfo[iiNormal].Index := -1;
@ -30442,6 +30519,43 @@ begin
end;
end;
//----------------- TBaseVirtualTree -----------------------------------------------------------------------------
procedure TBaseVirtualTree.DoDrawHint(Canvas: TCanvas; Node: PVirtualNode; R:
TRect; Column: TColumnIndex);
begin
if Assigned(FOnDrawHint) then
FOnDrawHint(Self, Canvas, Node, R, Column);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TBaseVirtualTree.DoGetHintSize(Node: PVirtualNode; Column:
TColumnIndex; var R: TRect);
begin
if Assigned(FOnGetHintSize) then
FOnGetHintSize(Self, Node, Column, R);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TBaseVirtualTree.DoGetHintKind(Node: PVirtualNode; Column:
TColumnIndex; var Kind: TVTHintKind);
begin
if Assigned(fOnGetHintKind) then
fOnGetHintKind(Self, Node, Column, Kind)
else
Kind := DefaultHintKind;
end;
function TBaseVirtualTree.GetDefaultHintKind: TVTHintKind;
begin
Result := vhkText;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TBaseVirtualTree.ReinitChildren(Node: PVirtualNode; Recursive: Boolean);
@ -34335,15 +34449,6 @@ begin
Result := TStringTreeOptions;
end;
//----------------- TCustomVirtualDrawTree -----------------------------------------------------------------------------
procedure TCustomVirtualDrawTree.DoDrawHint(Canvas: TCanvas; Node: PVirtualNode; const R: TRect; Column: TColumnIndex);
begin
if Assigned(FOnDrawHint) then
FOnDrawHint(Self, Canvas, Node, R, Column);
end;
//----------------------------------------------------------------------------------------------------------------------
function TCustomVirtualDrawTree.DoGetCellContentMargin(Node: PVirtualNode; Column: TColumnIndex;
@ -34360,15 +34465,6 @@ end;
//----------------------------------------------------------------------------------------------------------------------
procedure TCustomVirtualDrawTree.DoGetHintSize(Node: PVirtualNode; Column: TColumnIndex; var R: TRect);
begin
if Assigned(FOnGetHintSize) then
FOnGetHintSize(Self, Node, Column, R);
end;
//----------------------------------------------------------------------------------------------------------------------
function TCustomVirtualDrawTree.DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): Integer;
begin
@ -34389,6 +34485,12 @@ begin
FOnDrawNode(Self, PaintInfo);
end;
function TCustomVirtualDrawTree.GetDefaultHintKind: TVTHintKind;
begin
Result := vhkOwnerDraw;
end;
//----------------- TVirtualDrawTree -----------------------------------------------------------------------------------
function TVirtualDrawTree.GetOptions: TVirtualTreeOptions;

1
components/virtualtreeview-new/trunk/upgrade-v5-issues.txt
View File

@ -13,3 +13,4 @@
* Review KeyUnicode -> unnecessary?
* review FDottedBrush life cycle
* Reverted changes is FillBitmap. See if will work as is
* See if will keep TVTHintKind