    27 ГЛАВА 

    Разработка компонентов баз данных 

    В этой главе я раскрою перед вами секреты создания новых компонентов баз 
данных Delphi — как общий подход, так и отдельные нюансы. 
    Данная книга не является специальным пособием по созданию компонентов в 
среде Delphi. Этому предмету можно было бы посвятить не один том. Дэнни Торп, 
один из рецензентов настоящего издания, написал замечательную книгу по 
разработке компонентов Delphi — Delphi Component Design. Пока что это лучшая 
из известных мне книг по этому вопросу. Настоятельно рекомендую ее прочесть. 
    Для написания реальных приложений стандартного набора компонентов часто 
бывает недостаточно. Со временем вам наверняка придется написать несколько 
новых компонентов. Поэтому, несмотря на то, что данная книга не посвящена 
разработке компонентов, мы все же немного остановимся на этом вопросе. 
    Без сомнения, большинство "настоящих" приложений Delphi являются 
приложениями баз данных. Поэтому, как мне кажется, чем быстрее вы перестанете 
считать искусство создания компонентов черной магией, тем лучше. 
    В этой главе мы создадим четыре новых компонента. 
    О  ТАггауТаЫе. Наследник ТТаЫе, использующий строки и столбцы этого 
компонента в качестве массива. 
    О  TLiveQuery. Наследник ТТаЫе, обрабатывающий запросы эффективнее, чем 
это делает TQuery, поскольку использует представления таблиц, хранящиеся на сервере. 
    Q   TDBNavSearch. Заменитель компонента DBNavigator, имеющий вдобавок 
кнопку поиска. 
    Q  TZoomDlg. Диалоговое окно, позволяющее выбирать из одной таблицы 
значения, допустимые для поля другой. 
    У каждого из этих компонентов есть свои уникальные характеристики и 
"наследственность". Так, и ТАггауТаЫе, и TLiveQuery являются наследниками 
компонента ТТаЫе, но первый из них является простейшим потомком, а второй — 
более сложным. TDBNavSearch — это более мощная версия компонента TDBNavigator. 
TZoomDlg — невидимый компонент, ответственный за отображение формы на экране. 
Каждый из перечисленных компонентов имеет определенные тонкости и 
демонстрирует какие-то новые грани вопроса разработки компонентов. 

    Четыре основных правила разработки компонентов 

    Чтобы создать новый компонент Delphi, необходимо выполнить следующие 
четыре действия. 
    1.    Создать с помощью команды New Component меню Component новый класс 
компонентов, основанный на одном из классов библиотеки Visual Component 
Library (VCL) Delphi. 

    Глава 27. Разработка компонентов баз данных 515 

    2.	Добавить новые (или перекрыть унаследованные) методы и свойства нового компонента. 
    3.	Написать процедуру Register для регистрации нового компонента в палитре 
компонентов Delphi. 
    4.	Добавить компонент в палитру компонентов. 
    Новые компоненты можно создать вручную или с помощью мастера компонентов 
