VirtualStringTree - different formats of text in the same multiline node

Question

I have an instance of TVirtualStringTree that formats text of a node in two different ways. The implementation is based on using toShowStaticText in the StringOptions as described in the accepted answer of this question: VirtualTreeView - different color of text in the same node

Everything used to work fine until I've set the MultiLine flag for the nodes. Now the OnPaintText event will no longer be triggered having TextType = ttStatic.

The reason for this behaviour can be found in the TCustomVirtualStringTree.DoPaintNode method and is obviously intended:

// ... and afterwards the static text if not centered and the node is not multiline enabled.
if (Alignment <> taCenter) and not (vsMultiline in PaintInfo.Node.States) and (toShowStaticText in TreeOptions.FStringOptions) then
begin
  S := '';
  with PaintInfo do
    DoGetText(Node, Column, ttStatic, S);
  if Length(S) > 0 then
    PaintStaticText(PaintInfo, TextOutFlags, S);
end;

Nevertheless, I want to have two different text formats in the same MultiLine Node. How can I do that?

Chalfant

Answer 1

I solved this problem with usage of OnDrawText and this helper function:

class function TFontSizeHelper.TrueFontSize(fnt : TFont; const text : string): Winapi.Windows.TSize;
var
    dc : hdc;
begin
    dc := GetDC(0);
    SelectObject(DC, fnt.Handle);
    GetTextExtentPoint32(dc, PChar(text), Length(text), Result);
    ReleaseDC(0, DC);
end;

...
procedure TMyForm.VstDrawText(Sender : TBaseVirtualTree; TargetCanvas : TCanvas; Node : PVirtualNode;
Column : TColumnIndex; const Text : string; const CellRect : TRect; var DefaultDraw : Boolean);
const 
    TREEVIEW_FONTSPACE=2;
var
    ln1, ln2 : string;
    lineBegin : Integer;
    size : Winapi.Windows.TSize;
begin
    case Column of
        0 : begin
            DefaultDraw := False;
            lineBegin := Text.IndexOf(CRLF);
            ln1 := Text.Substring(0, lineBegin);
            TargetCanvas.TextOut(CellRect.Left, TREEVIEW_FONTSPACE, ln1);

            ln2 := Text.Substring(lineBegin + 2);
            TargetCanvas.Font.Color := clPurple;
            size := TFontSizeHelper.TrueFontSize(TargetCanvas.Font, ln1);
            // TargetCanvas.Font.style := [fsBold, fsUnderline];
            TargetCanvas.TextOut(CellRect.Left, size.cy, ln2);

        end;
    end;
end;

Adsorb