Wizualny defekt z kolorowaniem StringGrid

Witam

Poczytałem trochę na temat kolorowania pół string grid i wybrałem moim zdaniem najprostszy sposób do mojego celu, ale pojawił się problem.
Wpisałem sobie taki kod:

procedure TForm1.StringGrid1DrawCell(Sender: TObject; aCol, aRow: Integer;
  aRect: TRect; aState: TGridDrawState);
const nr : array [0..22] of Boolean = (false, false, false, true, true, false, false, true, true, false, false, true, true, false, false, true, true, false, false, true, true, false, false);
begin
  if nr[ARow] then begin
    StringGrid1.Canvas.Brush.Color:= $00FDECD7;
    StringGrid1.Canvas.Rectangle(aRect);
    StringGrid1.Canvas.TextOut(aRect.Left,aRect.Top,StringGrid1.Cells[ACol,ARow] );
  end;
end;

Kod ten koloruje całe wiersze w STringGrid ustawionym kolorem w Canvas.Brush.Color.
Posłużyłem się tablicą stałych bo koloruje sobie wybrane wiersze w efekcie mam 2 wiersze białe kolejne 2 pokolorowane i tak na zmianę.
Ale jest jeden wizualny problem. Jeśli koloruję w ten sposób to przesuwa mi się tekst w tych wierszach które pokolorowałem i dodatkowo pojawiają się wygryzione linie efekt nakładania się pola z tekstem na linie dzielącą komórki ale tu ta linia robi się grubsza.
Dołączam screena:

Jak to coś naprawić, żeby tekst nie przesuwał się tak jak w tych wierszach, które nie kolorowałem???

StringGrid1.Canvas.TextOut(aRect.Left+3,aRect.Top+3,StringGrid1.Cells[ACol,ARow] );

Poza tym, jak narysujesz wszystkie to wszystkie będą wyglądać podobnie.

StringGrid1.Canvas.TextOut(aRect.Left,aRect.Top,StringGrid1.Cells[ACol,ARow] );

W tej metodzie musisz dodać offsety od lewej i górnej krawędzi, bo inaczej tekst będzie dosunięty;

StringGrid1.Canvas.TextOut(ARect.Left + 2, ARect.Top + 2, StringGrid1.Cells[ACol, ARow]);

Ta linijka spowoduje narysowanie tekstu z dwupikselowym marginesem (od lewej i od góry); Jeśli chcesz większe marginesy to zwiększ offsety;

Dobra rada - jak już zabierasz się za własne malowanie komponentu, to maluj każdy wiersz; Dzięki temu będziesz miał jednakowo malowane i te białe, i te niebieskie; Wszystko możesz załatwić za pomocą jednego zestawu metod rysujących - reszta to tylko ustawienie koloru tła;

Poza tym wykorzystana macierz jest zbędna, dlatego że nie wiesz ile pozycji będzie w komponencie; Możesz to przecież obliczyć, np. tak:

with TStringGrid(Sender).Canvas do
begin
  Font.Color := clBlack;

  if (ARow - 1) mod 4 < 2 then
  begin
    Pen.Color := clWhite;
    Brush.Color := clWhite;
  end
  else
  begin
    Pen.Color := $00FDECD7;
    Brush.Color := $00FDECD7;
  end;

  Rectangle(ARect);
  TextOut(ARect.Left + 2, ARect.Top + 2, TStringGrid(Sender).Cells[ACol, ARow]);
end;

Dzięki temu tekst w każdym wierszu będzie miał taki sam odstęp od krawędzi komórki, no i wykluczysz konieczność stosowania macierzy wartości logicznych.

Zamiast Canvas.Rectangle i Canvas.TextOut spróbuj Canvas.FillRect i Canvas.TextRect. W tym ostatnim X i Y daj na 0.

Jak Ci to zacznie działać w zadowalający sposób to podaj rozwiązanie, ciekaw jestem efektu.

Dodanie po 2 piksele nie do końca pomaga , na to już wcześniej wpadłem w tych wierszach kolorowanych są pogrubione szare linie i tekst nadal jest bliżej lewej krawędzi, a dodawanie większej ilości jeszcze pogarsza efekt.

Malowanie całości też nie bardzo się sprawdzi bo tekst poprzesuwa się we wszystkich komórkach.

Spróbuje użyć tej innej funkcji zamiast texxtout.

A korzystam z macierzy bo zamierzałem kolorować niesymetrycznie więc nie da się tego zapisać w postaci IF, a tak sobie ustawie najprościej jak się da w macierzy true lub false.

przed StringGrid1.Canvas.TextOut dodaj StringGrid1.Canvas.Brush.Style := bsClear

abrakadaber napisał(a):

a niby dlaczego?

Zgadnij z dwóch raz które zrobione z bsClear.