(Component Wizard) Delphi. Чтобы вызвать мастер, нужно воспользоваться 
командой Component^New Component. Рекомендую всегда пользоваться мастером 
Component Wizard. Единственная ситуация, когда он не сможет вам помочь — это 
размещение нескольких компонентов в одном программном модуле. 

    ТАггауТаЫе 
    ; ^nceslof type: JTTable 
    ; OassNamc    [тАпауТаЫе 
    BsWePage: I Dala Access 
    в 

    Компонент ТАггауТаЫе позволяет обращаться к записям и полям таблицы базы 
данных, как к строкам и столбцам двумерного массива. Такой доступ удобен при 
выведении информации в виде электронных таблиц. Например, можно использовать 
компонент ТАггауТаЫе совместно с компонентом Delphi 
    TStringGrid для создания собственного элемента управления DBGrid. Вместо 
того, чтобы вручную искать в наборе данных нужную запись, можно с помощью 
ТАггауТаЫе обратиться к ней, как к строке двумерного массива. Подобным образом 
можно обращаться к полям таблицы как к столбцам псевдомассива. 
    Приступая к созданию компонента ТАггауТаЫе, воспользуйтесь командой New 
Component из меню Component. Выберите в качестве родительского класс ТТаЫе, в 
строке Class Name введите имя нового класса — ТАггауТаЫе, в строке Unit file 
name — имя файла ArrayTab. Pas, а в строке Palette Page — страницу палитры 
Data Access (см. рис. 27.1). Закройте диалоговое окно, щелкнув на кнопке 
Create Unit. Мастер компонентов создаст модуль, содержащий "заготовку" 
исходного текста нового компонента (см. листинг 27.1) 

    zl 
    : Unitffe name: JD ^Program Files'xBodanrADelpbi j\Lib\AnayTable pas       
  : ,;.J Search path:   j Files^BorlandVDelpbi 3Mmpotls,eVwotk \devguide\csd3\soutce 
    ША.. 
    Can»! 
    Нф 

    Рис. 27.1. Первое диалоговое окно мастера компонентов 

    Листинг 27.1. Исходный текст нового компонента, сгенерированный мастером 
компонентов Delphi 

    unit ArrayTab; 
    interface 
    uses 
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
    Db, DBTables; type 
    ТАггауТаЫе = class (TTable) 
    private 
    { Private declarations } 
    protected 
    { Protected declarations } 
    public 
    { Public declarations } 
    published 
    {   Published  declarations   } 
    end; 
    procedure  Register; implementation procedure  Register; begin 
    RegisterComponents (' Data Access1,    [ТАггауТаЫе]); end; end. 

    Обратите внимание на процедуру Register. В качестве ее параметров указаны 
новые компоненты (в данном случае список состоит из одного компонента 
ТАггауТаЫе), а также вкладка палитры компонентов Delphi, на которой они будут 
размещены. Для того чтобы установить компонент в палитру компонентов 

516 Часть IV. Темы повышенной сложности 

    Delphi, в его откомпилированном модуле должна быть соответствующая 
процедура Register. Однако это вовсе не означает, что данная процедура должна 
содержаться в исходном тексте того же программного модуля, что и сам 
компонент. Обычно процедуры регистрации всех новых компонентов объединяют в 
общий "регистрационный модуль", который используется, чтобы добавлять их к 
палитре компонентов. Например, ряд стандартных компонентов Delphi 
зарегистрирован с помощью регистрационных модулей каталога Lib. 
    К компоненту TArrayTable нужно добавить всего одно новое свойство — 
Records. Это свойство предназначено только для чтения, доступно исключительно 
во время работы программы и предоставляет доступ к первому измерению 
двухмерного массива из записей и полей, моделируемого компонентом. 
    При добавлении к компоненту свойства обычно создаются и процедуры 
чтения/записи этого свойства, позволяющие запись и считывание значений 
свойства с использованием обычных переменных класса, а также выполнение 
дополнительного кода при изменении значения свойства или обращении к нему. 
Измените описание класса TArrayTable следующим образом. 

    TArrayTable  =  class(TTable) private 
    {   Объявления   скрытых   элементов   } 
    function  GetRecords(RecNum:   Longlnt):   TDataSet; protected 
    {   Объявления  элементов   с   ограниченным доступом   } public 
    {   Объявления  общедоступных  элементов   } 
    property  Records[RecNum:   Longint]:   TDataSet   read  GetRecords; published 
    {   Объявления  тиражируемых  элементов   } end; 

    Как видите, изменения в описании класса, потребовавшиеся для обеспечения 
интерфейса, напоминающего интерфейс обычного массива, минимальны. Прежде 
всего, обратите внимание на функцию GetRecords, добавленную в раздел скрытых 
элементов класса. Функциям чтения свойств обычно присваивают имя, состоящее из 
слова Get и имени этого свойства. Процедуре записи свойства обычно 
присваивается аналогичное имя, в котором слово Get заменено на Set. Поскольку 
данное свойство предназначается только для чтения, процедуры записи у него нет. 
    Обратите внимание на описание свойства. Records — индексное свойство, то 
есть обращение к нему происходит по индексу, как к элементу массива. Обратите 
внимание на способ установления связи между свойством Records и функцией 
GetRecords. Обращение к функции чтения происходит с помощью ключевого слова 
read, а к функции записи — с помощью ключевого слова write. Индекс, 
определенный при ссылке на свойство Records, передается непосредственно к 
функции чтения GetRecords, которая использует его для доступа к нужной записи. 
    Обратите внимание на тип данных свойства Records — TDataSet. Было бы 
логичней, скажете вы, присвоить им тип TRecord. Но потерпите немного, скоро вы 
все поймете. 
    Теперь, изменив описание класса, мы готовы создать функцию GetRecords. Она 
должна вызываться каждый раз, когда в ходе работы нужно сослаться на свойство 
Records. Внесите в раздел Implementation компонента следующее определение 
функции GetRecords: 

    Function  TArrayTable.GetRecords(RecNum   :   Logint)    :   TDataSet; begin 
    First; 
    MoveBy(RecNum); 
    Result:=Self; end; 

    Обратите внимание на тип значения, возвращаемого функцией GetRecords. 
Подобно свойству Records, которое она обслуживает, эта функция возвращает 
результат типа TDataSet. Почему? Потому что компоненты Delphi TField не 
содержатся внутри классов записей любого типа. Следовательно, наборы данных 
Delphi не состоят из классов TRecord, к которым необходимо обращаться за 
информацией на уровне поля. Напротив, к компонентам TField можно обратиться 
непосредственно из DataSet с помощью свойства Fields. Это свойство также 
является индексным. Вместе со свойством Records оно образует основу интерфейса 
массива для набора данных DataSet, предоставляемому разрабатываемым компонентом. 
    Обратите внимание на код, выполняемый всякий раз при запросе свойства 
Records. Это свойство передает номер записи, необходимый для функции 
GetRecords, затем делает следующее. 

    Глава 27. Разработка компонентов баз данных 517 

    1.	Переходит к первой записи DataSet. 
    2.	Передвигается на количество строк от начала DataSet, равное номеру 
требуемой записи. 
    3.	Возвращает в качестве результата указатель на ТАггауТаЫе. 
    Переместив текущую позицию таблицы и возвратив указатель непосредственно 
на DataSet, компонент ТАггауТаЫе делает возможным обращение к любому из полей 
таблицы следующим образом: 
    X:=ArrayTablel.Records[4].Fields[2].Value; 
    Замечаете сходство с массивом? Компонент ТАггауТаЫе позволяет обратиться к 
любому столбцу в любой строке таблицы так, как будто это элемент массива. 
    Вот, практически, и все, что касается компонента ТАггауТаЫе. Полный 
исходный код нового компонента содержится в листинге 27.2. 

    Листинг 27.2. Полный исходный код компонента ТАггауТаЫе 

    { 
    Компонент АггауТаЫе. 
    Предназначен для создания интерфейса таблицы, подобного массиву. 
    Синтаксис для обращения к нужному полю: 
    Records[RecNum].Fields[FieldNum].AsType 
    Автор — Кен Хендерсон. 
    Copyright (с) 1995 by Ken Henderson. } unit ArrayTable; 
    interface 
    uses 
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
Db, DBTables; 
    type 
    ТАггауТаЫе = class (TTable) private 
    { Объявления скрытых элементов } 
    function GetRecords(RecNum: Longlnt): TDataSet; protected 
    { Объявления элементов с ограниченным доступом } public 
    { Объявления общедоступных элементов ) 
    property Records[RecNum: Longint]: TDataSet read GetRecords; published 
    { Объявления тиражируемых элементов } end; 
    procedure Register; implementation 
    function ТАггауТаЫе'. GetRecords (RecNum: Longint): TDataSet; begin 
    First; 
    MoveBy(RecNum); 
    Result := Self; end; 
    procedure Register; begin 
    RegisterComponents('Data Access', [ТАггауТаЫе]); end; 
    end. 

    518	Часть IV. Темы повышенной сложности 

    Теперь, когда компонент готов, его можно установить в палитру компонентов 
Delphi. Сохраните работу, затем выберите из меню Component команду Install 
Components. В появившемся диалоговом окне Install Component введите полный 
путь к файлу модуля ArrayTab. Pas, который был создан в строке Unit filename 
первого диалогового окна мастера компонентов. Для установки нового компонента 
щелкните на кнопке ОК. Диалоговое окно Install Component показано на рис. 27.2. 

    ... Jnto exiting package | : Onft fife name: Search path; - Package ffe 
name: ; Package iJe$Cfip*iorL	inlo new package j                               
          "fTi "^1::1^Щ^Я''!|||.|:в\К1::::^ 
    JDAProgram Files\Borland\Delphi 3\Lib\ArrayTab.pas                  
gfowse...    j 
    | D \Ptogram Files\BorlandVDelphi SSImpoits.e Wrk^devguideScsd3\source 
    JD VProgiam Files\Borland\Delphi 3\Lib\CSD3.dpk          _-^J       
Browse...    j 
    jOent/tarvfflt Devefoper*s Quide wtei DelpN 3 Examples |[  """1ж"""1|      
 Cancel     |         НеФ       | 
    
    
    
    
    Рис. 27.2. Добавление нового компонента к палитре компонентов Delphi в 
диалоговом окне Install Components 

    После щелчка на кнопке OK, Delphi предложит вам перестроить пакет (по 
умолчанию — DCLUSR30). Щелкните на кнопке Yes, в результате "чего новый 
компонент будет добавлен в пакет. Если для работы вашего пакета требуются 
другие пакеты, на экране может появиться сообщение с предложением включить 
новый компонент и в них. Щелкните и в этом случае на кнопке Yes. После 
установки нового компонента на экране останется активным окно Delphi Package 
Manager. Закройте его и щелкните на кнопке Yes, когда система предложит вам 
сохранить изменения в пакете. 

    Использование нового компонента в приложениях 

    После того, как компонент добавлен в палитру компонентов Delphi, его можно 
использовать в приложениях. Выберите в меню File команду New Application. 
Затем щелкните на вкладке Data Access в палитре компонентов и выберите 
компонент АггауТаЫе. Он должен быть крайним справа и иметь ту же пиктограмму, 
что и компонент Table. Поместите компонент АггауТаЫе на форму. Обратите 
внимание, что в окне Object Inspector он имеет те же свойства, что и компонент 
Table. Это объясняется тем, что новый компонент является наследником класса 
компонентов Table и не имеет новых тиражируемых (published) свойств, отличных 
от свойств компонента Table. (В окне Object Inspector перечисляются только 
такие свойства.) Затем поместите на форму кнопку и компонент stringGrid. 
Дважды щелкните на кнопке и измените ее обработчик событий следующим образом. 

    procedure  TForml.ButtonClick(Sender   :   TObject); var 
    Rcount,   Fcount   :   Integer; begin 
    With_ArrayTablel,   StringGridl  do begin Colco'unt :=Succ(FieldCount); 
RowCount:=Succ(RecordCount); Cells [0,0] :=TableName; For   FCount:=0   to   
Pred(FieldCount)   do 
    Cells[Succ(FCount),0]:=Fields[FCount].FieldName; For  RCount:=l   to  
RecordCount  do 
    For   FCount:=0   to   Pred(FieldCount)   do Cells[Succ(FCount),RCount]:= 
    Records[RCount].Fields[FCount].asString; end; end; 

    Как уже упоминалось, совместное применение компонентов АггауТаЫе и 
StringGrid позволяет вполне убедительно имитировать элемент управления DBGrid, 
используемый только для чтения. 

    Глава 27. Разработка компонентов баз данных 519 

    Рассмотрим более подробно приведенный программный фрагмент. В первую 
очередь отметим следующие операторы присваивания в начале процедуры. 

    ColCount:=Succ(FieldCount); RowCount:=Succ(RecordCount) ; 

    ColCount и RowCount — свойства компонента StringGrid. Присваивая им 
значения соответственно свойств FieldCount и RecordCount компонента АггауТаЫе, 
мы определяем размер сетки, достаточный для отображения всех строк и столбцов 
таблицы. Обратите внимание на использование функций Succ (FieldCount) и Succ 
(RecordCount). Они запрещают размещение данных в первой строке и первом 
столбце сетки. 

    Оператор присваивания 

    Cells[0,0]:=TableName; 

    помещает имя таблицы АггауТаЫе в верхнем левом углу сетки. Первый цикл 

    For  FCount:=0   to   Pred(FieldCount)   do 
    Cells[Succ(FCount),0]:=Fields[FCount].FieldName; 

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

    For  RCount:=l   to  RecordCount   do 
    For  FCount:=0   to   Pred(FieldCount)   do Cells[Succ(FCount),RCount]:= 
    Records[RCount].Fields[FCount].asString; 

    для ссылки на значения таблицы в порядке номеров используются свойства 
псевдомассива ТАггауТаЫе. 
    Чтобы иметь возможность изменять размеры или менять местами столбцы во 
время работы приложения, щелкните на компоненте stringGrid и измените 
положение переключателей goColsizing и goColMoving на True. 
    Теперь, когда исходный текст обработчика события OnClick компонента Button 
готов, осталось определить основные свойства компонента АггауТаЫе. Щелкните на 
компоненте АггауТаЫе в окне конструктора форм и определите его свойства 
DatabaseName и TableName так, чтобы они указывали на допустимую комбинацию 
базы данных и таблицы. Например, можно сослаться на базу данных RENTMAN и 
таблицу из части "Учебный курс" этой книги. Затем откройте свойство Active 
компонента АггауТаЫе, дважды щелкнув на нем. Наконец, сохраните плоды своих 
трудов и запустите приложение. Оно должно работать так, как показано на рис. 27.3. 
    Если щелкнуть на кнопке, сетка заполнится данными и будет выглядеть, как 
элемент управления DBGrid, свойство которого Readonly имеет значение True. 
    Рис. 27.3. Совместное использование компонента АггауТаЫе с компонентом 
StringGrid позволяет имитировать компонент DBGrid 

    TLiveQuery 

    Класс компонента TLiveQuery реализует функциональность активных запросов 
(live query) Delphi. Активные, или обновляемые, запросы обычно создаются в 
Delphi путем переключения свойства RequestLive компонента Query в положение 
True. Используемый компонентом оператор SQL должен подчиняться ограничениям, 
налагаемым Delphi на активные запросы. Компонент LiveQuery обходит эти 

    520 Часть IV. Темы повышенной сложности 

    ограничения, превращая определенный вами оператор SQL в хранящееся на 
сервере представление таблицы, открывающееся подобно обычной таблице. Если ваш 
сервер позволяет модифицировать представления, вы сможете обновлять набор 
данных, возвращаемый компонентом LiveQuery. 
    Поскольку LiveQuery создает собственное представление, используя команду 
SQL CREATE VIEW, то ваша СУБД должна поддерживать этот оператор. Другими 
словами, вы не сможете использовать TLiveQuery в локальных СУБД, таких как 
dBASE или Paradox. Однако здесь есть и положительные стороны: все типы 
обновляемых представлений, которые поддерживаются вашим сервером, 
поддерживаются также и компонентом TLiveQuery. 
    Компонент LiveQuery перекладывает ответственность за декомпозицию сложных 
запросов с приложения на могучие плечи сервера, который, по моему мнению, и 
должен этим заниматься. Поскольку лучшие эксперты по части диалектов SQL — их 
фирмы-производители, лучше всего будет позволять их детищам самим 
анализировать свои запросы. Чтобы ассоциировать возвращаемый набор данных с 
обновляемым запросом, необходимо просмотреть его столбцы. Каждый столбец 
возвращаемого набора данных должен быть урезан до настоящего имени таблицы и 
столбца, из которых он был взят. Необходимо тщательно сформулировать критерий 
отбора возвращаемого набора данных. Следует не только обновить нужные столбцы 
таблицы, но и экстраполировать соответствующие записи. Это довольно трудно 
сделать в случае сложных запросов, содержащих вычисляемые столбцы, 
многоуровневые объединения и сложные определения с использованием ключевых 
слов WHERE и HAVING. Вот пускай сервер и занимается этим гаданием на кофейной 
гуще. Он-то лучше всех знает свой диалект SQL и объекты базы данных. 
    Начнем с создания нового компонента, называемого TLiveQuery, порожденного 
от класса ТТаЫе. Разместите его на вкладке DataAccess, как и компонент 
АггауТаЫе. Введите в строке Unit filename имя файла, в котором хранится его 
код — LiveQry.PAS — и щелкните на кнопке Create Unit. Новый компонент 
откроется в редакторе исходного текста Delphi. 
    В сгенерированный исходный текст придется внести несколько незначительных 
изменений. Мы добавим в него четыре дополнительных тиражируемых свойства с 
поддерживающими их кодом и переменными. Эти изменения в коде класса содержатся 
в листинге 27.3. 

    Листинг 27.3. Определение класса компонента LiveQuery 

    TLiveQuery = class (ТТаЫе) private 
    { Private declarations } 
    FCreateViewSQL : String; 
    FDropViewSQL : String; 
    FTableNameFormat : TFileName; 
    FSQL : TStrings; 
    procedure SetQuery(Value: TStrings); protected 
    { Protected declarations } 
    procedure CreateTemporaryView; 
    procedure DropTemporaryView; 
    procedure DoBeforeOpen; override; 
    procedure DoAfterClose; override; public 
    { Public declarations } 
    constructor Create(AOwner: TComponent); override; 
    destructor Destroy; override; published 
    { Published declarations } 
    property CreateViewSQL : String read FCreateViewSQL write FCreateViewSQL; 
    property DropViewSQL : String read  FDropViewSQL write FDropViewSQL; 
    property SQL : TStrings read FSQL write SetQuery; 
    property TableNameFormat : 
    TFileName read FTableNameFormat write FTableNameFormat; end; 

    Перед определением класса необходимо определить следующие константы, 
используемые компонентом: 

    const 
    DEFAULTCREATIVEVIEWSQL = 'CREATE VIEW %s AS1; DEFAULTDROPVIEWSQL = 'DROP 
VIEW %s'; DEFAULTTABLENAMEFORMAT = 'TV%s'; 

    Глава 27. Разработка компонентов баз данных 521 

    Эти константы нельзя использовать в заголовке определения класса 
TLiveQuery, поскольку для определения используемых по умолчанию значений 
свойств в Delphi допускаются только целые константы или множества. Таким 
образом, если бы теоретически было возможно определить значение свойства 
TableNameFormat по умолчанию, скажем, следующим образом 
    property TableNameFormat   :   TFileName   read  FTableNameFormat write   
FTableNameFormat   default   DEFAULTTABLENAMEFORMAT; 
    то на практике вы не смогли бы это сделать, поскольку Delphi не допускает 
использование строковых констант в качестве используемых по умолчанию значений 
свойств. Этот механизм используется самой средой Delphi для определения того, 
отличается ли данное значение свойства от принятого по умолчанию. Отличные от 
принятого по умолчанию значения записываются на диск. Присвоение используемых 
по умолчанию значений происходит при вызове конструкторе компонента. 

    СВОЙСТВО CreateViewSQL 

    Свойство CreateViewSQL используется для определения синтаксиса команды 
CREATE VIEW, поддерживаемой вашей СУБД. По умолчанию компонент использует 
ANSI-совместимый синтаксис. Обратите внимание на конструкцию %s в константе 
DEFAULTCREATEVIEWSQL. На ее место функция Format поставит имя сгенерированного 
компонентом временного представления. 

    СВОЙСТВО DropViewSQL 

    Свойство DropViewSQL — "оппонент" свойства CreateViewSQL. Оно используется 
для определения синтаксиса команды DROP VIEW, поддерживаемой вашей СУБД. Как и 
в предыдущем случае, в константе DEFAULTDROPVIEWSQL используется конструкция 
%s, вместо которой функция Format поставит имя сгенерированного компонентом 
временного представления. 

    СВОЙСТВО TableNameFormat 

    Свойство TableNameFormat позволяет определить любой специальный формат 
имени представления в соответствии с требованиями СУБД. Некоторые системы 
требуют, чтобы каждой ссылке на объект предшествовало имя его 
объекта-владельца. Если ваш сервер баз данных предъявляет такие требования, 
можете воспользоваться свойством TableNameFormat для определения необходимого формата. 
    После ввода заголовка класса нужно заполнить его тело. Полная реализация 
компонента LiveQuery содержится в листинге 27.4. 

    Листинг 27.4. Тело компонента LiveQuery 

    constructor TLiveQuery.Create(AOwner: TComponent); begin 
    inherited Create(AOwner); 
    FSQL := TStringList.Create; 
    FCreateViewSQL := DEFAULTCREATEVIEWSQL; 
    FDropViewSQL := DEFAULTDROPVIEWSQL; 
    FTableNameFormat := DEFAULTTABLENAMEFORMAT; end; 
    destructor TLiveQuery.Destroy; begin 
    if Active then begin Close; 
    DropTemporaryView; end; 
    SQL.Free; 
    inherited Destroy; end; 
    procedure TLiveQuery.SetQuery(Value: TStrings); begin 
    ChecklnActive; 
    SQL.Assign(Value); 

    522	Часть IV. Темы повышенной сложности 

    end; 
    procedure TLiveQuery.CreateTemporaryView; var 
    TemporaryDB : TDatabase; WorkSQL : TStrings; begin 
    WorkSQL := TStringList.Create; WorkSQL.AddStrings(SQL); 
    TableName:=Format(TableNameFormat, [FormatDateTime('yyromddhhnnss',Now)]); 
WorkSQL.Insert(0,Format(CreateViewSQL, [TableName])); 
TemporaryDB:=Session.OpenDatabase(DatabaseName); if (TemporaryDBOnil) then try 
    if (TemporaryDB.IsSQLBased) then begin 
    if (DbiQExecDirect(TemporaryDB.Handle, qrylangSQL, 
    " "	PChar(WorkSQL.Text),nil)<>DBIERR_NONE) then raise 
EDatabaseError.Create('Error creating temporary view'); end else 
    raise EDatabaseError.Create ( 
    'Cannot use this component with local tables'); finally 
    Session.CloseDatabase(TemporaryDB); WorkSQL.Free; end; end; 
    procedure TLiveQuery.DoBeforeOpen; begin 
    inherited DoBeforeOpen; 
    CreateTemporaryView; end; 
    procedure TLiveQuery.DropTemporaryView; var 
    TemporaryDB : TDatabase; WorkSQL : TStrings; begin 
    WorkSQL:=TStringList.Create; 
    WorkSQL.Add(Format(DropViewSQL, [TableName])); "" 
TemporaryDB:=Session.OpenDatabase(DatabaseName); if (TemporaryDBOnil) then 
begin try 
    if (TemporaryDB.IsSQLBased) then begin if 
(DbiQExecDirect(TemporaryDB.Handle,qrylangSQL, 
PChar(WorkSQL.Text),nil)<>DBIERR_NONE) then 
    raise EDatabaseError.Create('Error dropping temporary view'); end else 
    raise EDatabaseError.Create ('Cannot use this component with local tables' finally 
    Session.CloseDatabase(TemporaryDB); WorkSQL.Free; end; end; end; 
    procedure TLiveQuery.DoAfterClose; begin 
    DropTemporaryView; 
    inherited DoAfterClose; end; 
    procedure Register; begin 
    RegisterComponents('Data Access', [TLiveQuery]); end; 
    end. 

    Глава 27. Разработка компонентов баз данных 523 

    Конструктор 

    В этом разделе каждый элемент раздела реализации свойств компонента будет 
рассмотрен отдельно. Прежде всего обратите внимание на конструктор компонента. 

    constructor  TLiveQuery.Create(AOwner   :   TComponent); begin 
    inherited  Create(AOwner); 
    FSQL   :=  TStringList.Create; 
    FCreateViewSQL   :=  DEFAULTCREATEVIEWSQL; 
    FDropViewSQL   :=   DEFAULTDROPVIEWSQL; 
    FTableNameFormat   :=   DEFAULTTABLENAMEFORMAT; end; 

    Первое, что он делает — вызывает конструктор Create своего предка, класса 
ТТаЫе, с помощью ключевого слова inherited и передает ему в качестве параметра 
компонент AOwner: 

    inherited Create(AOwner); 

    Компонент AOwner был в свою очередь получен конструктором TLiveQuery в 
качестве параметра. 
    Затем создается экземпляр объекта TStringList, который присваивается 
скрытой переменной FSQL. Эта переменная предназначена для хранения значений 
свойства SQL, которое вы используете для определения оператора активного запроса. 
    Следующие три оператора присваивают определенные ранее строковые константы 
скрытым переменным, которые соответствуют тиражируемым свойствам компонента. 
Это значения, используемые по умолчанию. Не попадитесь на удочку наличия 
ключевого слова Default, которое можно использовать в определении класса. Это 
лишь средство, применяемое механизмом управления потоками компонентов Delphi 
для определения, изменялись ли принятые по умолчанию значения свойств. Все 
измененные значения записываются на диск. Настоящее присваивание стандартных 
значений происходит в конструкторе Create компонента. 

    Деструктор 

    Следующая процедура в реализации компонента LiveQuery — это деструктор. Он 
выглядит следующим образом: 

    destructor  TLiveQuery.Destroy; begin 
    If Active  then begin Close; 
    DropTemporaryView; end; 
    SQL.Free; 
    inherited Destroy; end; 

    Деструктор вызывается всякий раз, когда требуется уничтожить компонент. 
Сначала он закрывает открытый компонентом курсор базы данных, если он еще не 
закрыт, а затем удаляет временное представление таблицы. Затем деструктор 
освобождает память, выделявшуюся для объекта TStrings свойства SQL, и вызывает 
деструктор родительского класса ТТаЫе. На этом работа деструктора заканчивается. 

    Процедура SetQuery 

    Следующая процедура — типичная процедура вида Set. .., используемая для 
присвоения значения свойству SQL. Выглядит она так. 

    procedure  TLiveQuery.SetQuery(Value   :   TStrings); begin 
    ChecklnActive; 
    SQL.Assign(Value); end; 

    524	Часть IV. Темы повышенной сложности 

    Первое, что делает SetQuery, — вызывает унаследованную от родительского 
класса процедуру ChecklnActive. Это гарантирует, что набор данных будет 
неактивным перед внесением в него изменений, которые могли бы повлиять на 
связь данных. Если во время этой операции компонент будет активен, может 
возникнуть исключительная ситуация, что приведет к аварийному завершению операции. 
    Второе и последнее действие процедуры SetQuery — вызов метода Assign 
свойства SQL. Этот метод .класса TStrings копирует содержимое одного объекта 
этого класса в другой. В данном случае копируется значение, указанное в 
качестве значения свойства SQL в окне свойств и событий Delphi. 

    Процедура CreateTemporaryView 

    Следующий метод в реализации компонента LiveQuery называется 
CreateTemporaryView. Эта процедура делает именно то, что можно предположить, 
судя по ее названию: создает на сервере временное представление, которое затем 
и становится набором данных для компонента LiveQuery. Представление является 
временным, потому что оно удаляется после закрытия или уничтожения компонента. 
Рассмотрим исходный текст процедуры CreateTemporaryView. 

    procedure  TLiveQuery.CreateTemporaryView; var 
    TemporaryDB   :   TDataBase; WorkSQL   :   TStrings; begin 
    WorkSQL   :   TStringList.Create/Try 
    WorkSQL.AddStrings(SQL) ; TableName:=Format(TableNameFormat, 
    [FormatDateTime('yymmddhhnnss',Now)]); 
WorkSQL.Insert(0,Format(CreateViewSQL,[TableName])); 
TemporaryDB:=Session.OpenDatabase(DatabaseName); try 
    If   (TemporaryDBOnil)   then  begin If   (TemporaryDB.IsSQLBased)   then 
begin If   (DbiQExecDirect(TemporaryDB.Handle, grylangSQL,Pchar(WorkSQL.Text), 
nil)ODBIERR_NONE)    then raise  EDatabaseError.Create( 'Error   creating   
temporary  view1); end else 
    raise  EDatabaseError.Create ( 
    'Cannot  use   this   component  with  local   tables'); end; finally 
    Session.CloseDatabase(TemporaryDB); end; finally 
    WorkSQL.Free; end; end; 

    Здесь есть несколько любопытных моментов. Во-первых, обратите внимание, 
что процедура CreateTemporaryView создает временную область WorkSQL для 
манипулирования запросом, содержащимся в свойстве SQL. Область WorkSQL 
создается в начале процедуры, а блоки Try. . .Finally гарантируют ее 
уничтожение в конце работы. 
    '   ""Цалёе, с помощью функции Format процедура CreateTemporaryView 
присваивает унаследованному от родительского класса свойству TableName 
значение определенного в компоненте свойства TableNameFormat, а также текущую 
дату и время. К сожалению, в компоненте LiveQuery унаследованное свойство 
TableName остается тиражируемым. Однако, в отличие от компонента Table, здесь 
нет необходимости делать его доступным для пользователя. Причина, по которой 
TableName остается тиражируемым свойством компонента LiveQuery, заключается в 
том, что Delphi просто не "умеет" делать скрытыми свойства, объявленные в 
классе предка в качестве тиражируемых.	^ 
    После присвоения значения свойству TableName снова вызывается функция 
Format — на этот раз чтобы с помощью свойства CreateViewSQL поместить в начало 
запроса SQL оператор CREATE VIEW. Вот где 

    Глава 27. Разработка компонентов баз данных 525 

    проявляется вся мощь LiveQuery! Компонент просто преобразует любой запрос 
SQL в оператор CREATE VIEW, а уж сервер 
CaiU'peifiaef'1Як'ёГб'"6брабать1йа%гь.и'Та1!Шм1 образом, Необходимым условием 
является, во-первых, способность сервера поддерживать такой синтаксис. Вы 
должны иметь возможность использовать тип запроса, указанный в свойстве SQL, в 
представлениях. Во-вторых, если вы намерены обновлять представление, ваш 
сервер должен это позволять (большинство позволяет), а также разрешать 
представлениям обновление использованных вами команд SQL. Вся ответственность 
за разбиение запроса и обновление свойств строк и столбцов возлагается на 
сервер, а не на приложение или BDE. 
    Когда оператор WorkSQL создан, следующая задача — выполнить его. Поскольку 
используется потомок компонента Table, нельзя исполнить запрос 
непосредственно. Если бы LiveQuery был потомком компонента Query, у вас был бы 
доступ к процедуре ExecSQL. Однако это не так. LiveQuery получает эту 
возможность, создавая подключения к серверу баз данных, используя BDE-функцию 
DbiQExecDirrect. Только таким образом ему удается выполнить содержащийся в 
WorkSQL запрос и создать временное представление. 
    Обратите внимание на третий параметр функции DbiQExecDirect. Поскольку он 
требует передачи переменной типа PChar, можно просто использовать вместо него 
свойство Text объекта WorkSQL. Компилятор Delphi сам выполнит преобразование к 
нужному типу данных. 
    Обратите внимание на использование свойства isSQLBased временного 
компонента Database. Как уже говорилось, этот компонент не может быть 
использован в локальных, не поддерживающих представлений СУБД, таких как dBASE 
или Paradox. Таким образом, крайне необходимо обеспечить проверку компонентом 
этого условия и в случае необходимости — обработки исключительной ситуации. 
    Процедура завершается закрытием подключения к временной базе данных и 
освобождением использованной для работы области памяти. Обратите внимание, что 
обе эти операции производятся в части finally блока try. . .finally. Помещая 
операторы в блоке finally, вы гарантируете их выполнение даже в том случае, 
если операторы, следующие за ключевым словом try, вызовут исключительную ситуацию. 

    5АТЕ     f 

    Процедура DoBef oreOpen 

    Метод DoBeforeOpen выполняет очень простую функцию: он перекрывает 
используемый по умолчанию метод DoBeforeOpen и создает временное представление 
при вызове метода компонента Open. Поскольку CreateTemporaryView также 
присваивает значение свойству компонента TableName, получается, что 
представление создается и инициализируется непосредственно перед открытием как 
обычная таблица. Обратите внимание, что первое действие процедуры DoBeforeOpen 
— вызов перекрываемой процедуры DoBeforeOpen базового класса. В результате 
перед созданием временного представления будут выполнены операторы, связанные 
пользователем с событием BeforeOpen. 

    Процедура DropTemporaryView 

    Следующая процедура в реализации компонента LiveQuery — DropTemporaryView. 
Как и следует из ее имени, она уничтожает представление, созданное методом 
CreateTemporaryView. Подобно своему антиподу CreateTemporaryView, 
DropTemporaryView использует временное подключение к базе данных и вызывает 
процедуру DbiExecDirect для выполнения запроса SQL, уничтожающего представление. 

    Процедура Do After Close 

    Процедура DoAfterClose выполняется после закрытия компонента и вызывает 
процедуру DropTemporaryView для удаления созданного ранее представления. 
Обратите внимание, что DoAfterClose использует унаследованный одноименный 
метод, выполняющий операторы, связанные пользователем с событием Af terClose. 
    Осталась нерассмотренной лишь процедура регистрации. Внимание: прежде чем 
откомпилировать файл LiveQry.PAS, необходимо добавить в его строку Uses модуль 
BDE, чтобы обеспечить прямое обращение к функциям API BDE. После окончательной 
настройки LIVEQRY.PAS можно добавить компонент TLiveQuery в палитру 
компонентов Delphi. Это делается так же, как и в случае с компонентом 
TArrayTable. Полный исходный код компонента TLiveQuery содержится в листинге 27.5. 

    526	Часть IV. Темы повышенной сложности 

    Листинг 27.5. Исходный код компонента TLiveQuery 

    Компонент LiveQuery. 

    Позволяет редактировать возвращаемый сервером набор данных путем создания 
временного представления этого набора данных. Если сервер поддерживает 
обновляемые представления, то данный компонент дает возможность пользователю, 
внося изменения в представление, изменять исходный набор данных. 

    Автор — Кен Хендерсон. 
    Copyright (с) 1995 by Ken Henderson. 

    Замечания по использованию. 

    Так как в основе данного компонента лежит применение временного 
представления, необходимо учитывать следующие факторы, которые можно отнести к негативным. 
    1). В связи с тем, что некоторые СУБД, например Sybase, не поддерживают 
временных представлений, мне пришлось вручную создавать имя такого 
представления, а также инициализировать и удалять объект представления. При 
создании имени я использую текущие дату и время, чтобы^свести до минимума 
вероятность возникновения конфликтов при совместном использовании данного 
компонента. Если вы хотите полностью обезопасить приложение от такого рода 
проблем, создайте обработчик соответствующей исключительной ситуации, в 
котором примените повторный вызов метода Open и т.п. 
    2). Для работы с этим компонентом пользователи должны иметь допуск на 
создание представлений. 
    3). Компонент можно применять только при работе с серверами, 
поддерживающими представления — для СУБД типа dBASE и Paradox он бесполезен. К 
достоинствам данного компонента можно отнести следующие особенности. 
    1). Он позволяет использовать синтаксис, поддерживаемый сервером для 
