Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: Общие вопросы > Покраска StringGrid


Автор: Litta 11.12.2009, 16:17
Приветствую!
Есть маленькая проблема со StringGrid!
Залил в него данные, необходимо покрасить, делаю так:

Код

procedure TRefuelDlg.St1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
if ARow<>0 then
 begin
  if (state = [gdSelected]) then
   begin
    with TStringGrid(Sender), Canvas do
     begin
      Brush.Color := clHighLight;
      FillRect(Rect);
      if ((ACol=1) or (ACol=3) or (ACol=4)) then
       TextRect(Rect, Rect.Left+10, Rect.Top, Cells[aCol, aRow])
      else
       TextRect(Rect, Rect.Left, Rect.Top, Cells[aCol, aRow]);
     end; 
   end
  else
   begin
    if (((st1.Cells[4,ARow]<>'') and (st1.Cells[5,ARow]<>'')) and (StrToInt(st1.Cells[4,ARow])>StrToInt(st1.Cells[5,ARow]))) then
     begin
      with TStringGrid(Sender), Canvas do
       begin
        Brush.color := clRed;
        FillRect(Rect);
      if ((ACol=1) or (ACol=3) or (ACol=4)) then
       TextRect(Rect, Rect.Left+10, Rect.Top, Cells[aCol, aRow])
      else
       TextRect(Rect, Rect.Left, Rect.Top, Cells[aCol, aRow]);
       end;
     end
    else
     begin
      with TStringGrid(Sender), Canvas do
       begin
        Brush.color := clWindow;
        FillRect(Rect);
      if ((ACol=1) or (ACol=3) or (ACol=4)) then
       TextRect(Rect, Rect.Left+10, Rect.Top, Cells[aCol, aRow])
      else
       TextRect(Rect, Rect.Left, Rect.Top, Cells[aCol, aRow]);
       end; 
     end;
   end;
 end;


В принципе работает, но есть проблема - при перемещении по строкам (все опции стоят в False, кроме goRowSelect, goThumbTracking и первых 4-х) - в первой ячейки выделенной записи исчезает текст! При этом обратил внимание, что если кликнуть непосредственно в эту первую ячейку (хотя стоит выделение всей строки) - её окантовка рисуется как-будто она становится фокусной... При этом, если становишься на строчку, которая соответственно условиям красится в красный - в ней всё видно, а если встать на обычную - сразу пропадает текст первой ячейки!
Извратился создав первую колонку и задав ей нулевую длинну - а в остальные уже пишу данные и всё вижу, но проблема задела, вот хотелось бы услышать ваше мнение?

ЗЫ: Font тоже пытался присвоить - не помогло, да и вобще - первая ячейка эта не красится даже в clHighLight

Автор: Демо 11.12.2009, 17:19
Проверь, правильно ли у тебя отрисовка идёт в случае если gdFocused in State

Автор: Litta 14.12.2009, 10:01
а собственно вся процедура прорисовки уже написана в приведённом выше коде!
Т.е. нужно добавить там код на
Код

if (state = [gdFocused) then

?

Автор: Litta 15.12.2009, 11:49
Проблему решил так:
Код

procedure TRefuelDlg.St1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
if ARow<>0 then
 begin
  if (state = [gdSelected]) then
   begin
    if (((st1.Cells[3,ARow]<>'') and (st1.Cells[4,ARow]<>'')) and (StrToInt(st1.Cells[3,ARow])>StrToInt(st1.Cells[4,ARow]))) then
     begin
      with TStringGrid(Sender), Canvas do
       begin
        Brush.color := clRed;
        FillRect(Rect);
        if ((ACol=0) or (ACol=2) or (ACol=3)) then
         TextRect(Rect, Rect.Left+10, Rect.Top, Cells[aCol, aRow])
        else
         TextRect(Rect, Rect.Left, Rect.Top, Cells[aCol, aRow]);
       end;
     end
    else
     begin
      with TStringGrid(Sender), Canvas do
       begin
        Brush.Color := clHighLight;
        FillRect(Rect);
        if ((ACol=0) or (ACol=2) or (ACol=3)) then
         TextRect(Rect, Rect.Left+10, Rect.Top, Cells[aCol, aRow])
        else
         TextRect(Rect, Rect.Left, Rect.Top, Cells[aCol, aRow]);
       end;
     end;
   end
  else
   begin
    if (((st1.Cells[3,ARow]<>'') and (st1.Cells[4,ARow]<>'')) and (StrToInt(st1.Cells[3,ARow])>StrToInt(st1.Cells[4,ARow]))) then
     begin
      with TStringGrid(Sender), Canvas do
       begin
        Brush.color := clRed;
        FillRect(Rect);
        if ((ACol=0) or (ACol=2) or (ACol=3)) then
         TextRect(Rect, Rect.Left+10, Rect.Top, Cells[aCol, aRow])
        else
         TextRect(Rect, Rect.Left, Rect.Top, Cells[aCol, aRow]);
       end;
     end
    else
     begin
      with TStringGrid(Sender), Canvas do
       begin
        if ((ACol=0) or (ACol=2) or (ACol=3)) then
         TextRect(Rect, Rect.Left+10, Rect.Top, Cells[aCol, aRow])
        else
         TextRect(Rect, Rect.Left, Rect.Top, Cells[aCol, aRow]);
       end;
     end;
   end;
 end;
end;

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)