Színes sztringrács

Gyakran előfordulhat, hogy igen méretes, akár 50 x 40-es StringGrid-el kell dolgoznunk egy Delphi programban. Ha editáljuk, vagy egyszerűen csak keresünk benne, gond lehet az, hogy vajon melyik sorban és oszlopban van a kiválasztott cella. Erre mutat megoldást a képen látható program listája. De nemcsak rögzített cellákat, hanem a belső cellák tartalmát is lehet különböző színekkel megjeleníteni, ami függhet a cella koordinátáitól, vagy a tartalmától is. Példámban a reáltárgyakat színesen, a többit feketével jelenítettem meg. A kiválasztott cella Kedd 7. óra és zöld színű. Még egy érdekessége van a programnak: futtása ESC billentyűre befejeződik.

A program futási képe:

A program listája:

unit USzin;

interface

uses
  Windows, Messages, SysUtils, Classes, 

Graphics, Controls, Forms, Dialogs, Grids, StdCtrls;

type
TfmSzin = class(TForm)
sgRacs: TStringGrid;
lbOrarend: TLabel;
procedure sgRacsDrawCell(Sender: TObject; Col, Row: Integer;
Rect: TRect; State: TGridDrawState);
procedure FormCreate(Sender: TObject);
procedure sgRacsClick(Sender: TObject);
procedure sgRacsKeyPress(Sender: TObject; var Key: Char);
private
{ Private declarations }
public
{ Public declarations }
end;

var
fmSzin: TfmSzin;
ACol, ARow: Integer;

implementation

{$R *.DFM}

procedure TfmSzin.sgRacsDrawCell(Sender: TObject; Col, Row: Integer;
Rect: TRect; State: TGridDrawState);
begin
With sgRacs.Canvas.Brush Do
Begin
{rögzített cellák}
If (gdFixed In State) And ((Col=ACol) Or (Row=ARow)) Then
Color:= clRed Else Color:=clBtnFace;

{kiválasztott cella}
If gdSelected In State Then Color:= clGreen;

{a táblázat belseje}
If Not((gdSelected In State) Or (gdFixed In State)) Then
Case Odd(Col) XOr Odd(Row) Of
True: Color:= clWindow;
False: Color:= clSilver;
End;
End;
With sgRacs.Canvas.Font Do
Begin
If sgRacs.Cells[Col,Row]='Matematika' Then Color:= clRed;
If sgRacs.Cells[Col,Row]='Fizika' Then Color:= clPurple;
If sgRacs.Cells[Col,Row]='Kémia' Then Color:= clFuchsia;
If sgRacs.Cells[Col,Row]='Biológia' Then Color:= clOlive;
If sgRacs.Cells[Col,Row]='Földrajz' Then Color:= clGreen;
End;
{szöveg beállítása rácson belül: +6 +4}
{kövér betüket akkor tud, ha DefaultDrawing=True}
sgRacs.Canvas.TextRect(Rect,Rect.Left+6,Rect.Top+4,sgRacs.Cells[Col,Row]);
If gdFocused In State Then sgRacs.Canvas.DrawFocusRect(Rect);
end;

procedure TfmSzin.FormCreate(Sender: TObject);
Var I: Word;
begin
With sgRacs Do
Begin
ColWidths[0]:= 24;
For I:= 1 To 7 Do Cells[0,I]:= IntToStr(I)+'.';
Cells[1,0]:= 'Hétfő';
Cells[2,0]:= 'Kedd';
Cells[3,0]:= 'Szerda';
Cells[4,0]:= 'Csütörtök';
Cells[5,0]:= 'Péntek';

Cells[1,1]:= 'Biológia';
Cells[1,2]:= 'Matematika';
Cells[1,3]:= 'Osztályfőnöki';
Cells[1,4]:= 'Magyar';
Cells[1,5]:= 'Angol/Német';
Cells[1,6]:= 'Testnevelés';

Cells[2,1]:= 'Fizika';
Cells[2,2]:= 'Ének';
Cells[2,3]:= 'Magyar';
Cells[2,4]:= 'Történelem';
Cells[2,5]:= 'Földrajz';
Cells[2,6]:= 'Informatika';

Cells[3,1]:= 'Angol/Német';
Cells[3,2]:= 'Rajz';
Cells[3,3]:= 'Kémia';
Cells[3,4]:= 'Matematika';
Cells[3,5]:= 'Testnevelés';
Cells[3,6]:= 'Magyar';

Cells[4,1]:= 'Magyar';
Cells[4,2]:= 'Földrajz';
Cells[4,3]:= 'Angol/Német';
Cells[4,4]:= 'Biológia';
Cells[4,5]:= 'Fizika';
Cells[4,6]:= 'Történelem';

Cells[5,1]:= 'Matematika';
Cells[5,2]:= 'Történelem';
Cells[5,3]:= 'Angol/Német';
Cells[5,4]:= 'Kémia';
Cells[5,5]:= 'Magyar';
Cells[5,6]:= 'Informatika';
    Col:= 2;
Row:= 7;
ACol:= Col;
ARow:= Row;
End;
end;

procedure TfmSzin.sgRacsClick(Sender: TObject);
begin
With sgRacs Do
Begin
ACol:= Col;
ARow:= Row;
RePaint;
End;
end;

procedure TfmSzin.sgRacsKeyPress(Sender: TObject; var Key: Char);
begin
If Key=#27 Then Application.Terminate;
end;

end.