StringGrid erste Zeile fixiert aber JEDE Row-0-Zelle mit anderer Farbe

[StefanL38]

Hallo,

also ich habe jetzt so einiges probiert um in einem StringGrid bei dem die erste Zeile (FixedRows = 1) fixiert ist
die Zellen eben dieser ersten, fixierten Reihe mit verschiedenen Farben zu versehen.

Die üblichen Vorschläge dazu sind, dass man in den Eventhandler DrawCell Bedingungen einbaut und
- von hinten durch die Brust ins Auge - das man mit einem farbigen Rechteck und evtl. den Textinhalt der Zelle
sozusagen übermalt.

Das habe ich aber für die fixierte Zelle nicht hinbekommen.
fixierte Zellen scheinen vom

Delphi-Quellcode:

    with TStringGrid(Sender).Canvas do

ausgenommen zu sein.

Wenn ich in der DrawCwell-procedure FixedRow zwischen 0 um darauf malen zu können
und nach dem malen auf 1 hin- und herschalte löst das immer neue DrawCell-Ereignisse aus.

Die andere Idee ist die erste Zeile fixiert zu lassen und mir die Koordinaten zu berechnen.
Da aber der Stringgrid mehr Spalten hat als im Ausschnitt gleichzeitig darstellbar müsste ich beim Scrollen
eine Menge Positionsmanagement machen damit die farbigen Rects immer an der richtigen Stelle gemalt werden.

Die ganze Spalte einfärben möchte ich lieber nicht weil ich dann auch noch die Schriftfarbe abhängig von der Hintergrundfarbe auf eine kontrastreiche Farbe ändern müsste.

Am einfachsten wäre natürlich eine Grid-Komponente die color als property für jede einzelne Zelle hat.
Einmal Farbe setzen und gut is.
Gibt es so eine Komponente?

Wenn jemand noch eine andere Idee postet wie man das realisieren kann wäre ich sehr dankbar.

viele Grüße Stefan

[StefanL38]

So jetzt habe ich doch eine Lösung gefunden:

Ich habe einen Array

Delphi-Quellcode:

  Spaltenfarbe : Array[0..100] of TColor;

definiert. Der Einfachheit halber 100 Elemente = mehr als ich maximal brauche.

Die Farbwerte im Array werden mit clWhite initialisiert

Delphi-Quellcode:

  for i := 0 to 100 do
  begin
    Spaltenfarbe[i] := clWhite;
  end;

Der Eventhandler SelectCell speichert mir die Spalte / Reihe der angeklickten Zelle

Delphi-Quellcode:

procedure TForm1.StringGridVorschauSelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);

  begin
  SelectedCellCol := ACol;
  SelectedCellRow := ARow;

  //ShowMessage('Col=' + IntToStr(SelectedCellCol) + ' Row=' + IntToStr(SelectedCellRow) );
end;

Doppelklick ruft den Farbauswahldialog auf

Delphi-Quellcode:

procedure TForm1.StringGridVorschauDblClick(Sender: TObject);
begin
  ColorCellCol    := SelectedCellCol;
  ColorCellRow    := SelectedCellRow;
  ColorDialog1.Execute;
  Spaltenfarbe[ColorCellCol] := ColorDialog1.Color;
end;

Und weist dem Array-Element die Farbe aus dem Colordialog zu.


Dem Farbauswahldialog habe ich gleich noch einen hinweisgebenden Titel verpasst

Delphi-Quellcode:

procedure TForm1.ColorDialog1Show(Sender: TObject);
begin
  SetWindowText(ColorDialog1.Handle, 'Farbe für Spalte '
  + StringGridVorschau.Cells[SelectedCellCol, 0] + ' setzen' );
end;

Im DrawCell-Eventhandler werden dann die farbigen Rects und mit weiß/schwarz als Kontrastfarbe
der Text geschrieben.
Aber nur dann wenn auch eine Farbe <> weiß gesetzt wurde.

Delphi-Quellcode:

procedure TForm1.StringGridVorschauDrawCell(Sender: TObject; ACol,
  ARow: Integer; Rect: TRect; State: TGridDrawState);

begin
  with sender as Tstringgrid do
    if ( (ARow = 0) and (Spaltenfarbe[ACol] <> clWhite) ) then
    begin
      Canvas.brush.Color := Spaltenfarbe[ACol];
      Canvas.Font.Color := BlackWhiteContrastColor(Spaltenfarbe[ACol]);
      canvas.fillRect(Rect);
      canvas.TextOut(Rect.Left,Rect.Top,Cells[ACol,ARow]);
    end;
end;

Die Schriftfarbe schwarz/weiß wird von dieser function ermittelt

Delphi-Quellcode:

function BlackWhiteContrastColor(value: TColor):TColor;
var
  intensity : Integer;
begin
  value := ColorToRGB(value);

  intensity := GetBValue(value) * 21 // Blue
    + GetGValue(value) * 174 // Green
    + GetRValue(value) * 61; // Red

   // intensity = 0 -> dark
   // intensity = 255*256 -> bright

  if intensity >= (128*256) then
    Result := clBlack
  else
    Result := clWhite;
end;

viele Grüße Stefan