VirtualTreeView MouseOver Color [Erledigt]

[SvB]

Moin,

ich möchte gerne in einem VirtualTreeView ähnlich dem Hottrack beim Drüberfahren mit der Maus über eine Zelle das die Hintergrund- und Schriftfarbe geändert werden.

Ich habe aktuell folgenden Code:

Code:

procedure TfrmFilterEditor.vstBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect;
  var ContentRect: TRect);

function NodeAtCursorPos: PVirtualNode;
var
  P: TPoint;
  HitInfo: THitInfo;
begin
  P := vst.ScreenToClient(Mouse.CursorPos);
  vst.GetHitTestInfoAt(p.X, p.Y, True, HitInfo);
  if (hiOnItem in HitInfo.HitPositions) and (HitInfo.HitColumn = 3) then begin
    Result := HitInfo.HitNode;
  end;
end;

begin
  if Node = NodeAtCursorPos then begin
    if (Column = 3) then begin
      TargetCanvas.Brush.Color := $00555351;
      TargetCanvas.FillRect(CellRect);
      //TargetCanvas.Font.Color := clWhite;
      //TargetCanvas.TextOut(ContentRect.Left, ContentRect.Top, 'Entfernen')
    end else begin
      //TargetCanvas.Brush.Color := clWindow;
      //TargetCanvas.FillRect(CellRect);
      vst.InvalidateNode(Node);
    end;
  end else begin
    //TargetCanvas.Brush.Color := clWindow;
    //TargetCanvas.FillRect(CellRect);
    vst.InvalidateNode(Node);
  end;
end;

Das funktioniert teilweise mit folgenden Problemem:
a) der Text wird nicht an der selben Stelle wie der Originaltext geschrieben (deshalb auskommentiert)
b) die CPU-Nutzung steigt von ein paar % auf über 60% an, sobald ich das Formular öffne (durch Invalidate)
c) wenn ich das Invalidate durch die auskommentierten Stellen ersetze, dann bleibt die Farbe einer geänderten Zelle erhalten wenn ich mich aus dem Bereich aller Zellen bewege

Gibt es hierfür eventuell eine bessere Lösung?
Vielen Dank für alle hilfreichen Infos.

[jaenicke]

Die TVirtualStringTree kann schon selbst HotTrack. Leider gibt es nach außen keine Information zur Spalte, so dass man diese selbst ermitteln müsste.

Am einfachsten ist aber das interne Feld dafür schlicht zu veröffentlichen (VirtualTrees.pas):

Delphi-Quellcode:

  TBaseVirtualTree = class(TCustomControl)
[..]
  public
[..]
    property HotNode: PVirtualNode read FCurrentHotNode write SetHotNode;
    property HotColumn: TColumnIndex read FCurrentHotColumn; // NEU
[..]

In der aktuellen Version ist das die Zeile 3219.

Und dann kannst du einfach OnBeforeCellPaint verwenden (toHotTrack muss natürlich in den TreeOptions unter PaintOptions aktiviert sein!):

Delphi-Quellcode:

procedure TForm118.VirtualStringTree1BeforeCellPaint(Sender: TBaseVirtualTree;
  TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
  CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
begin
  if (Node = VirtualStringTree1.HotNode) and (Column = VirtualStringTree1.HotColumn) then
    TargetCanvas.Brush.Color := clLime
  else
    TargetCanvas.Brush.Color := clWhite;
  TargetCanvas.FillRect(ContentRect);
end;

Ich werde einmal einen Pull Request für diese Änderung senden.
// EDIT:
Erledigt, pull request ist drin.

[SvB]

Vielen dank, sieht gut aus.

mit folgendem Code wird der Text auch nicht unterstrichen und die Textfarbe geändert wenn ich mit der Maus drüber fahre (so wie ich es haben möchte - und nur für Spalte 3)

Code:

procedure TfrmFilterEditor.vstPaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType);
begin
  TargetCanvas.Font.Style := TargetCanvas.Font.Style - [fsUnderline];
  if (Node = vst.HotNode) and (Column = vst.HotColumn) and (Column = 3) then
      TargetCanvas.Font.Color := clWhite;
end;

[jaenicke]

Der Pull Request wurde übernommen. Das funktioniert nun also auch mit der offiziellen Version ohne eigene Anpassung.