Создание перекрестных запросов (Cross-Tab)

Firebird 2 на полную катушку
Часть 1. Создание перекрестных запросов Cross-Tab).

0.Преамбула

1. Автор не претендует на роль истины в последней инстанции. Задачи и методы их решения, изглагаемые в статье, являются следствием опыта, полученного автором при написании программ, не являются панацеей и если кто-нибудь может предложить более оптимальное решение и поделиться им с нами, автор будет только рад :) 2. Автор является сторонником движения OpenSource и исповедует один из основных лозунгов OpenSource "Знания человека принадлежат миру", и поэтому Вы вправе свободно копировать, цитировать и использовать данный текст по своему усмотрению. Никаких ограничений на данный текст, изложенные в нем материалы, алгоритмы и методики, не накладывается.

1.Введение

В практическом написании программ для работы с базами данных часто возникает необходимость в отображении данных информационной системы, основанных на выполнении перекрестных запросов (Cross-Tab) к объектам базы данных. Перекрестным запросом в данном случае мы договримся называть набор данных, основанный на выполнении запросов к нескольким объектам базы данных, когда одно из измерений запроса требуется "развернуть" из записей набора данных в столбцы. Практических примеров таких запросов можно привести достаточно много: отчет "шахматка" в бухгалтерском учете, отчет "табель выходов" в подсистеме управления персоналом, журнал-ордер "Расходы по элементам" в финансовом учете, отчет "суммарные остатки ТМЦ по местам хранения". Иными словами, это такой набор данных, строки которого являются выборкой по какому-либо объекту базы данных, столбцы - выборкой по другому объекту, а пересечение строк и столбцов содержит необходимые расчетные значения. В силу ряда причин в своей повседневной рутине автор использует Firebird SQL Server, как основную СУБД для своих программ, поэтому дальше в статье речь пойдет исключительно об этом SQL-сервере, хотя автор надеется, что данный опыт может быть натолкнет читателей на мысли о том, как применить эти методики в других СУБД. Основной проблематикой решения Croos-Tab задач в рамках SQL-серверов семейства Interbase/Firebird/Yaffil было то, что логическим решением задачи был набор данных с переменным числом столбцов. И если сформировать тривиальный запрос SELECT не составляло труда, то со сложной бизнес-логикой (например, та же "шахматка") возникали проблемы. Как решение проблем с организацией бизнес-логики в базах данных InterBase/Firebird был разработан механизм триггеров и хранимых процедур, но тут возникала следующая трудность: хранимая процедура не может иметь переменное число столбцов. Автор сам сталкивался с решением задач данного типа и повседневная практика требовала их быстрого решения. Выходы из ситуации находились, например путем "статического" написания столбцов в хранимой процедуре. И, когда менялось заполнение одного из справочников по которому делался "разворот" в Cross-Tab, требовалось хранимую процедуру переделывать. Недостаком данного подхода являлось то, что данные и логика "разворота" в CrossTab были жестко зашиты в хранимую процедуру и, несмотря на то, что справочник редко изменялся, все же иногда приходилось переделывать некоторые формы или отчеты, например в связи с открытием нового филила и, соответственно, добавлением нового места хранения ТМЦ. Один знакомый автора, тоже занимающийся разработкой СУБД на основе InterBase, нашел следующий выход: в рамках одной транзакции создавалась хранимая процедура, делалась выборка данных из хранимой процедуры, строился отчет, а затем транзакции делался откат. В результате хранимай процедура "не сохранялась". Кстати, его система работает уже несколько лет, объем данных - около 1Гб. (Эй, кто там говорил, что в InterBase нельзя играться метаданными "на лету" ?). Преимуществом данного метода является отсутствие необходимости переделывать логику или алгоритмы программы при изменении наполнения справочников. К недостаткам, пожалуй, стоит отнести то, что разработчики не рекомендуют играться с метаданными на лету. Так было до выхода Firebrid 2.0. Во второй версии этого SQL-сервера появились так называемые динамические хранимые процедуры или хранимые процедуры без имени, описываемые конструкицей языка SQL EXECUTE BLOCK. Чуть ранее в Firebird была реализована возможность инициализировать параметры хранимой процедуры перед выполнением значениями по-умолчанию. Именно об этих двух новшествах далее пойдет речь.

2.Постановка учебной задачи

Путь у нас имеется две таблицы справочники - TABL$R_TMC ("Товарно-материальные ценности") и TABL$R_PLACE ("Места хранения"), таблица регистр TABL$P_TMC_QUANT("Регистр остатков по местам хранения"). Структура таблиц и их связей представлена ниже на рисунке:

Содержание таблицы TABL$R_TMC - номенклатурные названия ТМЦ, хранящихся на складе. В таблице TABL$R_PLACE содержаться названия мест хранения ("Основной склад", "Витрина в офисе", "Производство"). Регистр остатков TABL$P_TMC_QUANT содержит записи об остатках ТМЦ в данном месте хранения. Естественно, требуется организовать автоматическое заполнение регистра остатков нулями при изменении значений справочников (добавлении новых записей), например реализовав этот механизм в триггерах таблиц справочников. Мы не будем подробно останавливаться на этом моменте. Требуется построить Corss-Tab отчет об остатках ТМЦ по местам хранения и общим остатком в следующем виде:

