Virtual StringTree: How to determine if the node text is completely shown? - delphi

When TVirtualStreeTree.HintMode = hmTooltip, the node text will become the hint text when the mouse is hovered over a node and column where the node text is not completely shown. But I have to set HintMode = hmHint, so that I can in the even handler supply various hint text based on the position the current mouse cursor is, and in that HintMode the hint text is not generated automatically.
My question is how to know if the a node text is shown completely or not, so that I know should I supply the node text or empty string as the hint text?
Thanks.

You can call TBaseVirtualTree.GetDisplayRect to determine the text bounds of a node. Depending on the Unclipped parameter, it will give you the full or actual text width. TextOnly should be set to True:
function IsTreeTextClipped(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean;
var
FullRect, ClippedRect: TRect;
begin
FullRect := Tree.GetDisplayRect(Node, Column, True, True);
ClippedRect := Tree.GetDisplayRect(Node, Column, True, False);
Result := (ClippedRect.Right - ClippedRect.Left) < (FullRect.Right - FullRect.Left);
end;
Note that the function will implicitly initialize the node if it's not been initialized yet.

You can use what the tree control itself uses. Here's an excerpt from the cm_HintShow message handler for single-line nodes when hmTooltip mode is in effect.
NodeRect := GetDisplayRect(HitInfo.HitNode, HitInfo.HitColumn, True, True, True);
BottomRightCellContentMargin := DoGetCellContentMargin(HitInfo.HitNode, HitInfo.HitColumn
, ccmtBottomRightOnly);
ShowOwnHint := (HitInfo.HitColumn > InvalidColumn) and PtInRect(NodeRect, CursorPos) and
(CursorPos.X <= ColRight) and (CursorPos.X >= ColLeft) and
(
// Show hint also if the node text is partially out of the client area.
// "ColRight - 1", since the right column border is not part of this cell.
( (NodeRect.Right + BottomRightCellContentMargin.X) > Min(ColRight - 1, ClientWidth) ) or
(NodeRect.Left < Max(ColLeft, 0)) or
( (NodeRect.Bottom + BottomRightCellContentMargin.Y) > ClientHeight ) or
(NodeRect.Top < 0)
);
If ShowOwnHint is true, then you should return the node's text as the hint text. Otherwise, leave the hint text blank.
The main obstacle with using that code is that DoGetCellContentMargin is protected, so you can't call it directly. You can either edit the source to make it public, or you can duplicate its functionality in your own function; if you aren't handling the OnBeforeCellPaint event, then it always returns (0, 0) anyway.
The HitInfo data comes from calling GetHitTestInfoAt.

Related

how to make list with buttons at each item in Delphi

As shown in figure, I need to make a list with buttons on each item, one button at down left of the item, and some on the down right.
I Make the demo app using ListBox control and some Buttons within Panel above on ListBox, but when the ListBox scrolling, it's difficult to make the Buttons follow the ListItem.
who can help, thanks~~~
I got the way to make it!so, I'll post the answer myself~, but Remy Lebeau inspired me.
in the beginning, I used DrawFrameControl() to make button on list, It works but the style was look like classic windows style, and it's hard to make back color like the pic in the example.
then, I used FillRect() and DrawEdge() make the Button, I think it's well, here is the code:
hitPoint := lst1.ScreenToClient(Mouse.CursorPos);
// there is a btnRect var of the Button Rect
edgeRect.Left := btnRect.Left - 1;
edgeRect.Top := btnRect.Top - 1;
edgeRect.Right := btnRect.Right + 1;
edgeRect.Bottom := btnRect.Bottom + 1;
// make button
lst1.Canvas.FillRect(btnRect);
// make edge, FListMouseDown is bool var and setting value at MouseDown/MouseUp Event
//
if PtInRect(edgeRect, hitPoint) and FListMouseDown then begin
DrawEdge(lst1.Canvas.Handle, edgeRect, EDGE_ETCHED, BF_RECT); // button down style
end else begin
DrawEdge(lst1.Canvas.Handle, edgeRect, EDGE_RAISED, BF_RECT);
end;
The following work is store the Rect of Buttons in memory, write the ButtonOnClick event code, and calling ButtonOnClick event at ListMouseUp() event after judge if Mouse Hit Position is in the Button Rect, The Code is not important like the above drawing Buttons, so it is omitted

Calculating flow panel width based on its contents

I am dynamically populating frames into flow panels (as part of a horizontally oriented VCL Metropolis app). I need to resize each group's flow panel to fit all its items horizontally. I have a very simple formula which does the trick sometimes, but not all the time - specifically when adding an odd number of items. The flow panel's FlowStyle is set to fsTopBottomLeftRight and fits 2 frames vertically.
For example, adding 7 items automatically detects the correct width (4 items across). But adding 5 items does not detect the correct width (supposed to be 3 across but winds up detecting 2 across).
How can I make it correctly calculate the width for each group?
Here's the procedure that populates the items into each item group (some irrelevant stuff removed):
procedure TSplitForm.LoadScreen;
const
FRAME_WIDTH = 170; //Width of each frame
FRAME_HEIGHT = 250; //Height of each frame
FRAME_MARGIN = 30; //Margin to right of each group
FRAME_VERT_COUNT = 2; //Number of frames vertically stacked
var
CurGroup: TFlowPanel; //Flow panel currently being populated
procedure ResizeGroup(FP: TFlowPanel);
var
Count, CountHalf, NewWidth, I: Integer;
begin
//Resize the specific flow panel's width to fit all items
Count:= FP.ComponentCount;
NewWidth:= FRAME_WIDTH + FRAME_MARGIN; //Default width if no items
if Count > 0 then begin
//THIS IS WHERE MY CALCULATIONS DO NOT WORK
CountHalf:= Round(Count / FRAME_VERT_COUNT);
NewWidth:= (CountHalf * FRAME_WIDTH) + FRAME_MARGIN;
end;
if FP.Parent.Width <> NewWidth then
FP.Parent.Width:= NewWidth;
//Resize main flow panel's width to fit all contained group panels
//(automatically extends within scroll box to extend scrollbar)
Count:= TFlowPanel(FP.Parent.Parent).ControlCount;
NewWidth:= 0;
for I := 0 to Count-1 do begin
NewWidth:= NewWidth + FP.Parent.Parent.Controls[I].Width;
end;
NewWidth:= NewWidth + FRAME_MARGIN;
if FP.Parent.Parent.Width <> NewWidth then
FP.Parent.Parent.Width:= NewWidth;
end;
procedure Add(const Name, Title, Subtitle: String);
var
Frame: TfrmItemFrame;
begin
Frame:= AddItemFrame(CurGroup, Name); //Create panel, set parent and name
Frame.OnClick:= ItemClick;
Frame.Title:= Title;
Frame.Subtitle:= Subtitle;
ResizeGroup(CurGroup);
end;
begin
CurGroup:= fpMainGroup;
Add('boxMainItem1', 'Item 1', 'This is item 1');
Add('boxMainItem2', 'Item 2', 'This is item 2');
Add('boxMainItem3', 'Item 3', 'This is item 3');
Add('boxMainItem4', 'Item 4', 'This is item 4');
Add('boxMainItem5', 'Item 5', 'This is item 5');
CurGroup:= fpInventoryGroup;
Add('boxInventItem1', 'Item 1', 'This is item 1');
Add('boxInventItem2', 'Item 2', 'This is item 2');
Add('boxInventItem3', 'Item 3', 'This is item 3');
Add('boxInventItem4', 'Item 4', 'This is item 4');
Add('boxInventItem5', 'Item 5', 'This is item 5');
Add('boxInventItem6', 'Item 6', 'This is item 6');
Add('boxInventItem7', 'Item 7', 'This is item 7');
end;
This is a screenshot of what that code is producing:
As you can see, the first group with 5 items is hiding the 5th item, but the second group with 7 items is showing all 7 just fine.
The structure of parent/child relationships is like so (with flow panels in question bold):
SplitForm: TSplitForm (main form)
ScrollBox2: TScrollBox (container of main flow panel)
fpMain: TFlowPanel (container of all group panels)
pMainGroup: TPanel (container of flow panel and title panel)
fpMainGroup: TFlowPanel (container of item frames)
pMainGroupTitle: TPanel (title at top of group)
pInventoryGroup: TPanel (container of flow panel and title panel)
fpInventoryGroup: TFlowPanel (container of item frames)
pInventoryGroupTitle: TPanel (title at top of group)
(other panels for more groups)
I tried using each flow panel's AutoSize property, but it didn't acknowledge the heights (2 up) and made things even worse. I basically just need to properly detect the total number of columns within these flow panels.
Round(Count / FRAME_VERT_COUNT);
Here FRAME_VERT_COUNT is 2. When Count is 5 your expression becomes
Rount(2.5);
The default rounding mode is bankers rounding and this evaluates to 2. When Count is 7 the expression is
Round(3.5);
Bankers rounding means this is 4.
You could do what Sertac suggests and use ceil. However, I would simply avoid floating point altogether. It is just not needed and as a general rule, integer arithmetic is always to be preferred if it is viable. Your expression should be
(Count + FRAME_VERT_COUNT - 1) div FRAME_VERT_COUNT
You don't want a partial tile, so when you're calculating how many columns are needed you want the nearest (equal or greater) integer.
In the default rounding mode, Round(7/2) is '4'. That's fine. However Round(5/2) is '2'. That's because
With the default rounding mode (rmNearest), if X is exactly halfway
between two whole numbers, the result is always the even number.
With only two rows, rounding up can be a solution (division is always a whole number or a number exactly in between two whole numbers). For a general solution, better use Ceil.

How to check for presence of scroll bars in TJvTreeView

I am trying to position something w.r.t. a TJvTreeView, and I would like to know both the width and presence of the vertical scroll view. Does anyone know the canonical way to do that? Or failing that, any way that works?
Test for the presence of the WS_VSCROLL window style:
HasVertScrollBar := (GetWindowLongPtr(hWnd, GWL_STYLE) and WS_VSCROLL) <> 0;
To find the width of system scroll bars, call SystemParametersInfo passing SPI_GETNONCLIENTMETRICS.
var
ncm: TNonClientMetrics;
....
ncm.cbSize := SizeOf(ncm);
Win32Check(
SystemParametersInfo(SPI_GETNONCLIENTMETRICS, ncm.cbSize, Pointer(#ncm), 0)
);
The scroll bar width can then be retrieved from ncm.iScrollWidth.

TStringGrid: Why OnClick after OnKeyDown

Why does a Delphi StringGrid sometimes calls the OnClick event after an OnKeyDown?
Debugging screenshot:
My OnKeyDown event handler:
var
Top: Integer;
Bottom: Integer;
CurrentRow: Integer;
begin
Top := Grid.TopRow;
Bottom := Grid.TopRow + Grid.VisibleRowCount - 1;
if (Key = 38) then CurrentRow := Grid.Row - 1
else if (Key = 40) then CurrentRow := Grid.Row + 1;
// Disable OnClick because sometimes a 'TStringGrid.Click' is called anyway...
// (when clicking on form top window bar and navigating)
Grid.OnClick := nil;
if (CurrentRow < Top - 1) or (CurrentRow > Bottom + 1) then begin
if (Key = 38) then Grid.Row := Bottom
else if (Key = 40) then Grid.Row := Top;
end;
Grid.OnClick := GridClick;
end;
Edit:
It seems the 'OnClick' is not being fired when the last line is selected and pushing 'Down' or when the first line is selected and pushing 'Up'.
Way to reproduce:
Add a TStringGrid to a form and populate with a few lines. Add 'OnClick' and 'OnKeyDown' handler. No specific code needs to be added in these two handler methods. Select a row in the stringgrid on the form and press the up or down arrow on your keyboard.
Edit 2:
This isn't the solution, but to prevent the code in 'OnClick' being executed after pressing up, down, pageup or pagedown, I set a variable in 'OnKeyDown' what key was pressed and check for that variable in 'OnClick'.
Edit 3:
Updated stack trace and way to reproduce.
Well, that hard-coded key codes aren't the case making the least bit transparent, but you witness this effect when you use a direction key (up, down, left, etc...) to change the selection.
Why the OnClick event handler is called, is because TCustomGrid.OnKeyDown calls TCustomGrid.FocusCell, which calls Click.
Exactly why changing focus to another cell would establish a click I do not know, we would have to ask the developers I imagine. Perhaps to simulate the default behaviour when changing focus to another cell by clicking instead of keyboard.
Since you seem to handle direction key presses yourself, maybe you could consider to prevent this from happening at all by ignoring the key any further:
if Key in [VK_PRIOR..VK_DOWN] then
Key := 0;

How to reliably scroll Virtual TreeView to the bottom?

A TVirtualStringTree object with custom node height, How to reliably scroll Virtual TreeView to the bottom (i.e. the scrollbar gets to the bottom)?
I tried calling tree1.FullExpand then tree1.ScrollIntoView.(tree1.GetLast), but it does not work.
Thank you in advance.
ScrollIntoView works well for me. You can also try tree1.FocusedNode := tree1.GetLast;
Are you setting custom node height in OnMeasureItem event?
If it doesn't work, try to set tree's DefaultNodeHeight to the bigger value and in OnMeasureItem event change it to lower. I noticed that tree recalculates scrollbar's length better that way.
Try this:
SendMessage(VST.Handle, WM_VSCROLL, SB_BOTTOM, 0);
PostMessage(VST.Handle, WM_VSCROLL, SB_BOTTOM, 0);
I've had the same problem working with TVirtualDrawTree's. You have to make sure that node heights are computed before the tree actually scrolls.
This is what I do:
1.- Add this code to the OnInitNode event so that the tree knows that the height of the new node must be computed:
Node.States := node.States + [vsMultiline] - [vsHeightMeasured];
2.- In the OnMeasureItem, if you can't compute the height (e.g. node not initialized yet), make sure you tell the tree to repeat the call when needed:
In the OnMeasureItem event handler:
If (Node = Nil) Or (Node = tree.RootNode) Then Begin
Exclude(Node.States, vsHeightMeasured);
Exit;
End;
NodeData := tree.GetNodeData(Node);
If (NodeData = Nil) Or (NodeData^.XMLNode = Nil) Then Begin
Exclude(Node.States, vsHeightMeasured);
Exit;
End;
Try
// Code to measure node height here.
Except
Exclude(Node.States, vsHeightMeasured);
End;
I hope it helps you.
This also should work:
tree1.TopNode := tree1.GetLast

Resources