zamiast

Rectangle(ARect);

daj

FillRect(ARect);

wtedy nie będzie dodatkowych pogrubionych linii.

no popatrz a mi całkiem coś innego wyszło...
kod:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    img1: TImage;
    btn1: TButton;
    procedure btn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btn1Click(Sender: TObject);
begin
  with img1.Canvas do
  begin
    Brush.Style := bsSolid;
    Brush.Color := clRed;
    FillRect(img1.ClientRect);
    Font.Color := clBlack;TextOut(2, 10, 'Test');
    Brush.Style := bsClear;
    Font.Color := clBlack;TextOut(2, 30, 'Test');
  end;
end;

end.

A tu masz Microsoft Sans Serif rozmiar 20

    Font.Size := 20;
    Font.Name := 'Times New Roman';
    Font.Color := clBlack;TextOut(2, 10, 'Test');
    Brush.Style := bsClear;
    Font.Color := clBlack;TextOut(2, 35, 'Test');

OK problem rozwiązany i wyszło w miarę idealnie, musiałem tylko dodać 3 do X bo tekst w kolorowanym wierszu przesunął się do lewej krawędzi:

procedure TForm1.StringGrid1DrawCell(Sender: TObject; aCol, aRow: Integer;
  aRect: TRect; aState: TGridDrawState);
const nr : array [0..22] of Boolean = (false, false, false, true, true, false, false, true, true, false, false, true, true, false, false, true, true, false, false, true, true, false, false);
begin
  if nr[ARow] then begin
    StringGrid1.Canvas.Brush.Color:= $00FDECD7;
    StringGrid1.Canvas.FillRect(aRect);
    StringGrid1.Canvas.TextRect(aRect,3,0,StringGrid1.Cells[ACol,ARow]);
  end;
end; 

Nie jednak jeszcze nie jest idealnie. Pojawił się nowy problem znika mi tekst w kolejnych kolumnach ale w pierwszej kolumnie jest ok :D
Ki diabeł ?!?!

 
procedure TForm1.StringGrid1DrawCell(Sender: TObject; aCol, aRow: Integer;
  aRect: TRect; aState: TGridDrawState);

const nr : array [0..22] of Boolean = (false, false, false, true, true, false, false, true, true, false, false, true, true, false, false, true, true, false, false, true, true, false, false);

begin
   if nr[ARow] then begin
    StringGrid1.Canvas.Brush.Color:= $00FDECD7;
    StringGrid1.Canvas.FillRect(aRect);
    StringGrid1.Canvas.TextRect(aRect, aRect.Left+3, aRect.Top+3, StringGrid1.Cells[aCol, aRow]);
  end;
end;       

Powinno śmigać. Efekt w załączniku

1.

elTwardy napisał(a)

Ale jest jeden wizualny problem. Jeśli koloruję w ten sposób to przesuwa mi się tekst w tych wierszach które pokolorowałem

_13th_Dragon napisał(a)

StringGrid1.Canvas.TextOut(aRect.Left+3,aRect.Top+3,StringGrid1.Cells[ACol,ARow] );

Furious Programming napisał(a)

StringGrid1.Canvas.TextOut(ARect.Left + 2, ARect.Top + 2, StringGrid1.Cells[ACol, ARow]);

2.

elTwardy napisał(a)

i dodatkowo pojawiają się wygryzione linie efekt nakładania się pola z tekstem na linie dzielącą komórki ale tu ta linia robi się grubsza.

  if (ARow - 1) mod 4 < 2 then
  begin
    Pen.Color := clWhite; // <-
    {...}
    Pen.Color := $00FDECD7; // <-

Rozwiązania problemu @elTwardy są zawarte w pierwszych dwóch postach odpowiedzi; Trzeba tylko je przetestować zamiast kombinować, bo pytacz miał dobry kod, tyle że podawał nie do końca poprawne parametry aby rysowanie przebiegało prawidłowo, tak jak sobie tego życzył.

Luc napisał(a):

 
procedure TForm1.StringGrid1DrawCell(Sender: TObject; aCol, aRow: Integer;
  aRect: TRect; aState: TGridDrawState);

const nr : array [0..22] of Boolean = (false, false, false, true, true, false, false, true, true, false, false, true, true, false, false, true, true, false, false, true, true, false, false);

begin
   if nr[ARow] then begin
    StringGrid1.Canvas.Brush.Color:= $00FDECD7;
    StringGrid1.Canvas.FillRect(aRect);
    StringGrid1.Canvas.TextRect(aRect, aRect.Left+3, aRect.Top+3, StringGrid1.Cells[aCol, aRow]);
  end;
end;       

Powinno śmigać. Efekt w załączniku

OK, ta wersja wygląda już prawidłowo.
Dzięki za pomoc.