так как по мнению заказчика он гораздо удобнее в анализе данных.

3.Ограничения учебной задачи

При решении учебной задачи использовались: 1. Firebird SQL Server v2.0.1.12855 2. Утилита администрирования базами данных InterBase/Firebird IBExpert v2007.05.03 3. Компилятор языка Паскаль Delphi v7 4. Библиотека доступа к базам данных InterBase/Firebird InterbaseExpress, входящая в поставку компилятора Delphi 7. 5. Библиотека доступа к базам данных InterBase/Firebird FIBPlus (Demo version). 6. Библиотека EhLib, компонент TDBGridEh для отображения данных. Хотя, в принципе, подойдет и любой другой DBGrid.

4.Тривиальное решение задачи.

Под тривиальным решением мы будем понимать самый простой способ получить требуемый набор данных. Давайте рассмотрим подробнее, что нам требуется: 1) Выбрать элементы из таблицы-справочника ТМЦ; 2) Для каждого из элементов выбрать элементы со справочника "Места хранения". 3) Выбрать из регистра остатков отстаки ТМЦ в данном месте хранения. Создадим новый проект в Delphi и разместим на нем компоненты, как показано на рисунке:

Допустим, форма, изображенная на рисунке, будет называться FormMain :TFormMain = class(TForm). Компонент IBDataBase будет обеспечивать поключение к базе данных, компоненты trRead->IBQuery->DataSource->DBGridEh будут служить для отображения требуемого набора данных, компоненты TrTemp и QrTemp для временного выполнения запросов. Конечно, удобнее и правильней, создавать компоненты для временного выполнения запросов в RunTime, но мы исключим этот момент, чтобы излишне не нагромождать код. Создадим также в секции private два метода procedure RefreshFB15; и procedure RefreshFB20; которые будут формировать SQL-скрипт для выборки данных на Firebird v1.5 и v2.0 соответсвенно. В обрабочике события ButtonRefresh.OnClick мы будем вызывать один из этих методов соответсвенно. Итак, пусть у нас в распоряжении имеется Firebird версии "полтора". Получить требуемый набор данных мы можем при помощи простого оператора SELECT, где будет выбираться наимнования из справочника ТМЦ и для каждого из них будет выполняться SELECT FIRST 1 TQ.QUANT FROM TABL$P_TMC_QUANT для каждого из мест хранения. В общем виде оператор SELECT можно представить следующим образом: SELECT TMC.NAME, (SELECT FIRST 1 TQ.QUANT FROM TABL$P_TMC_QUANT TQ WHERE(TQ.TMC_ID = TMC.ID)AND(TQ.PLACE_ID = '1')) AS QUANT_1 ............ (SELECT FIRST 1 TQ.QUANT FROM TABL$P_TMC_QUANT TQ WHERE(TQ.TMC_ID = TMC.ID)AND(TQ.PLACE_ID = 'N')) AS QUANT_N FROM TABL$R_TMC TMC .... Конечно, прописывать скрипт статически не имеет смысла, так как справочник "Места хранения" может меняться с течением времени, поэтому мы будем формировать его на лету в цикле перебора элементов справочника. В добавок, есть возможность убить двух зайцев: сформировать скрипт и колонки в DBGrid-е. Ниже представлен листинг процедуры, выполняющей эти дейсвия.

procedure TFormMain.RefreshFB15;
var
  lk_Col    :TColumnEh;
  lk_sql    :string;
  lk_FldName:string;
const
  FldPrfx  = 'QNT';  // префикс названия столбцов в результирующем наборе данных;
