Rozdział 27
Tworzenie własnych komponentów
Delphi
W niniejszym rozdziale przedstawiamy zasady samodzielnego tworzenia
komponentów Delphi, przeznaczonych do obsługi bazy danych. Przedstawione
tutaj zostaną ogólne metody tworzenia wszelkiego rodzaju komponentów, a także
specyficzne zagadnienia, dotyczące budowy komponentów do obsługi baz danych.
Zagadnienie tworzenia komponentów Delphi doczekało się osobnych, obszernych
opracowań. Szczególną uwagę należy zwrócić na książkę Delphi Component
Design, autorstwa Danny'ego Thorpe'a.
Mimo że tworzenie własnych komponentów nie jest głównym tematem niniejszej
książki, nie można wykluczyć, że czytelnicy staną kiedyś przed koniecznością
samodzielnego zbudowania kilku komponentów. Rzeczywiste aplikacje nierzadko
wymagają uzupełnienia standardowego zbioru komponentów Delphi. Większość
"prawdziwych" aplikacji, napisanych w Delphi, będzie zapewne przeznaczona do
obsługi baz danych, dlatego przyszli autorzy takich aplikacji powinni przynajmniej
pobieżnie zapoznać się z problemem tworzenia komponentów.
W dalszej części tego rozdziału omówione zostaną trzy przykładowe, nowe
komponenty, przeznaczone do obsługi baz danych:
TArrayTable Potomek TTable, traktujący pola tabeli tak, jak elementy
tablicy.
TLiveQuery Potomek TTable, zapewniający lepszą niż TQuery obsługę
aktualizowanych zapytań (ang. live queries), dzięki wykorzystaniu perspektyw,
definiowanych na serwerze bazy danych.
TDBNavSearch Substytut komponentu TDBNavigator, oferujący
dodatkowy przycisk Szukaj.
TZoomDlg okno dialogowe, w którym dopuszczalne wartości wybranego pola
mogą być wybierane z innej tabeli bazy danych.
Każdy z wymienionych wyżej komponentów ma pewne specyficzne właściwości
i odmienny rodowód. TArrayTable jest prostym potomkiem TTable.
TLiveQuery jest bardziej złożonym potomkiem tego samego komponentu.
TDBNavSearch to poprawiona wersja komponentu TDBNavigator. Wreszcie
TZoomDlg jest komponentem niegraficznym, który wyświetla na ekranie
776 Część IV
formularz. Bliższa analiza powyższych komponentów ujawni różnorodne
problemy, związane samodzielnym tworzeniem komponentów.
Cztery etapy tworzenia komponentu
Oto cztery etapy tworzenia nowego komponentu Delphi:
1. Utworzenie nowej klasy komponentów na bazie jednej z klas dostępnych
w bibliotece VCL (Visual Component Library); służy do tego opcja New
Component z menu Component.
2. Dodanie nowych (lub zastąpienie odziedziczonych) metod i atrybutów nowego
komponentu.
3. Zapisanie procedury Register, rejestrującej nowy komponent na palecie
komponentów Delphi.
4. Dodanie komponentu do palety.
Nowe komponenty można tworzyć  ręcznie" albo przy pomocy Kreatora
Komponentów Delphi (Component Wizard). Kreator wywoływany jest poleceniem
New Component z menu Component. Zaleca się korzystanie z Kreatora wszędzie
tam, gdzie jest to możliwe. Nie ma w zasadzie powodu, aby rezygnować z usług
Kreatora, zwłaszcza w początkowej fazie tworzenia komponentu. Wyjątek
stanowią sytuacje, w których kilka komponentów musi znalez
ć się w jednym
module (unit).
TArrayTable
Komponent TArrayTable zapewnia dostęp do pól tabeli, tak jak gdyby były one
elementami dwuwymiarowej tablicy. Oznacza to, że aby uzyskać dostęp do
żądanego pola należy podać dwa indeksy - numer wiersza i kolumny. Mechanizm
taki bywa praktyczny wówczas, gdy zawartość bazy danych ma być prezentowana
na ekranie w postaci arkusza. Komponent TArrayTable można na przykład
wykorzystać razem ze standardowym komponentem TStringGrid - do
utworzenia własnej wersji kontrolki DBGrid. TArrayTable eliminuje
konieczność przesuwania wskaz
nika rekordu w zbiorze danych DataSet,
pozwalając na odwoływanie się do poszczególnych rekordów i pól za
pośrednictwem indeksów.
Aby przystąpić do tworzenia komponentu TArrayTable należy wybrać opcję
menu Component\New Component. Jako klasę przodka należy wskazać
TTtable, w polu Class Name wpisać nazwę klasy TArrayTable, wpisać
nazwę modułu ArrayTab.Pas i wybrać stronę palety DataAccess (zob. rysunek
27.1).
Rozdział 27 Tworzenie własnych komponentów Delphi 777
Rysunek 27.1
Pierwsze okno
dialogowe
Kreatora
komponentów.
Po naciśnięciu przycisku Create Unit okno dialogowe zostanie zamknięte,
a Kreator komponentów wygeneruje moduł zawierający definicję nowego
komponentu. Oryginalny tekst z
ródłowy takiego modułu przedstawiono na listingu
27.1.
Listing 27.1. W pierwszym etapie budowania nowego komponentu
Kreator generuje odpowiedni szkielet modułu (unit).
unit ArrayTab;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs,
Db, DBTables;
type
TArrayTable = class(TTable)
private
{ Private declarations }
protected
{ Protected declarations }
public
{ Public declarations }
published
{ Published declarations }
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents( Data Access , [TArrayTable]);
778 Część IV
end;
end.
Należy zwrócić uwagę na procedurę Register. W jej wywołaniu wymieniona
jest nazwa nowego komponentu oraz nazwy stron palety, na których ten
komponent ma być umieszczony. Aby komponent mógł być zainstalowany na
palecie Delphi, jego definicja musi obejmować procedurę Register. Nie
oznacza to jednak, że procedura Register musi rezydować w tym samym
module z
ródłowym, co sam komponent. Powszechną praktyką jest grupowanie
procedur rejestrujących kilku komponentów w jednym module, który jest
następnie używany do dodawania ich do palety. Na przykład, niektóre ze
standardowych komponentów Delphi rejestrowane są przy użyciu modułów,
zapisanych w katalogu Lib.
Do komponentu TArrayTable dodamy tylko jeden nowy atrybut - Records.
Jest to atrybut przeznaczony tylko do odczytu i dostępny wyłącznie w trakcie
wykonywania programu. Umożliwia on dostęp do pierwszego wymiaru (wierszy)
dwuwymiarowej tablicy rekordów/pól, którą symuluje nowy komponent.
Nowemu atrybutowi komponentu towarzyszą zazwyczaj metody zapisu i odczytu.
Metody takie umożliwiają pobieranie i zapisywanie wartości atrybutu ze
zmiennych prostszego typu, a także wykonywanie dodatkowych czynności
w chwili odczytywania lub zmiany wartości atrybutu. Definicję komponentu
TArrayTable należy zatem zmodyfikować w następujący sposób:
TArrayTable = class(TTable)
private
{ Private declarations }
function GetRecords(RecNum : Longint) : TDataSet;
protected
{ Protected declarations }
public
{ Public declarations }
property Records[RecNum : Longint] : TDataSet read
Ą' GetRecords;
published
{ Published declarations }
end;
Jak łatwo zauważyć, zmiany wprowadzone w definicji klasy są bardzo niewielkie.
Modyfikacje, zapewniające pożądany sposób dostępu do tabeli, nie są poważne.
Przede wszystkim należy zwrócić uwagę na pojawienie się funkcji GetRecords
w prywatnej (private) części definicji klasy. Funkcji odczytującej wartość atrybutu
zwyczajowo nadaje się nazwę składającą się ze słowa Get i nazwy atrybutu.
Analogicznie, nazwa procedury nadającej wartość atrybutowi składa się ze słowa
Rozdział 27 Tworzenie własnych komponentów Delphi 779
Set i nazwy atrybutu. W omawianym przykładzie nie występuje procedura zapisu,
gdyż nowy atrybut przeznaczony jest tylko do odczytu.
Uwagę zwraca także definicja samego atrybutu. Jest to atrybut indeksowany, co
oznacza, że przy odczytywaniu jego wartości należy podać indeks, podobnie jak
przy odwołaniu do elementu tablicy. Powiązanie między atrybutem Records
a funkcją GetRecords zapewnia słowo kluczowe read. W przypadku funkcji
przeznaczonej do zapisu wartości atrybutu należałoby użyć słowa kluczowego
write. Indeks, podawany w odwołaniu do atrybutu Records przekazywany jest
bezpośrednio do funkcji odczytującej GetRecords, a następnie wykorzystywany
przy uzyskiwaniu dostępu do żądanych rekordów.
Należy ponadto zwrócić uwagę na typ atrybutu Records - TDataSet. Na
pierwszy rzut oka przypisanie tego atrybutu właśnie typu TDataSet wydaje się
nieuzasadnione. Logiczne byłoby przypisanie atrybutu Records do klasy
w rodzaju TRecord lub analogicznej, obejmującej definicję rekordu. Wkrótce
wyjaśnimy powody, dla których atrybut Records reprezentuje jednak zbiór
danych TDataSet.
Po zmodyfikowaniu definicji klasy przychodzi czas na stworzenie odpowiedniej
funkcji GetRecords. Funkcja ta będzie wywoływana przy każdej próbie dostępu
do atrybutu Records. Oto tekst funkcji, który należy wpisać w sekcji
implementation tworzonego modułu:
functio TArrayTable.GetRecords(RecNum : Longint) : TDataSet;
begin
First;
MoveBy(RecNum);
Result:=Self;
end;
Funkcja GetRecords zwraca wartości typu TDataSet, podobnie jak atrybut
Records. Dlaczego? Otóż komponenty Delphi TField nie są przechowywane
w rekordach - zbiory danych DataSet nie składają się z szeregu rekordów, które
należałoby odczytać w celu uzyskania dostępu do danych z poszczególnych pól.
Dostęp do komponentów TField uzyskuje się natomiast bezpośrednio
z komponentu TDataSet, za pośrednictwem atrybutu Fields. Atrybut ten także
jest indeksowany. Jednoczesne użycie indeksowanego atrybutu Records nowego
komponentu i - również indeksowanego - atrybutu Fields wynikowego zbioru
danych stwarza wrażenie dostępu do pól zgromadzonych w dwuwymiarowej
tablicy.
Przyjrzyjmy się teraz fragmentowi programu, wykonywanemu przy każdym
odczycie wartości atrybutu Records. Do funkcji GetRecords przekazywany
jest numer żądanego rekordu. Funkcja wykonuje następujące czynności:
780 Część IV
1. Przesuwa wskaz
nik bieżącego rekordu na początek zbioru danych.
2. Przesuwa wskaz
nik do żądanego rekordu.
3. Jako wynik zwraca wskaz
nik do całego komponentu TArrayTable.
Dzięki temu, że funkcja najpierw ustawia wskaz
nik na żądanym rekordzie, po
czym zwraca wskaz
nik do całego zbioru danych, komponentu TArrayTable
można używać w następujący sposób:
X:=ArrayTable1.Records[4].Fields[2].Value;
Jak nietrudno zauważyć, dostęp do wartości poszczególnych pól odbywa się
podobnie, jak dostęp do elementów tablicy.
Na listingu 27.2 przedstawiono kompletny tekst z
ródłowy nowego komponentu
TArrayTable.
Listing 27.2. Kompletny tekst z
ródłowy komponentu
TArrayTable.
{
ArrayTable Delphi Component
Provides an array-like interface to a table.
Use the syntax:
Records[RecNum].Fields[FieldNum].AsType
to access individual field values.
Written by Ken Henderson.
Copyright (c) 1995-97 by Ken Henderson.
}
unit ArrayTab;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs,
Db, DBTables;
type
TArrayTable = class(TTable)
private
{ Private declarations }
function GetRecords(RecNum : Longint) : TDataSet;
protected
{ Protected declarations }
public
{ Public declarations }
Rozdział 27 Tworzenie własnych komponentów Delphi 781
property Records[RecNum : Longint] : TDataSet read
Ą' GetRecords;
published
{ Published declarations }
end;
procedure Register;
implementation
function TArrayTable.GetRecords(RecNum : Longint) : TDataSet;
begin
First;
MoveBy(RecNum);
Result:=Self;
end;
procedure Register;
begin
RegisterComponents( Data Access , [TArrayTable]);
end;
end.
Komponent jest teraz gotowy do zainstalowania na palecie Delphi. Po zapisaniu
tekstu z
ródłowego należy wybrać opcję Install Components z menu Component.
Gdy na ekranie pojawi się okno dialogowe Install Components, w należy wpisać
pełną ścieżkę dostępu do pliku ArrayTab.PAS, a następnie kliknąć OK, co
spowoduje zainstalowanie nowego komponentu. Okno dialogowe Install
Components przedstawiono na rysunku 27.2.
Rysunek 27.2.
Okno dialogowe
Install Components
umożliwia
dodawanie
komponentów do
palety Delphi.
Delphi pyta, czy ma uzupełnić pakiet DCLUSR30. Należy odpowiedzieć
twierdząco (Yes) - nowy komponent zostanie dodany do pakietu. Jeśli uzupełniany
pakiet korzysta z innych pakietów, to Delphi zapyta, czy również one mają być
dołączane. Także na to pytanie należy odpowiedzieć twierdząco. Po
zainstalowaniu komponentu w środowisku Delphi uruchomiony zostanie moduł
782 Część IV
Package Manager (menedżer pakietów). Należy go zamknąć i zgodzić się na zapis
zmian w pakiecie.
Korzystanie z komponentu w aplikacji
Komponent, zainstalowany na palecie Delphi, można już wykorzystać w aplikacji.
Z menu File należy wybrać opcję New Application. Następnie - ze strony Data
Access palety komponentów - należy wybrać komponent TArrayTable.
Znajduje się on po prawej stronie palety i reprezentowany jest przez tą samą ikonę,
co komponent TTable. Należy teraz umieścić komponent TArrayTable na
formularzu. W oknie Object Inspector pojawią się atrybuty nowego komponentu -
identyczne z atrybutami komponentu TTable. TArrayTable jest bowiem
potomkiem klasy TTable i nie zdefiniowano w nim żadnych nowych atrybutów
typu published (tylko takie atrybuty pojawiają się w oknie Object Inspector). Na
formularzu należy ponadto umieścić przycisk i obiekty StringGrid. Procedura
obsługi zdarzenia dla przycisku powinna przyjąć następującą postać (aby wpisać
procedurę obsługi zdarzenia należy dwukrotnie kliknąć na przycisku):
procedure TForm1.Button1Click(Sender: Tobject);
var
RCount, FCount : Integer;
begin
With ArrayTable1, StringGrid1 do begin
ColCount:=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:=1 to RecordCount do
for Fcount:=0 to Pred(FieldCount) do
Ą' Cells[Succ(FCount),RCount]:=Records
Ą' [RCount].Fields[FCount].AsString;
end;
end;
Jak już wspomniano, komponent StringGrid w połączeniu z TArrayTable może
być odpowiednikiem kontrolki DBGrid, przeznaczonej tylko do przeglądania,
a nie edycji danych.
Przyjrzyjmy się bliżej przedstawionemu powyżej fragmentowi programu.
Procedurę otwierają dwie instrukcje przypisania:
ColCount:=Succ(FieldCount);
RowCount:=Succ(RecordCount);
ColCount i RowCount to atrybuty komponentu StringGrid. Przypisanie im
odpowiednio wartości atrybutów FieldCount i RecordCount komponentu
Rozdział 27 Tworzenie własnych komponentów Delphi 783
ArrayTable nadaje obiektowi StringGrid rozmiary niezbędne do
wyświetlenia wszystkich wierszy i kolumn tabeli. Wartości FieldCount
i RecordCount zostały zwiększone o 1, gdyż pierwsza kolumna i pierwszy
wiersz nie będą zawierać danych pobranych z tabeli.
Przypisanie
Cells[0,0]:=TableName;
umieszcza nazwę tabeli ArrayTable w lewym-górnym rogu kontrolki
StringGrid.
Pierwsza pętla:
For FCount:=0 to Pred(FieldCount) do
Cells[Succ(FCount),0]:=Fields[FCount].FieldName;
umieszcza w pierwszym wierszu kontrolki StringGrid nazwy poszczególnych
pól. Nazwy pól pobierane są za pośrednictwem atrybutu FieldName.
Druga pętla:
for Rcount:=1 to RecordCount do
for Fcount:=0 to Pred(FieldCount) do
Cells[Succ(FCount),RCount]:=Records[RCount].Fields[FCount
Ą' ].AsString;
end;
end;
sekwencyjnie wypełnia pola właściwymi danymi, odwołując się do pseudo-tablicy
TArrayTable za pośrednictwem indeksów liczbowych.
Kolejnym etapem, po przygotowaniu procedury obsługi zdarzenia OnClick
przycisku, jest nadanie wartości najważniejszym atrybutom komponentu
ArrayTable. Należy zatem kliknąć na komponencie ArrayTable na
formularzu i wpisać wartości atrybutów DatabaseName i TableName, tak by
wskazywały na poprawną parę: baza danych-tabela. Można na przykład wybrać
bazę danych i tabelę RENTMAN z części  Tutorial . Następnie należy podwójnie
kliknąć na atrybucie Active komponentu ArrayTable, co spowoduje otwarcie
tabeli. Można teraz zapisać projekt i uruchomić aplikację. Na rysunku 27.3
przedstawiono okno aplikacji w czasie pracy.
WSKAZÓWKA:
Aby umożliwić użytkownikowi zmianę rozmiarów i kolejności wyświetlania
kolumn na ekranie, należy kliknąć komponent StringGrid i nadać wartość True
przełącznikom goColSizing i goColMoving atrybutu Options.
784 Część IV
Rysunek 27.3.
Komponent
ArrayTable może -
razem ze
StringGrid -
zastępować
komponent
DBGrid.
Kliknięcie przycisku spowoduje wypełnienie kontrolki StringGrid danymi
z tabeli. Będzie ona teraz przypominać kontrolkę DBGrid z atrybutem
ReadOnly.
TLiveQuery
Klasa TLiveQuery stanowi uzupełnienie mechanizmu aktualizowanych zapytań
(ang. live queries), dostępnego w Delphi. Aktualizowane zapytania tworzy się
standardowo nadając wartość True atrybutowi RequestLive komponentu
Query. Zapytanie w języku SQL, użyte w takim komponencie, podlega pewnym
ograniczeniom, narzucanym przez Delphi w odniesieniu do zapytań
aktualizowanych. Komponent LiveQuery pozwala obejść to ograniczenie,
przekształcając zapytanie SQL, określone przez użytkownika, w perspektywę,
zdefiniowaną na serwerze bazy danych. Perspektywa jest następnie otwierana, tak
jak zwykła tabela. Jeśli stosowany serwer pozwala na aktualizację perspektyw, to
powinna być także możliwa aktualizacja zbioru wynikowego, zwracanego przez
LiveQuery.
LiveQuery tworzy perspektywę przy pomocy polecenia SQL CREATE VIEW.
Dlatego też stosowana platforma systemowa musi dopuszczać użycie tego
polecenia. Oznacza to, że komponentu TLiveQuery nie będzie można używać
z lokalnymi tabelami, np. w formacie dBASE lub Paradox. Z drugiej strony należy
zwrócić uwagę na fakt, że każdy rodzaj aktualizacji perspektywy, dopuszczany
przez serwer, będzie również możliwy do wykonania za pośrednictwem
TLiveQuery.
LiveQuery przenosi odpowiedzialność za dekompozycję złożonych zapytań
z aplikacji na serwer bazy danych. Jest to zgodne z ideą modelu klient-serwer.
Producenci oprogramowania serwerów baz danych najlepiej znają własne dialekty
SQL, dlatego celowe wydaje się zlecenie analizy zapytań właśnie serwerowi.
Aktualizacja zbioru wynikowego wiąże się z odtworzeniem pierwotnych kolumn.
Rozdział 27 Tworzenie własnych komponentów Delphi 785
Dla każdej kolumny zbioru wynikowego znalez
ć trzeba odpowiednią rzeczywistą
tabelę i kolumnę. Równie starannej analizie podlegać muszą kryteria wyboru
wierszy w zbiorze wynikowym. Aktualizacji muszą podlegać nie tylko właściwe
kolumny, lecz także odpowiedni zbiór rekordów. W przypadku złożonych zapytań,
zawierających kolumny z wyliczanymi wartościami, wielopoziomowe złączenia
i skomplikowane klauzule WHERE i HAVING, odpowiednia analiza może okazać
się bardzo trudnym zadaniem. Dlatego lepiej będzie zlecić je serwerowi bazy
danych, który najlepiej zna swój własny dialekt SQL i obiekty bazy danych.
Komponent TLiveQuery będzie potomkiem klasy TTable. Należy go umieścić
na stronie Data Access, podobnie jak poprzedni komponent ArrayTable.
W polu Unit filename należy wpisać nazwę LiveQry.PAS, a następnie kliknąć
przycisk Create Unit, co spowoduje otwarcie edytora Delphi.
W wygenerowanym tekście programu trzeba będzie wprowadzić kilka niewielkich
zmian. Konieczne będzie dodanie czterech nowych atrybutów w sekcji published,
a także pomocniczych w stosunku do nich fragmentów programu i zmiennych
komponentu. Listing 27.3 ilustruje zmiany w definicji klasy.
Listing 27.3. Definicja klasy komponentu LiveQuery.
TLiveQuery = class(TTable)
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;
786 Część IV
end;
Przed definicją klasy należy umieścić kilka definicji stałych, które będą używane
przez komponent:
const
DEFAULTCREATEVIEWSQL =  CREATE VIEW %s AS ;
DEFAULTDROPVIEWSQL =  DROP VIEW %s ;
DEFAULTTABLENAMEFORMAT =  TV %s ;
Należy podkreślić, że powyższych stałych nie można używać w nagłówkach
w ramach definicji klasy TLiveQuery, gdyż Delphi nie zezwala na nadawanie
atrybutom wartości domyślnych, nie należących do typu całkowitego lub
zbiorowego. A zatem, wbrew oczekiwaniom, zapis:
property TableNameFormat : TFileName read FTableNameFormat
write FTableNameFormat deafult DEFAULTTABLENAMEFORMAT;
nie jest dozwolony, ponieważ w Delphi domyślna wartość atrybutu nie może
należeć do typu łańcuchowego. Domyślne wartości atrybutów wykorzystywane są
przez Delphi jedynie do określenia, czy wartość atrybutu uległa zmianie i czy
konieczny jest zapis na dysk. Właściwe przypisanie domyślnych wartości
atrybutów powinno odbywać się w konstruktorze komponentu.
CreateViewSQL
Atrybut CreateViewSQL zawiera tekst polecenia SQL CREATE VIEW,
w formie akceptowanej przez używany serwer bazy danych. Domyślnie stosowana
jest składnia zgodna ze standardem ANSI. Należy zwrócić uwagę na symbol %s
w stałej DEFAULTVIEWSQL. Funkcja Delphi Format zastąpi %s nazwą
tymczasowej perspektywy, wygenerowanej przez komponent. Mechanizm ten jest
zbliżony do stosowanego w funkcji sprintf() w języku C i C++.
DropViewSQL
Atrybut DropViewSQL jest odpowiednikiem CreateViewSQL, zawierającym tekst
polecenia usuwającego perspektywę - DROP VIEW. Również w tym przypadku
symbol %s zastępowany będzie przez funkcję Format nazwą tymczasowej
perspektywy, utworzonej przez komponent.
TableNameFormat
TableNameFormat umożliwia określenie specyficznej postaci nazwy perspektywy,
wymaganej przez stosowany serwer bazy danych. W przypadku niektórych
Rozdział 27 Tworzenie własnych komponentów Delphi 787
platform systemowych, przed każdym odwołaniem do obiektu występować musi
nazwa jego właściciela. Jeżeli stosowany serwer bazy danych stawia tego rodzaju
wymagania, to w ramach atrybutu TableNameFormat określić można
niezbędne elementy formatu.
Po przygotowaniu nagłówków nowej klasy należy wpisać jej część
implementacyjną, przedstawioną na listingu 27.4.
Listing 27.4. Główna część komponentu 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
CheckInActive;
SQL.Assign(Value);
end;
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 (TemporaryDB<>nil) then begin
If (TemporaryDB.IsSQLBased) then begin
788 Część IV
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 );
end;
finally
Session.CloseDatabase(TemporaryDB);
end;
finally
WorkSQL.Free;
end;
end;
procedure TLiveQuery.DoBeforeOpen;
begin
inherited DoBeforeOpen;
CreateTemporaryView;
end;
procedure TLiveQuery.DropTemporaryView;
var
TemporaryDB : TDatabase;
WorkSQL : TStrings;
begin
WorkSQL:=TStringList.Create;
try
WorkSQL.Add(Format(DropViewSQL,[TableName]));
TemporaryDB:=Session.OpenDatabase(DatabaseName);
try
If (TemporaryDB<>nil) then begin
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 )
end;
finally
Session.CloseDatabase(TemporaryDB);
end;
Rozdział 27 Tworzenie własnych komponentów Delphi 789
finally
WorkSQL.Free;
end;
end;
procedure TLiveQuery.DoAfterClose;
begin
DropTemporaryView;
inherited DoAfterClose;
end;
procedure Register;
begin
RegisterComponents( Data Access , [TLiveQuery]);
end;
Konstruktor
W kolejnych sekcjach omówione zostaną poszczególne elementy części
implementacyjnej tworzonego komponentu. Przyjrzyjmy się najpierw
konstruktorowi komponentu:
constructor TLiveQuery.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FSQL := TStringList.Create;
FCreateViewSQL := DEFAULTCREATEVIEWSQL;
FDropViewSQL := DEFAULTDROPVIEWSQL;
FTableNameFormat := DEFAULTTABLENAMEFORMAT;
end;
Pierwszą realizowaną czynnością jest wywołanie konstruktora Create przodka, tj.
klasy TTable. W wywołaniu używane jest słowo kluczowe inherited. Wiersz
inherited Create(AOwner);
wywołuje konstruktor Create komponentu TTable i przekazuje do niego parametr
AOwner, który pierwotnie przekazany został do komponentu TLiveQuery.
W kolejnym etapie działania konstruktor tworzy egzemplarz obiektu
TStringList i przypisuje go prywatnej zmiennej FSQL. W zmiennej tej
przechowywana będzie wartość atrybutu SQL, w ramach którego określa się ciąg
poleceń SQL, tworzących aktualizowane zapytanie.
Kolejne trzy instrukcje przypisują zdefiniowane wcześniej stałe prywatnym
zmiennym, odpowiadającym publikowanym (published) atrybutom komponentu.
Wartości domyślne atrybutów przypisywane są właśnie w ramach konstruktora
komponentu. Słowa kluczowe Default w definicji klasy mają - wbrew pozorom
790 Część IV
- inne przeznaczenie. Pozwalają jedynie stwierdzić, czy domyślna wartość atrybutu
została zastąpiona nową wartością. Wszystkie zmodyfikowane wartości atrybutów
zapisywane są na dysk. Właściwe przypisanie wartości domyślnych atrybutom
odbywa się w ramach konstruktora Create komponentu.
Destruktor
Kolejną procedurą w części implementacyjnej LiveQuery jest destruktor. Ma on
następującą postać:
destructor TLiveQuery.Destroy;
begin
If Active then begin
Close;
DropTemporaryView;
end;
SQL.Free;
inherited Destroy;
end;
Destruktor wywoływany jest każdorazowo przy usuwaniu komponentu. Procedura
ta przede wszystkim zamyka kursor bazy danych komponentu, jeśli jest on
otwarty, a następnie usuwa tymczasową perspektywę. Działanie destruktora
kończy się na zwolnieniu pamięci zarezerwowanej przez obiekt TStrings,
utworzony dla atrybutu SQL i wywołaniu destruktora przodka, tj. TTable.
SetQuery
Kolejna procedura, SetQuery, jest metodą zapisu (Set...) atrybutu SQL.
Przyjmuje ona następującą postać:
procedure TLiveQuery.SetQuery(Value: TStrings);
begin
CheckInActive;
SQL.Assign(Value);
end;
Pierwszą wykonywaną czynnością jest wywołanie odziedziczonej procedury
CheckInActive. CheckInActive pozwala upewnić się, że zbiór danych
DataSet jest nieaktywny przed dokonaniem jakichkolwiek zmian, które mogłyby
wpłynąć na jego powiązanie z innymi danymi. Jeśli komponent jest aktywny,
procedura generuje wyjątek przerywający operację.
Procedura SetQuery kończy się wywołaniem metody Assign komponentu
SQL. Metoda Assign kopiuje zawartość jednego obiektu TStrings do
Rozdział 27 Tworzenie własnych komponentów Delphi 791
drugiego. W tym przypadku, do atrybutu SQL kopiowana jest wartość wpisana
w oknie Object Inspector.
CreateTemporaryView
Metoda CreateTemporaryView tworzy - zgodnie ze swą nazwą - perspektywę
na serwerze bazy danych. Perspektywa ta stanie się zbiorem danych komponentu
LiveQuery. Perspektywa jest tymczasowa ( temporary ), gdyż zostanie usunięta
po zamknięciu lub usunięciu komponentu. W procedurze CreateTemporary-
View występuje kilka interesujących elementów. Przyjrzyjmy się jej tekstowi
z
ródłowemu:
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 (TemporaryDB<>nil) then begin
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 );
end;
finally
Session.CloseDatabase(TemporaryDB);
end;
finally
WorkSQL.Free;
end;
end;
Przede wszystkim należy zauważyć, że CreateTemporaryView tworzy na
własny użytek roboczy obszar, WorkSQL, w którym wykonuje wszelkie operacje
na zapytaniu, przechowywanym w atrybucie SQL. Obszar WorkSQL tworzony jest
792 Część IV
na początku procedury, a blok Try...Finally gwarantuje, że zarezerwowana
nań pamięć zostanie zwolniona, gdy obszar roboczy przestanie być potrzebny.
Następnie omawiana procedura nadaje wartość odziedziczonemu atrybutowi
TableName, korzystając z funkcji Format, atrybutu TableNameFormat
i bieżącej daty oraz czasu. Niestety, w komponencie LiveQuery TableName
jest wciąż atrybutem opublikowanym (published). W tym przypadku nie ma jednak
powodu, by użytkownik określał nazwę tabeli - wpisana nazwa i tak zostanie
zastąpiona nadawaną w procedurze CreateTemporaryView. TableName
pozostaje w komponencie LiveQuery atrybutem opublikowanym, gdyż Delphi
nie pozwala na przeniesienie atrybutu z sekcji published do private lub public
w komponencie potomnym. Dozwolona jest migracja w przeciwnym kierunku, tj.
opublikowanie atrybutu prywatnego. Nie można natomiast ukryć odziedziczonego
atrybutu.
Po określeniu nazwy tabeli, procedura ponownie korzysta z funkcji Format - tym
razem w celu umieszczenia polecenia CREATE VIEW na początku zapytania.
Wykorzystywany jest przy tym atrybut CreateViewSQL. Właśnie tutaj tkwi
istota działania komponentu LiveQuery. Przekazane komponentowi zapytanie
SQL przekształcane jest w instrukcję CREATE VIEW, które następnie trafia do
serwera bazy danych. Oznacza to przede wszystkim, że elementy języka,
zastosowane w zapytaniu, muszą być poprawnie obsługiwane przez serwer.
Przekazane zapytanie nie może zawierać elementów, których użycie nie jest
dozwolone w perspektywach. Ponadto, jeśli perspektywa ma podlegać aktualizacji,
serwer musi dopuszczać stosowanie aktualizowanych perspektyw (większość
serwerów daje taką możliwość), a zapytanie nie może zawierać elementów,
których stosowanie nie jest dozwolone w takich perspektywach. Zadania, związane
z analizą zapytania i aktualizacją odpowiednich wierszy i kolumn realizowane
będą wyłącznie przez serwer, a nie przez aplikację lub BDE.
Polecenie SQL, przygotowane w obiekcie WorkSQL, musi zostać przesłane do
serwera i wykonane. Ponieważ komponent LiveQuery jest potomkiem klasy
TTable, nie jest w nim dostępny prosty sposób przesyłania do serwera własnych
poleceń SQL. Gdyby przodkiem LiveQuery był komponent Query, do
dyspozycji stałaby procedura ExecSQL. Ponieważ TTable nie oferuje takiej
procedury, LiveQuery musi utworzyć własny potok, zapewniający połączenie
z serwerem bazy danych i skorzystać z funkcji BDE DbiQExecDirect w celu
przesłania zapytania SQL do serwera.
Należy zwrócić uwagę na trzeci argument funkcji DBiQExecDirect. Powinien
on być zmienną typu PChar. Możliwa jest jednak prosta konwersja atrybutu
Text obiektu WorkSQL do typu PChar. Kompilator Delphi automatycznie
wygeneruje kod, niezbędny do jej przeprowadzenia.
Rozdział 27 Tworzenie własnych komponentów Delphi 793
Na uwagę zasługuje ponadto użycie atrybutu IsSQLBased tymczasowego
komponentu typu Database. Jak już wspomniano, LiveQuery nie można
stosować z lokalnymi systemami zarządzania bazami danych, które nie pozwalają
na definiowanie perspektyw (należą do nich dBASE i Paradox). Nowy komponent
musi zatem sprawdzać, czy system zarządzania bazą danych funkcjonuje w oparciu
o serwer SQL. W razie potrzeby generowany jest odpowiedni wyjątek.
Ostatnie czynności, realizowane przez procedurę, obejmują zamknięcie
tymczasowego połączenia z bazą danych i zwolnienie pamięci zarezerwowanej na
obszar roboczy. Obie operacje realizowane są w sekcji finally bloku
try...finally. Fragment programu, umieszczony w sekcji finally, zostanie
wykonany nawet wówczas, gdy kod po słowie try spowoduje wystąpienie wyjątku.
DoBeforeOpen
Metoda DoBeforeOpen spełnia bardzo prostą funkcję: zastępuje domyślną
procedurę DoBeforeOpen i wywołuje procedurę tworzenia tymczasowej
perspektywy w momencie wywołania metody Open komponentu. Ponieważ
CreateTemporaryView nadaje również wartość atrybutowi TableName, cała
operacja skutkuje stworzeniem nazwy perspektywy i przypisaniem jego nazwy tuż
przed otwarciem jej, tak jak zwykłej tabeli. Należy podkreślić, że wywołanie
odziedziczonej procedury DoBeforeOpen przed przystąpieniem do dalszych
czynności gwarantuje, że ewentualny, napisany przez użytkownika, podprogram
obsługi zdarzenia BeforeOpen zostanie wykonany przed utworzeniem
tymczasowej perspektywy.
DropTemporaryView
Kolejna metoda w części implementacyjnej LiveQuery - DropTemporary-
View, usuwa perspektywę utworzoną przez metodę CreateTemporaryView.
Również ta metoda korzysta z własnego, tymczasowego połączenia z bazą danych
i przesyła polecenie SQL DROP VIEW do serwera przy pomocy procedury
DbiQExecDirect.
DoAfterClose
Procedura DoAfterClose wykonywana jest po zamknięciu komponentu.
Wywołuje ona metodę DropTemporaryView, która z kolei usuwa wcześniej
utworzoną perspektywę. Ponadto wywoływana jest odziedziczona metoda
DoAfterClose, dzięki czemu może być wykonany podprogram, skojarzony
przez użytkownika ze zdarzeniem AfterClose.
794 Część IV
Przed przystąpieniem do kompilacji modułu LiveQry.PAS konieczne jest
dodanie modułu BDE do klauzuli uses. Nowy komponent odwołuje się bowiem
bezpośrednio do funkcji API BDE. Po przygotowaniu moduły LIVEQRY.PAS
można dodać komponent TLiveQuery do palety komponentów. Odpowiedni
sposób postępowania opisano przy okazji omawiania komponentu
TArrayTable. Na listingu 27.5 przedstawiono kompletny tekst z
ródłowy
komponentu TLiveQuery.
Listing 27.5. Tekst z
ródłowy komponentu LiveQuery.
{
LiveQuery Delphi Component
Supports editing of SQL server result sets through the use of
temporary views.This allows any result set to be updated that
would be editable had the user created it as a view on the
back-end. Any updates that would be supported by the back-end
against views are therefore supported.
Written by Ken Henderson.
Copyright (c) 1995-97 by Ken Henderson.
A couple of caveats:
1) This magic is performed through the use of temporary views,
so
a) Since some platforms, like Sybase, don t support
temporary views, I have to construct a temp name and
both create and drop the view. I usethe date and time
to create a name, so name collisions with other users
are remotely possible.See the source code.You can
handle the exception that is raised, if this happens,
and simply re-issue the Open -- it s up to you.
b) Your users will need permission to create views,
obviously
c) Because it create views, the component is only usable
on servers that support views, i.e. remote servers --
you can t use it with dBase and Paradox tables.
On the positive side, you can:
1) Use any syntax your server supports for updatable views,
including:
a) as many tables as you want via joins
b) where and having clauses
This puts all the burden on the server, where, in my opinion,
it belongs. It also may mean that the SQL you execute will be
Rozdział 27 Tworzenie własnych komponentów Delphi 795
compiled ahead of time, which should make it execute more
efficiently. If your server doesn t like an update you try to
perform, obviously an exception will be raised.
}
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 }
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;
796 Część IV
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
CheckInActive;
SQL.Assign(Value);
end;
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 (TemporaryDB<>nil) then begin
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
Rozdział 27 Tworzenie własnych komponentów Delphi 797
raise EDatabaseError.Create( Cannot
Ą' use this component with local
Ą' tables );
end;
finally
Session.CloseDatabase(TemporaryDB);
end;
finally
WorkSQL.Free;
end;
end;
procedure TLiveQuery.DoBeforeOpen;
begin
inherited DoBeforeOpen;
CreateTemporaryView;
end;
procedure TLiveQuery.DropTemporaryView;
var
TemporaryDB : TDatabase;
WorkSQL : TStrings;
begin
WorkSQL:=TStringList.Create;
try
WorkSQL.Add(Format(DropViewSQL,[TableName]));
TemporaryDB:=Session.OpenDatabase(DatabaseName);
try
If (TemporaryDB<>nil) then begin
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 )
end;
finally
Session.CloseDatabase(TemporaryDB);
end;
finally
WorkSQL.Free;
end;
end;
798 Część IV
procedure TLiveQuery.DoAfterClose;
begin
DropTemporaryView;
inherited DoAfterClose;
end;
procedure Register;
begin
RegisterComponents( Data Access , [TLiveQuery]);
end;
end.
TDBNavSearch
TDBNavSearch jest szablonem komponentu (ang. component template),
zastępującym standardowy komponent DBNavigator. Na pierwszy rzut oka jego
jedyną przewagę stanowi obecność dodatkowego przycisku Szukaj,
uzupełniającego zestaw przycisków, oferowany przez DBNavigator. Bliższa
analiza obiektu DBNavSearch ujawni jednak wiele innych różnic. Tekst
z
ródłowy programu jest tym razem zbyt rozbudowany, by dało się go tutaj
szczegółowo analizować. Ogólne omówienie rozpoczniemy zatem od procedury
tworzenia szablonów komponentów, ich przeznaczenia i specyficznych
właściwości, wykorzystanych przy definiowaniu obiektu DBNavSearch.
Szablony (component templates) są obiektami, grupującymi większą liczbę
komponentów. Po umieszczeniu takiego szablonu na formularzu, ujrzymy szereg
komponentów, które nie muszą być identyczne ani w jakikolwiek sposób ze sobą
powiązane.
W jaki sposób tworzy się szablony komponentów? Oto odpowiednia procedura
postępowania - należy:
1. Na formularzu wybrać komponenty, które mają wejść w skład szablonu.
2. Wywołać opcję menu Component\Create Component Template.
3. Podać nazwę komponentu, wybrać stronę palety i ikonę, a następnie kliknąć
OK.
Nowy obiekt zostaje umieszczony na palecie komponentów Delphi i może być
stosowany w aplikacjach, tak jak wszystkie pozostałe komponenty.
Wszelkie dodatkowe podprogramy, skojarzone z komponentami, które weszły w
skład szablonu, zostaną dołączone do każdego formularza, na którym szablon
zostanie umieszczony. Właśnie ta właściwość szablonów komponentów decyduje
o ich rzeczywistej praktycznej wartości. Podprogramy, skojarzone z kontrolkami,
wchodzącymi w skład szablonu, kojarzone są automatycznie z formularzami, w
Rozdział 27 Tworzenie własnych komponentów Delphi 799
których szablon jest wykorzystywany. Mogą być zatem częściowo lub całkowicie
zastępowane (przesłaniane) i modyfikowane.
Konsekwencje, jakie niesie ze sobą możliwość dowolnego modyfikowania
podprogramów, skojarzonych z obiektami, łatwiej będzie dostrzec, jeśli
porównamy mechanizm indywidualnej modyfikacji komponentu DBNavigator
i obiektu DBNavSearch. Programiści stosunkowo często decydują się na
przypisanie niestandardowych funkcji przyciskom kontrolki DBNavigator.
Czasami pożądane jest, aby naciśnięcie przycisku Edit spowodowało wyświetlenie
na ekranie specjalnego formularza. W jaki sposób uzyskuje się ten efekt? Należy
napisać własny podprogram obsługi zdarzenia OnClick; podprogram taki musi
sprawdzić, który przycisk naciśnięto (zazwyczaj korzysta się tutaj z instrukcji
case). Wszystkie przyciski DBNavigatora obsługiwane są zatem przez jeden,
wspólny podprogram.
Natomiast DBNavSearch umożliwia modyfikację funkcji każdego z przycisków,
które traktowane są analogicznie, jak standardowe przyciski Delphi. Podprogram
obsługi zdarzenia OnClick zapisać można dla każdego przycisku z osobna.
Kontrolki, wchodzące w skład szablonu DBNavSearch są oddzielnymi
komponentami. Programista może zatem dwukrotnie kliknąć na dowolnie
wybranej kontrolce i przypisać jej indywidualny podprogram obsługi zdarzenia.
A zatem, aby zmodyfikować funkcję przycisku Edit, wystarczy na nim dwukrotnie
kliknąć. Na ekranie pojawi się tekst podprogramu, który aktualnie jest skojarzony
z wybranym przyciskiem. Podprogram można teraz usunąć lub dowolnie
rozbudować. Bez wątpienia jest to bardziej komfortowa metoda realizacji tego
samego zadania.
Przyjrzyjmy się kolejnemu, typowemu problemowi, związanemu z kontrolką
DBNavigator. Często zachodzi potrzeba usunięcia niektórych przycisków.
W przypadku standardowego komponentu DBNavigator - aby dodać lub usunąć
przyciski programista musi zmodyfikować zawartość atrybutu
VisibleButtons. Atrybut ten należy do typu zbiorowego, nie ma zatem
możliwości dodania własnych przycisków, różnych od dostępnych standardowo.
Zbiór wszystkich potencjalnie dostępnych przycisków ograniczony jest w definicji
typu. Ten sam problem występuje również we wszelkich komponentach
potomnych, utworzonych na bazie DBNavigator. Zmiennych typu zbiorowego
nie można rozszerzać na drodze dziedziczenia. Jak widać, również w tym
przypadku modyfikacja jednego, wspólnego atrybutu ma wpływ na wszystkie
przyciski.
Natomiast w przypadku obiektu DBNavSearch przyciski, które w danej aplikacji
mają pozostać niewidoczne, można po prostu usunąć. Jeśli dany przycisk nie jest
w ogóle potrzebny, może zostać usunięty z formularza. Jeśli ma być tymczasowo
niewidoczny, to wystarczy przypisać wartość FALSE jego atrybutowi Visible.
800 Część IV
Kontrolki, wchodzące w skład szablonu, zachowują się tak samo, jak zwykłe
komponenty, umieszczane na formularzu pojedynczo.
Po tym wstępie, prezentującym podstawowe różnice między tradycyjnymi
komponentami, a szablonami komponentów (component templates), pora przyjrzeć
się bliżej implementacji obiektu DBNavSearch. Poniżej przedstawiono kolejne
czynności, które doprowadziły do utworzenia szablonu komponentów
DBNavSearch:
1. Na formularzu umieszczono zestaw przycisków typu SpeedButton oraz
komponent DataSource. Obiekty te odpowiadają przyciskom i atrybutowi
DataSource komponentu DBNavigator.
2. Z każdym obiektem SpeedButton skojarzono odpowiednią mapę bitową;
w ten sposób osiągnięto zewnętrzne podobieństwo przycisków do ich
odpowiedników w komponencie DBNavigator.
3. Dla każdego przycisku napisano odpowiedni podprogram obsługi zdarzenia
OnClick. Podprogramy te wykonują operacje na zbiorze danych DataSet za
pośrednictwem komponentów DataSource, skojarzonych z poszczególnymi
przyciskami. Na przykład, podprogram obsługi dla przycisku Edit zawiera
następującą instrukcję:
nsDataSource.DataSet.Edit;
4. Podprogram obsługi przycisku Search (Szukaj) jest szczególnie rozbudowany -
konieczne było stworzenie dodatkowego formularza, w którym użytkownik
wpisywał będzie wyszukiwany wzorzec danych.
5. Po wybraniu na formularzu komponentów SpeedButton i DataSource,
wywołano opcję menu Component\Create Componenet Template. Nowemu
komponentowi nadano nazwę TDBNavSearch. Umieszczono go na stronie
palety DataControls i przypisano mu unikalną mapę bitową, ułatwiającą
identyfikację.
Tak, w ogólnym zarysie, wyglądał proces tworzenia obiektu TDBNavSearch.
Aby wykorzystać nowy obiekt w aplikacji należy:
1. Przepisać tekst z
ródłowy DBNavSch.PAS (zob. poniższy listing) albo
załadować go z dysku CD-ROM, dołączonego do książki.
2. Wybrać komponenty SpeedButton i DataSource na formularzu.
3. Wywołać opcję menu Component\Create Component Template.
4. Wpisać nazwę szablonu: TDBNavSearch, a jako stronę palety, na której ma
rezydować nowy obiekt, wybrać DataControls.
Rozdział 27 Tworzenie własnych komponentów Delphi 801
5. Można ponadto załadować mapę bitową DBNavSch.BMP, która odtąd
identyfikowała będzie nowy obiekt (wspomniana mapa bitowa również
znajduje się na dysku CD-ROM dołączonym do książki).
6. Kliknąć OK, co spowoduje utworzenie nowego szablonu komponentów.
7. Nowy szablon można teraz umieszczać na formularzach, tak jak zwykły
komponent. Należy jednak mieć na względzie kilka ograniczeń:
W przeciwieństwie do zwykłych kontrolek, kontrolki, zawarte w szablonie
zawsze rozmieszczane są na formularzu w takim układzie, w jakim
znajdowały się po utworzeniu szablonu. Oznacza to, że niezależnie od
tego, w którym miejscu formularza programista kliknie, umieszczając
szablon, atrybuty Top i Left kontrolek zostaną automatycznie skopiowane
z oryginalnego formularza. Nie stanowi to większego problemu, gdyż
wszystkie umieszczone kontrolki są od razu wybrane i można je po prostu
przesunąć w dowolne miejsce.
Na tym samym formularzu nie może znajdować się więcej niż jeden
komponent DBNavSearch. Kod wynikowy podprogramów, skojarzonych
z kontrolkami zawartymi w szablonie, działa w sposób wykluczający
obecność kilku egzemplarzy tej samej kontrolki na formularzu.
Projekty, w których wykorzystywany jest obiekt DBNavSearch, a także
wszystkie formularze, na których umieszczony jest ten szablon muszą
odwoływać się w klauzuli uses do modułu DBSearch (zawierającego
formularz pojawiający się na ekranie po wybraniu opcji wyszukiwania
danych). Aby dodać moduł do klauzuli uses należy skorzystać z polecenia
File\Use Unit.
Na listingu 27.6 przedstawiono kompletny tekst z
ródłowy DBNavSearch.
Listing 27.6. Kompletny tekst z
ródłowy DBNavSearch.
{
DBNavSearch Delphi Component Template
Provides a DBNavigator-like control that includes a search
facility.
Written by Ken Henderson.
Copyright (c) 1997 by Ken Henderson.
}
unit DBNavSch;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, ExtCtrls, DBCtrls, Grids, DBGrids, Db,
802 Część IV
DBTables, Buttons;
type
TDBNavSchForm = class(TForm)
sbFirst: TSpeedButton;
sbPrior: TSpeedButton;
sbNext: TSpeedButton;
sbLast: TSpeedButton;
sbInsert: TSpeedButton;
sbDelete: TSpeedButton;
sbEdit: TSpeedButton;
sbPost: TSpeedButton;
sbCancel: TSpeedButton;
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 sbInsertClick(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
c : 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;
Rozdział 27 Tworzenie własnych komponentów Delphi 803
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;
dsEdit : begin
sbEdit.Enabled:=False;
sbPost.Enabled:=True;
sbCancel.Enabled:=True;
end; dsInsert : 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? , 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;
804 Część IV
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.sbInsertClick(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;
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
Rozdział 27 Tworzenie własnych komponentów Delphi 805
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
c : 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,
806 Część IV
Ą' 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
{I don t test the return value of
GotoKey because GotoNearest is a
procedure, preventing consistent
behavior for exact and inexact
searches.}
If SearchForm.AllowPartial.Checked then
Ą' GotoKey
else GotoNearest;
end else Cancel;
end;
end;
finally
SearchForm.Free;
end;
end;
end.
Na listingu 27.7 przedstawiono natomiast tekst z
ródłowy formularza DBNavSch.
Listing 27.7. Tekst z
ródłowy formularza DBNavSch.
object DBNavSchForm: TDBNavSchForm
Left = 200
Top = 108
Width = 544
Height = 375
Caption =  DBNavSchForm
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name =  MS Sans Serif
Font.Style = []
PixelsPerInch = 96
TextHeight = 13
object sbFirst: TSpeedButton
Tag = 254
Rozdział 27 Tworzenie własnych komponentów Delphi 807
Left = 80
Top = 296
Width = 25
Height = 25
Enabled = False
Glyph.Data = {
46010000424D460100000000000076000000280000001C0000000D0000000100
040000000000D000000000000000000000001000000000000000000000000000
80000080000000808000800000008000800080800000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
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 = {
12010000424D12010000000000007600000028000000140000000D0000000100
0400000000009C00000000000000000000001000000000000000000000000000
80000080000000808000800000008000800080800000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
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 = {
12010000424D12010000000000007600000028000000140000000D0000000100
0400000000009C00000000000000000000001000000000000000000000000000
80000080000000808000800000008000800080800000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
33333333000033333333333333333333000033333333333FF333333300003083
333333833FF333330000300083333383333FF333000030000083338333333FF3
00003000000083833333333F0000300000833383333338830000300083333383
808 Część IV
3338833300003083333333833883333300003333333333888333333300003333
33333333333333330000333333333333333333330000}
NumGlyphs = 2
OnClick = sbNextClick
end object sbLast: TSpeedButton
Tag = 254
Left = 157
Top = 296
Width = 25
Height = 25
Enabled = False
Glyph.Data = {
46010000424D460100000000000076000000280000001C0000000D0000000100
040000000000D000000000000000000000001000000000000000000000000000
80000080000000808000800000008000800080800000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
3333333333333333000033333333333333333333333333330000333333333333
3333FF333333FFF30000330833333380333833FF333833F30000330008333380
33383333FF3833F300003300000833803338333333F333F30000330000000880
33383333333333F3000033000008338033383333338833F30000330008333380
33383333883833F3000033083333338033383388333833F30000333333333333
3338883333388833000033333333333333333333333333330000333333333333
33333333333333330000}
NumGlyphs = 2
OnClick = sbLastClick
end
object sbInsert: TSpeedButton
Tag = 254
Left = 183
Top = 296
Width = 25
Height = 25
Enabled = False
Glyph.Data = {
46010000424D460100000000000076000000280000001C0000000D0000000100
040000000000D000000000000000000000001000000000000000000000000000
80000080000000808000800000008000800080800000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
333333333333333300003333333333333333333FFFF333330000333330003333
3333338333F3333300003333300033333333338333F333330000333330003333
3333FF3333FFFF3300003300000000033338333333333F330000330000000003
3338333333333F3300003300000000033338333333333F330000333330003333
333888833338833300003333300033333333338333F333330000333330003333
3333338333F33333000033333333333333333388883333330000333333333333
33333333333333330000}
NumGlyphs = 2
OnClick = sbInsertClick
end
object sbDelete: TSpeedButton
Tag = 254
Left = 209
Top = 296
Width = 25
Height = 25
Rozdział 27 Tworzenie własnych komponentów Delphi 809
Enabled = False
Glyph.Data = {
46010000424D460100000000000076000000280000001C0000000D0000000100
040000000000D000000000000000000000001000000000000000000000000000
80000080000000808000800000008000800080800000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
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 = {
46010000424D460100000000000076000000280000001C0000000D0000000100
040000000000D000000000000000000000001000000000000000000000000000
80000080000000808000800000008000800080800000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
3333333333333333000033333333333333333333333333330000333333333333
333333333333333300003333333333333333FFFFFFFFFFF30000330000000000
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 = {
46010000424D460100000000000076000000280000001C0000000D0000000100
040000000000D000000000000000000000001000000000000000000000000000
80000080000000808000800000008000800080800000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
33333333333333330000333333333333333333F3333333330000333303333333
33333F3F3333333300003330003333333333F333F33333330000330000033333
333F33333F33333300003000300033333383333333F333330000300333000333
338333F8333F33330000333333300033333888338333F3330000333333330003
3333333338333F33000033333333300033333333338333F30000333333333300
3333333333383383000033333333333333333333333388330000333333333333
810 Część IV
33333333333333330000}
NumGlyphs = 2
OnClick = sbPostClick
end
object sbCancel: TSpeedButton
Tag = 255
Left = 286
Top = 296
Width = 25
Height = 25
Enabled = False
Glyph.Data = {
46010000424D460100000000000076000000280000001C0000000D0000000100
040000000000D000000000000000000000001000000000000000000000000000
80000080000000808000800000008000800080800000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
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 = {
46010000424D460100000000000076000000280000001C0000000D0000000100
040000000000D000000000000000000000001000000000000000000000000000
80000080000000808000800000008000800080800000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
3333333FFFFF3333000033333808333333333FF3338833330000333800833333
3333833338333333000033300833333333338333833333330000338083333333
3338333F3333333300003300333333333338333F3FFFFFF30000330033300000
3338333F833333F300003300833380003338333F383333F30000338008380000
33383333F33333F3000033300000008033338333333383F30000333380008330
33333833333883F3000033333333333333333388888338330000333333333333
33333333333333330000}
NumGlyphs = 2
OnClick = sbRefreshClick
end
object sbSearch: TSpeedButton
Tag = 254
Left = 338
Top = 296
Width = 25
Height = 25
Rozdział 27 Tworzenie własnych komponentów Delphi 811
Enabled = False
Glyph.Data = {
46010000424D460100000000000076000000280000001C0000000D0000000100
040000000000D000000000000000000000001000000000000000000000000000
80000080000000808000800000008000800080800000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00700777777777
77788777777777770000000077777777778888777777777700000F0007777777
778F888777777777000070F0007777777778F888777777770000770F00000087
77778F888888877700007770F0087780777778F8887788770000777700877F78
07777788877F788700007777087777F7887777887777F788000077770877777F
7077778877777F7800007777087FF777707777887FF7777800007777888FF777
887777888FF77788000077777088777807777778887778870000777777088880
77777777888888770000}
NumGlyphs = 2
OnClick = sbSearchClick
end
object nsDataSource: TDataSource
OnStateChange = nsDataSourceStateChange
Left = 364
Top = 293
end
end
Listing 27.8 zawiera tekst x
ródłowy modułu DBSearch.
Listing 27.8. Tekst z
ródłowy modułu DBNavSch.
unit Dbsearch;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes,
Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons,
ExtCtrls, Mask, DBCtrls, Db, Math;
type
TSearchForm = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
ScrollBox1: TScrollBox;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
IgnoreCase: TCheckBox;
AllowPartial: TCheckBox;
DataSource1: TDataSource;
Label1: TLabel;
DBCheckBox1: TDBCheckBox;
DBEdit1: TDBEdit;
private
{ Private declarations }
public
{ Public declarations }
function AddLabel(LabelCaption : String; LabelTop :
Ą' Integer) : Integer;
812 Część IV
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(ScrollBox1);
TL.Parent:=ScrollBox1;
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.ScrollBox1);
TDBE.Parent:=SearchForm.ScrollBox1;
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.ScrollBox1);
TDBC.Parent:=SearchForm.ScrollBox1;
TDBC.Caption:=  ;
TDBC.DataSource:=DBDataSource;
TDBC.DataField:=SField.FieldName;
TDBC.Top:=DBTop;
TDBC.Left:=DBLeft;
end;
end;
end.
Rozdział 27 Tworzenie własnych komponentów Delphi 813
Na listingu 27.9 przedstawiono tekst z
ródłowy formularza DBSearch.
Listing 27.9. Tekst z
ródłowy formularza 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
PixelsPerInch = 96
TextHeight = 16
object Panel1: TPanel
Left = 0
Top = 0
Width = 584
Height = 232
Align = alClient
BevelInner = bvLowered
TabOrder = 0
object ScrollBox1: 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 Label1: TLabel
Left = 440
Top = 64
Width = 48
Height = 16
Caption =  Label1
Visible = False
end
object DBCheckBox1: TDBCheckBox
Left = 440
Top = 96
Width = 97
Height = 17
Caption =  DBCheckBox1
814 Część IV
TabOrder = 0
ValueChecked =  True
ValueUnchecked =  False
Visible = False
end
object DBEdit1: TDBEdit
Left = 440
Top = 120
Width = 121
Height = 24
MaxLength = 0
TabOrder = 1
Visible = False
end
end
end
object Panel2: TPanel
Left = 0
Top = 232
Width = 584
Height = 41
Align = alBottom
BevelInner = bvLowered
TabOrder = 1
object BitBtn1: 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 =  &Cancel
TabOrder = 1
Kind = bkCancel
end
object IgnoreCase: TCheckBox
Left = 8
Top = 12
Width = 126
Height = 17
Caption =  &Ignore case?
TabOrder = 2
end
object AllowPartial: TCheckBox
Left = 128
Top = 12
Rozdział 27 Tworzenie własnych komponentów Delphi 815
Width = 209
Height = 17
Caption =  &Allow partial searches?
State = cbChecked
TabOrder = 3
end
end
object DataSource1: TDataSource
Left = 444
Top = 28
end
end
Komponent ZoomDlg
Komponent ZoomDlg umożliwia użytkownikowi wybór dozwolonych wartości
kolumny wprost z innej tabeli bazy danych. Pojawienie się w Delphi pól typu
Lookup częściowo wyeliminowało konieczność samodzielnego tworzenia tego
rodzaju dodatkowego komponentu. Mimo to analiza obiektu ZoomDlg i procesu
jego powstawania będzie bardzo pouczająca.
W ramach komponentu ZoomDlg zdefiniowano tylko jedną opublikowaną
(published) metodę - Execute, która powinna być skojarzona ze zdarzeniem
OnClick dowolnej kontrolki, powiązanej z danymi, np. DBEdit. Metoda
Execute komponentu ZoomDlg będzie na ogół wywoływana po podwójnym
kliknięciu na kontrolce DBEdit. Execute wyświetla na ekranie formularz,
skojarzony z komponentem. Definicja formularza przechowywana jest w module
ZoomForm. Korzystając z formularza, użytkownik może wybrać wartość kolumny
z innej tabeli. Kontrolki, oferujące taką możliwość wyboru, można wyróżnić
innym kolorem, co zwiększy przejrzystość okna dialogowego. Tekst z
ródłowy
komponentu ZoomDlg jest zbyt złożony, by dało się go tutaj szczegółowo
omówić. Dlatego też ograniczymy się do zamieszczenia odpowiedniego listingu
i ogólnego omówienia, podobnie jak w przypadku komponentu DBNavSearch.
Listingi 27.10-27.12 zawierają kompletny tekst z
ródłowy komponentu ZoomDlg.
Listing 27.10. Komponent ZoomDlg.
{ZoomDlg.PAS
ZoomDlg Delphi Component
Supports drilling down into a table column to select a value
for it from a second table. This is a non-visual component
that is invoked using its Execute method, as with other
dialog components. When Execute is called, ZoomForm is
instantiated and displays the second table.Once a selection
816 Część IV
from the second table is made, the appropriate column value
is assigned to the column in the first table.
Written by Ken Henderson.
Copyright (c) 1995-97 by Ken Henderson.
}
unit Zoomdlg;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes,
Graphics, Controls,Forms, Dialogs, ZoomForm, DBTables,
DsgnIntf, TypInfo;
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);
try
Rozdział 27 Tworzenie własnych komponentów Delphi 817
fmZoom.ShowForm(Sender,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;
PropInfo: PPropInfo;
SourceTable : TTable;
begin
818 Część IV
Instance := TComponent(GetComponent(0));
PropInfo := TypInfo.GetPropInfo(Instance.ClassInfo,
Ą' GetTablePropName);
if (PropInfo <> nil) and (PropInfo^.PropType^.Kind =
Ą' tkClass) then
begin
SourceTable := TObject(GetOrdProp(Instance,
Ą' PropInfo)) as TTable;
if (SourceTable <> nil) then
SourceTable.GetFieldNames(List);
end;
end;
procedure Register;
begin
RegisterComponents( Dialogs , [TZoomDialog]);
RegisterPropertyEditor(TypeInfo(string), TZoomDialog,
Ą'  SourceField , TSourceFieldProperty);
end;
end.
Listing 27.11. Tekst z
ródłowy modułu ZoomForm komponentu
ZoomDlg.
{ZoomForm.PAS
Zoom form for the
ZoomDlg Delphi Component
Supports drilling down into a table column to select a value
for it from a second table. This is a non-visual component
that is invoked using its Execute method, as with other
dialog components. When Execute is called, ZoomForm is
instantiated and displays the second table. Once a selection
from the second table is made, the appropriate column value
is assigned to the column in the first table.
Written by Ken Henderson.
Copyright (c) 1995-97 by Ken Henderson.
}
unit ZoomForm;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes,
Graphics, Controls, Forms, Dialogs, ExtCtrls, DBCtrls,
StdCtrls, Buttons, DB, DBTables, Grids, DBGrids, Tabs;
Rozdział 27 Tworzenie własnych komponentów Delphi 819
type
TfmZoom = class(TForm)
dsZoom: TDataSource;
Panel1: TPanel;
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
820 Część IV
If (not (DataSource.DataSet.State in [dsInsert,
Ą' 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 TCustomEdit do begin
Clear;
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 [dsInsert,
Ą' 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.
Listing 27.12. Tekst z
ródłowy formularza ZoomForm.
object fmZoom: TfmZoom
Rozdział 27 Tworzenie własnych komponentów Delphi 821
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
PixelsPerInch = 96
TextHeight = 16
object Panel1: TPanel
Left = 0 Top = 388
Width = 644
Height = 45
Align = alBottom
BevelInner = bvLowered
TabOrder = 0
object Panel3: TPanel
Left = 451
Top = 2
Width = 191
Height = 41
Align = alRight
BevelOuter = bvNone
TabOrder = 0
object bbOK: TBitBtn
Left = 5
Top = 4
Width = 89
Height = 33
Caption =  &OK
TabOrder = 0
OnClick = bbOKClick
Kind = bkOK
end
object bbCancel: TBitBtn
Left = 97
Top = 4
Width = 89
Height = 33
Caption =  &Cancel
TabOrder = 1
Kind = bkCancel
end
end
object nsZoom: TDBNavigator
Left = 8
822 Część IV
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, dgIndicator,
Ą' 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
Komponent ZoomDlg jest obiektem pod wieloma względami nietypowym. Przede
wszystkim, oprócz procedury Register, rejestrującej go na palecie komponentów
Delphi, ZoomDlg zawiera także specjalny edytor atrybutu SourceField.
Dzięki niemu programista może wybrać dowolne pole zbioru danych DataSet;
wybór odbywa się tak samo, jak w przypadku innych atrybutów zawierających
identyfikator pola, a dostępnych w standardowych komponentach z biblioteki
Rozdział 27 Tworzenie własnych komponentów Delphi 823
VCL. Fragment programu, odpowiedzialny za utworzenie i zarejestrowanie
edytora atrybutu, przedstawiono na listingu 27.13.
Listing 27.13. Tekst z
ródłowy edytora atrybutu SourceField.
{ 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;
PropInfo: PPropInfo;
SourceTable : TTable;
begin
Instance := TComponent(GetComponent(0));
PropInfo := TypInfo.GetPropInfo(Instance.ClassInfo,
Ą' GetTablePropName);
824 Część IV
if (PropInfo <> nil) and (PropInfo^.PropType^.Kind =
Ą' tkClass) then begin
SourceTable := TObject(GetOrdProp(Instance,
Ą' PropInfo)) as TTable;
if (SourceTable <> nil) then
SourceTable.GetFieldNames(List);
end;
end;
{& }
RegisterPropertyEditor(TypeInfo(string), TZoomDialog,
Ą'  SourceField , TSourceFieldProperty);
Własny edytor atrybutów
Dokładniejsza analiza programu z listingu 27.13 pozwoli prześledzić proces
tworzenia własnego edytora atrybutu. Proces ten rozpisać można na cztery etapy:
1. Zdefiniowanie nowego, potomnego typu edytora atrybutu na podstawie jednego
z typów, zdefiniowanych w module DsgnIntf.
2. Przygotowanie podprogramów zapewniających edycję i prezentację atrybutu
w formie tekstu. Jeśli atrybut nie należy do typu łańcuchowego, to edytor musi
zapewnić odpowiednią konwersję.
3. Udostępnienie informacji o określonych właściwościach edytora, tak aby moduł
Object Inspector był w stanie prawidłowo go obsługiwać.
4. Zarejestrowanie edytora atrybutu przy użyciu procedury
RegisterPropertyEditor.
W omawianym przykładzie edytor SourceFieldProperty jest potomkiem klasy
TStringProperty, zdefiniowanej w module DsgnIntf. Jedyna różnica pomiędzy
edycją atrybutu SourceField a dowolnego innego atrybutu łańcuchowego sprowadza
się do uwzględnienia rozwijanej listy dozwolonych nazw pól.
Ponieważ bazowym typem atrybutu jest typ łańcuchowy, nie jest konieczne
definiowanie specjalnych procedur konwersji danych przy odczycie i zapisie
wartości atrybutu. Procedury odziedziczone z klasy StringProperty będą
działały bez żadnych modyfikacji.
SourceFieldProperty przekazuje Object Inspectorowi informacje o swoich
wybranych właściwościach za pośrednictwem funkcji GetAttributes,
przesłaniającej odpowiednią funkcję klasy TStringProperty. Ciało funkcji
składa się z jednego wiersza:
Rozdział 27 Tworzenie własnych komponentów Delphi 825
Result := [paValueList, paSortList, paMultiSelect];
Object Inspector informowany jest o trzech specyficznych właściwościach nowego
edytora. Po pierwsze, wartości obsługiwanego atrybutu pochodzą z zamkniętej
listy. Po drugie, wartości a liście, zwracane przez funkcję GetValues, mają być
sortowane. Wiele osób (w tym także sam autor) uważa automatyczne sortowanie
dozwolonych wartości za uciążliwe; mimo to w omawianym, przykładowym
edytorze przyjęto zasadę obowiązującą w odniesieniu do wszystkich
standardowych atrybutów VCL - dozwolone wartości są automatycznie sortowane
na liście. Ostatnia własność, paMultiSelect, umożliwia wyświetlanie/edycję
atrybutu również w sytuacji, gdy na formularzu wybranych jest jednocześnie kilka
komponentów. Niektórych atrybutów (np. Name) nie można modyfikować
w odniesieniu do kilku komponentów jednocześnie.
W końcowej fazie przygotowywania nowego edytora atrybutu, wywoływana jest
procedura RegisterPropertyEditor:
RegisterPropertyEditor (TypeInfo(string), TZoomDlg,
'SourceField', TSourceFieldProperty);
W wywołaniu powyższej procedury należy podać cztery parametry:

Typ danych, na których operuje edytor. Informacje o typie należy przekazywać,
korzystając z wbudowanej funkcji TypeInfo.
komponentu, z którym powiązany jest edytor. Jeśli w miejscu tego parametru
Typ
występować będzie wartość nil, to edytora można będzie używać w odniesieniu do
wszystkich komponentów, zawierających atrybut określonego typu.

Nazwa atrybutu, na którym edytor będzie operował. Jest ona brana pod uwagę
tylko wówczas, gdy drugi parametr określa typ komponentu.

Klasa edytora, która ma zostać zarejestrowana jako właściwa dla wskazanego
typu atrybutu.
W omawianym przykładzie w wywołaniu RegisterPropertyEditor
określono łańcuchowy typ atrybutu. Edytor będzie obsługiwał wyłącznie atrybut
SourceField komponentu ZoomDlg.
Inne specyficzne cechy komponentu ZoomDlg.
Kluczowe znaczenie dla funkcjonowania komponentu ZoomDlg ma fragment
programu skojarzony ze zdarzeniem OnClick przycisku OK na formularzu
ZoomForm. Oto wspomniany fragment:
procedure TfmZoom.bbOKClick(Sender: TObject);
begin
826 Część IV
If Caller is TDBEdit then begin
With Caller as TDBEdit do begin
If (not (DataSource.DataSet.State in [dsInsert,
Ą' 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 TCustomEdit do begin
Clear;
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 [dsInsert,
Ą' dsEdit])) then
DataSource.DataSet.Edit;
DataSource.DataSet.FieldByName(DataField).
Ą' AsString:=dsZoom.DataSet.FieldByName
Ą' (SourceField).AsString;
end;
end;
ModalResult := mrOK;
end;
Szczególną uwagę zwrócić należy na intensywne wykorzystanie mechanizmu
RTTI (ang. Runtime Type Information - uzyskiwanie informacji o typie danych
podczas wykonywania programu). Większość języków kompilowanych do kodu
maszynowego nie oferuje mechanizmu RTTI. Delphi jest jednak nietypowym
narzędziem, wyposażonym w wiele możliwości, których brak w innych,
podobnych produktach. W omawianym przykładzie mechanizm RTTI
wykorzystano w module ZoomForm do określenia typu komponentu, który
spowodował przywołanie na ekran formularza. Znając typ kontrolki, ZoomDlg
może prawidłowo wpisać nazwę pola.
Należy ponadto zwrócić uwagę na konstrukcję With...as, której użyto do konwersji
typu zmiennej Caller. Jest to "bezpieczny" mechanizm konwersji typu -
Rozdział 27 Tworzenie własnych komponentów Delphi 827
generuje on wyjątek w przypadku błędu konwersji. W większości języków,
oferujących mechanizm konwersji typu danych (typecast), błędne przekształcenie
typu powoduje na ogół błąd ochrony (ang. acces violation). W przypadku
konwersji klas Delphi można dodatkowo zabezpieczyć się przed tego rodzaju
błędami, stosując konstrukcję With...as. Na ewentualny błąd konwersji może
wówczas zareagować odpowiednia procedura obsługi wyjątku.