Разноцветный DBGrid. 8 лет спустя.

© 2003 Андрей Финк

Почти восемь лет назад, появилась на свет Borland Delphi 1. Все эти восемь лет программисты во всем мире, связанные с базами данных, решали несколько сложнейших задач, которые (вместе с решениями) описаны здесь:

• Разноцветный DBGRID
• Что можно поместить в DBGrid
• НеОбычный TDBGrid

Рассмотрим, как их можно решить в наши дни. Воспользуемся бесплатной для exUSSR библиотекой EhLib Дмитрия Большакова. В настоящее время это лучшие компоненты в exUSSR по соотношению функциональность+качество/цена. Вся настройка грида для большей наглядности делается в исходном коде. В ваших приложениях большинство действий можно проделать визуально в дизайнере.

1. Демонстрационный проект

Время идет, BDE официально признан мертвым, поэтому мы в качестве движка будем использовать ADO. Почитать подробнее можно здесь: "Немного об использовании ADO в Delphi" (из этой же статьи взята базка в MS ACCESS). Никаких проблем связка TADOConnection – TADODataSet не вызывает. Интересным моментом в программе является редактирование свойства TADOConnection.ConnectionString в run-time:

  //редактирование ConnectionString
  ADOC.Connected := FALSE;
  ADOC.ConnectionString := edConnStr.Text;
  AdoConEd.EditConnectionString(ADOC);
  edConnStr.Text := ADOC.ConnectionString;

2. Раскрашиваем строку

Пишется обработчик события OnGetCellParams:

procedure TFmMain.EhGridGetCellParams(Sender: TObject; Column: TColumnEh;
  AFont: TFont; var Background: TColor; State: TGridDrawState);
Begin
  // Даем DBGrid'у ЦУ
  //на строку
  if Column.Field.DataSet.Fields[0].AsInteger > 2 then begin
    Background := clGray;
  end;

  //на ячейку 1
  if (Column.Field.Index = 1) and (Column.Field.AsString = 'Петров' ) then begin
    Background := clGreen;
    AFont.Color := clWhite;
  end;

  //на ячейку 2
  if (Column.Field.Index = 2) and (Length(ADODataSetPhone.Value) > 7) then begin
    AFont.Style := AFont.Style + [fsBold];
  end;
End;//1.РАСКРАШИВАЕМ СТРОКУ

Никакого рисования на канве, никаких тонкостей с вызовом методов, просто указываем гриду свойства ячейки, передаваемые в аргументах – и всё, остальное он делает сам!

Если нужно просто подсветить строку на которой стоит курсор, то это ещё проще:

  EhGrid.OptionsEh := EhGrid.OptionsEh + [dghRowHighlight];

3. CheckBox в поле DBGrid

Если поле DataSet’а имеет тип Boolean, то никаких дополнительных усилий делать не придется, грид сам будем отображать checkbox. Для полей других типов нужно настроить свойства столбца DBGridEh следующим образом:

  //1.сделаем поле Code - полем с CheckBox
  EhGrid.Columns[3].KeyList.Add('8;9;7;6;5;4;3;2;1'); //TRUE
  EhGrid.Columns[3].KeyList.Add('0'); //FALSE
  EhGrid.Columns[3].Checkboxes := TRUE;

Всё!

4. Картинка в поле DBGrid

Чтобы показать вместо значения поля картинку, зависящую от значения поля, необходимо сделать следующее: Column[i].ImageList – ImageList с картинками, Column[i].KeyList свойство типа Strings - каждая строка – значение поля, вместо которого будет подставляться картинка из ImageList с соотвествующим индексом; свойствоColumn[i].NotInKeyListIndex должно содержать индекс картинки сопоставляемый значениям поля, которых нет в KeyList (например, это удобно для значения NULL). Список из свойства PickList используется для сопоставления картинкам всплывающих подсказок (для этого необходимо также выставить в TRUE свойства Column.Tooltips и DBGridEh.ShowHint).

  With column[xxx] do begin
    ImageList := Self.ImageList;
    //табличка преобразований значения поля в картинку
    KeyList.Add('Петров');
    KeyList.Add('Иванов');
    KeyList.Add('Семенов');
    NotInKeyListIndex := 3; //для других значений поля
    DblClickNextval := TRUE; //циклическая смена значения в поле по двойному клику мышки
    //хинты к картинкам
    PickList.Add('Это фото Петрова');
    PickList.Add('Это фото Иванова');
    PickList.Add('Это фото Семенова');
    Tooltips := TRUE;
  End;

5. Полосатое окно

Код взят из примеров к EhLib, обработчик OnGetCellParams:

  if odd(EhGrid.SumList.RecNo) then begin
    Background := $00FFC4C4; //цвет первой
  end else begin
    Background := $00FFDDDD;//цвет второй
  end;

6. MultiSelect

Для начала нужно выставить

  EhGrid.Options := EhGrid.Options + [dgMultiSelect];

После этого любое выделение сделанное пользователем доступно через свойство TDBGridEh.Selection. Selection.SelectionType указывает на тип выделения:

  case EhGrid.Selection.SelectionType of
    gstNon: ShowMessage('Ничего не выделено');
    gstRecordBookmarks: ShowMessage('Выделено строк: '+IntToStr(EhGrid.Selection.Rows.Count));
    gstRectangle:
      begin
        ADODataSet.Bookmark := EhGrid.Selection.Rect.TopRow;
        S1 := ADODataSet.Fields[0].AsString;
        ADODataSet.Bookmark := EhGrid.Selection.Rect.BottomRow;
        S2 := ADODataSet.Fields[0].AsString;
        ShowMessage(Format('Выделено прямоугольник от закладки %s до закладки %s. От столбца %d до столбца %d',
          [S1,S2,
          EhGrid.Selection.Rect.LeftCol,
          EhGrid.Selection.Rect.RightCol]));
      end;
    gstColumns: ShowMessage('Выделено столбцов:'+IntToStr(EhGrid.Selection.Columns.Count));
    gstAll: ShowMessage('Выделен весь грид!');
  end;//case

Более подробный пример есть в Справке в EhLib, а для копирования/вырезания/вставки уже есть готовые процедуры.

7. Сложные заголовки

Это то, чего так не хватает в стандартном гриде и из-за чего с завистью начинаешь посматривать на 1С ;-).
Показать как это делается ещё проще, чем объяснить:

  EhGrid.UseMultititle> := TRUE;
  EhGrid.Column[1].title>.Caption := 'title>1|Subtitle>1';
  EhGrid.Column[2].title>.Caption := 'title>1|Subtitle>2';

После этого столбцы с заголовками Subtitle>1 и Subtitle>2 будут объединены под заголовком title>1.

8. Быстрый (инкрементальный) поиск

Это то, что поражает в DBGridEh после обычного грида (как демка BioLife в Delphi после TurboPascal).

  EhGrid.OptionsEh := EhGrid.OptionsEh + [dghIncSearch];

Указывает гриду на то, что после нажатия Ctrl+F следует перейти в режим быстрого поиска.

  EhGrid.OptionsEh := EhGrid.OptionsEh + [dghPreferIncSearch];

Указывает на то, что режим «быстрого» поиска является основным, нажатия цифро-буквенных клавиш будут восприниматься гридом как часть строки, которую он будет искать в текущем столбце. Перейти к режиму редактирования можно нажатием F2.

9. Авто-Сортировка

Для того, чтобы сделать сортировку по столбцам в обычном гриде, нужно проделать длительную кропотливую работу, с EhLib это займет несколько секунд:

  //9.Авто Сортировка
  for i:=0 to EhGrid.Columns.Count-1 do begin
    EhGrid.Columns[i].title>.title>Button := TRUE; //заголовок "кнопка"
  end;
  EhGrid.OptionsEh := EhGrid.OptionsEh + [dghAutoSortMarking]; //автоматическая сортировка
  EhGrid.OptionsEh := EhGrid.OptionsEh + [dghMultiSortMarking];//сортировка по нескольким столбцам

в USES надо добавить один из модулей: EhLibADO, EhLibBDE, EhLibCDS, EhLibDBX или EhLibIBX в зависимости от типа DataSet’ов которые вы используете. Данные модули, при включении их в приложение, автоматически регистрируют объект-сортировщик.

Есть одно НО: на текущий момент (июль 2003) версия EhLib c сайта разработчика может сортировать только DataSet со словом Query: TIBQuery, TSQLQuery, TADOQuery и тд. Кроме того возможность грида SortLocal реализована только для ClientDataSet. Нам же требуется работа с TADODataSet и хотелось бы реализовать локальную сортировку recordset’а, которую умеет делать ADO.

Помогли исходники. Код EhLib красивый, удобно разбит на модули. В результате его изучения возникли следующие исправления:

unit DbUtilsEh:
const
  SOrderBy = 'ORDER BY';
  EOL = #13#10;

//побавим поддержку серверной сортировки не только в объекты со свойством SQL: TStrings,
//но и в объекты со свойством CommandText: [Wide]String;
function IsSQLBasedDataSet(DataSet: TDataSet; var SQL: String): Boolean;
var
  FPropInfo: PPropInfo;