создания обновляемых представлений. 
    2) . В объединениях можно использовать как  угодно много таблиц. 
    3). В операторах SELECT допускается применение ключевых слов WHERE и 
HAVING. Как видно из всего вышесказанного, обработка генерируемых операторов 
SQL полностью возлагается на сервер, как это и должно быть в нормальных 
системах клиент/сервер. Кроме того, такой подход позволяет применить 
предварительную компиляцию операторов SQL, что повышает производительность 
приложения. Если используемый сервер не поддерживает обновляемых 
представлений, об этом вы узнаете по возникновению исключительной ситуации. 

    } 
    unit Liveqry; 
    interface 
    uses 
    SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 
Forms, Dialogs, Db, DBTables, BDE; 
    const 
    DEFAULTCREATEVIEWSQL = 'CREATE VIEW %s AS '; DEFAULTDROPVIEWSQL = 'DROP 
VIEW %s'; DEFAULTTABLENAMEFORMAT = 'TV%s'; 
    type 
    TLiveQuery = class(TTable) private 
    { Private declarations } 
    FCreateViewSQL : String; 
    FDropViewSQL : String; 
    FTableNameFormat : TFileName; 
    FSQL : TStrings; 
    procedure SetQuery(Value: TStrings); protected 
    { Protected declarations } 

    Глава 27. Разработка компонентов баз данных 527 

    procedure CreateTemporaryView; 
    procedure DropTemporaryView; 
    procedure DoBeforeOpen; override; 
    procedure DoAfterClose; override; public 
    { Public declarations } 
    constructor Create(AOwner: TComponent); override; 
    destructor Destroy; override; published 
    { Published declarations } 
    property CreateViewSQL : String read FCreateViewSQL write FCreateViewSQL; 
    property DropViewSQL : String read  FDropViewSQL write FDropViewSQL; 
    property SQL : TStrings read FSQL write SetQuery; 
    property TableNameFormat : 
    TFileName read FTableNameFormat write FTableNameFormat; end; 
    procedure Register; implementation 
    constructor TLiveQuery.Create(AOwner: TComponent); begin 
    inherited Create(AOwner); 
    FSQL := TStringList.Create; 
    FCreateViewSQL := DEFAULTCREATEVIEWSQL; 
    FDropViewSQL := DEFAULTDROPVIEWSQL; 
    FTableNameFormat := DEFAULTTABLENAMEFORMAT; end; 
    destructor TLiveQuery.Destroy; begin 
    if Active then begin Close; 
    DropTemporaryView; end; 
    SQL.Free; 
    inherited Destroy; end; 
    procedure TLiveQuery.SetQuery(Value: TStrings); begin 
    ChecklnActive; 
    SQL.Assign(Value); end; 
    procedure TLiveQuery.CreateTemporaryView; var 
    TemporaryDB : TDatabase; WorkSQL : TStrings; begin 
    WorkSQL := TStringList.Create; WorkSQL.AddStrings(SQL) ; 
    TableName:=Format(TableNameFormat, 
[FormatDateTime('yyiranddhhnnss',Now)]); 
WorkSQL.Insert(0,Format(CreateViewSQL, [TableName])); 
TemporaryDB:=Session.OpenDatabase(DatabaseName); if (TemporaryDBonil) then try 
    if (TemporaryDB.IsSQLBased) then begin 
    if (DbiQExecDirect(TemporaryDB.Handle, qrylangSQL, 
    PChar(WorkSQL.Text),nil)<>DBIERR_NONE) then 
    raise EDatabaseError.Create ('Error creating temporary view'); end else 
    raise EDatabaseError.Create( 
    'Cannot use this component with local tables'); 

    528 Часть IV. Темы повышенной сложности 

    finally 
    Session.CloseDatabase(TemporaryDB); WorkSQL.Free; end; end; 
    procedure TLiveQuery.DoBeforeOpen; begin 
    inherited DoBeforeOpen; 
    GreateTemporaryView;: end; 
    procedure TLiveQuery.DropTemporaryView; var 
    TemporaryDB : TDatabase; WorkSQL : TStrings; begin 
    WorkSQL:=TStringList.Create; 
    WorkSQL.Add(Format(DropViewSQL, [TableName])); 
