Enable displaying tooltips for shortened celltext in VirtualTrees like the old TListView did by default.

This commit is contained in:
Ansgar Becker
2007-10-05 23:41:25 +00:00
parent db55bbcbe3
commit 55ef55d546
2 changed files with 52 additions and 0 deletions

View File

@@ -126,9 +126,12 @@ object MDIChild: TMDIChild
Header.Height = 20
Header.Options = [hoAutoResize, hoColumnResize, hoDblClickResize, hoDrag, hoHotTrack, hoShowSortGlyphs, hoVisible]
Header.SortColumn = 0
HintMode = hmTooltip
Images = MainForm.ImageList1
IncrementalSearch = isInitializedOnly
ParentShowHint = False
PopupMenu = popupHost
ShowHint = True
TabOrder = 0
TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScrollOnExpand, toAutoSort, toAutoTristateTracking, toAutoDeleteMovedNodes]
TreeOptions.MiscOptions = [toToggleOnDblClick]
@@ -139,6 +142,7 @@ object MDIChild: TMDIChild
OnFreeNode = vstFreeNode
OnGetText = vstGetText
OnGetImageIndex = vstGetImageIndex
OnGetHint = vstGetHint
OnGetNodeDataSize = vstGetNodeDataSize
OnHeaderClick = vstHeaderClick
OnInitNode = vstInitNode
@@ -174,9 +178,12 @@ object MDIChild: TMDIChild
Header.Options = [hoAutoResize, hoColumnResize, hoDblClickResize, hoDrag, hoHotTrack, hoShowSortGlyphs, hoVisible]
Header.SortColumn = 0
Header.SortDirection = sdDescending
HintMode = hmTooltip
Images = MainForm.ImageList1
IncrementalSearch = isInitializedOnly
ParentShowHint = False
PopupMenu = popupHost
ShowHint = True
TabOrder = 0
TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScrollOnExpand, toAutoSort, toAutoTristateTracking, toAutoDeleteMovedNodes]
TreeOptions.MiscOptions = [toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]
@@ -187,6 +194,7 @@ object MDIChild: TMDIChild
OnFreeNode = vstFreeNode
OnGetText = vstGetText
OnGetImageIndex = vstGetImageIndex
OnGetHint = vstGetHint
OnGetNodeDataSize = vstGetNodeDataSize
OnHeaderClick = vstHeaderClick
OnInitNode = vstInitNode
@@ -251,9 +259,12 @@ object MDIChild: TMDIChild
Header.Options = [hoAutoResize, hoColumnResize, hoDblClickResize, hoDrag, hoHotTrack, hoShowSortGlyphs, hoVisible]
Header.SortColumn = 1
Header.SortDirection = sdDescending
HintMode = hmTooltip
Images = MainForm.ImageList1
IncrementalSearch = isInitializedOnly
ParentShowHint = False
PopupMenu = popupHost
ShowHint = True
TabOrder = 0
TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScrollOnExpand, toAutoSort, toAutoTristateTracking, toAutoDeleteMovedNodes]
TreeOptions.MiscOptions = [toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]
@@ -264,6 +275,7 @@ object MDIChild: TMDIChild
OnFreeNode = vstFreeNode
OnGetText = vstGetText
OnGetImageIndex = vstGetImageIndex
OnGetHint = vstGetHint
OnGetNodeDataSize = vstGetNodeDataSize
OnHeaderClick = vstHeaderClick
OnInitNode = vstInitNode
@@ -359,9 +371,12 @@ object MDIChild: TMDIChild
Header.Options = [hoColumnResize, hoDblClickResize, hoDrag, hoHotTrack, hoShowSortGlyphs, hoVisible]
Header.PopupMenu = popupDbGridHeader
Header.SortColumn = 0
HintMode = hmTooltip
Images = MainForm.ImageList1
IncrementalSearch = isInitializedOnly
ParentShowHint = False
PopupMenu = popupDbGrid
ShowHint = True
TabOrder = 1
TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScrollOnExpand, toAutoSort, toAutoTristateTracking, toAutoDeleteMovedNodes]
TreeOptions.MiscOptions = [toEditable, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]
@@ -374,6 +389,7 @@ object MDIChild: TMDIChild
OnFreeNode = vstFreeNode
OnGetText = vstGetText
OnGetImageIndex = vstGetImageIndex
OnGetHint = vstGetHint
OnGetNodeDataSize = vstGetNodeDataSize
OnHeaderClick = vstHeaderClick
OnInitNode = vstInitNode
@@ -695,9 +711,12 @@ object MDIChild: TMDIChild
Header.Font.Style = []
Header.Height = 20
Header.Options = [hoColumnResize, hoDblClickResize, hoDrag, hoHotTrack, hoShowSortGlyphs, hoVisible]
HintMode = hmTooltip
Images = MainForm.ImageList1
IncrementalSearch = isInitializedOnly
ParentShowHint = False
PopupMenu = popupTableGrid
ShowHint = True
TabOrder = 2
TreeOptions.MiscOptions = [toAcceptOLEDrop, toEditable, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]
TreeOptions.PaintOptions = [toShowDropmark, toShowHorzGridLines, toShowVertGridLines, toThemeAware, toUseBlendedImages]
@@ -709,6 +728,7 @@ object MDIChild: TMDIChild
OnFreeNode = vstFreeNode
OnGetText = vstGetText
OnGetImageIndex = vstGetImageIndex
OnGetHint = vstGetHint
OnGetNodeDataSize = vstGetNodeDataSize
OnHeaderClick = vstHeaderClick
OnInitNode = vstInitNode

View File

@@ -502,6 +502,9 @@ type
procedure ComboBoxQueryDelimiterExit(Sender: TObject);
procedure ComboBoxQueryDelimiterAdd(delimiter: String);
procedure FormCreate(Sender: TObject);
procedure vstGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle; var
HintText: WideString);
procedure popupFilterPopup(Sender: TObject);
private
@@ -6453,4 +6456,33 @@ begin
menuFilterSQLHelp.Caption := 'Lookup "'+sstr(SynMemoFilter.WordAtCursor,50)+'" in SQL help ...';
end;
{**
Display tooltips in VirtualTrees. Imitates default behaviour of TListView.
}
procedure TMDIChild.vstGetHint(Sender: TBaseVirtualTree; Node:
PVirtualNode; Column: TColumnIndex; var LineBreakStyle:
TVTTooltipLineBreakStyle; var HintText: WideString);
var
NodeData : PVTreeData;
r : TRect;
DisplayedWidth,
NeededWidth : Integer;
begin
NodeData := Sender.GetNodeData( Node );
if NodeData.Captions.Count > Column then
HintText := NodeData.Captions[Column]
else
Exit;
// Check if the list has shortened the text
r := Sender.GetDisplayRect(Node, Column, True);
DisplayedWidth := r.Right-r.Left;
NeededWidth := Canvas.TextWidth(HintText) + TVirtualStringTree(Sender).TextMargin*2;
//debug(format('need: %d, given: %d, font: %s %d', [NeededWidth, DisplayedWidth, canvas.Font.Name, canvas.Font.Size]));
// Disable displaying hint if text is displayed completely in list
if NeededWidth <= DisplayedWidth then
HintText := '';
end;
end.