Как раскрасить ячейки StringGrid'а в разные цвета в соответствии с условием?

[monushka]

По этому поводу нашла только одну тему на форуме, но там вообще что-то нереальное написано ... Поэтому прошу объяснить мне более доступным методом (если можно, конечно). Мне необходимо сделать так, чтобы ячейка с оценкой 3 была, допустим, желтого цвета, а ячейка с оценками 1 или 2 была красного цвета. Помогите пожалуйста!
Заранее спасибо!

[mihali4]

Хорошо, попробую.
Раскраску производим по событию OnDrawCell, т.е.
StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
Для каждой ячейки StringGrid1.Cells[ACol,ARow] сначала проверяем условие и в зависимости от его выполнения устанавливаем параметры вывода.
Например:

with StringGrid1.Canvas do //работаем с канвой, холстом
if StringGrid1.Cells[ACol,ARow]='3' then
begin
Font.Color:=clRed; //устанавливаем красный цвет шрифта
Brush.Color:=clYellow; //устанавливаем желтый цвет фона (красное с 
желтым неплохо сочетаются для привлечения внимания)
FillRect(Rect); //заливаем фон
end else
if ((StringGrid1.Cells[ACol,ARow]='1') or (StringGrid1.Cells[ACol,ARow]='2')) then
begin
//по аналогии устанавливаем наоборот, желтый шрифт и красный фон
end;
Font.Size:=9; //при желании меняем размер шрифта
Font.Style:=Font.Style+[fsItalic]; // или наклон
Font.Style:=Font.Style+[fsBold];// или толщину
al:=taCenter; //при желании устанавливаем ориентацию текста. Это - 
как обычно - по центру, влево, вправо. Свойство Alignment.
//Ну, и собственно вывод раскрашенного текста
WriteText(StringGrid1.Canvas, Rect, 2, 2, StringGrid1.Cells[Col,Row], al);

WriteText - отдельная вспомогательная процедура, она приведена в
http://www.programmersforum.ru/showthread.php?t=8170
Ее устройством можете не заморачиваться. Ее просто нужно добавить в ваш проект.
Итак, вопрос - что тут "нереального"?

[monushka]

Я попробовала раскрасить ячейки, как было описано выше, но возникли трудности с WriteText, поэтому сделала следующим образом:

procedure TForm1.SG1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
with SG1.Canvas do
if SG1.Cells[ACol,ARow]='__________3__________' then
begin
Font.Color:=clRed;
Brush.Color:=clYellow;

FillRect(Rect);
end;
with SG1.Canvas do
if (SG1.Cells[ACol,ARow]='__________1__________') then
begin
Font.Color:=clYellow;
Brush.Color:=clRed;
FillRect(Rect);
end;
with SG1.Canvas do
if (SG1.Cells[ACol,ARow]='__________2__________') then
begin
Font.Color:=clYellow;
Brush.Color:=clRed;
FillRect(Rect);
end;
with SG1.Canvas do
if (SG1.Cells[ACol,ARow]='__________4__________') then
begin
Font.Color:=clYellow;
Brush.Color:=clGreen;
FillRect(Rect);
end;
with SG1.Canvas do
if (SG1.Cells[ACol,ARow]='__________5__________') then
begin
Brush.Color:=clGreen;
Font.Color:=clYellow;
FillRect(Rect);
end;
end;

но видимо без WriteText не обойтись, т.к. в итоге ячейки раскрашиваются, а текста нет. Т.е. он есть, но его не видно под заливкой. Пожалуйста, объясните как создавать эту процедуру и на каком событии. Потому что если просто скопировать, прга выдает кучу непонятных ошибок. Спасибо.

[Stilet]

но видимо без WriteText не обойтись

Верно. Его правда можно заменить на TextOut.
Пример Михалыча нужно вставить в событие OnDrawCell для СтрингГрида.
Ну у тебя тоже пример пойдет, добавь только WriteText(StringGrid1.Canvas, Rect, 2, 2, StringGrid1.Cells[Col,Row], taCenter);
В конец процедуры и все путем.

[mihali4]

Причина использования WriteText в том, что TextOut не позволяет вывести текст с нужным Alignment, что нужно для приличного оформления вывода результатов.
Стилет вам все верно подсказал - почему вы упустили вывод WriteText?
Какие такие ошибки у вас возникают при его использовании?
И еще. Строка with SG1.Canvas do может использоваться только один раз, объединив в своем блоке begin..end все проверки.
Далее. Ваши условия.
Есть взаимоисключающие, должны идти:

if SG1.Cells[ACol,ARow]='__________3__________' then
begin
Font.Color:=clRed; 
Brush.Color:=clYellow; 
FillRect(Rect);
end else
if (SG1.Cells[ACol,ARow]='__________4__________') then
begin
Font.Color:=clYellow;
Brush.Color:=clGreen;
FillRect(Rect);
end;

У вас же получается, что, независимо от выполнения предыдущего условия, вы все равно проверяете на ВСЕ остальные... Зачем???
Есть совместные условия:

if ((SG1.Cells[ACol,ARow]='__________1__________') or (SG1.Cells[ACol,ARow]='__________2__________')) then
begin
Font.Color:=clYellow;
Brush.Color:=clRed;
FillRect(Rect);
end;

Они могут объединяться.
И последнее.
Оператор FillRect(Rect);
Зачем его везде дублировать?
Он должен использоваться один раз, непосредственно перед WriteText...

[monushka]

При вставке строки
WriteText(StringGrid1.Canvas, Rect, 2, 2, StringGrid1.Cells[ACol,ARow], taCenter); выдает ошибку
[Error] Unit1.pas(743): Undeclared identifier: 'WriteText'
я так понимаю, что именно Write Text необходимо где-то объявить. В примере на странице http://www.programmersforum.ru/showthread.php?t=8170 его объявляли для TForm1, но на какое событие? Я не могу понять...

[Квэнди]

Ни на какое : прописываете заголовок процедуры/функции в секцию private (к примеру)
затем пишете её текст (с заголовоком, в котором указан родительский класс процедуры) в теле модуля. Пример:
type
tform1=class(tform)
....
private
....
procedure test;
....
begin
.....
procedure tform1.test;
begin
end;
.....
end.

[monushka]

Сообщение от Stilet

Верно. Его правда можно заменить на TextOut.
Пример Михалыча нужно вставить в событие OnDrawCell для СтрингГрида.
Ну у тебя тоже пример пойдет, добавь только WriteText(StringGrid1.Canvas, Rect, 2, 2, StringGrid1.Cells[Col,Row], taCenter);
В конец процедуры и все путем.

Объясните, пожалуйста, как именно добавить? Нужна ведь еще процедура WriteText. Вот в ней проблема... Если просто скопировать с темы, ссылка на которую указана выше, то выдает ошибки. Дело в том, что я не знаю на какое событие для FOrm1 нужно ее писать. Вот. Помогите, пожалуйста!

[monushka]

procedure TForm1.WriteText(ACanvas: TCanvas; ARect: TRect; DX, DY: Integer;
  const Text: string; Alignment: TAlignment);
const
  AlignFlags : array [TAlignment] of Integer =
    ( DT_LEFT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
      DT_RIGHT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
      DT_CENTER or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX );
var
  I, Left: Word;
begin
  I := ColorToRGB(ACanvas.Brush.Color);
  if GetNearestColor(ACanvas.Handle, I) = I then
  begin
   case Alignment of
      taLeftJustify:
        Left := ARect.Left + DX;
      taRightJustify:
        Left := ARect.Right - ACanvas.TextWidth(Text) - 3;
    else
    Left := ARect.Left + (ARect.Right - ARect.Left) shr 1
        - (ACanvas.TextWidth(Text) shr 1);
    end;
    ExtTextOut(ACanvas.Handle, Left, ARect.Top + DY, ETO_OPAQUE or
      ETO_CLIPPED, @ARect, PChar(Text), Length(Text), nil);
  end;
end;

И куда вот то писать?

[Alter]

Можно таким способом, а по поводу размера и длины текста в Grid`е. То для установления ширины колонок в таблице можно использовать функцию которая изменит размер колонки под самую длинную строку(такие вопросы были в DelphiWorld 6, и тут они могли тоже быть).
Вот код:

Установим опции в Grid: [goFixedVertLine,goFixedHorzLine,goV ertLine,goHorzLine,goRangeSelect,go ColMoving,goEditing,goAlwaysShowEdi tor];

unit ColorGr;

interface

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

type
  TForm1 = class(TForm)
    SG1: TStringGrid;
    procedure SG1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.SG1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
 WITH SG1 DO
 Begin
  IF ARow>0 Then
  Case ACol OF
 0:begin
    Canvas.Brush.Color := clYellow;
    Canvas.FillRect( Rect );
    Canvas.TextOut(Rect.Left, Rect.Top, Cells[ACol, ARow]);
   end;
 1:begin
    Canvas.Brush.Color := clLime;
    Canvas.FillRect( Rect );
    Canvas.TextOut(Rect.Left, Rect.Top, Cells[ACol, ARow]);
   end;
 2:begin
    Canvas.Brush.Color := clWhite;
    Canvas.FillRect( Rect );
    Canvas.TextOut(Rect.Left, Rect.Top, Cells[ACol, ARow]);
   end;
 3:begin
    Canvas.Brush.Color := clRed;
    Canvas.FillRect( Rect );
    Canvas.TextOut(Rect.Left, Rect.Top, Cells[ACol, ARow]);
   end;
 4:begin
    Canvas.Brush.Color := clBlue;
    Canvas.FillRect( Rect );
    Canvas.TextOut(Rect.Left, Rect.Top, Cells[ACol, ARow]);
   end;
  End;
 End;
end;

end.

совет - используй для оформления кода кнопочку #code. Модератор.