unit Db_QBF; { Форма запроса базы данных }

{ Все права защищены. Автор Rick Rutt.

Данный модуль может без какой-либо оплаты быть использован в программе,
скопирован или распространен любым человеком и для любой цели, если все
копии данного модуля сохраняют это авторское уведомление.
Автор предоставляет разрешение каждому для создания производного кода, если
каждая производная работа содержит авторское уведомление и строку
"Части данной работы основываются на Db_QBF.PAS, созданным Rick Rutt."
}

{ Данный модуль обеспечивает простую, но эффективную форму запроса

для доступа приложений к базам данных, используя Borland Delphi.
Данный модуль также располагает сервисом Sort By Form (форма сортировки).

Форма запроса отображает модальное диалоговое окно с компонентом StringGrid,
содержащим искомые поля, полученные при вызове DbGrid. Пользователь может
ввести точную величину поиска для любого количества полей и использовать
функцию drag and drop (перетащи и брось) для изменения порядка сортировки полей.
(Только тех полей, которые содержат искомые величины, влияющие на сортировку.)
Когда пользователь щелкает в диалоговом окне на кнопку OK, данный модуль
модифицирует значение свойства IndexFieldNames компонента DbGrid, применяет
диапазон поиска (точные величины), и обновляет данные.
В случае, если пользователь не указывает ни одной из величин поиска,
данный модуль очищает значение свойства IndexFieldNames компонента DbGrid,
очищает диапазон поиска и обновляет данные.

Сервис Sort By Form работает аналогично, за исключением того,
что не принимает в расчет величину поиска, введенную пользователем. Пользователь
пользуется функцией drag and drop (перетащи и брось) для установления порядка
сортировки и затем нажимает на кнопку OK. Данный модуль модифицирует
значение свойства IndexFieldNames компонента DbGrid, очищает диапазон поиска
и обновляет данные.
}

{ Создайте соответствуюшую форму диалога, используя меню "File/New.../Dialogs"

и выбрав пункт "Standard Dialog Box". Разместите на форме компонент StringGrid
(Вы найдете его в палитре компонентов на странице "Additional").
Установите следующие размеры StringGrid: высота 161 и ширина 305.
И, наконец, замените исходный код новой формы (PAS-файл) данным модулем.
}

interface

uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons,

  StdCtrls, ExtCtrls, Grids, DBGrids;

{ Следующие две процедуры обеспечивают механизм доступа

сервисов данного модуля.

Кнопка (или пункт меню) вызывают процедуру,
передавая ей в качестве аргумента DbGrid. (Не забудьте добавить строку
"uses Db_QBF;" в секцию реализации модуля вызова форм.)

Ограничение: компонент DbGrid должен ссылаться на DataSource,
который, в свою очередь, ссылается на DataSet, работающий с
таблицой. Данный модуль не поддерживает запрос напрямую к
DataSet ввиду отсутствия свойства IndexFieldNames.
}

procedure QueryByForm(grid: TDbGrid);

procedure SortByForm(grid: TDbGrid);

{ Следующая секция управляется средой Delphi. }

type

  TdlgQBF = class(TForm)
    OKBtn: TBitBtn;
    CancelBtn: TBitBtn;
    HelpBtn: TBitBtn;
    gridQBF: TStringGrid;
    procedure OKBtnClick(Sender: TObject);
    procedure CancelBtnClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var

  dlgQBF: TdlgQBF;

implementation

{ Следующая секция пишется программистом

с помощью среды Delphi. }

uses Dialogs, Db, DbTables;

{$R *.DFM}

const

  qbfRowHeight = 16;
  qbfColWidth = 150;

  qbfFieldLabel = '<<Поле>>';
  qbfValueLabel = '<<Значение>>';

  qbfQueryCaption = 'Запрос для таблицы ';
  qbfSortCaption = 'Порядок сортировки для таблицы ';

var

  { Объявим некоторые элементы управления, участвующие
  в QBF-диалоге при нажатии кнопки OK. }
  CallingGrid: TDbGrid;
  CallingMode: (modeQuery, modeSort);

procedure SetupAndShowForm;
  { Инициализация формы, обеспечивающей визуализацию
  работы двух объявленных выше процедур }
var

  i, j, n: integer;
  tbl: TTable;
  f: TField;
