Firebird 2.0 на полную катушку
Часть 1. Создание перекрестных запросов (Cross-Tab).
0.Преамбула
1. Автор не претендует на роль истины в последней инстанции. Задачи и методы их решения,
изглагаемые в статье, являются следствием опыта, полученного автором при написании программ, не являются панацеей и если
кто-нибудь может предложить более оптимальное решение и поделиться им с нами, автор будет только рад :)
2. Автор является сторонником движения OpenSource и исповедует один из основных лозунгов OpenSource
"Знания человека принадлежат миру", и поэтому Вы вправе свободно копировать, цитировать и использовать данный
текст по своему усмотрению. Никаких ограничений на данный текст, изложенные в нем материалы, алгоритмы
и методики, не накладывается.
3. Автор выражает особую благодарность участникам форума Мастера DELPHI
за их толковые советы и поддержку в "трудные" времена, в часности Вечным Мастерам, ставивших его переодически на путь истинный. :)
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.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 := '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;
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;
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.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 будут помещены следующие скрипты:
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
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;