TemporaryDB:=Session.OpenDatabase(DatabaseName); if (TemporaryDBOnil) then 
begin try 
    if (TemporaryDB.IsSQLBased) then begin if 
(DbiQExecDirect(TemporaryDB.Handle,qrylangSQL, 
PChar(WorkSQL.Text),nil)<>DBIERR_NONE) then 
    raise EDatabaseError.Create('Error dropping temporary view' end else 
    raise EDatabaseError.Create( 
    'Cannot use this component with local tables'); finally 
    Session. CloseDatabase(TemporaryDB); WorkSQL.Free; end; end; end; 
    procedure TLiveQuery.DoAfterClose; begin 
    DropTemporaryView; 
    inherited DoAfterClose; end; 
    procedure Register; begin 
    RegisterComponents('Data Access', [TLiveQuery]); end; 
    end. 

    Компонент TDBNavSearch 

    Компонент TDBNavSearch это пример компонента, — составной компонент 
(component template), используемый в качестве заменителя стандартного 
компонента Delphi DBNavigator. Единственное его внешнее отличие — 
дополнительная кнопка поиска. Однако, если взглянуть на DBNavSearch более 
пристально, обнаружится целый ряд преимуществ по сравнению с DBNavigator. Сам 
его исходный текст слишком сложен для подробного анализа. Поговорим для начала 
о способах создания составных компонентов, о том, что они делают, и какие 
преимущества извлекает из этого DBNavSearch. 
    Составные компоненты отличаются от обычных тем, что состоят более чем из 
одного компонента. При перетаскивании составного компонента на форму на ней 
может оказаться любое количество компонентов. Такие компоненты не обязательно 
образуют один элемент управления. Это может быть набор элементов как 
объединенных в группу, так и несвязанных между собой. 

    Глава 27. Разработка компонентов баз данных 529 

    Как получить составной компонент? Очень просто1. 
    1.    Выделите на форме компоненты, которые хотите объединить в составной компонент. 
    2.   Выберите команду Component^Create Component Template. 
    3.    Введите имя нового компонента в строке Component, вкладку палитры в 
строке Palette page, выбери для него пиктограмму и щелкните на кнопке ОК. 
    Теперь новый компонент включен в состав палитры компонентов Delphi и может 
быть использован приложениях, подобно другим компонентам. 
    Если компоненты, использованные в качестве его составных частей, имели 
какой-нибудь связанный ним код, этот код будет добавлен во все формы, в 
которых разместится новый компонент. В этом и з ключается основное достоинство 
составных компонентов. Поскольку код, ассоциированный с элементами управления 
составного компонента, переносится вместе с ним в формы, его можно 
переопределить адаптировать к каждой конкретной форме, в которой он появляется. 
    Чтобы глубже понять последствия возможности изменения этого кода, давайте 
сопоставим возможности настройки компонентов DBNavigator и DBNavSearch. 
Разработчики часто любят изменять поведение DBNavigator при щелчках на его 
кнопках. Например, программист может пожелать, чтобы после щелчка на кнопке 
Edit или Insert компонента DBNavigator выводилась специальная форма. Как это 
сделать? Нужно создать обработчика события OnClick компонента DBNavigator, а 
затем, проверив параметр процедуры Button (обычно с помощью оператора Case), 
определить, какая кнопка вызвала это событие. Ведь все кнопки вызывают общее 
событие click. 
    Компонент DBNavSearch, напротив, позволяет изменить поведение одной из 
кнопок так, как вы привыкли делать это в Delphi, — связав новый код с событием 
кнопки OnClick. Поскольку элементы управления в составном компоненте 
DBNavSearch по-прежнему остаются раздельными, можно, дважды щелкнув на любом 
из них, связать с этим компонентом специальный код. Таким образом, чтобы 
переопределить поведение кнопки Edit, необходимо дважды щелкнуть на ней; в 
открывшемся окне появится связанный с ней в данный момент исходный текст 
обработчика события, который можно удалить или дополнить. Безусловно, такой 
подход удобнее, чем используемый стандартными компонентами Delphi. 
    Рассмотрим другую типичную для DBNavigator задачу — удаление из элемента 
управления нескольких кнопок. Чтобы добавить или удалить кнопки с помощью 
стандартного компонента DBNavigator, нужно воспользоваться групповым свойством 
VisibleButtons. Поскольку свойство определено для заранее заданного множества 
элементов, вы не можете добавить в это множество новые кнопки. Приходится 
ограничиваться только элементами управления, входящими в множество. При 
создании нового компонента на основе TDBNavigator вы сталкиваетесь с теми же 
ограничениями. Дело в том, что множество переменных нельзя расширить путем 
наследования. Здесь тоже все кнопки элемента управления имеют общее свойство. 
    Компонент DBNavSearch, напротив, позволяет удалить кнопки, которые не 
должны быть видны на форме. Если вам не нужны кнопки Insert, Edit или Delete, 
просто удалите их из формы. Если же вы хотите лишь сделать их временно 
невидимыми, — отключите их свойство Visible. Подведем итоги: элемент 
управления действует и настраивается так же, как и остальные компоненты Delphi. 
    Теперь, когда вы уже немного познакомились с TDBNavSearch, давайте 
разберемся, как он был создан. Для этого пришлось выполнить следующие действия. 
    1.    На форму поместили несколько компонентов SpeedButton и компонент 
DataSource. Они будут играть роль кнопок и свойства DataSource компонента DBNavigator. 
    2.    Каждой кнопке присвоили растровое изображение, которое сделало бы их 
похожими на кнопки компонента DBNavigator . 
    3.   Событию OnClick каждой из кнопок присвоили код, управляющий набором 
данных, на который ссылается сопровождающий эту кнопку компонент DataSource. 
Например, кнопка Edit была настроена на вызов следующего оператора. 

    nsDataSource.DataSet.Edit; 

    4.   Для обработки новой кнопки Search был написан специальный код. Это 
потребовало организации отдельной формы поиска, в которой можно задавать 
искомые значения. 
    5.   С помощью мыши были выделены компоненты SpeedButton и DataSource. 
Затем была выбрана команда ComponentoCreate Component Template. Новому 
компоненту было присвоено имя TDBNavSearch и пиктограмма, после чего он был 
добавлен в палитру компонентов Data Controls. 

    530	Часть IV. Темы повышенной сложности 

    Теперь, когда вы познакомились с основными этапами создания компонента 
TDBNavSearch, могу побиться об заклад, что вам не терпится узнать, как 
использовать это в ваших приложениях. Вот что для этого нужно сделать. 
    1.    Введите приведенный ниже исходный код или загрузите его с 
прилагаемого компакт-диска. Сохраните его в файле DBNavSearch. Pas. 
    2.   Перетащите на форму компоненты SpeedButton и элемент управления DataSource. 
    3.   Выберите команду Component^Create Component Template. 
    4.    Присвойте новому составному компоненту имя TDBNavSearch и разместите 
его в палитре компонентов на вкладке Data Controls. 
    5.   Можете загрузить растровое изображение DBNavSch.BMP и сделать его 
пиктограммой нового компонента (этот файл есть и на прилагаемом к книге компакт-диске). 
    6.   Для создания нового компонента щелкните на кнопке ОК. 
    7.   Теперь можете поместить новый составной компонент на форму, как вы 
это делали с обычными компонентами. Однако здесь есть несколько подводных 
камней, о которых не следует забывать. 
    •    В отличие от обычных элементов управления, элементы управления в 
составном компоненте помещены на форму в том же положении, которое они 
занимали на своих исходных формах. Это значит, что независимо от того, где вы 
щелкнете кнопкой мыши, чтобы разместить составной компонент, свойства Тор и 
Left его элементов управления сохранят значения, которые они имели на исходной 
форме. Однако это не имеет большого значения, так как все элементы управления 
изначально выделены, и их можно перетащить в нужное место. 
    •    Нельзя располагать больше одного компонента DBNavSearch на одной 
форме. Это ограничение связано с функционированием кода, связанного с 
элементами управления составного компонента. При создании этого кода 
предполагается, что компонент DB.NavSearch — единственный на форме. 
Существование двух DBNavSearch на одной форме может оказаться разрушительным 
для обоих. 
    •    Необходимо явно добавить модуль DBSearch (который содержит форму 
поиска DBNavsearch) во все проекты, использующие DBNavSearch, и в оператор 
Uses всех использующих его форм. Добавив к проекту этот модуль, можно 
воспользоваться командой File^Use Unit, в результате чего он добавится к 
оператору Uses формы нужного проекта. Полный исходный текст компонента 
DBNavSearch содержится в листинге 27.6. 

    Листинг 27.6. Полный исходный текст компонента DBNavSearch 

    { 
    Компонент DBNavSearch. 
    Создает элемент управления с интерфейсом навигатора и обладающий 
средствами поиска. 
    Автор - Кен Хендерсон. 
    Copyright (с) 1997 by Ken Henderson. } unit DBNavSch; 
    interface 
    uses 
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
ExtCtrls, DBCtrls, Grids, DBGrids, Db, DBTables, Buttons; 
    type 
    TDBNavSchForm = class(TForm) sbFirst: TSpeedButton; sbPrior: TSpeedButton; 
sbNext: TSpeedButton; sbLast: TSpeedButton; sblnsert: TSpeedButton; sbDelete: 
TSpeedButton; sbEdit: TSpeedButton; sbPost: TSpeedButton; sbCancel: TSpeedButton; 

    Глава 27. Разработка компонентов баз данных 531 

    sbRefresh: TSpeedButton; 
    sbSearch: TSpeedButton; 
    nsDataSource: TDataSource; 
    procedure nsDataSourceStateChange(Sender: TObject); 
    procedure sbCancelClick(Sender: TObject); 
    procedure sbDeleteClick(Sender: TObject); 
    procedure sbEditClick(Sender: TObject); 
    procedure sbFirstClick(Sender: TObject); 
    procedure sblnsertClick(Sender: TObject); 
    procedure sbLastClick(Sender: TObject); 
    procedure sbNextClick(Sender: TObject); 
    procedure sbPostClick(Sender: TObject); 
    procedure sbPriorClick(Sender: TObject); 
    procedure sbRefreshClick(Sender: TObject); 
    procedure sbSearchClick(Sender: TObject); private 
    { Private declarations } public 
    { Public declarations } end; 
    var 
    DBNavSchForm: TDBNavSchForm; 
    implementation uses Dbsearch; {$R *.DFM} 
    procedure TDBNavSchForm.nsDataSourceStateChange(Sender: TObject); const 
    BROWSEBUTTONS = $FE; var 
    с : integer; begin 
    if (nsDataSource.DataSet <> nil) then Case nsDataSource.DataSet.State of 
dsInActive : begin 
    for c:=0 to Pred(ComponentCount) do if (Components[c].Tag>=BROWSEBUTTONS) 
and (Components[c] is TSpeedButton) then 
TSpeedButton(Components[c]).Enabled:=False; end; dsBrowse :    begin 
    for c:=0 to Pred(ComponentCount) do if (Components[c].Tag>=BROWSEBUTTONS) 
and (Components[c] is TSpeedButton) then TSpeedButton(Components[c]).Enabled:= 
(Components[c].Tag=BROWSEBUTTONS); if nsDataSource.DataSet.Bof then begin 
sbFirst.Enabled:=False; sbPrior.Enabled:=False; end else begin 
    sbFirst.Enabled:=True; sbPrior.Enabled:=True; end; 
    if nsDataSource.DataSet.Eof then begin sbLast.Enabled:=False; 
sbNext.Enabled:=False; end else begin 
    sbLast.Enabled:=True; sbNext.Enabled:=True; end; 
    end; 

    532 Часть IV. Темы повышенной сложности 

    dsEdit :    begin 
    sbEdit.Enabled:=False; 
    sbPost.Enabled:=True; 
    sbCancel.Enabled:=True; end; dslnsert :    begin 
    sbEdit.Enabled:=False; 
    sbPost.Enabled:=True; 
    sbCancel.Enabled:=True; end; 
    end; 
    end; 
    procedure TDBNavSchForm.sbCancelClick(Sender: TObject); begin 
    nsDataSource.DataSet.Cancel; 
    end; 
    procedure TDBNavSchForm.sbDeleteClick(Sender: TObject); begin 
    if (Application.MessageBox('Delete 
record?1,'Confirm',MB_OKCANCEL+MB_ICONQUESTION)= IDOK) then 
    nsDataSource.DataSet.Delete; end; 
    procedure TDBNavSchForm.sbEditClick(Sender: TObject); begin 
    nsDataSource.DataSet.Edit; end; 
    procedure TDBNavSchForm.sbFirstClick(Sender: TObject); begin 
    With nsDataSource.DataSet do begin First; if Bof then begin 
    sbFirst.Enabled:=False; sbPrior.Enabled:=False; end else begin 
    sbFirst.Enabled:=True; sbPrior.Enabled:=True; end; if Eof then begin 
    sbLast.Enabled:=False; sbNext.Enabled:=False; end else begin 
    sbLast.Enabled:=True; sbNext.Enabled:=True; end; end; end; 
    procedure TDBNavSchForm.sblnsertClick(Sender: TObject); begin 
    nsDataSource.DataSet.Insert; end; 
    procedure TDBNavSchForm.sbLastClick(Sender: TObject); begin 
    With nsDataSource.DataSet do begin Last; if Bof then begin 
    sbFirst.Enabled:=False; sbPrior.Enabled:=False; end else begin 
    sbFirst.Enabled:=True; sbPrior.Enabled:=True ; end; 
    ГИ 

    Глава 27. Разработка компонентов баз данных 533 

    if Eof then begin 
    sbLast.Enabled:=False; sbNext.Enabled:=False; end else begin 
    sbLast.Enabled:=True; sbNext.Enabled:=True; end; end; end; 
    procedure TDBNavSchForm.sbNextClick(Sender: TObject); begin 
    With nsDataSource.DataSet do begin Next ; if Bof then begin 
    sbFirst.Enabled:=False; sbPrior.Enabled:=False; end else begin 
    sbFirst.Enabled:=True; sbPrior.Enabled:=True; end; if Eof then begin 
    sbLast.Enabled:=False; sbNext.Enabled:=False; end else begin 
    sbLast.Enabled:=True; sbNext.Enabled:=True; end; end; end; 
    procedure TDBNavSchForm.sbPostClick(Sender: TObject); begin 
    nsDataSource.DataSet. Post; end; 
    procedure TDBNavSchForm.sbPriorClick(Sender: TObject); begin 
    With nsDataSource.DataSet do begin Prior; if Bof then begin 
    sbFirst.Enabled:=False; sbPrior.Enabled:=False; end else begin 
    sbFirst.Enabled:=True ; sbPrior.Enabled:=True; end; if Eof then begin 
    sbLast.Enabled:=False; sbNext.Enabled:=False; end else begin 
    sbLast.Enabled:=True; sbNext.Enabled:=True; end; end; end; 
    procedure TDBNavSchForm.sbRefreshClick(Sender: TObject), begin 
    nsDataSource.DataSet.Refresh; end; 
    procedure TDBNavSchForm,sbSearchClick(Sender: TObject); const 
    FLDHEIGHT = 30; 
    LABELSTART = 2; var 

    534 Часть IV. Темы повышенной сложности 

    с : Byte; 
    LabelWidth, WidestLabelWidth : Byte; begin 
    WidestLabelWidth:=0; 
    SearchForm:=TSearchForm.Create(Self); try 
    With nsDataSource.DataSet as TTable do begin if IndexFieldCount>0 then begin 
    for c:=0 to IndexFieldCount-1 do begin 
    LabelWidth:=SearchForm.AddLabel(IndexFields[c].FieldName,LABELSTART+ 
    (c*FLDHEIGHT)); 
    If (LabelWidth>WidestLabelWidth) then WidestLabelWidth:=LabelWidth; end; 
    {Use two separate loops so that the widest label can be detected and 
allowed for.} for c:=0 to IndexFieldCount-1 do begin 
    SearchForm.AddDBControl(Self.nsDataSource,IndexFields[c], 
    LABELSTART+(c*FLDHEIGHT),WidestLabelWidth+5); end; SetKey; If 
(SearchForm.ShowModal=mrOK) then begin 
    {Я не проверяю значение, возвращаемое функцией GotoKey, так как процедура 
GotoNearest корректно обрабатывает как точный, так и неточный поиск.} If 
SearchForm.AllowPartial.Checked then GotoKey else GotoNearest; end else 
Cancel; end; end; finally 
    SearchForm.Free; end; end; 
    end. 
    В листинге 27.7 содержится текстовое представление формы поиска DBNavSch. 
    Листинг 27.7. Текстовое представление формы DBNavSch 
    object DBNavSchForm: TDBNavSchForm Left = 200 Top = 108 Width = 544 Height 
= 375 
    Caption = 'DBNavSchForm1 Font.Charset = DEFAULT_CHARSET Font.Color = 
clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif Font.Style = [] 
PixelsPerlnch = 96 TextHeight = 13 object sbFirst: TSpeedButton 
    Tag = 254 
    Left = 80 
    Top = 296 
    Width = 25 
    Height = 25 
    Enabled = False 
    Glyph.Data = { 
    46010000424D460100000000000076000000280000001COOOOOOOD0000000100 
040000000000DO00000000000000000000001000000000000000000000000000 
80000080000000808000800000008000800080800000COCOC000808080000000 
FFO00OFFO000OOFFFFOOFFOO0000FFOOFFOOFFFFOOOOFFFFFF00333333333333 

    Глава 27. Разработка компонентов баз данных 535 

    3333333333333333000033333333333333333333333333330000333333333333 
3333FFF33333FFF30000330833333380333833F333FF33F30000330833338000 
333833F3FF3333F30000330833800000333833FF333333F30000330880000000 
33383333333333F3000033083380000033383338333333F30000330833338000 
333833F3883333F30000330833333380333833F3338833F30000333333333333 
3338883333338833000033333333333333333333333333330000333333333333 33333333333333330000} 
    NumGlyphs = 2 
    OnClick = sbFirstClick end object sbPrior: TSpeedButton 
    Tag = 254 
    Left = 106 
    Top = 296 
    Width = 25 
    Height = 25 
    Enabled = False 
    Glyph.Data = { 
    12010000424D1201000000000000760000002800000014OOOOOOOD0000000100 
0400000000009C00000000000000000000001000000000000000000000000000 8000008 
00000008 08000800000008 0008 0008 08 OOOOOCOCOC00080808 0000000 
FFOOOOFFOOOOOOFFFFOOFFOOOOOOFFOOFFOOFFFFOOOOFFFFFF00333333333333 
33333333000033333333333333333333000033333333333333333FFF00003333 
33380333333FF33F00003333380003333FF3333F000033380000033FF333333F 
00003800000003833333333F00003338000003388333333F0000333338000333 
3883333F00003333333803333338833F00003333333333333333388300003333 33333333333333330000333333333333333333330000} 
    NumGlyphs = 2 
    OnClick = sbPriorClick end object sbNext: TSpeedButton 
    Tag = 254 
    Left = 132 
    Top = 296 
    Width = 25 
    Height = 25 
    Enabled = False 
    Glyph.Data = { 
    12010000424D1201000000000000760000002800000014OOOOOOOD0000000100 
0400000000009C00000000000000000000001000000000000000000000000000 
80000080000000808000800000008000800080800000COCOC000808080000000 
FFOOOOFFOOOOOOFFFFOOFFOOOOOOFFOOFFOOFFFFOOOOFFFFFF00333333333333 
33333333000033333333333333333333000033333333333FF333333300003083 
333333833FF333330000300083333383333FF333000030000083338333333FF3 
00003000000083833333333F0000300000833383333338830000300083333383 
3338833300003083333333833883333300003333333333888333333300003333 33333333333333330000333333333333333333330000} 
    NumGlyphs = 2 
    OnClick = sbNextClick end object sbLast: TSpeedButton 
    Tag = 254 
    Left = 157 
    Top =296 
    Width = 25 
    Height = 25 
    Enabled = False 
    Glyph.Data = { 
    46010000424D460100000000000076000000280000001COOOOOOOD0000000100 
04OOOOOOOOOODOOOOOOOOOOOOOOOOOOOOOOO1000000000000000000000000000 
80000080000000808000800000008000800080800000COCOC000808080000000 
FFOOOOFFOOOOOOFFFFOOFFOOOOOOFFOOFFOOFFFFOOOOFFFFFF00333333333333 
3333333333333333000033333333333333333333333333330000333333333333 
3333FF333333FFF30000330833333380333833FF333833F30000330008333380 33383333FF3833F300003300000833803338333333F333F30000330000000880 

    536 Часть IV. Темы повышенной сложности 

    33383333333333F3000033000008338033383333338833F30000330008333380 
33383333883833F3000033083333338033383388333833F30000333333333333 
3338883333388833000033333333333333333333333333330000333333333333 33333333333333330000} 
    NumGlyphs = 2 
    OnClick = sbLastClick end object sblnsert: TSpeedButton 
    Tag = 254 
    Left = 183 
    Top = 296 
    Width = 25 
    Height = 25 
    Enabled = False 
    Glyph.Data = { 
    46010000424D460100000000000076000000280000001COOOOOOOD0000000100 
040000000000DO00000000000000000000001000000000000000000000000000 
80000080000000808000800000008000800080800000COCOC000808080000000 
FFOO00FFOOOOOOFFFFOOFFOOOOOOFFOOFFOOFFFFOOOOFFFFFF00333333333333 
333333333333333300003333333333333333333FFFF333330000333330003333 
3333338333F3333300003333300033333333338333F333330000333330003333 
3333FF3333FFFF3300003300000000033338333333333F330000330000000003 
3338333333333F3300003300000000033338333333333F330000333330003333 
333888833338833300003333300033333333338333F333330000333330003333 
3333338333F33333000033333333333333333388883333330000333333333333 33333333333333330000} 
    NumGlyphs = 2 
    OnClick = sblnsertClick end object sbDelete: TSpeedButton 
    Tag = 254 
    Left = 209 
    Top = 296 
    Width = 25 
    Height = 25 
    Enabled = False 
    Glyph.Data = { 
    46010000424D460100000000000076000000280000001COOOOOOOD0000000100 
0400000000OODOOOOOOOOOO00000000000001000000000000000000000000000 
800000800000008080008000000080008000808OOOOOCOCOC000808080000000 
FFOOOOFFOOOOOOFFFFOOFFOOOOOOFFOOFFOOFFFFOOOOFFFFFF00333333333333 
3333333333333333000033333333333333333333333333330000333333333333 
3333333333333333000033333333333333333333333333330000333333333333 
3338FFFFFFFFFFF3000033000000000033383333333333F30000330000000000 
33383333333333F3000033000000000033383333333333F30000333333333333 
33388888888888F3000033333333333333333333333333330000333333333333 
3333333333333333000033333333333333333333333333330000333333333333 33333333333333330000} 
    NumGlyphs = 2 
    OnClick = sbDeleteClick end object sbEdit: TSpeedButton 
    Tag = 254 
    Left = 235 
    Top = 296 
    Width = 25 
    Height = 25 
    Enabled = False 
    Glyph.Data = { 
    46010000424D460100000000000076000000280000001COOOOOOOD0000000100 
040000000000D000000000000000000000001000000000000000000000000000 
8000G080000000808000800000008000800080800000COCOC000808080000000 
FFOOOOFFOOOOOOFFFFOOFFOOOOOOFFOOFFOOFFFFOOOOFFFFFFOO333333333333 
3333333333333333000033333333333333333333333333330000333333333333 333333333333333300003333333333333333FFFFFFFFFFF30000330000000000 

    Глава 27. Разработка компонентов баз данных 537 

    33383333333333F300003330000000033333833333333F330000333300000033 
333338333333F333000033333000033333333383333F33330000333333003333 
3333333833F33333000033333333333333333333883333330000333333333333 
3333333333333333000033333333333333333333333333330000333333333333 33333333333333330000} 
    NumGlyphs = 2 
    OnClick = sbEditClick end object sbPost: TSpeedButton 
    Tag = 255 
    Left = 260 
    Top = 296 
    Width = 25 
    Height = 25 
    Enabled = False 
    Glyph.Data = { 
    46010000424D460100000000000076000000280000001COOOOOOOD0000000100 04 
0000000 OOODOOOO 0000 0000 00000000000100 0000 0000000 0000 0000 0000 00 800 
0008 0000 000 8 08 00 08 00000008 00 08 00 080 8 OOOOOCOCOCOOO 8 08 08 00 
00000 FFOOOOFFOOOOOOFFFFOOFFOOOOOOFFOOFFOOFFFFOOOOFFFFFF00333333333333 
33333333333333330000333333333333333333F3333333330000333303333333 
33333F3F3333333300003330003333333333F333F33333330000330000033333 
333F33333F33333300003000300033333383333333F333330000300333000333 
338333F8333F33330000333333300033333888338333F3330000333333330003 
3333333338333F33000033333333300033333333338333F30000333333333300 
3333333333383383000033333333333333333333333388330000333333333333 33333333333333330000} 
    NumGlyphs = 2 
    OnClick = sbPostClick end object sbCancel: TSpeedButton 
    Tag = 255 
    Left = 286 
    Top = 296 
    Width =25 
    Height = 25 
    Enabled = False 
    Glyph.Data = { 
    46010000424D460100000000000076000000280000001COOOOOOODOOO0000100 
040000000000D000000000000000000000001000000000000000000000000000 
80000080000000808000800000008000800080800000COCOC000808080000000 
FFOOOOFFOOOOOOFFFFOOFFOOOOOOFFOOFFOOFFFFOOOOFFFFFF00333333333333 
3333333333333333000033333333333333333FF33333FF330000333003333300 
3333833F333833F3000033300033300033338333F38333F30000333300030003 
3333383338333F330000333330000033333333833333F3330000333333000333 
33333338333F33330000333330000033333333833333F3330000333300030003 
3333383338333F33000033300033300033338333F38333F30000333003333300 
3333833F333833F3000033333333333333333883333388330000333333333333 33333333333333330000} 
    NumGlyphs = 2 
    OnClick = sbCancelClick end object sbRefresh: TSpeedButton 
    Tag = 254 
    Left = 312 
    Top = 296 
    Width = 25 
    Height = 25 
    Enabled = False 
    Glyph.Data = { 
    46010000424D460100000000000076000000280000001COOOOOOOD0000000100 
040000000000D000000000000000000000001000000000000000000000000000 
80000080000000808000800000008000800080800000COCOC000808080000000 
FFOOOOFFOOOOOOFFFFOOFFOOOOOOFFOOFFOOFFFFOOOOFFFFFF00333333333333 3333333FFFFF3333000033333808333333333FF3338833330000333800833333 

    538 Часть IV. Темы повышенной сложности 

    3333833338333333000033300833333333338333833333330000338083333333 
3338333F3333333300003300333333333338333F3FFFFFF30000330033300000 
3338333F833333F300003300833380003338333F383333F30000338008380000 
33383333F33333F3000033300000008033338333333383F30000333380008330 
33333833333883F3000033333333333333333388888338330000333333333333 33333333333333330000} 
    NumGlyphs = 2 
    OnClick = sbRefreshClick end object sbSearch: TSpeedButton 
    Tag = 254 
    Left = 338 
    Top = 296 
    Width = 25 
    Height = 25 
    Enabled = False 
    Glyph.Data = { 
    46010000424D460100000000000076000000280000001COOOOOOOD0000000100 
040000000000D000000000000000000000001000000000000000000000000000 
80000080000000808000800000008000800080800000COCOC000808080000000 
FFOOOOFFOOOOOOFFFFOOFFOOOOOOFFOOFFOOFFFFOOOOFFFFFF00700777777777 
77788777777777770000000077777777778888777777777700000FO007777777 
778F888777777777000070FO007777777778F888777777770000770FO0000087 
77778F888888877700007770F0087780777778F8887788770000777700877F78 
07777788877F788700007777087777F7887777887777F788000077770877777F 
7077778877777F7800007777087FF777707777887FF7777800007777888FF777 
887777888FF77788000077777088777807777778887778870000777777088880 77777777888888770000} 
    NumGlyphs = 2 
    OnClick = sbSearchClick end object nsDataSource: TDataSource 
    OnStateChange = nsDataSourceStateChange 
    Left = 364 
    Top = 293 end end 
    В листинге 27.8 содержится исходный текст модуля DBSearch. 
    Листинг 27.8. Исходный текст программного модуля DBSearch 
    unit Dbsearch; interface 
    uses 
    SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 
Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, Mask, DBCtrls, Db, Math; 
    type 
    TSearchForm = class(TForm) 
    Panell: TPanel; 
    Panel2: TPanel; 
    ScrollBoxl: TScrollBox; 
    BitBtnl: TBitBtn; 
    BitBtn2: TBitBtn; 
    IgnoreCase: TCheckBox; 
    AllowPartial: TCheckBox; 
    DataSourcel: TDataSource; 
    Labell: TLabel; 
    DBCheckBoxl: TDBCheckBox; 
    DBEditl: TDBEdit; private 

    Глава 27. Разработка компонентов баз данных 539 

    { Private declarations } 
    public 
    { Public declarations } 
    function AddLabel (LabelCaption : String; LabelTop : Integer) : 
Integer/procedure AddDBControl(DBDataSource : TDataSource; SField : TField; 
DBTop, DBLeft Integer); 
    end; 
    var 
    SearchForm: TSearchForm; 
    implementation {$R *.DFM} 
    function TSearchForm.AddLabel(LabelCaption : String; LabelTop : Integer) : 
Integer; var 
    TL : TLabel; begin 
    TL:=TLabel.Create(ScrollBoxl) ; 
    TL.Parent:=ScrollBoxl; 
    TL.AutoSize:=True; 
    TL.Top:=LabelTop; 
    TL.Left:=2; 
    TL.Caption:=LabelCaption; 
    Result:=TL.Width; end; 
    procedure TSearchForm.AddDBControl(DBDataSource : TDataSource; SField : 
TField; DBTop, 
    DBLeft : Integer); 
    var 
    TDBE : TDBEdit; TDBC : TDBCheckBox; Ruler : String; begin 
    If (SField.DataType <> ftBoolean) then begin 
TDBE:=TDBEdit.Create(SearchForm.ScrollBoxl); 
TDBE.Parent:=SearchForm.ScrollBoxl; TDBE.DataSource:=DBDataSource; TDBE.DataField:=SField.FieldName; 
    SetLength(Ruler,SField.DisplayWidth+2); 
    FillChar(Ruler[1],SField.DisplayWidth+2,'M'); 
    TDBE.Width:=Canvas.TextWidth(Ruler); 
    TDBE.Top:=DBTop; 
    TDBE.Left:=DBLeft; 
    if (SField.DataType=ftString) 
    then TDBE.MaxLength:=MinIntValue([Pred(Width-DBLeft),SField.Size]); end 
else begin 
    TDBC:=TDBCheckBox.Create(SearchForm.ScrollBoxl); 
    TDBC.Parent:=SearchForm.ScrollBoxl; 
    TDBC.Caption:=''; 
    TDBC.DataSource:=DBDataSource; 
    TDBC.DataField:=SField.FieldName; 
    TDBC.Top:=DBTop; TDBC.Left:=DBLeft; end; end; 
    end. 

    В листинге 27.9 содержится текстовое представление формы DBSearch. 

    540 Часть IV. Темы повышенной сложности 

    Листинг 27.9, Текстовое представление формы DBSearch 

    object SearchForm: TSearchForm Left = 24 Top = 120 Width = 592 Height = 
300 Caption = 'Search' Font.Charset = DEFAULT_CHARSET Font.Color = clBlack 
Font.Height = -13 Font.Name = 'Courier New' Font.Style = [] Position = 
poScreenCenter PixelsPerlnch = 96 TextHeight = 16 object Panell: TPanel Left = 
0 Top = 0 Width = 584 Height = 232 Align = alClient Bevellnner = bvLowered 
TabOrder = 0 
    object ScrollBoxl: TScrollBox Left = 2 Top = 2 Width = 580 Height = 228 
Align = alClient Font.Charset = ANSI_CHARSET Font.Color = clBlack Font.Height 
= -13 Font.Name = 'Courier New' Font.Style = [] ParentFont = False TabOrder = 
0 object Labell: TLabel Left = 440 Top = 64 Width = 48 Height = 16 Caption = 
'Labell' Visible = False end 
    object DBCheckBoxl: TDBCheckBox Left = 440 Top = 96 Width = 97 Height = 17 
    Caption = 'DBCheckBoxl' TabOrder = 0 ValueChecked = 'True' ValueUnchecked 
= 'False' Visible = False end 
    object DBEditl: TDBEdit Left = 440 Top = 120 Width = 121 Height = 24 
MaxLength = 0 TabOrder = 1 Visible = False 

    Глава 27. Разработка компонентов баз данных 541 

    end '      ••"''•' 
    end	' '           • end 
    object Panel2: TPanel Left = 0 Top = 232 Width = 584 Height =41 Align = 
alBottom Bevellnner = bvLowered TabOrder = 1 object BitBtnl: TBitBtn 
    Left = 386 
    Top = 4 
    Width =89 
    Height = 33 
    Caption = '&OK' 
    TabOrder = 0 
    Kind = bkOK end object BitBtn2: TBitBtn 
    Left = 490 
    Top = 4 
    Width =89 
    Height = 33 
    Caption = 'SCancel' 
    TabOrder = 1 
    Kind = bkCancel end object IgnoreCase: TCheckBox 
    Left = 8 
    Top = 12 
    Width = 126 
    Height = 17 
    Caption = 'Slgnore case?' 
    TabOrder = 2 end object AllowPartial: TCheckBox 
    Left = 128 
    Top = 12 
    Width = 209 
    Height = 17 
    Caption = 'SAllow partial searches?' 
    State = cbChecked 
    TabOrder = 3 end end 
    object DataSourcel: TDataSource Left = 444 Top = 28 end end 

    Компонент ZoomDlg 

    Компонент ZoomDlg предоставляет разработчику простой способ отбора из 
одной таблицы допустимых! переменных для столбцов другой. С внедрением в 
Delphi полей выборки необходимость в этом компонен:| те несколько снизилась. 
Однако, создавая его, можно многому научиться. 
    В компоненте ZoomDlg определен только один общедоступный метод — Execute, 
предназначенный! для связки с событием OnDblClick какого-либо элемента 
управления для работы с данными, например] DBEdit. Обычно для вызова метода 
Execute компонента ZoomDlg нужно дважды щелкнуть на этом ком-1 

    542 Часть IV. Темы повышенной сложности 

