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, MessagesSysUtilsClasses

  GraphicsControlsFormsDialogs, GridsStdCtrls;

type
  TfmSzin = class(TForm)
    sgRacsTStringGrid;
    lbOrarendTLabel;
    procedure sgRacsDrawCell(SenderTObject; Col, Row: Integer;
      RectTRectStateTGridDrawState);
    procedure FormCreate(SenderTObject);
    procedure sgRacsClick(SenderTObject);
    procedure sgRacsKeyPress(SenderTObjectvar KeyChar);
  private
    Private declarations }
  public
    Public declarations }
  end;

var
  fmSzinTfmSzin;
  AColARow: Integer;

implementation

{$R *.DFM}

procedure TfmSzin.sgRacsDrawCell(SenderTObject; Col, Row: Integer;
  RectTRectStateTGridDrawState);
begin
  With sgRacs.Canvas.Brush Do
  Begin
    {rögzített cellák}
    If (gdFixed In StateAnd ((Col=AColOr (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 StateOr (gdFixed In State)) Then
    Case Odd(Col) XOr Odd(RowOf
      TrueColor:= clWindow;
      FalseColor:= 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(SenderTObject);

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(SenderTObject);
begin
  With sgRacs Do
  Begin
    ACol:= Col;
    ARow:= Row;
    RePaint;
  End;
end;

procedure TfmSzin.sgRacsKeyPress(SenderTObjectvar KeyChar);
begin
  If Key=#27 Then Application.Terminate;
end;

end.