Wizualny defekt z kolorowaniem StringGrid

Rejestracja:około 11 lat
Ostatnio:około 11 lat
Postów:9

0

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:

Kopiuj

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:

user image

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

Image1.png (6 KB) - ściągnięć: 191

Delphi

_13th_Dragon

2014-02-18 10:00

_13th_Dragon2014-02-18 10:00

Rejestracja:ponad 19 lat
Ostatnio:3 miesiące

1

Kopiuj

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.

flowCRANE 2014-02-18 10:04

Byłeś szybszy ;)

flowCRANE

2014-02-18 10:03

flowCRANE2014-02-18 10:03

Moderator Delphi/Pascal

Rejestracja:ponad 13 lat
Ostatnio:około 6 godzin
Lokalizacja:Tuchów
Postów:12171

0

Kopiuj

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;

Kopiuj

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:

Kopiuj

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.

edytowany 3x, ostatnio: flowCRANE 2014-02-18 10:24

_13th_Dragon 2014-02-18 10:19

if ((ARow-1) mod 4) < 2 then

flowCRANE 2014-02-18 10:25

A no racja - nie zauważyłem, że są komórki nagłowkowe;

Luc

2014-02-18 10:22

Luc2014-02-18 10:22

Rejestracja:ponad 19 lat
Ostatnio:około 11 lat

0

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

Zobacz pozostałe 11 komentarzy

Luc 2014-02-18 14:18

To teraz porównaj sobie twoje rozwiązanie z moim. Moje ogranicza się do użycia innych funkcji (od biedy można było rzeczywiście użyć TextOut, ale, dla mnie, o wiele bardziej intuicyjne jest użycie metod uszczegółowionych) i zero dodatkowych linii kodu. A twoje?

flowCRANE 2014-02-18 14:20

Jedno przypisanie więcej (Pen), jeden parametr mniej (jeden problem z głowy), całkowite pozbycie się macierzy wartości logicznych (drugi problem z głowy), jednakowe rysowanie tekstu we wszystkich wierszach (kolejny problem wyrównania tekstu z głowy); Źle?

Luc 2014-02-18 14:24

Zero przypisań więcej, zero linii więcej, zero ingerencji w oryginalny algorytm problemu, podany sposób rozwiązuje problem w całości prostymi środkami i jednocześnie wskazuje źródło błędu. Gorzej? Nic nie wnosi do tematu?

flowCRANE 2014-02-18 14:27

FillRect poniekąd, bo przysporzył kolejnego problemu, TextRect nic;

Luc 2014-02-18 14:32

I znowu się mylisz, bo FillRect rozwiązał problem pojawiającej się ramki i nie miał nic wspólnego z rozsypywaniem się tekstu.

vpiotr

2014-02-18 10:59

~~vpiotr~~2014-02-18 10:59

Rejestracja:ponad 13 lat
Ostatnio:prawie 3 lata

0

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

elTwardy

2014-02-18 11:02

elTwardy2014-02-18 11:02

Rejestracja:około 11 lat
Ostatnio:około 11 lat
Postów:9

0

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.

edytowany 1x, ostatnio: elTwardy 2014-02-18 11:12

_13th_Dragon 2014-02-18 11:05

Przecież powiedziałem - 3 piksele. Albo użyj przed tym InflateRect(Arect,-1,-1);

abrakadaber

2014-02-18 11:06

~~abrakadaber~~2014-02-18 11:06

Rejestracja:ponad 12 lat
Ostatnio:8 miesięcy
Postów:6610

1

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

_13th_Dragon 2014-02-18 11:09

Wtedy źle będzie wyglądać tekst.

~~abrakadaber~~ 2014-02-18 11:11

a niby dlaczego?

_13th_Dragon

2014-02-18 11:19

_13th_Dragon2014-02-18 11:19

Rejestracja:ponad 19 lat
Ostatnio:3 miesiące

0

abrakadaber napisał(a):

a niby dlaczego?

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

eadf2145e2.png (1 KB) - ściągnięć: 153

_13th_Dragon 2014-02-18 11:21

Oczywiście przy jasnym tle nie będzie to aż tak wyraźnie widoczne, ale niektórzy ludzi mają dobry wzrok.

misiakufal

2014-02-18 11:31

misiakufal2014-02-18 11:31

Rejestracja:ponad 15 lat
Ostatnio:prawie 9 lat

0

zamiast

Kopiuj

Rectangle(ARect);

daj

Kopiuj

FillRect(ARect);

