Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2008.07.27;
Скачать: [xml.tar.bz2];

Вниз

Разноцветные столбцы в TStringGrid, как?   Найти похожие ветки 

 
maxon   (2008-06-27 23:12) [0]

Как БЫСТРО раскрасить каждый 2й столбик у таблицы?

Мне необходимо чтобы каждый 2-ой столбик в таблице был другого цвета. Вот мой вариант, но он крайне медлителен :(


// TStringGrid.Options:= [goFixedVertLine,goFixedHorzLine,goColSizing,goColMoving,goRowSelect];

procedure HighlightingGrid( xRow: integer; xState: TGridDrawState );
var
 ix:     integer;    // Щетчик
 iXMax:  integer;    // Кол-во столбцов
 rctRct: TRect;      // Регион ячейки
begin
 if xRow > 0 then   // Подсветка начинается с 1-ой строки, т.е. не 0-ой
 begin
   iXMax:= fMain.sgMain.ColCount - 1;

   for ix:= 0 to iXMax do
   begin
     if ix mod 2 = 0 then // Подсвечиваем каждую 2-ю ячейку
     begin
       if ( gdSelected in xState ) then // Если ячейка выделена
       begin
         fMain.sgMain.Canvas.Brush.Color:= clHighlight;
         fMain.sgMain.Canvas.Font.Color:= clHighlightText;
       end
       else { if ( gdSelected in xState ) then }
       begin
         fMain.sgMain.Canvas.Brush.Color:= $CFCFCF;
         fMain.sgMain.Canvas.Font.Color:= fMain.sgMain.Font.Color;
       end; { if ( gdSelected in xState ) then }

       rctRct:= fMain.sgMain.CellRect( ix, xRow ); // Находим регион текущей ячейки

       fMain.sgMain.Canvas.TextRect( rctRct, rctRct.Left, rctRct.Top, fMain.sgMain.Cells[ix,xRow] );
     end; { if ix mod 2 = 0 then }
   end; { for ix:= 0 to iXMax do }
 end; { if xRow > 0 then }
end;

procedure TfMain.sgMainDrawCell(Sender: TObject; ACol, ARow: Integer;
 Rect: TRect; State: TGridDrawState);
begin
 HighlightingGrid( ARow, State );
end;


Можно ли, как-нибудь, сделать тоже самое но быстрее?


 
Тын-Дын ©   (2008-06-27 23:16) [1]

http://forum.sources.ru/index.php?showtopic=125297&hl=stringgrid


 
maxon   (2008-06-27 23:23) [2]

Спасибо Тын-Дын!

Жаль только регистрация на том форуме требуется :(


 
Тын-Дын ©   (2008-06-27 23:33) [3]


> maxon   (27.06.08 23:23) [2]
> Спасибо Тын-Дын!Жаль только регистрация на том форуме требуется
> :(


Читать можно без регистрации, файлы - нельзя.


 
Плохиш ©   (2008-06-28 11:49) [4]


> maxon   (27.06.08 23:12)  
> Как БЫСТРО раскрасить каждый 2й столбик у таблицы?
>
> Мне необходимо чтобы каждый 2-ой столбик в таблице был другого
> цвета. Вот мой вариант, но он крайне медлителен :(

Конечно медленный, ну зачем по запросу на отрисовку одной ячейки перересовывать всю строку? Рисуй только одну ячейку с координатами ACol, ARow, для остальных ячеек отдельно вызовут OnDrawCell.


 
KSergey ©   (2008-06-28 13:19) [5]

http://www.delphikingdom.com/asp/viewitem.asp?catalogid=168


 
sniknik ©   (2008-06-28 13:28) [6]

Плохиш ©   (28.06.08 11:49) [4]
+
"медленность" еще скрыта (при больших обьемах данных) в самом принципе стринггрида, в том что он не для данных, не для хранения/работы с ними, а только для отображения (т.е. если строк намного больше чем в нем отображается за раз, то это уже повод задуматься).
хорошие результаты по ускорению дает разделение данных и отображения (типа датасет+"отображаемое окно" из него (грид), т.е. принцип используемый бд компонентами. которыми можно и воспользоваться, чтобы не изобретать велосипед. даже если базы данных как таковой нет)


 
maxon   (2008-06-29 23:17) [7]

2 Плохиш
Об этом я и не подумал, спасибо!


procedure TfMain.sgMainDrawCell(Sender: TObject; ACol, ARow: Integer;
 Rect: TRect; State: TGridDrawState);
begin
 if ARow > 0 then
 begin
   if ( ACol mod 2 = 0 ) then
   begin
     if ( gdSelected in State ) then
     begin
       fMain.sgMain.Canvas.Brush.Color:= clHighlight;
       fMain.sgMain.Canvas.Font.Color:= clHighlightText;
     end
     else { if ( gdSelected in xState ) then }
     begin
       fMain.sgMain.Canvas.Brush.Color:= $CFCFCF;
       fMain.sgMain.Canvas.Font.Color:= fMain.sgMain.Font.Color;
     end; { if ( gdSelected in xState ) then }

     fMain.sgMain.Canvas.TextRect( Rect, Rect.Left, Rect.Top, fMain.sgMain.Cells[ACol,ARow] );
   end;
 end;
end;


2 KSergey
Тоже спасибо. Будет больше времени, тоже попробую.

2 sniknik
Данных, в общем, не много но требуется отображать их в более удобочитаемом виде.


 
Игорь Шевченко ©   (2008-06-30 00:33) [8]

Убери fmain из кода


 
sniknik ©   (2008-06-30 08:39) [9]

> Убери fmain из кода
или, имхо лучше, "пляши" от Sender-а. переносимость кода улучшится.

procedure TfMain.sgMainDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
begin
 with TStringGrid(Sender) do
   if ARow > 0 then
     if ( ACol mod 2 = 0 ) then begin

      if ( gdSelected in State ) then begin
         Canvas.Brush.Color:= clHighlight;
         Canvas.Font.Color := clHighlightText;
      end else begin
         Canvas.Brush.Color:= $CFCFCF;
         Canvas.Font.Color := Font.Color;
      end;

      Canvas.TextRect( Rect, Rect.Left, Rect.Top, Cells[ACol,ARow] );
    end;
end;


 
maxon   (2008-06-30 23:46) [10]

2 shiknik
Ты прав!

procedure TfMain.sgMainDrawCell(Sender: TObject; ACol, ARow: Integer;
 Rect: TRect; State: TGridDrawState);
begin
 if ( ScEdOpt.bColoringGrid ) then
 begin
   if ( ARow > 0 ) and ( ACol mod 2 = 0 ) and ( not( gdSelected in State ) ) then
   begin
     with TStringGrid(Sender).Canvas do
     begin
       Brush.Color:= $CFCFCF;
       Font.Color:= TStringGrid(Sender).Font.Color;
       TextRect( Rect, Rect.Left + 2, Rect.Top + 2, TStringGrid(Sender).Cells[ACol,ARow] );
     end; { with TStringGrid(Sender).Canvas do }
   end; { if ( ARow > 0 ) and ( ACol mod 2 = 0 ) and ( not( gdSelected in State ) ) then }
 end; { if ( ScEdOpt.bColoringGrid ) then }
end;


 
Игорь Шевченко ©   (2008-06-30 23:54) [11]


> procedure TfMain.sgMainDrawCell(Sender: TObject; ACol, ARow:
>  Integer;
>  Rect: TRect; State: TGridDrawState);
> begin
>  if ( ScEdOpt.bColoringGrid ) then
>  begin
>    if ( ARow > 0 ) and ( ACol mod 2 = 0 ) and ( not( gdSelected
> in State ) ) then
>    begin
>      with TStringGrid(Sender).Canvas do
>      begin
>        Brush.Color:= $CFCFCF;
>        Font.Color:= TStringGrid(Sender).Font.Color;
>        TextRect( Rect, Rect.Left + 2, Rect.Top + 2, TStringGrid(Sender).
> Cells[ACol,ARow] );
>      end; { with TStringGrid(Sender).Canvas do }
>    end; { if ( ARow > 0 ) and ( ACol mod 2 = 0 ) and ( not(
> gdSelected in State ) ) then }
>  end; { if ( ScEdOpt.bColoringGrid ) then }
> end;


Увижу на работе у кого такой код - уволю. Зачем дублировать условия в комментариях ? Тем более в блоках из нескольких строк


 
maxon   (2008-06-30 23:56) [12]

Чтоб знать откуда этот END взялся!?
В следующий раз удалять буду :)


 
Игорь Шевченко ©   (2008-07-01 00:06) [13]


> Чтоб знать откуда этот END взялся!?
> В следующий раз удалять буду :)


Не сочти за наезд, но такой прием уместен, как минимум, когда end от begin отстоит больше чем на экран, тогда, глядя на комментарий можно понять. А когда между begin и end меньше десяти строк, то такой комментарий просто вреден - все видно по отступам, а они в твоем коде вполне присутствуют.
Но когда end от begin отстоит больше, чем на экран - это значит, что в коде скорее всего, что-то не так, хотя, безусловно бывают и исключения.


 
Германн ©   (2008-07-01 00:18) [14]


> Но когда end от begin отстоит больше, чем на экран - это
> значит, что в коде скорее всего, что-то не так, хотя, безусловно
> бывают и исключения.
>

Ох бывают. :)
Но и тогда подобные комментарии полезны лишь в случаях, когда в промежутке между "лестничными END"ами" стоИт некий код. Чтобы не перепутать END"ы.



Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2008.07.27;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.49 MB
Время: 0.007 c
2-1214313276
implementation
2008-06-24 17:14
2008.07.27
Двойной клик по фиксированной ячейке в TStringGrid.


15-1212514820
olevacho_
2008-06-03 21:40
2008.07.27
инструменты создания отчетов для полиграфии


15-1213271856
SKIPtr
2008-06-12 15:57
2008.07.27
подключение сети между виртуальными компьюторами


2-1214419508
Igor23
2008-06-25 22:45
2008.07.27
CMD+ShellExecute


15-1213088790
zAlexandrz
2008-06-10 13:06
2008.07.27
Проблема с трассирокой программы





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский