Раскрасит DBGRID

[xes]

Подскажите как выделить строки с одинаковым содиржимиым допустим есть следйющие строки

1
2
2
7
8
9
5
8

Возможно ли раскрасить одинаковые строки Dbgrid в соответствующие оттенки цветов. Вот нашел такой пример пытался переработать, перебирал с помощю цыклов значения но чего не получилось кроми зацикливания и бесконечыной раскраски.

Здесь мы будем использовать событие "OnDrawColumnCell". Следующий пример разукрашивает ячейки колонки "Status" когда значение НЕ равно "a".
Если Вы хотите закрасить целую линию, то достаточно удалить условие "If..." (смотрите ниже)

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;  
                                       DataCol: Integer; Column: TColumn;  
                                       State: TGridDrawState);  
const  
  clPaleGreen = TColor($CCFFCC);  
  clPaleRed =   TColor($CCCCFF);  
begin  

If Column.FieldName = 'Status' then  //Удалите эту линию, если хотете закрасить целую линию  

If Column.Field.Dataset.FieldbyName('Status').AsString <> 'a'  
  then  
   If (gdFocused in State) //имеет ли ячейка фокус?  
    then dbgrid1.canvas.brush.color := clBlack          //имеет фокус 
    else dbgrid1.canvas.brush.color := clPaleGreen;  //не имеет фокуса 

//Теперь давайте закрасим ячейку используя стандартный метод:  
dbgrid1.DefaultDrawColumnCell(rect,DataCol,Column,State)  
end;

[xes]

Подскажите как доработать програмуя сделал так
в результате запросов я получаю эти числа котрые надо выделить и присваеваю их переменной вариант.
тоесть если есть столбец с числами 1,2,2,1,5,7,12,4 то я получу переменную "а" типа вариант и в ней я так понимаю содержаться числа 2 и 1.
Как впихнуть уже известные значения ячейки которую надо красить в саму процедуру не знаю. Вторая процедура по клику кнопки создает этот вариант "а" .

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
const
  clPaleGreen = TColor($CCCCFF);
  clPaleRed =   TColor($CCCCFF);
begin
for i:=0 to (Длина масива) do 
begin
if Column.Field.DataSet.FieldByName('Позиция').AsInteger=a[i] then
      if (gdFocused in State) then
        dbgrid1.canvas.brush.color := clBlack          //имеет фокус
      else
        dbgrid1.canvas.brush.color := clPaleGreen;  //не имеет фокуса
    dbgrid1.DefaultDrawColumnCell(rect,DataCol,Column,State);
end;
end;

procedure TForm1.Button12Click(Sender: TObject);
var   a:Variant;
begin
  QExecOpenSQL(1, 1, 'select nt from draw2 where kol>1'); // Тут мы имеем результат запроса виде таблицы в которой имена одинаковы чисел: 1  2
  a:=DataModule1.Query1.FieldByName('nt').AsVariant;
//  Button1.Caption:=VarToStr(a);
end;

1. У меня не получается преобразовать "а" в вариантный масив и загнать его в процедуру раскраски.
2. Расположить запрос внутри процедуры
TForm1.DBGrid1DrawColumnCell тоже не льзя ругаеться. Ghjwtlehe получение масива одинаковых чисел, надо повесить на кокое то событие связанное с изменением содержимого DBGRid, которое наступает раньше чем его раскраска. А потом загнать полученый масив a[i]-ых в процедуру DBGrid1DrawColumnCell для раскраски этих строк.

[Stilet]

Вот смотри: РАскрасит строки с двойками в зеленый цвет.

procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect;
  Field: TField; State: TGridDrawState);
var
  holdColor: TColor;
begin
  holdColor := DBGrid1.Canvas.Brush.Color; {сохраняем оригинальный цвет}
  {"раскрашиваем" ячейки только для поля EmpNo}
    if pos('2',Field.AsString)<>0 then
    begin
      DBGrid1.Canvas.Brush.Color := clGreen;
      DBGrid1.Canvas.Font.Color:=clWhite;
      DBGrid1.Canvas.FillRect(rect);
      DBGrid1.Canvas.TextOut(Rect.Left,Rect.Top,Field.AsString);
      DBGrid1.Canvas.Brush.Color := holdColor;
    end;
end;

[xes]

Нет не то или я чтото не догоняю. Сложность не в раскраски ячейки с номером "2", а сложность в том чтобы узнать что ячеек с номером "2" встречаеться больше чем 1 штука и тогда их раскрасить. Тоесть два столбца полученый врезультате запроса
1 Квдрат 25*25
2 Диаметр Д16
2 Диаметр Д25 (В одной поззиции только один инструмент)
17 Прям 15*123
5 Круг 14

Во 2-ой позици стоит два разных инструмента этого не может быть. значит надо выделить эти строки красным. вот и проблема узнать строки с каким значением надо выделить.
Я их узнаю в результате проведения запросов, в итоге выполнения запроса через Qery, я имею столбец одинаковых (повторяющихся) значений тоесть резултат запроса таблица в данном случае только одно число 2. Если повторяющихся чисел больше то соответственно столбец содержит эти повторяющиеся числа
2
23
14

Можно тупо вывести ссобщение в Label что мол в позициях 2, 23, 14 инструмент пересикаеться что не допустимо.
Либо попытаться загнать полученые числа в Form1.DBGrid1DrawColumnCell.

В этой процедуре я присвоил значение переменной "а" вариант значение поля с теми числами которые надо раскрасить.

procedure TForm1.Button12Click(Sender: TObject);
var a:Variant;
begin
QExecOpenSQL(1, 1, 'select nt from draw2 where kol>1'); // Тут мы имеем результат запроса виде таблицы в которой имена одинаковы чисел: 1 2
a:=DataModule1.Query1.FieldByName('nt').AsVariant; 
// Button1.Caption:=VarToStr(a);
end;

Теперь эту переменную надо какимто образом загнать в процедуру
procedure TForm1.DBGrid1DrawColumnCell
и в цикле перебрать эти значения и раскрасить DBGRID.

[Serge_Bliznykov]

нужно в обработчике на DBGrid1DrawColumnCell
тупо перебирать, есть ли текущая переменная в списке дублирующихся. пишу наобум, прямо тут, будут ошибки, главное, хочу донести идёю:

... предварительно где-то на FormCreate или FormOpen
выполнили Ваш QExecOpenSQL(1, 1, 'select nt from draw2 where kol>1'); 

procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect;
  Field: TField; State: TGridDrawState);
var
  holdColor: TColor;
begin
  if not Query1.IsEmpty // если таблица повторов не пуста
  then begin
    // ищем текущее поле в таблице повторов
    if Query1.Locate('nt',Field.AsInteger ,[]) then begin
      holdColor := DBGrid1.Canvas.Brush.Color; {сохраняем оригинальный цвет}
      DBGrid1.Canvas.Brush.Color := clRed;
      DBGrid1.Canvas.Font.Color:=clWhite;
      DBGrid1.Canvas.FillRect(rect);
      DBGrid1.Canvas.TextOut(Rect.Left,Rect.Top,Field.AsString);
      DBGrid1.Canvas.Brush.Color := holdColor;
    end;
  end;
end;

Н я бы советовал другой подход - более простой и быстрый и понятный ;-)
Изменить запрос так, чтобы в запросе уже было количество повторов - и тогда раскарашивать без всяких поисков и переборов - тупо проверяя значение поля..

[Stilet]

Я бы сначала дал запрос на максимальное количество повторяющегося, отсортированный по убыванию, тогда первая же запись даст максимально количество цифр, вот ее значение и применяй в раскраске.

нужно в обработчике на DBGrid1DrawColumnCell
тупо перебирать

Я бы так легкомысленно не делал. Locate будет перескакивать на ту запись, представляешь как грид колбасить будет? Да и даже с Lookup
не стоит пробовать - медленно слишком

[Serge_Bliznykov]

Stilet, не сказал, для меня это было очевидно, думал, что и все очевидно - запрос, в котором ищуются повторяющиеся записи (Query1) - НИ В КОЕМ СЛУЧАЕ не должен быть ТОТ, с которым связан DBGrid!!!!!
Это отдельный запрос.
По поводу скорости работы - не спорю - это будет медленно, впрочем, очень сильно зависит от количества записей в основном гриде и особенно в query1, где повторы. Не хочет городить огород ради иллюстрации, но, думаю, что при двух-трёх повторяющихся номерах - работу Locate на глаз видно не будет.
Хотя, концептуально, я полностью согласен.

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

Я бы сначала дал запрос на максимальное количество повторяющегося, отсортированный по убыванию, тогда первая же запись даст максимально количество цифр, вот ее значение и применяй в раскраске.

Виталий, а поясни, я не понял, как КОЛИЧЕСТВО повторов поможет расскрасить повторяющиеся записи??!
Например, список 1,2,2,2,3,5,,23,23,27 ...
нужно расскрасить все 2-ки и все 23

[Stilet]

Серж, извини что засомневался, короче я имел ввиду примерно следующее