begin
  Result := FALSE;
  SQL := '';
  //Query
  FPropInfo := GetPropInfo(DataSet.ClassInfo, 'SQL');
  if (FPropInfo <> NIL) and (FPropInfo^.PropType^.Kind = tkClass) then
  try
    SQL := Trim((TObject(GetOrdProp(DataSet, FPropInfo)) as TStrings).Text);
    Result := TRUE;
  except // if PropInfo is not TStrings or not inherited of
  end;
  //APR: Dataset
  FPropInfo := GetPropInfo(DataSet.ClassInfo, 'CommandText');
  if (FPropInfo <> NIL) and (FPropInfo^.PropType^.Kind in [tkLString,tkWString]) then
  try
    SQL := Trim(GetStrProp(DataSet, FPropInfo));
    Result := TRUE;
  except
  end;
End;//IsSQLBasedDataSet

//общая для всех типов dataSet’ов серверная сортировка
procedure ApplySortingForSQLBasedDataSet(Grid: TCustomDBGridEh; DataSet: TDataSet;
  UseFieldName: Boolean);
var
  i,j: Integer;
  s: String;
  SQL: String;//теперь это строка (по новым стандартам Borland)
begin
  if not IsSQLBasedDataSet(DataSet, SQL) then
    raise Exception.Create(DataSet.ClassName + ' is not SQL based dataset');
  s := '';
  for i := 0 to Grid.SortMarkedColumns.Count - 1 do begin
    if UseFieldName
      then s := s + Grid.SortMarkedColumns[i].FieldName
      else s := s + IntToStr(Grid.SortMarkedColumns[i].Field.FieldNo);
    if Grid.SortMarkedColumns[i].title>.SortMarker = smUpEh
      then s := s + ' DESC, '
      else s := s + ', ';
  end;

  if s <> '' then
    s := SOrderBy + ' ' + Copy(s, 1, Length(s) - 2);

  i := Pos(SOrderBy,SQL);
  if i <= 0 then begin
    SQL := SQL + EOL + S;
  end
  else begin
    j := i;
    while SQL[j] in [' '..':','<'..#255] do inc(j); //всё  что больше пробела и кроме ;
    SQL := Copy(SQL,1,i-1) + S + EOL + Copy(SQL,j,MaxInt);
end;
  DataSet.Close;
  (DataSet as IProviderSupport).PSSetCommandText(SQL);
  DataSet.Open;
end;

unit EhLibADO:
//класс сортировщик для TADODataSet
type
  TADODatasetFeaturesEh = class(TSQLDatasetFeaturesEh)
  public
    procedure ApplySorting(Sender: TObject; DataSet: TDataSet; IsReopen: Boolean); override;
  end;

//бежим по столбцам и собираем названия полей по которым следует сортировать
procedure TADODatasetFeaturesEh.ApplySorting(Sender: TObject; DataSet: TDataSet; IsReopen: Boolean);
var
  i: Integer;
  LIndexFields: String;
begin
  if (Sender is TCustomDBGridEh) and TCustomDBGridEh(Sender).SortLocal then begin
    with TCustomDBGridEh(Sender) do begin
      LIndexFields := '';
      for i := 0 to SortMarkedColumns.Count - 1 do begin
        case SortMarkedColumns[i].title>.SortMarker of
          smDownEh: LIndexFields := LIndexFields +'['+ SortMarkedColumns[i].FieldName + '],';
          smUpEh:   LIndexFields := LIndexFields +'['+ SortMarkedColumns[i].FieldName + '] DESC,';
        end;//case
      end;
      LIndexFields := Copy(LIndexFields,1,Length(LIndexFields)-1);
      if DataSet is TCustomADODataSet then begin
        TCustomADODataSet(DataSet).Sort := LIndexFields;
        TCustomADODataSet(DataSet).First;
      end;
    end;//with
  end
//иначе серверная сортировка – общая для всех
  else begin
    inherited ApplySorting(Sender,DataSet,IsReopen);
  end;//if
End;//ApplySorting

//регистрация объектов сортировщиков
initialization
  RegisterDatasetFeaturesEh(TSQLDatasetFeaturesEh, TADOQuery);
  RegisterDatasetFeaturesEh(TADODatasetFeaturesEh, TADODataSet);

Теперь в любом проекте кодирование сортировки TADODataSet будет занимать мгновения ;-)

X.Подведение итогов.

Безусловно, все эти годы прогресс не стоял на месте. ;-)
То, на что раньше требовались часы кропотливого труда, теперь занимает минуты.
Хочется сказать БОЛЬШОЕ СПАСИБО Дмитрию Большакову, автору EhLib, за великолепный продукт и идеальную ценовую политику!

Исходный код примера, демонстрационная базка и исправленные модули EhLib здесь (19.8K).

Copyright© 2003 Андрей Финк  Специально для Delphi Plus