wtedy nie będzie dodatkowych pogrubionych linii.

edytowany 1x, ostatnio: misiakufal 2014-02-18 11:32

abrakadaber

2014-02-18 11:32

~~abrakadaber~~2014-02-18 11:32

Rejestracja:ponad 12 lat
Ostatnio:8 miesięcy
Postów:6610

0

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

Kopiuj

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.

user image

A tu masz Microsoft Sans Serif rozmiar 20

user image

Kopiuj

    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');

user image

edytowany 3x, ostatnio: ~~abrakadaber~~ 2014-02-18 11:40

Zobacz pozostałe 5 komentarzy

flowCRANE 2014-02-18 14:15

Dokładnie; Choć nie wiem po co ustawiać BrushStyle, skoro przy zwykłym Brush.Color i TextOut poprawnie rysuje - z tłem i wygładzaniem; Chyba, że na nowszych systemach jest problem to rozumiem;

_13th_Dragon 2014-02-18 14:23

Nie zawsze tło jest jednolite. W tym przypadku napis najeżdżał na ramkę rysowaną przez Rectangle i częściowo ją zamazywał, na co @abrakadaber zaproponował Brush.Style:=bsClear; (ja też myślałem że autor postu chce tej dodatkowej ramki). Ja myślałem że w tym przypadku nie działa wygładzanie (nigdy), ale okazuje się że nie działa tylko pod niektórymi windowsami.

flowCRANE 2014-02-18 14:26

Wiem, wiem - tutaj jednak jest plus, bo jest jednolite; Jakoś to wygładzanie działa - trzeba by sprawdzić różne warianty;

_13th_Dragon 2014-02-18 14:28

Dopóki była ramka - nie było jednolite.

flowCRANE 2014-02-18 14:48

Było - ta ramka była niechciana, pytacz wspomniał o tym; No i z jego kodu to wynikało ;)

elTwardy

2014-02-18 11:55

elTwardy2014-02-18 11:55

Rejestracja:około 11 lat
Ostatnio:około 11 lat
Postów:9

0

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:

Kopiuj

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ł ?!?!

edytowany 1x, ostatnio: elTwardy 2014-02-18 12:03

Luc 2014-02-18 12:06

@elTwardy, to ja jeszcze podpowiem (o czym zapomniałem wcześniej), że jeśli zamierzasz zmieniać rozmiar okna, albo przewijać tabelkę w poziomie, lepiej zamiast stałych marginesów X i Y dać aRect.Left + coś i aRect.Top + coś tam. Unikniesz problemu, który właśnie się pojawił.

Luc

2014-02-18 12:13

Luc2014-02-18 12:13

Rejestracja:ponad 19 lat
Ostatnio:około 11 lat

0

Kopiuj

 
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

test.png (16 KB) - ściągnięć: 116

edytowany 1x, ostatnio: Luc 2014-02-18 14:14

flowCRANE

2014-02-18 14:08

flowCRANE2014-02-18 14:08

Moderator Delphi/Pascal

Rejestracja:ponad 13 lat
Ostatnio:około 6 godzin
Lokalizacja:Tuchów
Postów:12171

0

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)

Kopiuj

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

Furious Programming napisał(a)

Kopiuj

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.

Kopiuj

  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ł.

elTwardy

2014-02-18 14:29

elTwardy2014-02-18 14:29

Rejestracja:około 11 lat
Ostatnio:około 11 lat
Postów:9

0

Luc napisał(a):

Kopiuj

 
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.

flowCRANE 2014-02-18 14:51

Zaznacz więc post @Luc jako rozwiązanie i rozdaj plusiki pomocnym postom - pamiętaj o tym na przyszłość, że w ten sposób kończy się tutaj dyskusję;

Wizualny defekt z kolorowaniem StringGrid

elTwardy

_13th_Dragon

flowCRANE

Luc

vpiotr

elTwardy

abrakadaber

_13th_Dragon

abrakadaber napisał(a):

misiakufal

abrakadaber

elTwardy

Luc

flowCRANE

elTwardy napisał(a)

_13th_Dragon napisał(a)

Furious Programming napisał(a)

elTwardy napisał(a)

elTwardy

Luc napisał(a):

Data Scientist

Programista Systemów Automatyki - PCS7

DevOps Engineer - migracja serwerów (Kubernetes,Docker,RoR)

Java Developer

Praca dla programistów

Forum dyskusyjne

Sprawy administracyjne

O nas

Skontaktuj się z nami