From 55ef55d54674f9e879dfd9cb8fd54df3fa10bcbe Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Fri, 5 Oct 2007 23:41:25 +0000 Subject: [PATCH] Enable displaying tooltips for shortened celltext in VirtualTrees like the old TListView did by default. --- source/childwin.dfm | 20 ++++++++++++++++++++ source/childwin.pas | 32 ++++++++++++++++++++++++++++++++ 2 files changed, 52 insertions(+) diff --git a/source/childwin.dfm b/source/childwin.dfm index 92cee508..b1a74900 100644 --- a/source/childwin.dfm +++ b/source/childwin.dfm @@ -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 diff --git a/source/childwin.pas b/source/childwin.pas index 8f9fcaf8..940600d4 100644 --- a/source/childwin.pas +++ b/source/childwin.pas @@ -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.