DBGrid - Farbverlauf für aktive Zeile

[coasting]

Moin!

beschäftige mich nach ein paar Jahren Pause wieder mit der Programmierung unter Lazarus/FPC. Ich bin mittlerweile auf MacOS umgestiegen, aber das sollte hierbei eigentlich keine Rolle spielen.

Ich möchte die aktive Zeile / Datensatz in einem DBGrid mit einem Farbverlauf darstellen. dgRowSelect ist gesetzt. Einfarbig sieht meine Lösung wie folgt aus und sie funktioniert auch:

Code: Alles auswählen

procedure TfrmMain.DBGrid1PrepareCanvas(sender: TObject; DataCol: Integer;
  Column: TColumn; AState: TGridDrawState);
var
  row : integer;
  R: TRect;
  Grid: TDBGrid;
begin
  Grid := Sender as TDBGrid;
  with Grid do
  begin
    row := DataSource.DataSet.RecNo;
    // Standard-Zeilenhintergrund
    if Odd(row) then
      Canvas.Brush.Color := RGBToColor(240, 245, 254)
    else
      Canvas.Brush.Color := clWhite;
    // Selektierte Zeile
    if (gdSelected in AState) and Focused then
    begin
      Canvas.Font.Style := [fsBold];
      Canvas.Brush.Color := RGBToColor(85, 148, 212);
      Canvas.Font.Color := clWhite;
    end;
  end;
end;

Ich habe nun versucht einen Farbverlauf für die selektierte Zeile anzeigen zu lassen. Der entsprechende Bereich in OnPrepareCanvas sieht wir folgt aus:

Code: Alles auswählen

...
    if (gdSelected in AState) and Focused then
    begin
      R := CellRect(DataCol, Row - 1);
      // Verlauf 
      FillGradient(Canvas, R, RGB(125, 125, 125), RGB(85, 148, 212), True);
      Canvas.Font.Style := [fsBold];
      Canvas.Font.Color := clWhite;
    end;
...

DIe Funktion FillGradient ist wie folgt geschrieben:

Code: Alles auswählen

procedure TfrmMain.FillGradient(FCanvas: TCanvas; const ARect: TRect;
  StartColor, EndColor: TColor; Vertical: Boolean = True);
var
  i, Steps: Integer;
  R1, G1, B1, R2, G2, B2: Byte;
  R, G, B: Double;
  Ratio: Double;
  LineRect: TRect;
begin
  // Schrittanzahl je nach Richtung bestimmen
  if Vertical then
    Steps := ARect.Bottom - ARect.Top
  else
    Steps := ARect.Right - ARect.Left;
  if Steps <= 0 then Exit;
  // Start- und Endfarben zerlegen
  R1 := GetRValue(ColorToRGB(StartColor));
  G1 := GetGValue(ColorToRGB(StartColor));
  B1 := GetBValue(ColorToRGB(StartColor));
  R2 := GetRValue(ColorToRGB(EndColor));
  G2 := GetGValue(ColorToRGB(EndColor));
  B2 := GetBValue(ColorToRGB(EndColor));
  for i := 0 to Steps - 1 do
  begin
    Ratio := i / Steps;
    R := R1 + (R2 - R1) * Ratio;
    G := G1 + (G2 - G1) * Ratio;
    B := B1 + (B2 - B1) * Ratio;
    Canvas.Pen.Color := RGB(Round(R), Round(G), Round(B));
    Canvas.Brush.Color := Canvas.Pen.Color;
    if Vertical then
      LineRect := Rect(ARect.Left, ARect.Top + i, ARect.Right, ARect.Top + i + 1)
    else
      LineRect := Rect(ARect.Left + i, ARect.Top, ARect.Left + i + 1, ARect.Bottom);
    Canvas.FillRect(LineRect);
  end;
end;

Die Textfarbe wird korrekt in Weiß gezeichnet und der Text wird auch Fett angezeigt, der Hintergrund bleibt aber Weiß. Ich habe es auch mit BGRABitmap versucht, was einfacher umzusetzen wäre, brachte aber genau dasselbe Resultat.

Was mache ich hier falsch?

[wp_xyz]

Ich sage zwar immer, dass man, wenn man Farben im Grid verändern will, das OnPrepareCanvas-Ereignis verwenden soll. Aber das Ereignis macht nur das, nach dem es benannt ist: Es bereitet den Canvas vor, führt aber selbst keine Zeichenoperation aus. Der Zellhintergrund wird weiterhin in TCustomgrid.DrawFillRect per Canvas.FillRect gemalt - und damit ist dein in OnPreparecanvas erzeugter Farbverlauf futsch.