begin
  if not IBDatabase.Connected then exit;
  // откатываем траназакцию отображения данных и соответсвенно, закрываем наборы данных
  if trRead.InTransaction then trRead.Rollback;
  // скрываем DBGridEh, чтобы не "моргал" при создании колонок
  DBGridEh.Visible    := false;
  DBGridEh.FrozenCols := 0;
  // очищаем колонки
  DBGridEh.Columns.Clear;
  // создаем первую колонку
  lk_Col               := DBGridEh.Columns.Add;
  lk_Col.Color         := DBGridEh.FixedColor;
  lk_Col.FieldName     := 'TMC_NAME';
  lk_Col.Title.Caption := 'ТМЦ|Наименование';
  lk_Col.Width         := 320;
  lk_Col.Tag           := 666;
  lk_Col.Footer.ValueType := fvtStaticText;
  lk_Col.Footer.Alignment := taLeftJustify;
  lk_Col.Footer.Value     := 'ИТОГО';
  // выполняем запрос к справочнику "места хранения"
  if TrTemp.InTransaction then TrTemp.Rollback;
  TrTemp.StartTransaction;
  QrTemp.SQL.Text := 'SELECT T.ID, T.NAME FROM TABL$R_PLACE T ';
  try
    QrTemp.Open;
  except
    DBGridEh.Visible := true;
    exit;
  end;
  // переменная lk_sql будет содержать скрипт выборки данных
  lk_sql := 'SELECT TMC.ID AS TMC_ID, TMC.NAME AS TMC_NAME '+#13#10;
  // цикл перебора элементов справочника "места хранения"
  QrTemp.First;
  while not QrTemp.Eof do
    begin
    // создаем имя "временного" столбца
    lk_FldName := FldPrfx + FormatFloat('000000', QrTemp.FieldByName('ID').AsInteger);
    // добавляем этот стобец в выборку
    lk_sql := lk_sql + '  ,(SELECT FIRST 1 TQ.QUANT FROM TABL$P_TMC_QUANT TQ WHERE(TQ.TMC_ID = '+
      'TMC.ID)AND(TQ.PLACE_ID = '''+QrTemp.FieldByName('ID').AsString+''')) AS '+lk_FldName+'  '+#13#10;
    // добавляем колоку в DBGridEh
    lk_Col               := DBGridEh.Columns.Add;
    lk_Col.FieldName     := lk_FldName;
    lk_Col.DisplayFormat := '# ### ##0';
    lk_Col.Title.Caption := 'Место хранения|'+QrTemp.FieldByName('NAME').AsString;
    lk_Col.Width         := 56;
    lk_Col.Footer.ValueType     := fvtSum;
    lk_Col.Footer.FieldName     := lk_FldName;
    lk_Col.Footer.DisplayFormat := '# ### ##0';
    lk_Col.Footer.Alignment     := taRightJustify;
    QrTemp.Next;
    end;
  // закрываем выборку по справочнику "места хранения"
  if TrTemp.InTransaction then TrTemp.Rollback;
  // добавляем в выборку столбец "ИТОГО"
  lk_FldName := FldPrfx + 'TOTAL';
  lk_sql := lk_sql+'  ,(SELECT SUM(TQ.QUANT) FROM TABL$P_TMC_QUANT TQ WHERE(TQ.TMC_ID = '+
    'TMC.ID)) AS '+lk_FldName+'  '+#13#10;
  // добавляем колонку в DBGridEh
  lk_Col               := DBGridEh.Columns.Add;
  lk_Col.Color         := DBGridEh.FixedColor;
  lk_Col.DisplayFormat := '# ### ##0';
  lk_Col.FieldName     := lk_FldName;
  lk_Col.Title.Caption := 'ИТОГО';
  lk_Col.Width         := 62;
  lk_Col.Footer.ValueType     := fvtSum;
  lk_Col.Footer.FieldName     := lk_FldName;
  lk_Col.Footer.DisplayFormat := '# ### ##0';
  lk_Col.Footer.Alignment     := taRightJustify;
  // Инициализируем скрипт выборки данных
  IBQuery.SQL.Text := lk_sql+'FROM TABL$R_TMC TMC ORDER BY TMC.NAME; ';
  DBGridEh.FrozenCols  := 1;
  // Показываем DBGridEh
  DBGridEh.Visible     := true;
  // Открываем набор данных
  if not trRead.InTransaction then
    trRead.StartTransaction;
  try
    IBQuery.Open;
  except
  end;
end;
 

В результате выполнения данного метода в объекте IBQuery в свойстве SQL будет следующий скрипт:

SELECT TMC.ID AS TMC_ID, TMC.NAME AS TMC_NAME
,(SELECT FIRST 1 TQ.QUANT FROM TABL$P_TMC_QUANT TQ WHERE(TQ.TMC_ID = TMC.ID)AND(TQ.PLACE_ID = '1')) AS QNT000001
,(SELECT FIRST 1 TQ.QUANT FROM TABL$P_TMC_QUANT TQ WHERE(TQ.TMC_ID = TMC.ID)AND(TQ.PLACE_ID = '2')) AS QNT000002
,(SELECT FIRST 1 TQ.QUANT FROM TABL$P_TMC_QUANT TQ WHERE(TQ.TMC_ID = TMC.ID)AND(TQ.PLACE_ID = '3')) AS QNT000003
,(SELECT FIRST 1 TQ.QUANT FROM TABL$P_TMC_QUANT TQ WHERE(TQ.TMC_ID = TMC.ID)AND(TQ.PLACE_ID = '4')) AS QNT000004
,(SELECT FIRST 1 TQ.QUANT FROM TABL$P_TMC_QUANT TQ WHERE(TQ.TMC_ID = TMC.ID)AND(TQ.PLACE_ID = '5')) AS QNT000005
,(SELECT SUM(TQ.QUANT) FROM TABL$P_TMC_QUANT TQ WHERE(TQ.TMC_ID = TMC.ID)) AS QNTTOTAL
FROM TABL$R_TMC TMC ORDER BY TMC.NAME;
 

При выполнении этой процедуры во время прогона программы мы получим требуемый набор данных:

Таким же образом можно создавать печатные отчеты. Например, используя генератор отчетов FastReport в цикле перебора элементов справочника "Места хранения" можно вместо колонок DBGridEh создавать компоненты TfrxMemoView и прописывать им нужные свойства. Преимущество данного метода состоит в том, что его можно использовать почти для всех версии Firebird и InterBase, поддерживающих конструкцию SELECT FIRST ... (InterBase v6.0 кажется ее не поддерживает). Метод в принципе хорош, но что делать, если выборка в Cross-Tab не является тривиальным SELECT-ом, а сопряжена с некоторой бизнес-логикой, например, как отчет "Расходы по элементам" или "Шахматка" ? Ответ, как бы, напрашивается сам: использовать хранимую процедуру. Как мы оговаривали ранее, хранимые процедуры не могут содержать переменного числа столбцов и тут на выручку приходит конструкция EXECUTE BLOCK. Синтаксис этой конструкции такой же, как и конструкции CREATE PROCEDURE <..NAME..>, но преимущество в том, что она может быть выполнена как тривиальный SELECT-запрос, и следовательно, может быть сформирована на лету. Мы не будем усложнять поставленную задачу дополнительной логикой с целью упрощения исходного кода, "усложнить" дополниетльными условиями и/или вычислениями, думаю, Вы сможете сами. Мы просто договоримся сформировать требуемый набор данных при помощи конструкции EXECUTE BLOCK. Здесь требуется сделать небольшое но важное отступление, которое касается обработки параметров запросов в компонетах Delphi. Дело в том, что в Firebird двоеточие ":" является служебным символом, служащим для передачи значений в параметры в языке хранимых процедур. В компонентах Delphi признаками параметров служат двоеточие и вопросительный знак. Поэтому, если Вы используете в IBQuery запросы конструкции EXECUTE BLOCK, Вам нужно выставить свойство у этого компонента ParamCheck := false. Ниже находится листинг процедуры RefreshFB20, формирующей набор данных на основе конструкции EXECUTE BLOCK

procedure TFormMain.RefreshFB20;
var
  lk_Col    :TColumnEh;
  lk_vars_s :string;
  lk_body_s :string;
  lk_total_s:string;
  lk_FldName:string;
const
  FldPrfx  = 'QNT';
begin
  if not IBDatabase.Connected then exit;
  if trRead.InTransaction then trRead.Rollback;
  DBGridEh.Visible    := false;
  DBGridEh.FrozenCols := 0;
  DBGridEh.Columns.Clear;
  lk_Col               := DBGridEh.Columns.Add;
  lk_Col.Color         := DBGridEh.FixedColor;
  lk_Col.FieldName     := 'TMC_NAME';
  lk_Col.Title.Caption := 'Òîâàð|Íàèìåíîâàíèå';
  lk_Col.Width         := 320;
  lk_Col.Tag           := 666;
  lk_Col.Footer.ValueType := fvtStaticText;
  lk_Col.Footer.Alignment := taLeftJustify;
  lk_Col.Footer.Value     := 'ÈÃÎÃÎ';
  if TrTemp.InTransaction then TrTemp.Rollback;
  TrTemp.StartTransaction;
  QrTemp.SQL.Text := 'SELECT T.ID, T.NAME FROM TABL$R_PLACE T ';
  try
    QrTemp.Open;
  except
    DBGridEh.Visible := true;
    exit;
  end;
  lk_vars_s := '';
  lk_body_s := '';
  lk_total_s:= '';
  QrTemp.First;
  while not QrTemp.Eof do
    begin
    lk_FldName := FldPrfx + FormatFloat('000000', QrTemp.FieldByName('ID').AsInteger);
    lk_vars_s  := lk_vars_s + '  ,'+lk_FldName+' NUMERIC(15,3) '+#13#10;
    lk_body_s  := lk_body_s +'    SELECT FIRST 1 Q.QUANT FROM TABL$P_TMC_QUANT '+
      'Q WHERE (Q.TMC_ID = :TMC_ID)AND(Q.PLACE_ID = '''+
      QrTemp.FieldByName('ID').AsString+''') INTO :'+lk_FldName+'; '+#13#10;
    lk_total_s := lk_total_s + ' + :'+lk_FldName;
    lk_Col               := DBGridEh.Columns.Add;
    lk_Col.FieldName     := lk_FldName;
    lk_Col.DisplayFormat := '# ### ##0';
    lk_Col.Title.Caption := 'Ìåñòà õðàíåíèÿ|'+QrTemp.FieldByName('NAME').AsString;
    lk_Col.Width         := 56;
    lk_Col.Footer.ValueType     := fvtSum;
    lk_Col.Footer.FieldName     := lk_FldName;
    lk_Col.Footer.DisplayFormat := '# ### ##0';
    lk_Col.Footer.Alignment     := taRightJustify;
    QrTemp.Next;
    end;
  if TrTemp.InTransaction then TrTemp.Rollback;
  lk_FldName := FldPrfx + 'TOTAL';
  lk_vars_s  := lk_vars_s + '  ,'+lk_FldName+' NUMERIC(15,3) '+#13#10;
  lk_body_s  := '    '+lk_FldName+' = 0;'+#13#10+
    lk_body_s + '    '+lk_FldName+' = :'+lk_FldName+lk_total_s+';'+#13#10;
  lk_Col               := DBGridEh.Columns.Add;
  lk_Col.Color         := DBGridEh.FixedColor;
  lk_Col.DisplayFormat := '# ### ##0';
  lk_Col.FieldName     := lk_FldName;
  lk_Col.Title.Caption := 'Èòîãî';
  lk_Col.Width         := 62;
  lk_Col.Footer.ValueType     := fvtSum;
  lk_Col.Footer.FieldName     := lk_FldName;
  lk_Col.Footer.DisplayFormat := '# ### ##0';
  lk_Col.Footer.Alignment     := taRightJustify;
  IBQuery.SQL.Text :=
    'EXECUTE BLOCK RETURNS( '+#13#10+
    '   TMC_ID   INTEGER '+#13#10+
    '  ,TMC_NAME VARCHAR(255)'+#13#10+
    lk_vars_s+
    ')AS '+#13#10+
    'BEGIN '+#13#10+
    '  FOR SELECT T.ID, T.NAME FROM TABL$R_TMC T ORDER BY T.NAME INTO :TMC_ID, :TMC_NAME DO '+#13#10+
    '    BEGIN '+#13#10+
    lk_body_s+
    '    SUSPEND;'+#13#10+
    '    END '+#13#10+
    'END ';
  DBGridEh.FrozenCols  := 1;
  DBGridEh.Visible     := true;
  if not trRead.InTransaction then
    trRead.StartTransaction;
  try
    IBQuery.Open;
  except
  end;
end;
 

В результате выполнения этой процедуры в компоненте IBQuery в свойстве SQL будет содержаться следующий скрипт:

EXECUTE BLOCK RETURNS(
TMC_ID    INTEGER
,TMC_NAME  VARCHAR(255)
  ,QNT000001 NUMERIC(15,3)
,QNT000002 NUMERIC(15,3)
,QNT000003 NUMERIC(15,3)
,QNT000004 NUMERIC(15,3)
,QNT000005 NUMERIC(15,3)
,QNTTOTAL  NUMERIC(15,3)
)AS
BEGIN
FOR SELECT T.ID, T.NAME FROM TABL$R_TMC T ORDER BY T.NAME INTO :TMC_ID, :TMC_NAME DO
BEGIN
QNTTOTAL = 0;
    SELECT FIRST 1 Q.QUANT FROM TABL$P_TMC_QUANT Q WHERE (Q.TMC_ID = :TMC_ID)AND(Q.PLACE_ID = '1') INTO :QNT000001;
SELECT FIRST 1 Q.QUANT FROM TABL$P_TMC_QUANT Q WHERE (Q.TMC_ID = :TMC_ID)AND(Q.PLACE_ID = '2') INTO :QNT000002;
SELECT FIRST 1 Q.QUANT FROM TABL$P_TMC_QUANT Q WHERE (Q.TMC_ID = :TMC_ID)AND(Q.PLACE_ID = '3') INTO :QNT000003;
SELECT FIRST 1 Q.QUANT FROM TABL$P_TMC_QUANT Q WHERE (Q.TMC_ID = :TMC_ID)AND(Q.PLACE_ID = '4') INTO :QNT000004;
SELECT FIRST 1 Q.QUANT FROM TABL$P_TMC_QUANT Q WHERE (Q.TMC_ID = :TMC_ID)AND(Q.PLACE_ID = '5') INTO :QNT000005;
QNTTOTAL = :QNTTOTAL + :QNT000001 + :QNT000002 + :QNT000003 + :QNT000004 + :QNT000005;
    SUSPEND;
    END
END
 

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

5.Усложняем посталенную задачу.

Чтобы продемонстрировать еще одну возможность Cross-Tab наборов данных, зададимся целью сделать редактируемый набор данных таким образом, чтобы была возможность редактировать остатки прямо в этой форме. Стоит сказать, конечно, что на практике нельзя давать возможность пользователям редактировать остатки вручную, изменения в регистре остатков должны производится только триггерами при проведении/распроведении соотвествующих документов, которые влияют на остатки. Но для демонстрации такая постановка задачи вполне подойдет. Для того, чтобы сделать редактируемый набор данных, основанный на выборке из нескольких таблиц, обычно пользуются компонентом TIBDataSet, и в часности его свойствами SelectSQL, RefreshSQL и UpdateSQL. Сразу возникает следующий вопрос: если с выборкой данных нет проблем (предыдущий пример), то для изменения данных требуется выполнить сразу несколько SQL-операторов UPDATE, что нельзя выполнить в рамках одного скрипта. Логически напрашивается вывод о необходимости использования хранимой процедуры, в которую в качестве параметров мы будем передвать новые значения полей Cross-Tab. Хранимую процедуру создавать незачем, мы можем сформировать ее на лету так же, как и процедуру выборки данных через конструкцию EXECUTE BLOCK. Возникает вторая проблема, которая поднималась всколзь ранее: обработка параметров запросов в Firebird и в компонентах Delphi, связанная с двоеточием. Общий смысл проблемы состоит в том, что в хранимой процедуре можно инициализировать значения параметров по-умолчанию, чем можно воспользоваться для передачи значений параметров в конструкцию EXECUTE BLOCK в виде PARAM_1 INTEGER = ?Q_PARAM_1, плюс к этому ко всему внутри процедуры мы можем обращаться к значениям параметров через двоеточие, и тут делфячий парсер начинает путаться: где параметры запроса, а где обращение внутри процедуры. Более подробно данная проблема описана в документации к SQL-серверу Firebird ($firebird)/doc/sql.extensions/README.execute_block.txt, в часности здесь сказано, что препроцессор языка SQL клиентского приложения в случае с конструкцией EXECUTE BLOCK должен парсить скрипт только в секции параметров, и "не залазить" в тело процедуры. В общем, Interbase Express для решения данного класса задач не совсем подходит. В принципе, данную проблему можно решить, внеся исправления в исходный код IBX, но я предлагаю четателю не заниматься мазохизмом, в отличие от автора :), а воспользоваться готовым решением от компании DevRace в виде библиотеки FIBPlus, которая поддерживает спецификацию языка SQL для Firebird версии 2 и выше. Скачать демонстрационную версию библиотеки можно с их сайта. Создадим новый проект в Delphi и разместим на нем компоненты, как показано на рисунке:

Назначение компонент, расположенных на главной форме приложения, то же, что и у предыдущего примера. Отличие состоит только в том, что вместо тривиального запроса и компонента IBQuery мы используем компонент pFIBDataSet, чтобы сделать живой набор данных. Также, этот компонент имеет две транзакции trRead и trWrite для чтения и записи соответственно, что позволяет использовать функциональные особенности Firebird в обработке транзакций чтения и транзакций записи в полную силу. Второе, на чем автор хочет остановить внимание, это свойство SQLs компонента pFIBDataSet, которое содержит SQL-скрипты выборки, обновления, изменения и удаления записи. Вот именно эти скрипты мы будем формировать программно. Алгоритм формирования этих свойств в принципе тот же, только мы будем в одном цикле формировать сразу несколько скриптов. Ниже приведен исходный код процедуры Refresh, которую мы будем вызывать в обработчике события ButtonRefresh.OnClick.

procedure TFormMain.RefreshView;
var
  lk_Col    :TColumnEh;
  lk_vars_s :string;
  lk_body_s :string;
  lk_total_s:string;
  lk_vars_u :string;
  lk_body_u :string;
  lk_FldName:string;
const
  FldPrfx  = 'QNT';
begin
  if not FIBDatabase.Connected then exit;
  if trRead.InTransaction then trRead.Rollback;
  DBGridEh.Visible    := false;
  DBGridEh.FrozenCols := 0;
  DBGridEh.Columns.Clear;
  lk_Col               := DBGridEh.Columns.Add;
  lk_Col.Color         := DBGridEh.FixedColor;
  lk_Col.FieldName     := 'TMC_NAME';
  lk_Col.Title.Caption := 'ТМЦ|Наименование';
  lk_Col.Width         := 320;
  lk_Col.Tag           := 666;
  lk_Col.Footer.ValueType := fvtStaticText;
  lk_Col.Footer.Alignment := taLeftJustify;
  lk_Col.Footer.Value     := 'ИТОГО';
  if TrTemp.InTransaction then TrTemp.Rollback;
  TrTemp.StartTransaction;
  QrTemp.SQL.Text := 'SELECT T.ID, T.NAME FROM TABL$R_PLACE T ';
  try
    QrTemp.ExecQuery;
  except
    DBGridEh.Visible := true;
    exit;
  end;
  lk_vars_s := '';
  lk_body_s := '';
  lk_total_s:= '';
  lk_vars_u := '';
  lk_body_u := '';
  while not QrTemp.Eof do
    begin
    lk_FldName := FldPrfx + FormatFloat('000000', QrTemp.FN('ID').AsInteger);
    lk_vars_s  := lk_vars_s + '  ,'+lk_FldName+' NUMERIC(15,3) '+#13#10;
    lk_body_s  := lk_body_s +'    SELECT FIRST 1 Q.QUANT FROM TABL$P_TMC_QUANT '+
      'Q WHERE (Q.TMC_ID = :TMC_ID)AND(Q.PLACE_ID = '''+
      QrTemp.FN('ID').AsString+''') INTO :'+lk_FldName+'; '+#13#10;
    lk_vars_u  := lk_vars_u + '  ,Q_'+lk_FldName+' NUMERIC(15,3) = ?'+lk_FldName+' '+#13#10;
    lk_body_u  := lk_body_u +
      '  UPDATE TABL$P_TMC_QUANT QNT SET '+#13#10+
      '    QNT.QUANT = :Q_'+lk_FldName+' '+#13#10+
      '  WHERE (QNT.TMC_ID = :Q_TMC_ID)AND(QNT.PLACE_ID = '''+QrTemp.FN('ID').AsString+''' ); '+#13#10;
    lk_total_s := lk_total_s + ' + :'+lk_FldName;
    lk_Col               := DBGridEh.Columns.Add;
    lk_Col.FieldName     := lk_FldName;
    lk_Col.DisplayFormat := '# ### ##0';
    lk_Col.Title.Caption := 'Места хранения|'+QrTemp.FN('NAME').AsString;
    lk_Col.Width         := 56;
    lk_Col.Footer.ValueType     := fvtSum;
    lk_Col.Footer.FieldName     := lk_FldName;
    lk_Col.Footer.DisplayFormat := '# ### ##0';
    lk_Col.Footer.Alignment     := taRightJustify;
    QrTemp.Next;
    end;
  if TrTemp.InTransaction then TrTemp.Rollback;
  lk_FldName := FldPrfx + 'TOTAL';
  lk_vars_s  := lk_vars_s + '  ,'+lk_FldName+' NUMERIC(15,3) '+#13#10;
  lk_body_s  := '    '+lk_FldName+' = 0;'+#13#10+
    lk_body_s + '    '+lk_FldName+' = :'+lk_FldName+lk_total_s+';'+#13#10;
  lk_Col               := DBGridEh.Columns.Add;
  lk_Col.Color         := DBGridEh.FixedColor;
  lk_Col.DisplayFormat := '# ### ##0';
  lk_Col.FieldName     := lk_FldName;
  lk_Col.Title.Caption := 'ИТОГО';
  lk_Col.Width         := 62;
  lk_Col.Footer.ValueType     := fvtSum;
  lk_Col.Footer.FieldName     := lk_FldName;
  lk_Col.Footer.DisplayFormat := '# ### ##0';
  lk_Col.Footer.Alignment     := taRightJustify;
  pFIBDataSet.SQLs.SelectSQL.Text :=
    'EXECUTE BLOCK RETURNS( '+#13#10+
    '   TMC_ID   INTEGER '+#13#10+
    '  ,TMC_NAME VARCHAR(255)'+#13#10+
    lk_vars_s+
    ')AS '+#13#10+
    'BEGIN '+#13#10+
    '  FOR SELECT T.ID, T.NAME FROM TABL$R_TMC T ORDER BY T.NAME INTO :TMC_ID, :TMC_NAME DO '+#13#10+
    '    BEGIN '+#13#10+
    lk_body_s+
    '    SUSPEND;'+#13#10+
    '    END '+#13#10+
    'END ';
  pFIBDataSet.SQLs.RefreshSQL.Text :=
    'EXECUTE BLOCK ( '+#13#10+
    '  Q_TMC_ID INTEGER = ?TMC_ID '+#13#10+
    ')RETURNS( '+#13#10+
    '   TMC_ID   INTEGER '+#13#10+
    '  ,TMC_NAME VARCHAR(255)'+#13#10+
    lk_vars_s+
    ')AS '+#13#10+
    'BEGIN '+#13#10+
    '  TMC_ID = :Q_TMC_ID; '+#13#10+
    '  SELECT FIRST 1 T.NAME FROM TABL$R_TMC T WHERE(T.ID = :TMC_ID) INTO :TMC_NAME; '+#13#10+
    lk_body_s+
    '  SUSPEND;'+#13#10+
    'END ';
  pFIBDataSet.SQLs.UpdateSQL.Text :=
    'EXECUTE BLOCK ( '+#13#10+
    '  Q_TMC_ID INTEGER = ?TMC_ID '+#13#10+
    lk_vars_u+
    ')AS '+#13#10+
    'BEGIN '+#13#10+
    lk_body_u+
    'END ';
  if not trRead.InTransaction then
    trRead.StartTransaction;
  try
    pFIBDataSet.Open;
  except
  end;
  DBGridEh.FrozenCols  := 1;
  DBGridEh.Visible     := true;
end;
 

В результате выполнения этой процедуры, в свойство pFIBDataSet.SQLs будут помещены следующие скрипты:

--------------------------------------------------------------------------------
--- pFIBDataSet.SQLs.SelectSQL.Text
EXECUTE BLOCK RETURNS(
TMC_ID   INTEGER
,TMC_NAME VARCHAR(255)
  ,QNT000001 NUMERIC(15,3)
,QNT000002 NUMERIC(15,3)
,QNT000003 NUMERIC(15,3)
,QNT000004 NUMERIC(15,3)
,QNT000005 NUMERIC(15,3)
,QNTTOTAL NUMERIC(15,3)
)AS
BEGIN
FOR SELECT T.ID, T.NAME FROM TABL$R_TMC T ORDER BY T.NAME INTO :TMC_ID, :TMC_NAME DO
BEGIN
QNTTOTAL = 0;
    SELECT FIRST 1 Q.QUANT FROM TABL$P_TMC_QUANT Q WHERE (Q.TMC_ID = :TMC_ID)AND(Q.PLACE_ID = '1') INTO :QNT000001;
SELECT FIRST 1 Q.QUANT FROM TABL$P_TMC_QUANT Q WHERE (Q.TMC_ID = :TMC_ID)AND(Q.PLACE_ID = '2') INTO :QNT000002;
SELECT FIRST 1 Q.QUANT FROM TABL$P_TMC_QUANT Q WHERE (Q.TMC_ID = :TMC_ID)AND(Q.PLACE_ID = '3') INTO :QNT000003;
SELECT FIRST 1 Q.QUANT FROM TABL$P_TMC_QUANT Q WHERE (Q.TMC_ID = :TMC_ID)AND(Q.PLACE_ID = '4') INTO :QNT000004;
SELECT FIRST 1 Q.QUANT FROM TABL$P_TMC_QUANT Q WHERE (Q.TMC_ID = :TMC_ID)AND(Q.PLACE_ID = '5') INTO :QNT000005;
QNTTOTAL = :QNTTOTAL + :QNT000001 + :QNT000002 + :QNT000003 + :QNT000004 + :QNT000005;
    SUSPEND;
    END
END
--------------------------------------------------------------------------------
--- pFIBDataSet.SQLs.RefreshSQL.Text
EXECUTE BLOCK (
Q_TMC_ID   INTEGER = ?TMC_ID
)RETURNS(
TMC_ID    INTEGER
,TMC_NAME  VARCHAR(255)
  ,QNT000001 NUMERIC(15,3)
,QNT000002 NUMERIC(15,3)
,QNT000003 NUMERIC(15,3)
,QNT000004 NUMERIC(15,3)
,QNT000005 NUMERIC(15,3)
,QNTTOTAL  NUMERIC(15,3)
)AS
BEGIN
TMC_ID = :Q_TMC_ID;
SELECT FIRST 1 T.NAME FROM TABL$R_TMC T WHERE(T.ID = :TMC_ID) INTO :TMC_NAME;
QNTTOTAL = 0;
    SELECT FIRST 1 Q.QUANT FROM TABL$P_TMC_QUANT Q WHERE (Q.TMC_ID = :TMC_ID)AND(Q.PLACE_ID = '1') INTO :QNT000001;
SELECT FIRST 1 Q.QUANT FROM TABL$P_TMC_QUANT Q WHERE (Q.TMC_ID = :TMC_ID)AND(Q.PLACE_ID = '2') INTO :QNT000002;
SELECT FIRST 1 Q.QUANT FROM TABL$P_TMC_QUANT Q WHERE (Q.TMC_ID = :TMC_ID)AND(Q.PLACE_ID = '3') INTO :QNT000003;
SELECT FIRST 1 Q.QUANT FROM TABL$P_TMC_QUANT Q WHERE (Q.TMC_ID = :TMC_ID)AND(Q.PLACE_ID = '4') INTO :QNT000004;
SELECT FIRST 1 Q.QUANT FROM TABL$P_TMC_QUANT Q WHERE (Q.TMC_ID = :TMC_ID)AND(Q.PLACE_ID = '5') INTO :QNT000005;
QNTTOTAL = :QNTTOTAL + :QNT000001 + :QNT000002 + :QNT000003 + :QNT000004 + :QNT000005;
  SUSPEND;
END
--------------------------------------------------------------------------------
--- pFIBDataSet.SQLs.UpdateSQL.Text
EXECUTE BLOCK (
Q_TMC_ID    INTEGER       = ?TMC_ID
,Q_QNT000001 NUMERIC(15,3) = ?QNT000001
,Q_QNT000002 NUMERIC(15,3) = ?QNT000002
,Q_QNT000003 NUMERIC(15,3) = ?QNT000003
,Q_QNT000004 NUMERIC(15,3) = ?QNT000004
,Q_QNT000005 NUMERIC(15,3) = ?QNT000005
)AS
BEGIN
UPDATE TABL$P_TMC_QUANT QNT SET
QNT.QUANT = :Q_QNT000001
WHERE (QNT.TMC_ID = :Q_TMC_ID)AND(QNT.PLACE_ID = '1' );
UPDATE TABL$P_TMC_QUANT QNT SET
QNT.QUANT = :Q_QNT000002
WHERE (QNT.TMC_ID = :Q_TMC_ID)AND(QNT.PLACE_ID = '2' );
UPDATE TABL$P_TMC_QUANT QNT SET
QNT.QUANT = :Q_QNT000003
WHERE (QNT.TMC_ID = :Q_TMC_ID)AND(QNT.PLACE_ID = '3' );
UPDATE TABL$P_TMC_QUANT QNT SET
QNT.QUANT = :Q_QNT000004
WHERE (QNT.TMC_ID = :Q_TMC_ID)AND(QNT.PLACE_ID = '4' );
UPDATE TABL$P_TMC_QUANT QNT SET
QNT.QUANT = :Q_QNT000005
WHERE (QNT.TMC_ID = :Q_TMC_ID)AND(QNT.PLACE_ID = '5' );
END

На этапе прогона программы мы получим живой набор данных, который можно редактировать прямо в сетке. Как видно из примера, мы создали в рантайм только Update-скрипт, который позволяет производить модификацию данных. Таким же образом можно сделать Insert и Delete скрипты, которые будут осуществлять вставку и удаление записей, что мы предоставим сделать читателю самостоятельно. Область применения Cross-Tab достаточно широка и не ограничивается только "Остатками по складу". Не ограничивается эта область только очетами, иногда требуется делать макеты ввода данных для пользователей, что мы и рассмотрели в данной статье. Аналогичным образом можно сделать и "Табель выходов", который ведет начальник подразделения предприятия, отмечая выход на работу, больничные, отпускные и т.д.

5.Заключение

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