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 znaleźć 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 wskaź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
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 ź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]);
Rysunek 27.1
Pierwsze okno
dialogowe
Kreatora
komponentów.
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 ź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 wskaźnik bieżącego rekordu na początek zbioru danych.
2. Przesuwa wskaźnik do żądanego rekordu.
3. Jako wynik zwraca wskaźnik do całego komponentu
TArrayTable
.
Dzięki temu, że funkcja najpierw ustawia wskaźnik na żądanym rekordzie, po
czym zwraca wskaź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 źródłowy nowego komponentu
TArrayTable
.
Listing 27.2. Kompletny tekst ź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 ź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.
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ł
Rysunek 27.2.
Okno dialogowe
Install Components
umożliwia
dodawanie
komponentów do
palety Delphi.
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
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.
Rysunek 27.3.
Komponent
ArrayTable może -
razem ze
StringGrid -
zastępować
komponent
DBGrid.
Rozdział 27 Tworzenie własnych komponentów Delphi
785
Dla każdej kolumny zbioru wynikowego znaleźć 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
ź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 źródłowy
komponentu
TLiveQuery
.
Listing 27.5. Tekst ź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
ź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 ź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 źródłowy
DBNavSearch
.
Listing 27.6. Kompletny tekst źródło
wy 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 źródłowy formularza DBNavSch.
Listing 27.7. Tekst ź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 Ÿród³owy modu³u DBSearch.
Listing 27.8.
Tekst ź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 źródłowy formularza DBSearch.
Listing 27.9. Tekst ź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 ź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 ź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 ź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 źródłowy formu
larza 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 ź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.
Typ komponentu, z którym powiązany jest edytor. Jeśli w miejscu tego parametru
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.