VPF::Покраска StringGrid - Форум программистов

Litta

Дата 11.12.2009, 16:17 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 55
Регистрация: 14.3.2006

Репутация: нет
Всего: 1

Приветствую!
Есть маленькая проблема со 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

Это сообщение отредактировал(а) Litta - 11.12.2009, 16:18

Присоединённый файл ( Кол-во скачиваний: 13 )

12.JPG 160,78 Kb

Демо

Дата 11.12.2009, 17:19 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

Репутация: 30
Всего: 50

Проверь, правильно ли у тебя отрисовка идёт в случае если gdFocused in State

--------------------

Litta

Дата 14.12.2009, 10:01 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 55
Регистрация: 14.3.2006

Репутация: нет
Всего: 1

а собственно вся процедура прорисовки уже написана в приведённом выше коде!
Т.е. нужно добавить там код на

Код


if (state = [gdFocused) then

Litta

Дата 15.12.2009, 11:49 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 55
Регистрация: 14.3.2006

Репутация: нет
Всего: 1

Проблему решил так:

Код


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;

Это сообщение отредактировал(а) Litta - 15.12.2009, 11:51

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »