TTreeView custom draw item width - delphi

Question

I use the OnCustomDrawItem event to draw a TTreeView like this :
Here is my code :
procedure Tform1.trvArbreCustomDrawItem(Sender: TCustomTreeView; Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
var
vRect : TRect;
vBmp : TBitmap;
vBmpRect : TRect;
vTreeView : TTreeView;
vBarreInfo : TScrollInfo;
vDeltaX : Integer;
begin
DefaultDraw := False;
vTreeView := TTreeView(Sender);
vRect := Node.DisplayRect(False);
vBmp := TBitmap.Create();
FillChar(vBarreInfo, SizeOF(vBarreInfo), 0);
vBarreInfo.cbSize := SizeOf(vBarreInfo);
vBarreInfo.fMask := SIF_RANGE or SIF_POS;
if GetScrollInfo(trvArbre.Handle, SB_HORZ, vBarreInfo) then
begin
if vBarreInfo.nMax > vRect.Right - vRect.Left then
begin
vBmp.Width := vBarreInfo.nMax + 1;
vBmp.Height := vRect.Bottom - vRect.Top;
vDeltaX := vBarreInfo.nPos;
end
else
begin
vBmp.Width := vRect.Right - vRect.Left;
vBmp.Height := vRect.Bottom - vRect.Top;
vDeltaX := 0;
end;
end
else
begin
vBmp.Width := vRect.Right - vRect.Left;
vBmp.Height := vRect.Bottom - vRect.Top;
vDeltaX := 0;
end;
vBmpRect := Rect(0, 0, vBmp.Width, vBmp.Height);
if cdsSelected in State then
begin
vBmp.Canvas.Brush.Color := cMenuDownFond;
vBmp.Canvas.Pen .Color := cMenuDownBordure;
end
else if cdsHot in State then
begin
vBmp.Canvas.Brush.Color := cMenuSurvolFond;
vBmp.Canvas.Pen .Color := cMenuSurvolBordure;
end
else
begin
vBmp.Canvas.Brush.Color := clWhite;
vBmp.Canvas.Pen .Color := clwhite;
end;
vBmp.Canvas.Rectangle(vBmpRect);
vBmpRect.Left := vBmpRect.Left + 3;
vBmpRect.Left := vBmpRect.Left + (Node.Level * vTreeView.Indent);
if Node.StateIndex >= 0 then
begin
vTreeView.StateImages.Draw(vBmp.Canvas, vBmpRect.Left, vBmpRect.Top, Node.StateIndex);
end;
vBmpRect.Left := vBmpRect.Left + 18;
vTreeView.Images.Draw(vBmp.Canvas, vBmpRect.Left, vBmpRect.Top, Node.ImageIndex);
vBmpRect.Left := vBmpRect.Left + 18 + 3;
vBmp.Canvas.Font := vTreeView.Font;
DrawText
(
vBmp.Canvas.Handle,
PChar(Node.Text),
Length(Node.Text),
vBmpRect,
DT_SINGLELINE or DT_LEFT or DT_VCENTER or DT_NOPREFIX or DT_END_ELLIPSIS
);
BitBlt
(
Sender.Canvas.Handle,
vRect.Left,
vRect.Top,
vRect.Right - vRect.Left,
vRect.Bottom - vRect.Top,
vBmp.Canvas.Handle,
vDeltaX,
0,
SRCCOPY
);
FreeAndNil(vBmp);
end;
My problem is that the node "My last node wich is not too long" is not too long to justify the presence of the horizontal scrollbar.
When I set DefaultDraw to true I obtain :
It seems that the width of the node is computed with a font I don't use.
I tried to change the font of the canvas, to use Windows API, to use the OnAdvancedCustomDrawItem with no result.
Thanks.

Answer 1

I use Delphi 7. I copied ComCtrls.pas in the folder of my application. I changed procedure TCustomTreeView.CNNotify(var Message: TWMNotify);. Line 8979 from Result := Result or CDRF_SKIPDEFAULT to Result := Result or CDRF_SKIPDEFAULT; and I commented line 8980 else if FCanvasChanged then in order to simulate DefaultDraw=True and FCanvasChanged even if I set DefaultDraw to False in event et don't change font. After a lot of tests, I don't see any caveats.