begin

  n := CallingGrid.FieldCount;
  if n <= 0 then
  begin { Вместо вывода сообщений могут генерится исключительные ситуации }
    MessageDlg(
      'При обращении к DbGrid, модуль Db_QBF не обнаружил полей',
      mtWarning, [mbOK], 0);
  end
  else if CallingGrid.DataSource = nil then
  begin
    MessageDlg(
      'При обращении к DbGrid, модуль Db_QBF не обнаружил ссылки на DataSource',
      mtWarning, [mbOK], 0);
  end
  else if CallingGrid.DataSource.DataSet = nil then
  begin
    MessageDlg(
      'При обращении к DbGrid, модуль Db_QBF обнаружил подключенный
      DataSource без ссылки на DataSet',
      mtWarning, [mbOK], 0);
  end
  else if not (CallingGrid.DataSource.DataSet is TTable) then
  begin
    MessageDlg(
      'При обращении к DbGrid, модуль Db_QBF обнаружил подключенный
      DataSource с сылкой на DataSet, не являющийся таблицей.',
      mtWarning, [mbOK], 0);
  end
  else
    with dlgQBF.gridQBF do
    begin
      { Данные свойства могут быть изменены и в режиме проектирования }
      DefaultRowHeight := qbfRowHeight;
      Scrollbars := ssVertical;
      ColCount := 2; { Для режима сортировки необходимы две пустые колонки }

      { Данные свойства должны быть установлены во время выполнения программы }
      RowCount := Succ(n);
      Cells[0, 0] := qbfFieldLabel;
      Options := Options + [goRowMoving];

      tbl := TTable(CallingGrid.DataSource.DataSet);

      if CallingMode = modeQuery then
      begin
        dlgQBF.Caption := qbfQueryCaption + tbl.TableName;
        Cells[1, 0] := qbfValueLabel;
        Options := Options + [goEditing];
          { Позволяем пользователю ввести значение }
        DefaultColWidth := qbfColWidth;
      end
      else
      begin
        dlgQBF.Caption := qbfSortCaption + tbl.TableName;
        Cells[1, 0] := '';
          { Ввод "пустышки" для первой, нефункциональной колонки }
        Options := Options - [goEditing]; { Убираем возможность редактирования }
        DefaultColWidth := (2 * qbfColWidth);
          { Этим трюком мы помещаем две пустых секции над одной колонкой }
      end;

      j := 0; { Фактическое число полей, показываемое пользователю }
      for i := 1 to n do
      begin
        f := CallingGrid.Fields[Pred(i)];
        if f.DataType in [ftBlob, ftBytes, ftGraphic, ftMemo, ftUnknown,
          ftVarBytes] then
          RowCount := Pred(RowCount) { Игнорируем неиндексируемые поля }
        else
        begin
          Inc(j);
          Cells[0, j] := f.FieldName;
          Cells[1, j] := ''; { Сбрасываем искомую величину }
        end;
      end;

      dlgQBF.HelpBtn.Visible := False; { Помощь, понятно, отсутствует... }
      dlgQBF.ShowModal;
    end; { with dlgQBF.gridQBF }
end;

procedure QueryByForm(Grid: TDbGrid);
begin

  CallingGrid := Grid; { Сохраняем для использования при нажатии на кнопку OK }
  CallingMode := modeQuery;
  SetupAndShowForm;
end;

procedure SortByForm(Grid: TDbGrid);
begin

  CallingGrid := Grid; { Сохраняем для использования при нажатии на кнопку ОК }
  CallingMode := modeSort;
  SetupAndShowForm;
end;

procedure TdlgQBF.CancelBtnClick(Sender: TObject);
begin

  { Просто прячем диалог, не делая никаких изменений в вызывающем Grid'е. }
  dlgQBF.Hide;
end;

procedure TdlgQBF.OKBtnClick(Sender: TObject);
var

  flds, sep, val: string;
  i, n, nfld: integer;
begin

  flds := ''; { Список полей, разделенных ';'. }
  sep := ''; { Разделитель ';' ставится после добавления первого поля. }
  nfld := 0; { Количество полей в списке. }

  with dlgQBF.gridQBF do
  begin
    n := Pred(RowCount);
    if n > 0 then
      for i := 1 to n do
      begin
        val := Cells[1, i];
          { Значение поиска, введенное пользователем (если имеется) }
        if (CallingMode = modeSort)
          or (val <> '') then
        begin
          flds := flds + sep + Cells[0, i];
          sep := ';';
          nfld := Succ(nfld);
        end;
      end;

    with CallingGrid.DataSource.DataSet as TTable do
    begin
      IndexFieldNames := flds;
      if (CallingMode = modeSort)
        or (flds = '') then
      begin
        CancelRange;
      end
      else
      begin
        SetRangeStart;
        for i := 1 to n do
        begin
          val := Cells[1, i];
          if val <> '' then
          begin
            FieldByName(Cells[0, i]).AsString := val;
          end;
        end;

        {Устанавливаем конец диапазона так, чтобы он соответствовал его началу}
        SetRangeEnd;
        for i := 1 to n do
        begin
          val := Cells[1, i];
          if val <> '' then
          begin
            FieldByName(Cells[0, i]).AsString := val;
          end;
        end;
        ApplyRange;
      end;

      Refresh;
    end; { with CallingGrid.DataSource.DataSet }
  end; { with dlgQBF.gridQBF }

  dlgQBF.Hide;
end;

end.