Предположим у меня в базе поле i char(10)
Вот запрос на определение количества повторюшек:

SELECT Count(ter.i) AS Cn, ter.i
FROM ter
GROUP BY ter.i

вот сама прога раскраски. Раскрашивает все записи, в которых по полю i повторения:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, ADODB, StdCtrls, Grids, DBGrids;

type
  TForm1 = class(TForm)
    ADOTable1: TADOTable;
    ListBox1: TListBox;
    DBGrid1: TDBGrid;
    DataSource1: TDataSource;
    ADOQuery1: TADOQuery;
    DataSource2: TDataSource;
    DBGrid2: TDBGrid;
    procedure FormCreate(Sender: TObject);
    procedure DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect;
      Field: TField; State: TGridDrawState);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var i:array of string;
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var e,k:integer;
begin
 SetLength(i,ADOQuery1.RecordCount+1);k:=0;
 k:=0;
 ADOQuery1.First;
 for e:=0 to ADOQuery1.RecordCount-1 do begin
 if ADOQuery1.FieldByName('Cn').AsInteger>1 then begin
   i[k]:=ADOQuery1.FieldByName('i').AsString;
   inc(k);
  end;
  ADOQuery1.Next;
 end;
 ADOQuery1.Close;
end;

procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect;
  Field: TField; State: TGridDrawState);
var
  holdColor: TColor;e,u:integer;
begin
  holdColor := DBGrid1.Canvas.Brush.Color; {сохраняем оригинальный цвет}
  {"раскрашиваем" ячейки только для поля EmpNo}
     //********* FOR ******************
     e:=-1;
     for  u:=0  to high(i)  do
     begin
       if i[u]=Field.AsString then begin e:=u; break; end;
     end;
     //******* END FOR ****************{}
     if  e>=0 then  DBGrid1.Canvas.Brush.Color := strtoint(i[e])*100 else
            DBGrid1.Canvas.Brush.Color := holdColor;

    begin
      DBGrid1.Canvas.Font.Color:=clWhite;
      DBGrid1.Canvas.FillRect(rect);
      DBGrid1.Canvas.TextOut(Rect.Left,Rect.Top,Field.AsString);
    end;
end;

end.

Короче вот там в условии можно указывать при каком количестве повторов раскрашивать запись )

[xes]

Почемуто не получаеться раскрасить ниже приведенным кодом хотя по логике вроди все верно. Раскрашивает только последние элементы масива.

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
var i,g:integer;
const
  clPaleGreen = TColor($CCFFCC);
  clPaleRed = TColor($CCCCFF);
begin
  dbgrid1.canvas.brush.color := clPaleRed; //Красный все ну это так чтобы было пока
  for i:=Low(draw) to High(draw) do//Перебираем все значения масива и сравниваем с текущей записью если удовлетворяет сразу Break и раскрашиваем эту строку.
  begin
    if Column.Field.Dataset.FieldbyName('Позиция').AsInteger = draw[i] then
    begin
      dbgrid1.canvas.brush.color := clPaleGreen;
      Break;
    end;
  end;
  dbgrid1.DefaultDrawColumnCell(rect,DataCol,Column, State);
end;

procedure TForm1.Button12Click(Sender: TObject);
var i:integer;
begin
  SetLength(draw,0);
  i:=0;
  QExecOpenSQL(3, 1, 'select nt from draw2 where kol>1');
  DataModule1.Query3.First;
  while not DataModule1.Query3.Eof do
  begin
    SetLength(draw,i+1);
    draw[i]:=DataModule1.Query3.FieldByName('nt').AsInteger;
    DataModule1.Query3.Next;
  end;
end;

<img src='http://programmersforum.ru/attachment.php?attachmentid=3837&st c=1&d=1211004604' />

----------


Serge_Bliznykov-у Спасибо код работает только надо доработать под мою конкретную ситуацию.
Код красит почти нормально, только во все ячейки вводит значение DBGrid1.Canvas.TextOut(Rect.Left,Re ct.Top,Field.AsString); Как бы доработать чтобы вводилось только в столбец Позиция?

Извеняюся за токие вопросы. Но просто не понимаю как работает эта процедура, что за что тут отвечает откуда береться, в какой переменной столбыы где записи перебираються...?

И получаеться.
<img src='http://programmersforum.ru/attachment.php?attachmentid=3838&st c=1&d=1211007573' />

[Vlad_p]

ПРЕДЛАГАЮ ПРИМЕР С КНИГИ: "Библия для программиста в среде Delphi" автор Horrific aca Фленов Михаил стр. 368