поненте. Подобно прочим диалоговым компонентам, метод Execute выводит на 
экран форму, связанную с компонентом ZoomDlg. Эта экранная форма хранится в 
модуле ZoomForm. Она позволяет пользователю выбрать значение для элемента 
столбца данных из другой таблицы. В своих программах я взял за правило 
выделять элементы управления, поддерживающие этот механизм, отдельным цветом, 
чтобы пользователь мог легко догадаться об их специальных свойствах. Как и при 
создании компонента DBNavSearch, исходный код компонента ZoomDlg слишком велик 
для подробного рассмотрения. Поэтому сначала взгляните на листинг, а затем 
обсудим его основные черты. Полный исходный текст компонента ZoomDlg 
содержится в листингах 27.10—27.12. 

    Листинг 27.10. Компонент ZoomDlg 

    {ZoomDlg.PAS Компонент ZoomDlg. 
    Предназначен для выбора нужного значения поля одной таблицы из другой 
таблицы. Этот компонент является невизуальным. Он вызывается, как и другие 
компоненты, создающие стандартные диалоговые окна, с помощью метода Execute. 
При вызове этого метода на экра-н'е~появляется диалоговое окно, содержащее 
указанную таблицу. Как только пользователь выбирает из этой таблицы нужное 
значение, диалоговое окно закрывается, а значение подставляется в текущее поле 
первой таблицы. 
    Автор — Кен Хендерсон. 
    Copyright (с) 1995-97 by Ken Henderson. 
    } 
    unit Zoomdlg; 
    interface 
    uses 
    SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 
