private
{ Private declarations }
PROCEDURE SetCellTextColor(X, Y: Integer; Color: TColor);
public
{ Public declarations }
end;
var
Form1: TForm1;
Colors: array of array of TColor;
implementation
{$R *.dfm}
//------------------------------------------------------------------------------
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
With(Sender as TStringGrid) do
begin
Canvas.Font.Color := Colors[ACol, ARow];
Canvas.TextRect(Rect,Rect.Left + 2, Rect.Top + 2, Cells[ACol, ARow]);
Canvas.FrameRect(Rect);
end;
end;
//------------------------------------------------------------------------------
PROCEDURE TForm1.SetCellTextColor(X, Y: Integer; Color: TColor);
begin
Colors[X, Y] := Color;
StringGrid1.Repaint;
end;
//------------------------------------------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
var
I, J: Integer;
begin
SetLength(Colors,StringGrid1.ColCount);
for I := Low(Colors) to High(Colors) do
begin
SetLength(Colors[I], StringGrid1.RowCount);
for J := Low(Colors[I]) to High(Colors[I]) do
Colors[I, J] := clBlack;
end;
end;
//------------------------------------------------------------------------------
procedure TForm1.FormShow(Sender: TObject);
begin
StringGrid1.Cells[1,1]:= 'A Madsen';
StringGrid1.Cells[1,2]:= 'B Madsen';
StringGrid1.Cells[1,3]:= 'C Madsen';
StringGrid1.Cells[1,4]:= 'D Madsen';
StringGrid1.Cells[3,2]:= 'X';
StringGrid1.Cells[3,4]:= 'X';
end;
//------------------------------------------------------------------------------
procedure TForm1.Button1Click(Sender: TObject);
begin // Er kun til prøve.
SetCellTextColor(1,1, clGray);
SetCellTextColor(1,2, clRed);
SetCellTextColor(1,3, clBlack);
SetCellTextColor(1,4, clGreen);
end;
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
ARow: Integer; var CanSelect: Boolean);
begin
SetCellTextColor(ACol,ARow, clRed); // Fjernes nå de to næste linier
virker.
//If Button = MBRight Then SetCellTextColor(ACol,ARow, clBlack);
//If Button = MBLeft Then SetCellTextColor(ACol,ARow, clRed);
end;
//------------------------------------------------------------------------------
//------ Virker, men kun ved klik på Formen ------
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
If Button = MBRight Then Showmessage ('Det var højre knap');
If Button = MBLeft Then Showmessage ('Det var venstre knap');
end;
//------------------------------------------------------------------------------
end.
|