Unterschidliche Schriftgrössen in Virtualstringtree

[aschne1]

Hallo

Ich verwende zur Datenanzeige die Komponente VirtualStringTree. Zur besseren Übersicht hinterlege ich die einzelnen Hauptknoten abwechslungsweise farbig blau-weiss-blau-weiss-usw.... (nicht wegen Herrn Stoiber ).Die Unterknoten haben die gleiche Farbe wie der Hauptknoten. Soweit kriege ich das auch hin.

Nun möchte ich die Unterknoten aber in einer anderen Schriftgrösse anzeigen. Auch das geht mit der untenstehenden Procedure, nur wenn die Kinderknoten ausklappen steigt die CPU-Auslastung auf 95-99%. Sobald ich alle Unterknoten wieder einklappe ist die CPU-Auslastung unter 5%.

Ich bin mir sicher, dass es eine einfache Lösung gibt. Nur welche?

Delphi-Quellcode:

procedure Tfrm_Pos.vstPositionBeforeCellPaint(Sender: TBaseVirtualTree;
  TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
  CellRect: TRect);
begin
    if Node.Parent <> Sender.RootNode then
    begin
      TVirtualStringTree(Sender).Font.Size := 8;
      if not Odd(Node.Parent.Index) then TargetCanvas.Brush.Color := clWhite
      else TargetCanvas.Brush.Color := kon_color1;
    end
    else
    begin
      TVirtualStringTree(Sender).Font.Size := 12;
      if not Odd(Node.Index) then TargetCanvas.Brush.Color := clWhite
      else TargetCanvas.Brush.Color := kon_color1;
    end;
    TargetCanvas.FillRect(CellRect);
end;

Danke für Eure Hilfe

Gruss

[generic]

das beforeitemErase ist denke ich besser für deine zwecke was die farbe betrifft.
du kannst die tiefe eines knoten mit
tiefe:=vst.GetNodeLevel(node); abfragen um dann die nicht anderes zu malenden knoten zu überspringen.

Delphi-Quellcode:

procedure TForm1.VirtualStringTree1BeforeItemErase(
  Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode;
  ItemRect: TRect; var ItemColor: TColor;
  var EraseAction: TItemEraseAction);
begin
  if sender.AbsoluteIndex(node) mod 2=0 then
    ItemColor:=$123344;
  EraseAction:=eaColor;
end;

die fontsize änderst du am besten im on painttext.

Delphi-Quellcode:

procedure TForm1.VirtualStringTree1PaintText(Sender: TBaseVirtualTree;
  const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
  TextType: TVSTTextType);
begin
  if sender.AbsoluteIndex(node) mod 2=0 then
    TargetCanvas.Font.Size:=24;
end;

[aschne1]

@generic
Danke für Deine Hilfe. Funzt prima!

Für alle die das gleiche Problem haben noch mein Code:

Delphi-Quellcode:

procedure Tfrm_Pos.vstPositionBeforeItemErase(Sender: TBaseVirtualTree;
  TargetCanvas: TCanvas; Node: PVirtualNode; ItemRect: TRect;
  var ItemColor: TColor; var EraseAction: TItemEraseAction);
begin
  if Node.Parent = Sender.RootNode then
    if Odd(Node.Index) then ItemColor:=kon_color1 else
  else
    if Odd(Node.Parent.Index) then ItemColor:=kon_color1;
  EraseAction:=eaColor;
end;

procedure Tfrm_Pos.vstPositionPaintText(Sender: TBaseVirtualTree;
  const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
  TextType: TVSTTextType);
begin
  if Node.Parent <> Sender.RootNode then
  begin
    TargetCanvas.Font.Size:=8;
    Node.NodeHeight := 16;
  end;
end;

Gruss

[generic]

ich glaube nicht das das komiliert.

im oberenblock steht 2 mal hintereinander else else

[NicoDE]

Zitat von generic:

ich glaube nicht das das komiliert.

Leider doch

Anders formatiert:

Delphi-Quellcode:

//...
  if Node.Parent = Sender.RootNode then
    if Odd(Node.Index) then
      ItemColor := kon_color1
    else
      {;}
  else
    if Odd(Node.Parent.Index) then
      ItemColor := kon_color1;

[aschne1]

Hi

Was heist hier 'Leider doch'?

Könnte auch mit begin/end arbeiten, doch mit zwei else hintereinander umgehe ich das. Denn so gehört der else-Zweig zu:
if Node.Parent = Sender.RootNode then mit nur einem else zu:
if Odd(Node.Index) then Welche Lösung ist sinnvoller, bzw. schneller?

Gruss