Forms, Dialogs, ZoomForm, DBTables, Dsgnlntf, Typlnfo; 
    type 
    TZoomDialog = class(TComponent) private 
    { Private declarations } 
    FCaption : string; 
    FSourceTable : TTable; 
    FSourceField : string; protected 
    { Protected declarations } public 
    { Public declarations } published 
    { Published declarations } 
    procedure Execute(Sender : TObject); published 
    { Public declarations } 
    property Caption : string read FCaption write FCaption; 
    property SourceTable : TTable read FSourceTable write FSourceTable; 
    property SourceField : string read FSourceField write FSourceField; end; 
    procedure Register; implementation 
    procedure TZoomDialog.Execute(Sender : TObject); begin 
    fmZoom:=TfmZoom.Create(Self); 

    Глава 27. Разработка компонентов баз данных 543 

    try 
    fmZoom.ShowFormfSender,Caption, SourceTable,SourceField); finally 
    fmZoom.Free; end; end; 
    { TSourceFieldProperty } 
    type 
    TSourceFieldProperty = class(TStringProperty) public 
    function GetAttributes: TPropertyAttributes; override; 
    procedure GetValueList(List: TStrings); 
    procedure GetValues(Proc: TGetStrProc); override; 
    function GetTablePropName: string; virtual; end; 
    function TSourceFieldProperty.GetAttributes: TPropertyAttributes; begin 
    Result := [paValueList, paSortList, paMultiSelect] ; end; 
    function TSourceFieldProperty.GetTablePropName: string; begin 
    Result := 'SourceTable'; end; 
    procedure TSourceFieldProperty.GetValues(Proc: TGetStrProc); var 
    I: Integer; Values: TStringList; begin 
    Values := TStringList.Create; try 
    GetValueList(Values); 
    for I := 0 to Values.Count - 1 do Proc(Values[I]); finally 
    Values.Free; end; end; 
    procedure TSourceFieldProperty.GetValueList(List: TStrings); var 
    Instance: TComponent; 
    Proplnfo: PPropInfo; 
    SourceTable : TTable; begin 
    Instance := TComponent(GetComponent(0)); 
    Proplnfo := TypInfo.GetPropInfo(Instance.Classlnfo, GetTablePropName); 
    if (Proplnfo <> nil) and (Proplnfo'4.РгорТурел.Kind = tkClass) then 
    begin 
    SourceTable := TObject(GetOrdProp(Instance, Proplnfo)) as TTable; if 
(SourceTable <> nil) then 
    SourceTable.GetFieldNames(List) ; 
    end; end; 
    procedure Register; begin 
    RegisterComponents('Dialogs', [TZoomDialog]); 
    RegisterPropertyEditor(Typelnfo(string), TZoomDialog, 'SourceField', 
TSourceFieldProperty) ; end; 
    end. 

    544	Часть IV. Темы повышенной сложности 

    Листинг 27.11, Исходный текст программного модуля zoomForm компонента ZoomDig 

    unit ZoomForm; interface 
    uses 
    SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 
Forms, Dialogs, ExtCtrls, DBCtrls, StdCtrls, Buttons, DB, DBTables, Grids, 
DBGrids, Tabs, DBNavSearch; 
    type 
    TfmZoom = class(TForm) 
    dsZoom: TDataSource; 
    Panel1: ТPanel;: 
    Panel2: TPanel; 
    dgZoom: TDBGrid; 
    Panel3: TPanel; 
    bbOK: TBitBtn; 
    bbCancel: TBitBtn; 
    nsZoom: TDBNavigator; 
    procedure bbOKClick(Sender: TObject); 
    procedure FormClose(Sender: TObject; var Action: TCloseAction); 
    procedure FormShow(Sender: TObject);' private 
    { Private declarations } 
    FSourceTable : TTable; 
    FSourceField : string; public 
    { Public declarations } 
    Caller : TObject; 
    procedure ShowForm(Sender : TObject; Cap : String; SourceTab : TTable; 
SourceFld String); 
    property SourceTable : TTable read FSourceTable write FSourceTable; 
    property SourceField : string read FSourceField write FSourceField; end; 
    var 
    fmZoom: TfmZoom; 
    implementation ($R *.DFM} 
    procedure TfmZoom,ShowForm(Sender : TObject; Cap : String; SourceTab : TTable; 
    SourceFld: String); 
    begin 
    Caption:=Cap; 
    Caller:=Sender; 
    SourceTable:^SourceTab; 
    SourceField:=SourceFld; 
    dsZoom.DataSet:=SourceTable; 
    ShowModal; end; 
    procedure TfmZoom.bbOKClick(Sender: TObject); begin 
    If Caller is TDBEdit then begin 
    With Caller as TDBEdit do begin 
    If (not (DataSource.DataSet,State in [dslnsert, dsEdit])) then 
    DataSource.DataSet.Edit; DataSource.DataSet,FieldByName(DataField).AsString:= 
    dsZoom.DataSet.FieldByName(SourceField).AsString; end; 
    end else If Caller is TCustomEdit then begin With Caller as TCustomEd.it. 
do begin Clear; 

    Глава 27. Разработка компонентов баз данных 
    18 Delphi 3 и системы клиент/сервер 545 

    Text:=dsZoom.DataSet.FieldByName(SourceField).AsString; end; 
    end else If Caller is TComboBox then begin With Caller as TComboBox do 
begin Clear; 
    Text:=dsZoom.DataSet.FieldByName(SourceField).AsString; end; 
    end else If Caller is TDBComboBox then begin With Caller as TDBComboBox do begin 
    If (not (DataSource.DataSet.State in [dslnsert, dsEdit])) then 
    DataSource.DataSet.Edit; DataSource.DataSet.FieldByName(DataField).AsString:= 
    dsZoom.DataSet.FieldByName(SourceField).AsString; end; end; 
    ModalResult := mrOK; end; 
    procedure TfmZoom.FormClose(Sender: TObject; var Action: TCloseAction); begin 
    with SourceTable do if Active then Close; end; 
    procedure TfmZoom.FormShow(Sender: TObject); begin 
    With SourceTable do 
    If not Active then Open; end; 
    end. 

Листинг 27.12. Текстовое представление формы ZoomForm 

    object fmZoom: TfmZoom Left = 89 Top = 96 Width = 652 Height = 460 Caption 
= 'fmZoom' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText 
Font.Height = -13 Font.Name = 'System' Font.Style = [] Position = 
poScreenCenter OnClose = FormClose OnShow = FormShow PixelsPerlnch = 96 
TextHeight = 16 object Panell: TPanel Left = 0 Top = 388 Width = 644 Height = 
45 Align = alBottom Bevellnner = bvLowered TabOrder = 0 object Panels: TPanel 
Left = 451 Top = 2 Width = 191 Height = 41 Align = alRight BevelOuter = bvNone 
TabOrder = 0 object bbOK: TBitBtn 

    546	Часть IV. Темы повышенной сложности 

    Left = 5 Top = 4 Width = 89 Height = 33 Caption = 'SDK' TabOrder = 0 
OnClick = bbOKClick Kind = bkOK end 
    object bbCancel: TBitBtn Left = 97 Top = 4 Width = 89 Height = 33 Caption 
= 'scancel' TabOrder = 1 Kind = bkCancel end end 
    object nsZoom: TDBNavigator Left = 8 Top = 8 Width = 240 Height = 25 
DataSource = dsZoom TabOrder = 1 end end 
    object Panel2: TPanel Left = 0 Top = 0 Width = 644 Height = 388 Align = 
alClient TabOrder = 1 object dgZoom: TDBGrid Left = 1 Top = 1 Width = 642 
Height = 386 Align = alClient DataSource = dsZoom Font.Charset = 
DEFAULT_CHARSET Font.Color = clBlack Font.Height = -13 Font.Name = 'Arial' 
Font.Style = [] Options = [dgTitles, dglndicator, dgColumnResize, dgColLines, 
    dgRowLines, dgTabs, dgConfirmDelete, dgCancelOnExit] ParentFont = False 
Readonly = True TabOrder = 0 
    TitleFont.Charset = DEFAULT_CHARSET TitleFont.Color = clBlack 
TitleFont.Height = -13 TitleFont.Name = 'Arial' TitleFont.Style = [] end end 
    object dsZoom: TDataSource Left = 83 Top = 33 
end 
end 

    Компонент ZoomDlg необычен по нескольким причинам. Прежде всего, он не 
только получает место в палитре компонентов Delphi с помощью процедуры 
Register, но и регистрирует редактор свойств для своего свойства SourceField. 
Это позволяет выбирать доступные поля из набора данных, когда вы опре

    Глава 27. Разработка компонентов баз данных 547 

    деляете значение SourceField так же легко, как это делается с другими 
свойствами типа полей комш нентов из библиотеки VCL Delphi. Операторы, 
необходимые для создания и регистрации редакто! свойств, содержится в листинге 27.13. 

    Листинг 27.13. Исходный текст редактора свойств 

    { TSourceFieldProperty } 
    type 
    'PSourceF'ield'Property = class (TStringProperty) 
    public 
    function GetAttributes: TPropertyAttributes; override; procedure 
GetValueList(List: TStrings); procedure GetValues (Proc: TGetStrProc) ; 
override/function GetTablePropName: string; virtual; 
    end; 
    function TSourceFieldPi?operty.GetAttributes: TPropertyAttributes; begin 
    Result := [paValueList, paSortList, paMultiSelect] ; end; 
    function TSourceFieldProperty.GetTablePropName: string; begin 
    Result := 'SourceTable'; end; 
    procedure TSourceFieldProperty.GetValues(Proc: TGetStrProc); var 
    I: Integer; Values: TStringList; begin 
    Values := TStringList. Create/try 
    GetValueList(Values); 
    for I := 0 to Values.Count - 1 do Proc(Values[I]); finally 
    Values.Free; end; end; 
    procedure TSourceFieldProperty.GetValueList(List: TStrings); var 
    Instance: TComponent; 
    Proplnfo: PPropInfo; 
    SourceTable : TTable; begin 
    Instance := TComponent(GetComponent(0)); 
    Proplnfo := TypInfo.GetPropInfo(Instance.Classlnfo, GetTablePropName); 
    if (Proplnfo <> nil) and (Proplnfo~.РгорТурел.Kind = tkClass) then 
    begin 
    SourceTable := TObject(GetOrdProp(Instance, Proplnfo)) as TTable; if 
(SourceTable <> nil) then 
    SourceTable.GetFieldNames(List); 
    end; end; 
    procedure Register; begin 
    RegisterComponents('Dialogs', [TZoomDialog]); 
    RegisterPropertyEditor(Typelnfo(string), TZoomDialog, 'SourceField', 
TSourceFieldProperty) ; end; 

    548	Часть IV. Темы повышенной сложности 

    Создаем собственный редактор свойств 

    Внимательное изучение содержащегося в листинге 27.13 исходного текста 
позволит вам понять методы создания редакторов свойств. Для создания такого 
редактора выполните следующие операции. 
    1.   Создайте класс-потомок одного из редакторов свойств, определенных в 
модуле Dsgnlntf. 
    2.    Напишите процедуры, позволяющие редактировать и выводить свойство на 
экран в текстовом представлении. Если это свойство не строкового типа, 
необходимо предусмотреть в редакторе соответствующие механизмы преобразования. 
    3.   Объявите в качестве тиражируемых соответствующие свойства нового 
редактора свойств, чтобы средство Object Inspector могло корректно их обрабатывать. 
    4.    С помощью процедуры RegisterPropertyEditor зарегистрируйте ваш 
редактор свойств. 
    В листинге 27.13 редактор свойства SourceFieldProperty унаследован от 
класса TStringProperty. Единственное отличие свойства SourceField от прочих 
строковых свойств заключается в необходимости вывода на экран раскрывающегося 
списка доступных полей. 
    Поскольку свойство является строковым, нет необходимости определять новые 
процедуры для преобразования типов: процедуры, унаследованные от класса 
stringProperty, прекрасно подойдут. 
    SourceFieldProperty сообщает Object Inspector о своих тиражируемых 
свойствах с помощью перекрытия функции GetAttributes класса TStringProperty. 
Сама функция состоит из одной строки. 

    Result   :=   [paValueList,   paSortList,   paMultiSelect]; 

    Здесь в одной строке определены три значения свойства редактора 
SourceFieldProperty. Первое говорит о том, что в качестве значения 
используется список допустимых значений — то есть допускается выбор из этого 
списка. Второй атрибут, paSortList, дает Object Inspector указание сортировать 
возвращаемый функцией Getvalues список. И хотя лично мне не нравится 
расположение имен полей в алфавитном порядке, я скопировал такое упорядочение 
ради сохранения однотипности с другими редакторами. Последний атрибут, 
paMultiSelect, показывает, что свойство SourceField изменяться и выводиться на 
экран даже в том случае, если выбрано несколько компонентов. Некоторые типы 
свойств (как, например, Name) нельзя редактировать при таких условиях. 
    Наконец, редактор свойств регистрируется посредством вызова функции RegisterPropertyEditor. 

    RegisterPropertyEditor(Typelnfo(string),   TZoomDlg, 'SourceField',   TSourceFieldProperty); 

    При вызове функции RegisterPropertyEditor необходимо передать ей следующие 
четыре параметра. 
    Q  Тип свойства, которым должен пользоваться редактор. Это делается с 
помощью встроенной функции 
    Typelnfo. 
    Q Тип компонента, с которым должен быть связан редактор. Если в качестве 
этого параметра передать nil, созданный редактор будет связываться со всеми 
компонентами, имеющими свойства данного типа. 
    Q  Имя редактируемого свойства. Это имеет значение только в том случае, 
если вы указали имя компонента вторым параметром. 
    Q   Класс редактора, связываемого с этим свойством. 
    В данном случае процедура RegisterPropertyEditor вызывается с параметрами, 
указывающими, что свойство принадлежит к строковому типу, и что редактор нужно 
привязывать только к свойству 

    SourceField компонента ZoomDialog. 


    Другие особенности компонента zoomDig 

    Центральная процедура компонента ZoomDig — это обработчик события OnClick 
кнопки ОК формы 

    ZoomForm. 
    procedure TfmZoom.bbOKClick(Sender: TObject); begin 
    If Caller is TDBEdit then begin With Caller as TDBEdit do begin 
    If (not (DataSource.DataSet.State in [dslnsert, dsEdit])) then DataSource.DataSet.Edit; 

    Глава 27. Разработка компонентов баз данных 549 

    DataSource.DataSet.FieldByName(DataField).AsString:= 
    dsZoom.DataSet.FieldByName(SourceField).AsString; end; 
    end else If Caller is TCustomField then begin With Caller as TCustomEdit 
do begin Clear; 
    Text:=dsZoom.DataSet.FieldByName(SourceField).asStzing; end; 
    end else If Caller is TDBComboBox then begin With Caller as TDBComboBox do begin 
    If (not (DataSource.DataSet.State in [dslnsert, dsEdit])) then DataSource.DataSet.Edit; 
    DataSource.DataSet.FieldByName(DataField).AsString:= 
dsZoom.DataSet.FieldByName(SourceField).AsString; end; end; 
    ModaResult := mrOK; end; 

    Самая заметная особенность этого программного фрагмента — широкое 
использование информации о типах времени выполнения (RTTI — RunTime Type 
Information). Обычные компиляторы не поддерживают RTTI. Однако, как вы уже, 
очевидно, заметили, Delphi имеет множество функций, отсутствующих в . гих 
компиляторах. В данном случае объект ZoomForm использует RTTI, чтобы 
определить тип объекта, ко торый его вызвал, чтобы потом правильно присвоить 
значение компонента. 
    Обратите внимание на использование оператора With. . .as для приведения 
типа переменной Caller.] Такой блок считается "безопасным", поскольку при 
ошибке в операции преобразования типа возникает исключительная ситуация. В 
других языках, допускающих приведение типа, в случае некорректного приведения 
может возникнуть ошибка нарушение доступа. Синтаксис With. . .as позволяет 
избежать такой ситуации и безопасно преобразовать тип переменных. 
Исключительные ситуации, возникшие при ошибке| приведения типа, легко обрабатываются. 

    Резюме 

    Теперь вы знаете, как создавать различные типы компонентов базы данных. 
Надеюсь, их создание бы-1 ло для вас не только хорошим уроком, но и подарило 
вам несколько новых игрушек. Сомневаюсь, правда,] что вам придется часто 
создавать новые компоненты при разработке приложений баз данных. Это придет-J 
ся делать лишь изредка. Но в любом случае примеры из этой главы вам пригодятся. 

    На заметку 
    Чтобы установить компоненты, обсуждавшиеся в этой главе, можно 
воспользоваться теми же методами, что и для компонента TArrayTable. После 
того, как вы сделаете это, загрузите демонстрационные приложения с 
прилагаемого к книге компакт-диска. Они покажут вам, как использовать эти 
компоненты в реальных приложениях.

    Что дальше... 

    Глава 28, "Приложения для работы с Internet", посвящена относительно новой 
области для технологии | клиент/сервер в Delphi — разработке приложений 
Internet. Мы создадим простой Web-броузер, приложе- j ние для покупок по сети 
и исследуем удивительно широкие возможности Delphi в области разработки 
приложений для Internet. 

550 Часть IV. Темы повышенной сложности 
