Лидеры

Модифицируйте на здоровье. Мне не жалко :-)

по аналогии с этой темой procedure TForm1.StringGrid1DrawColumnCell(Sender: TObject; const Canvas: TCanvas; const Column: TColumn; const Bounds: TRectF; const Row: Integer; const Value: TValue; const State: TGridDrawStates); var aTextRect: TRectF; aTextLayout: TTextLayout; begin aTextRect := Bounds; aTextRect.Right := Round(aTextRect.Right) + 2; // убираем вертикальную линию сетки aTextRect.Bottom := Round(aTextRect.Bottom) - 1; // оставляем горизонтальную Canvas.FillRect(aTextRect, 0, 0, AllCorners, 1); if StringGrid1.Selected = Row then Canvas.ClearRect(aTextRect, claAquamarine); // красим выделенную строку aTextLayout := TTextLayoutManager.DefaultTextLayout.Create; try aTextLayout.BeginUpdate; try aTextLayout.WordWrap := False; aTextLayout.Opacity := Column.AbsoluteOpacity; aTextLayout.Trimming := TTextTrimming.Character; aTextLayout.TopLeft := aTextRect.TopLeft; aTextLayout.Text := Value.ToString; aTextLayout.MaxSize := PointF(aTextRect.Width, aTextRect.Height); if Column.Index = 0 then begin aTextLayout.Font.Family := 'Times New Roman'; // меняем шрифт колонки aTextLayout.Color := claBrown; end; if Column.Index = 1 then begin aTextLayout.Font.Size := 18; // меняем шрифт другой колонки aTextLayout.Font.Style := [TFontStyle.fsBold]; end; finally aTextLayout.EndUpdate; end; aTextLayout.RenderLayout(Canvas); finally aTextLayout.Free; end; end;

procedure TFormFM.NavigationTreeView(aTree: TTreeView; const aData: string); var Root, Child, SubChild, Item: TTreeViewItem; StrList: TStringList; i, c: integer; Str, ParseStr: string; begin StrList := TStringList.Create; StrList.Text := aData; aTree.BeginUpdate; aTree.Clear; for i := 0 to StrList.Count - 1 do begin Str := StrList.Strings[i]; ParseStr := Parse('">', '</option>', Str); if Pos('a', ParseStr) > 0 then ParseStr := StringReplace(ParseStr, 'a', 'a', [rfReplaceAll]); Item := TTreeViewItem.Create(nil); Item.StyleLookup := 'treeviewitemstyle'; Item.Text := trim(StringReplace(ParseStr, '-', '', [rfReplaceAll])); Item.HelpKeyword := Parse('<option value="', '">', Str); Item.ClipChildren := false; if Pos('-', ParseStr) = 0 then begin aTree.AddObject(Item); Root := Item; end else if ParseStr.StartsWith('-- ') then begin Root.AddObject(Item); Child := Item; end else if ParseStr.StartsWith('---- ') then begin Child.AddObject(Item); SubChild := Item; end else if ParseStr.StartsWith('------ ') then begin SubChild.AddObject(Item); end; end; aTree.EndUpdate; aTree.RealignContent; FreeAndNil(StrList); end; вот решение если кто столкнется с таким же багом спасибо Ярославу!