Um zu verstehen, was du tun kannst, setze einen Breakpoint auf das "end;" deines OnPrepareCanvas-Event-Handlers. Und gehe zu "Projekt" > "Projekteinstellungen" > "Hinzufügungen und Beeinflussungen" > "Hinzufügen" > "Benutzerdefinierte Option"; gehe in die Zeile "Custom" von "Gespeichert in der Projektsitzung" und schreibe "-gw3". Das bewirkt die Neukompilieren aller vom Projekt benötigten Units mit Dwarf3-Debuginformation, auch wenn sie zu externen Packages gehören, und du kommst mit dem Debugger in die Grids-Unit hinein.

Wenn du nun das Projekt startest (was wegen der Neukompilierung aller Units etwas dauert) und die IDE bei dem gesetzten Breakpoint angehalten hat, drücke mehrmals F8 (oder "Start" > "Einen Schritt weiter") und du kommst in TCustomDrawGrid.DrawCell. Dort auf der Zeile DefaultDrawCell drücke F7 ("Start" > "Einen Schritt hinein"), um in diese Routine einzutauchen. Ein paarmal F8 führt dich zu dem schon erwähnten DrawFillRect, in dem der Zellhintergrund gemalt wird. Wenn du hier mit F7 eintauchst und CTRL+SHIFT+AUF drückst, kommst du zum Interface-Deklaration der Methode. Man sieht dort, dass die Methode leider nicht virtuell ist - schade, sonst könnte man durch Überschreiben hier einfach den Farbverlauf erzeugen, ohne sonst etwas tun zu müssen.

Drücke wieder CTRL+SHIFT+AUF (oder AB), um wieder in die Implemenation zu gelangen und verfolge mit F8 schrittweise, was sonst noch geschieht. Nach ein paar F9 weiter kommst du zu DrawTextInCell. Wenn du hier wieder F7 drückst, siehst du, dass hier der Text gezeichnet wird. Und wenn du wieder mit CTRL+SHIFT+AUF ins Interface gehst, siehst du, dass diese Methode aber nun virtuell ist. Wenn du diese nun überschreibst und am Anfang einen Farbverlauf zeichnest, sollte es genau passen. OK - vielleicht flackert's ein bisschen, weil vorher ja der FillRect-Hintergrund gezeichnet worden ist. Aber das kannst du verhindern, indem du einen OnPrepareCanvas-Handler schreibst, in dem der Brush.Style für die Farbverlaufzellen auf bsClear gesetzt wird, also der Hintergrund doch nicht gezeichnet wird. Anschließend rufst du per "inherited" einfach die bisherige Methode auf und lässt den Zell-Text ausgeben.

Das Überschreiben von DrawTextInCell geht am einfachsten, indem du in der Unit, in der das StringGrid verwendet wird, eine Klasse TStringGrid redeklarierst, die von Grids.TStringGrid abstammt. Alternativ kannst du dieses modifizierte Grid in eine eigene Unit stecken, die aber als letztes in der Uses-Zeile genannt werden muss, damit der Compiler auf den Trick hereinfällt. Denn er soll das "normale" StringGrid durch das gleichnamige mit der modifizierten DrawTextInCell-Methode ersetzen.

Code: Alles auswählen

type
  TStringGrid = class(Grids.TStringGrid)
  protected
    procedure DrawCellText(aCol,aRow: Integer; aRect: TRect; aState: TGridDrawState; aText: String); override;
  end; 
  
procedure TStringGrid.DrawCellText(aCol,aRow: Integer; aRect: TRect; aState: TGridDrawState; aText: String);
begin
  if [gdSelected, gdFocused] * aState <> [] then
    Canvas.GradientFill(ARect, clWhite, clSkyblue, gdVertical);
  inherited;
end; 

procedure TForm1.StringGrid1PrepareCanvas(Sender: TObject; aCol, aRow: Integer;
  aState: TGridDrawState);
begin
  if [gdSelected, gdFocused] * aState <> [] then
    StringGrid1.Canvas.Brush.Style := bsClear;
end;  

Ein auf deinem Code beruhendes StringGrid-Projekt findest du im Anhang (für ein DBGrid sollte es analog funktionieren).

Übrigens: Für einen Farbverlauf gibt es die TCanvas-Methode GradientFill (https://lazarus-ccr.sourceforge.io/docs ... tfill.html). Und die alternierende Hintergrundfarbe kann man mit der Eigenschaft AlternateColor erzeugen.

[coasting]

Vielen Dank für die schnelle Antwort und die ausführliche Erklärung dazu
Die TCanvas-Methode GradientFill habe ich tatsächlich übersehen :/ Die Eigenschaft AlternateColor des DBGrid kannte ich, aber ich wollte mehr Flexibilität bei den Farben.
Dein Beispiel Projekt funktioniert tadellos. Werde es wahrscheinlich am Wochenende in mein Projekt übernehmen und berichte wenn es fertig ist.

VIelen Dank nochmals!