第十三章 剖析几个数据库应用程序
前面已经详细讲述了Delphi 4的数据库编程技术。为了使读者能够透彻地理解有关编程技术并灵活运用，我们把Delphi 4的几个示范程序拿出来加以剖析，这些示范程序都编得非常有技巧。要说明的是，剖析程序时我们可能会忽略掉一些与主题无关的细节。
13.1 一个后台查询的示范程序 这一节详细剖析一个后台查询的示范程序，项目名称叫Bkquery，它可以在C:\Program Files\Borland\Delphi4\Demos\Db\Bkquery目录中找到。它的主窗体如图13.1所示。
图13.1 Bkquery的主窗体
我们先从处理窗体的OnCreate事件的句柄开始，因为它是应用程序的起点。Procedure TAdhocForm. FormCreate(Sender: TObject);
Procedure CreateInitialIni;
Const
VeryInefficientName = 'IB:
Very Inefficient Query';
VeryInefficientQuery ='select EMP_NO, Avg(Salary) as Salary\n'+' from employee, employee, employee\n' +'
group by EMP_NO';
AmountDueName = 'DB: Amount Due By Customer';
AmountDueByCustomer ='select Company, Sum(ItemsTotal) - Sum(AmountPaid) as AmountDue\n' +'
from customer, orders\n' +'
where Customer.CustNo = Orders.CustNo\n' + ' group by Company';
Begin
With SavedQueries Do
Begin
WriteString(VeryInefficientName, 'Query', VeryInefficientQuery);
WriteString(VeryInefficientName, 'Alias', 'IBLOCAL');
WriteString(VeryInefficientName, 'Name', 'SYSDBA');
SavedQueryCombo.Items.Add(VeryInefficientName);
WriteString(AmountDueName, 'Query', AmountDueByCustomer);
WriteString(AmountDueName, 'Alias', 'DBDEMOS');
WriteString(AmountDueName, 'Name', '');
SavedQueryCombo.Items.Add(AmountDueName);
End;
End;
Begin
Session.GetAliasNames(AliasCombo.Items);
SavedQueries := TIniFile.Create('BKQUERY.INI');
SavedQueries.ReadSections(SavedQueryCombo.Items);
If SavedQueryCombo.Items.Count <= 0 then CreateInitialIni;
SavedQueryCombo.ItemIndex := 0;
QueryName := SavedQueryCombo.Items[0];
Unmodify;ReadQuery;
End;
FormCreate主要做了这么几件事情：首先，它调用TSession的GetAliasNames函数把所有已定义的BDE别名放到一个字符串列表中，实际上就是填充图13.1中的“Database Alias”框。接着，创建了一个TIniFile类型的对象实例，并指定文件名是BKQUERY.INI。如果这个文件现在还不存在的话，就需要调用CreateInitialIni去创建一个文件。至于怎样写.INI文件，这不是本章要讨论的主题。最后，调用ReadQuery把文件中保存的有关参数读出来。
ReadQuery函数是这样定义的：
Procedure TAdhocForm.ReadQuery;
Begin
If not CheckModified then Exit;
With SavedQueries Do
Begin
QueryName := SavedQueryCombo.Items[SavedQueryCombo.ItemIndex];
QueryEdit.Text := IniStrToStr(ReadString(QueryName, 'Query', ''));
AliasCombo.Text := ReadString(QueryName, 'Alias', '');
NameEdit.Text := ReadString(QueryName, 'Name', '');
End;
Unmodify;
If Showing thenIf NameEdit.Text <> '' then PasswordEdit.SetFocus else
QueryEdit.SetFocus;
End;
当用户单击“Execute”按钮，程序就调用BackgroundQuery在后台执行查询。Procedure TAdhocForm.ExecuteBtnClick(Sender: TObject);
Begin
BackgroundQuery(QueryName, AliasCombo.Text, NameEdit.Text, PasswordEdit.Text,QueryEdit.Text);
BringToFront;
End;
BackgroundQuery是在另一个叫ResItFrm的单元中定义的，后面将重点介绍这个过程。当用户单击“New”按钮，程序就把窗体上的一些窗口重新初始化。
Procedure TAdhocForm.NewBtnClick(Sender: TObject);
Function UniqueName: string;
var
I: Integer;
Begin
I := 1;
Repeat
Result := Format('Query%d', [I]);
Until
SavedQueryCombo.Items.IndexOf(Result) < 0;
End;
Begin
AliasCombo.Text := 'DBDEMOS';
NameEdit.Text := '';
PasswordEdit.Text := '';
QueryEdit.Text := '';QueryEdit.SetFocus;
QueryName := UniqueName;
SavedQueryCombo.ItemIndex := -1;
Unnamed := True;
End;
当用户单击“Save”按钮，程序就调用SaveQuery函数把当前有关参数保存到.INI文件中。
Procedure TAdhocForm.SaveBtnClick(Sender: TObject);
Begin
SaveQuery;
End;
而SaveQuery是这样定义的：
Procedure TAdhocForm.SaveQuery;
Begin
If Unnamed then SaveQueryAs
Else
With SavedQueries Do
Begin
WriteString(QueryName, 'Query', StrToIniStr(QueryEdit.Text));
WriteString(QueryName, 'Alias', AliasCombo.Text);
WriteString(QueryName, 'Name', NameEdit.Text);Unmodify;
End;
End;
当用户单击“Save As”按钮，程序调用SaveQueryAs函数以另一个名称保存有关参数。
Procedure TAdhocForm.SaveAsBtnClick(Sender: TObject);
Begin
SaveQueryAs;
End;
而SaveQueryAs是这样定义的：
Procedure TAdhocForm.SaveQueryAs;
Begin
If GetNewName(QueryName) then
Begin
Unnamed := False;
SaveQuery;
With SavedQueryCombo, Items Do
Begin
If IndexOf(QueryName) < 0 then Add(QueryName);
ItemIndex := IndexOf(QueryName);
End;
End;
End;
其中，GetNewName是在一个叫SaveQAs的单元中定义的，它将打开如图13.2所示的对话框，让用户输入一个文件名。图13.2 指定另一个文件名此外，程序还处理了SavedQueryCombo框的OnChange事件：
Procedure TAdhocForm.SavedQueryComboChange(Sender: TObject);
Begin
ReadQuery;
End;
所谓后台查询，实际上是运用多线程的编程技术，使查询在一个专门的线程中进行。为此，首先要以TThread为基类声明一个线程对象：
TypeTQueryThread = Class(TThread)PrivateQueryForm: TQueryForm;
MessageText: string;
Procedure ConnectQuery;
Procedure DisplayMessage;
ProtectedProcedure Execute;
override;
PublicConstructor Create(AQueryForm: TQueryForm);
End;
我们先看线程对象是怎样创建的：
Constructor TQueryThread.Create(AQueryForm: TQueryForm);
Begin
QueryForm := AQueryForm;
FreeOnTerminate := True;
Inherited Create(False);
End;
当用户单击“Execute”按钮，程序就调用BackgroundQuery函数在后台执行查询。BackgroundQuery是这样定义的：
Procedure BackgroundQuery(const QueryName, Alias, User, Password, QueryText: string);
var
QueryForm: TQueryForm;
Begin
QueryForm := TQueryForm.Create(Application);
With QueryForm, Database Do
Begin
Caption := QueryName;
QueryLabel.Caption := QueryText;
Show;
AliasName := Alias;
Params.Values['USER'] := User;
Params.Values['PASSWORD'] := Password;
Query.Sql.Text := QueryText;
End;
TQueryThread.Create(QueryForm);
End;
BackgroundQuery主要做了三件事情，一是动态创建和显示一个窗体(TQueryForm)，因为要用这个窗体显示查询结果。二是把传递过来的参数分别赋给TDadabase构件的AliasName、Params以及TQuery构件的SQL属性。三是创建线程对象的实例。由于线程对象的FreeOnTerminate属性设为True，所以用不着专门去删除线程对象。
好，现在让我们看看这个程序最关键的代码，即线程对象的Execute函数：
Procedure TQueryThread.Execute;
varUniqueNumber: Integer;
Begin
Try
With QueryForm Do
Begin
UniqueNumber := GetUniqueNumber;
Session.SessionName := Format('%s%x', [Session.Name, UniqueNumber]);
Database.SessionName := Session.SessionName;
Database.DatabaseName:=Format('%s%x',[Database.Name,UniqueNumber]);
Query.SessionName := Database.SessionName;
Query.DatabaseName := Database.DatabaseName;
Query.Open;
Synchronize(ConnectQuery);MessageText := 'Query openned';
Synchronize(DisplayMessage);
End;
Except
On E: Exception Do
Begin
MessageText := Format('%s: %s.', [E.ClassName, E.Message]);
Synchronize(DisplayMessage);
End;
End;
End;
由于这是个多线程的数据库应用程序，因此，需要显式地使用TSession构件，而且要保证每个线程所使用的BDE会话期对象是唯一的。所以，程序首先调用GetUniqueNumber来获得一个唯一的序号。同样，对于TDatabase构件来说，也有类似的问题。
Execute通过Synchronize让主线程去执行ConnectQuery、DisplayMessage等方法，这是因为ConnectQuery、DisplayMessage都需要与VCL打交道，必须用Synchronize作外套。
13.2 一个缓存更新的示范程序 这一节详细剖析一个缓存更新的示范程序，项目名称叫Cache，它可以在C:\Program Files\Borland\Delphi4\Demos\Db\Cacheup目录中找到。它的主窗体如图13.3所示。
图13.3 Cache的主窗体
主窗体上有一个“Cached Updates”复选框，如果选中此复选框，表示使用缓存更新技术。否则，表示不使用缓存更新技术，当用户修改了数据后，数据被直接写到数据集中。
主窗体上还有一个“Use Update SQL”复选框，如果选中这个复选框，表示使用TUpdateSQL构件来进行缓存更新。
当用户单击“Apply Updates”按钮，就向数据库申请更新数据。
当用户单击“Cancel Updates”按钮，所有未决的修改将被取消。
当用户单击“Revert Record”按钮，对当前记录所作的修改将被取消。
在“Show Records”分组框内有几个复选框，用于选择要在栅格中显示哪些记录，包括未修改的记录、修改的记录、插入的记录和删除的记录。
当用户单击“Re-Execute Query”按钮，就重新执行查询。此外，这个示范程序还用一个计算字段来表达当前的更新状态。
下面我们就来看看怎样实现上述功能。在介绍程序代码之前，我们先要介绍数据模块CacheData，因为几个关键的构件都是放在这个数据模块上，如图13.4所示。
图13.4 数据模块
数据模块上有四个构件，分别是：一个TDataSource构件，其名为CacheDS，一个TDatabase构件名为CacheDB，一个TQuery构件名为CacheQuery，一个TUpdateSQL构件名为UpdateSQL。
TQuery构件的OnCalcFields事件是这样处理的：
Procedure TCacheData.CacheQueryCalcFields(DataSet: TDataSet);
ConstUpdateStatusStr: array[TUpdateStatus] of string = ('Unmodified', 'Modified','Inserted', 'Deleted');
Begin
If CacheQuery.CachedUpdates then
CacheQueryUpdateStatus.Value := UpdateStatusStr[CacheQuery.UpdateStatus];
End;
上述代码用于给计算字段CacheQueryUpdateStatus赋值，以显示当前的更新状态。TQuery构件的OnUpdateError事件是这样处理的：
Procedure TCacheData.UpdateErrorHandler(DataSet: TDataSet; E: EDatabaseError;
UpdateKind:TUpdateKind;
var UpdateAction: TUpdateAction);
Begin
UpdateAction := UpdateErrorForm.HandleError(DataSet, E, UpdateKind);
End;
现在我们回到主窗体，从处理主窗体的OnCreate事件的句柄开始。
Procedure TCacheDemoForm. FormCreate(Sender: TObject);
Begin
FDataSet := CacheData.CacheDS.DataSet as TDBDataSet;
FDataSet.CachedUpdates := CachedUpdates.Checked;
SetControlStates(FDataSet.CachedUpdates);
FDataSet.Open;
End;
第一行代码从TDataSource构件的DataSet属性取出当前的数据集，第二行代码是根据复选框CachedUpdates来决定数据集的CachedUpdates属性，进而再调用SetControlStates函数设置窗体上有关控件的状态，最后调用Open执行查询。SetControlStates是这样定义的：
Procedure TCacheDemoForm.SetControlStates(Enabled: Boolean);
Begin
ApplyUpdatesBtn.Enabled := True;
CancelUpdatesBtn.Enabled := True;
RevertRecordBtn.Enabled := True;
UnmodifiedCB.Enabled := True;
ModifiedCB.Enabled := True;
InsertedCB.Enabled := True;
DeletedCB.Enabled := True;
UseUpdateSQL.Enabled := True;
End;
下面是处理一些控件的事件。首先是复选框CachedUpdates的OnClick事件：
Procedure TCacheDemoForm.ToggleUpdateMode(Sender: TObject);
Begin
FDataSet.CachedUpdates := not FDataSet.CachedUpdates;
SetControlStates(FDataSet.CachedUpdates);
End;
复选框UseUpdateSQL的OnClick事件是这样处理的：
Procedure TCacheDemoForm.UseUpdateSQLClick(Sender: TObject);
Begin
FDataSet.Close;
If UseUpdateSQL.Checked then
FDataSet.UpdateObject := CacheData.UpdateSQLElseFDataSet.UpdateObject := nil;
FDataSet.Open;
End;
当用户单击“Apply Updates”按钮，就向数据库申请更新数据。
Procedure TCacheDemoForm.ApplyUpdatesBtnClick(Sender: TObject);
Begin
FDataSet.Database.ApplyUpdates([FDataSet]);
End;
当用户单击“Cancel Updates”按钮，所有未决的修改将被取消。
Procedure TCacheDemoForm.CancelUpdatesBtnClick(Sender: TObject);
Begin
FDataSet.CancelUpdates;
End;
当用户单击“Revert Record”按钮，对当前记录所作的修改将被取消。
Procedure TCacheDemoForm.RevertRecordBtnClick(Sender: TObject);
Begin
FDataSet.RevertRecord;
End;
在“Show Records”分组框内的几个复选框，它们的OnClick事件是这样处理的：
Procedure TCacheDemoForm.UpdateRecordsToShow(Sender: TObject);varUpdRecTypes : TUpdateRecordTypes;
Begin
UpdRecTypes := [];
If UnModifiedCB.Checked then
Include(UpdRecTypes, rtUnModified);
If ModifiedCB.Checked then Include(UpdRecTypes, rtModified);
If InsertedCB.Checked then Include(UpdRecTypes, rtInserted);
If DeletedCB.Checked thenInclude(UpdRecTypes, rtDeleted);
FDataSet.UpdateRecordTypes := UpdRecTypes;
End;
UpdateRecordsToShow 函数首先声明了一个TUpdateRecordTypes类型的变量UpdRecTypes，并把它初始化为空的集合。然后依次判断四个复选框是否选中，如选中的话，就把对应的元素包含到这个集合中，作为数据集的UpdateRecordTypes属性。
当用户单击“Re-Execute Query”按钮，就重新执行查询。
Procedure TCacheDemoForm.ReExecuteButtonClick(Sender: TObject);
Begin
FDataSet.Close;
FDataSet.Open;
End;
此外，在主窗体上，还有一个菜单命令叫About，此命令将调用ShowAboutDialog打开一个对话框。
ShowAboutDialog是这样定义的：
Procedure ShowAboutDialog;
Begin
With TAboutDialog.Create(Application) Do
Try
AboutMemo.Lines.LoadFromFile(ExtractFilePath(ParamStr(0))+'ABOUT.TXT');
ShowModal;
FinallyFree;
End;
End;
13.3 一个Client/Server示范程序 这一节详细剖析一个Client/Server示范程序，项目名称叫Csdemos，它可以在C:\Program Files\Borland\Delphi4\Demos\Db\Csdemos目录中找到。其主窗体如图13.5所示。
图13.5 Csdemos的主窗体
当用户单击“Show a View in action”按钮时，就打开FrmViewDemo窗口。
Procedure TFrmLauncher.BtnViewsClick(Sender: TObject);
Begin
FrmViewDemo.ShowModal;
End;
当用户单击“Salary Change Trigger Demo”按钮时，就打开FrmTriggerDemo窗口。
Procedure TFrmLauncher.BtnTriggClick(Sender: TObject);
Begin
FrmTriggerDemo.ShowModal;
End;
当用户单击“Query Stored Procedure Demo”按钮时，就打开FrmQueryProc窗口。
Procedure TFrmLauncher.BtnQrySPClick(Sender: TObject);
Begin
FrmQueryProc.ShowModal;
End;
当用户单击“Executable Stored Procedure Demo”按钮时，就打开FrmExecProc窗口。
Procedure TFrmLauncher.BtnExecSPClick(Sender: TObject);
Begin
FrmExecProc.ShowModal;
End;
当用户单击“Transaction Editing Demo”按钮时，就打开FrmTransDemo窗口。
Procedure TFrmLauncher.BtnTransClick(Sender: TObject);
Begin
FrmTransDemo.ShowModal;
End;
下面我们详细介绍这些窗口。FrmViewDemo窗口如图13.6所示。
图13.6 FrmViewDemo窗口
当这个窗口弹出时，首先调用TTable构件的Open函数打开数据集。
Procedure TFrmViewDemo.FormShow(Sender: TObject);
Begin
VaryingTable.Open;
End;
程序用两个快捷按钮来切换表格名称，其中，左边一个按钮对应于EMPLOYEE表。
Procedure TFrmViewDemo.BtnShowEmployeeClick(Sender: TObject);
Begin
ShowTable('EMPLOYEE');
End;
右边一个按钮对应于PHONE_LIST表。
Procedure TFrmViewDemo.BtnShowPhoneListClick(Sender: TObject);
Begin
ShowTable('PHONE_LIST');
End;
ShowTable是这样定义的：
Procedure TFrmViewDemo.ShowTable( ATable: string );
Begin
Screen.Cursor := crHourglass;
VaryingTable.DisableControls;
VaryingTable.Active := FALSE;
VaryingTable.TableName := ATable;
VaryingTable.Open;
VaryingTable.EnableControls;
Screen.Cursor := crDefault;
End;
FrmTriggerDemo窗口如图13.7所示：
图13.7 FrmTriggerDemo窗口
当这个窗口弹出时，首先调用两个TTable构件的Open打开数据集。
Procedure TFrmTriggerDemo.FormShow(Sender: TObject);
Begin
DmEmployee.EmployeeTable.Open;
DmEmployee.SalaryHistoryTable.Open;
End;
其中，DmEmployee是数据模块的名称。FrmQueryProc窗口如图13.7所示。
图13.7 FrmQueryProc
当这个窗口弹出时，将触发OnShow事件。这个事件是这样处理的：
Procedure TFrmQueryProc.FormShow(Sender: TObject);
Begin
DmEmployee.EmployeeTable.Open;
EmployeeSource.Enabled := True;
With EmployeeProjectsQuery Do
If not Active then Prepare;
End;
首先调用EmployeeTable的Open打开数据集，然后把数据源EmployeeSource的Enabled属性设为True，接着调用Prepare准备查询。
为了执行查询，程序处理了数据源EmployeeSource的OnDataChange事件：
Procedure TFrmQueryProc.EmployeeDataChange(Sender: TObject; Field: TField);
Begin
EmployeeProjectsQuery.Close;
EmployeeProjectsQuery.Params[0].AsInteger :=DmEmployee.EmployeeTableEmp_No.Value;
EmployeeProjectsQuery.Open;
WriteMsg('Employee ' + DmEmployee.EmployeeTableEmp_No.AsString +' is assigned to ' + IntToStr(EmployeeProjectsQuery.RecordCount) +' project(s).');
End;
调用WriteMsg的目的是在状态栏上显示一个消息。WriteMsg是这样定义的：
Procedure TFrmQueryProc.WriteMsg(StrWrite: String);
Begin
StatusBar1.SimpleText := StrWrite;
End;
最后，当这个窗口暂时隐去时，应当把数据源EmployeeSource的Enabled属性设为False：
Procedure TFrmQueryProc.FormHide(Sender: TObject);
Begin
EmployeeSource.Enabled := False;
End;
FrmExecProc窗口如图13.8所示。
图13.8 FrmExecProc
当这个窗口弹出时，将触发OnShow事件。这个事件是这样处理的：
Procedure TFrmExecProc.FormShow(Sender: TObject);
Begin
DmEmployee.SalesTable.Open;
DmEmployee.CustomerTable.Open;
SalesSource.Enabled := True;
End;
当用户在栅格中浏览记录时，将触发SalesSource的OnDataChange事件。在处理这个事件的句柄中，要判断ORDER_STATUS字段的值是否是SHIPPED，如果是，就使“Ship Order”按钮有效。
Procedure TFrmExecProc.SalesSourceDataChange(Sender: TObject; Field: TField);
Begin
If DmEmployee.SalesTable['ORDER_STATUS'] <> NULL then
BtnShipOrder.Enabled :=AnsiCompareText(DmEmployee.SalesTable['ORDER_STATUS'],'SHIPPED')<>0;
End;
当用户单击“Ship Order”按钮，就执行存储过程，存储过程的参数取自PO_NUMBER字段。
Procedure TFrmExecProc.BtnShipOrderClick(Sender: TObject);
Begin
With DmEmployee Do
Begin
ShipOrderProc.Params[0].AsString := SalesTable['PO_NUMBER'];
ShipOrderProc.ExecProc;
SalesTable.Refresh;
End;
End;
FrmTransDemo窗口如图13.9所示。
这个窗口演示了怎样处理事务。首先，要调用EmployeeDatabase(TDatabase构件)的StartTransaction开始一次新的事务。此后，对数据库的所有修改都暂时保留在缓存中，直到程序调用Commit或Rollback。
Procedure TFrmTransDemo.FormShow(Sender: TObject);
Begin
DmEmployee.EmployeeDatabase.StartTransaction;
DmEmployee.EmployeeTable.Open;
End;
当用户单击“Commit Edits”按钮，就要向服务器提交数据。首先要访问TDatabase构件的InTransaction属性，看看当前是否正在处理事务。如果是的话，还要弹出一个对话框，让用户确认是否要提交数据。程序代码如下：
Procedure TFrmTransDemo.BtnCommitEditsClick(Sender: TObject);
Begin
If DmEmployee.EmployeeDatabase.InTransaction and(MessageDlg('Are you sure you want to commit your changes?',mtConfirmation, [mbYes, mbNo], 0) = mrYes) then
Begin
DmEmployee.EmployeeDatabase.Commit;
DmEmployee.EmployeeDatabase.StartTransaction;
DmEmployee.EmployeeTable.Refresh;
End
Else
MessageDlg('Can抰 Commit Changes:No Transaction Active',mtError, [mbOk], 0);
End;
如果用户回答Yes的话，调用Commit向服务器提交数据。当用户单击“Undo Edits”按钮，调用Rollback取消所有的修改。
Procedure TFrmTransDemo.BtnUndoEditsClick(Sender: TObject);
Begin
If DmEmployee.EmployeeDatabase.InTransaction and(MessageDlg('Are you sure you want to undo all changes made during the ' +'current transaction?', mtConfirmation, [mbYes, mbNo], 0) = mrYes) then
Begin
DmEmployee.EmployeeDatabase.Rollback;
DmEmployee.EmployeeDatabase.StartTransaction;
DmEmployee.EmployeeTable.Refresh;
End
Else
MessageDlg('Can抰 Undo Edits: No Transaction Active', mtError, [mbOk], 0);
End;
在窗口即将隐去的时候，也要调用Commit向服务器提交数据，因为用户可能没有单击“Commit Edits”按钮。
Procedure TFrmTransDemo.FormHide(Sender: TObject);
Begin
DmEmployee.EmployeeDatabase.Commit;
End;
13.4 一个TDBCtrlGrid构件的示范程序 这一节详细剖析一个TDBCtrlGrid构件的示范程序，项目名称叫Ctrlgrid，它可以在C:\ Program Files\Borland\Delphi4\Demos\Db\Ctrlgrid目录中找到。它的主窗体如图13.10所示。
我们先介绍数据模块，因为几个关键的构件在数据模块上，如图13.11所示
可以看出，DM1上有三个TTable构件和三个TDataSource构件，这三个TTable构件分别访问Master表、Industry表和Holdings表。
主窗体上有两个栅格，一个是用TDBGrid构件建立的栅格，另一个是用TDBCtrlGrid构件建立的栅格，这两个栅格都用同一个TDBNavigator构件来导航。
这个程序运用了这样一个编程技巧，当用户把输入焦点移到TDBGrid构件建立的栅格中时，导航器就为TDBGrid构件建立的栅格导航；当用户把输入焦点移到TDBCtrlGrid构件建立的栅格中时，导航器就为TDBCtrlGrid构件建立的栅格导航。程序代码如下：
Procedure TFmCtrlGrid.DBGrid1Enter(Sender: TObject);
Begin
DBNavigator1.DataSource := DM1.DSMaster;
End;
Procedure TFmCtrlGrid.DBCtrlGrid1Enter(Sender: TObject);
Begin
DBNavigator1.DataSource := DM1.DSHoldings;
End;
当主窗体弹出时，将触发OnShow事件。程序是这样处理OnShow事件的：
Procedure TFmCtrlGrid.FormShow(Sender: TObject);
Begin
DM1.CalculateTotals(Sender, nil);
End;
其中，CalculateTotals用于计算几个数值，这些数值将显示在“InvestmentValue”框内。CalculateTotals是在数据模块DM1的单元中定义的：
Procedure TDM1.CalculateTotals(Sender: TObject; Field: TField);
var
flTotalCost, flTotalShares, flTotalValue, flDifference: Real;
strFormatSpec: string;
Begin{显示股票交易的次数}
FmCtrlGrid.lPurchase.Caption := IntToStr( tblHoldings.RecordCount );
{如果股票交易次数为0，就把“Investment Value”框内的数值清掉}
If tblHoldings.recordCount = 0 then
Begin
FmCtrlGrid.lTotalCost.Caption := '';
FmCtrlGrid.lTotalShares.Caption := '';
FmCtrlGrid.lDifference.Caption := '';
End
Else
Begin
{ 把光标设为沙漏状，因为计算数值的时间可能较长 }
Screen.Cursor := crHourglass;
{ 把数值初始化为0.0 }
flTotalCost := 0.0;
flTotalShares := 0.0;
{ 计算购买所持股票的金额 }
tblHoldings.DisableControls;
tblHoldings.First;
While not tblHoldings.eof Do
Begin
flTotalCost := flTotalCost + tblHoldingsPUR_COST.AsFloat;flTotalShares := flTotalShares + tblHoldingsSHARES.AsFloat;
tblHoldings.Next;
End;
tblHoldings.First;
tblHoldings.EnableControls;{ 计算股票的市值和赢亏 }
flTotalValue := flTotalShares * tblMasterCUR_PRICE.AsFloat;
flDifference := flTotalValue - flTotalCost;
strFormatSpec := tblMasterCUR_PRICE.DisplayFormat;
{ 显示上述数据 }
FmCtrlGrid.lTotalCost.Caption := FormatFloat( strFormatSpec, flTotalCost );
FmCtrlGrid.lTotalShares.Caption := FormatFloat( strFormatSpec, flTotalValue );
FmCtrlGrid.lDifference.Caption := FormatFloat( strFormatSpec, flDifference );
{ 如果是赚的，就以绿色显示。如果是亏的，就以红色显示 }
If flDifference > 0 then FmCtrlGrid.lDifference.Font.Color := clGreen
Else FmCtrlGrid.lDifference.Font.Color := clRed;
FmCtrlGrid.lDifference.Update;
{ 把光标恢复原状 }
Screen.Cursor := crDefault;
End;
End;
此外，当用户选择“About”命令时，将打开About框。程序代码如下：
Procedure TFmCtrlGrid.About1Click(Sender: TObject);
Begin
With TFMAboutBox.Create(nil) Do
Try
ShowModal;
Finally
Free;
End;
End;
当显示Holdings表的数据集打开后，就动态指定CalculateTotals作为处理dsMaster的OnDataChange事件的句柄。
Procedure TDM1.tblHoldingsAfterOpen(DataSet: TDataSet);
Begind
sMaster.OnDataChange := CalculateTotals;
End;
此外，这个程序还演示了书签的用法。
Procedure TDM1.tblHoldingsAfterPost(DataSet: TDataSet);
var
bmCurrent : TBookmark;
Begin
With tblHoldings Do
Begin
bmCurrent := GetBookmark;
Try
CalculateTotals(nil, nil);
GotoBookmark(bmCurrent);
Finally;
FreeBookmark(bmCurrent);
End;
End;
End;
13.5 一个捕捉数据库错误的示范程序 这一节剖析一个捕捉数据库错误的示范程序，项目名称叫Dberrors，它可以在C:\Program Files\Borland\Delphi4\Demos\Db\Dberrors目录中找到。它的主窗体如图13.11所示。
这个程序演示了怎样捕捉数据库错误。Delphi 4用OnPostError、OnEditError和OnDeleteError事件来捕捉错误，这些错误产生于用户对数据库的操作，如修改、删除和插入记录。
首先从它的数据模块开始。它的数据模块叫DM，如图13.12所示。
图13.12 数据模块
可以看出，数据模块上有三个TTable构件和三个TDataSorce构件，这三个TTable构件分别访问Customer表、Orders表和Items表。
要说明的是，这三个表之间并不是并行的关系，而是一对多的Master/Detail关系。例如，Orders表的MasterSource属性指定必须指定为CustomerSource，而Items表的MasterSource属性必须指定为OrdersSource。因此，这些TTable构件和TDataSource构件的生成顺序(Creation Order)是很重要的，不能搞错。
这个程序的主窗体很简单，有三个栅格(TDBGrid构件)，分别显示Customer表、Orders表和Items表的数据。
这个程序用同一个TDBNavigator构件为这三个栅格导航。因此，这个程序运用了一个小小的编程技巧，即动态地切换TDBNavigator构件的DataSource属性。程序代码如下：
Procedure TFmMain.GridOrdersEnter(Sender: TObject);
Begin
DBNavigator1.DataSource := Dm.OrdersSource;
End;
Procedure TFmMain.GridCustomersEnter(Sender: TObject);
Begin
DBNavigator1.DataSource := Dm.CustomerSource;
End;
Procedure TFmMain.GridItemsEnter(Sender: TObject);
Begin
DBNavigator1.DataSource := Dm.ItemsSource;
End;
如果用户在Customer表中修改、插入或删除了记录，当用户要把输入焦点移到其他栅格中之前，应当调用Post把用户对数据的编辑写到数据库中。
Procedure TFmMain.GridCustomersExit(Sender: TObject);
Begin
If Dm.Customer.State in [dsEdit,dsInsert] then Dm.Customer.Post;
End;
此外，当用户选择“About”命令时，将显示一个About框。代码如下：
Procedure TFmMain.About1Click(Sender: TObject);
var fmAboutBox : TFmAboutBox;
Begin
FmAboutBox := TFmAboutBox.Create(self);
Try
FmAboutBox.showModal;
Finally
FmAboutBox.free;
End;
End;
下面重点分析怎样捕捉错误。凡是捕捉错误的代码都是在数据模块的单元中实现的，这也是使用数据模块的好处之一。当程序调用Post或用户单击导航器上的Post按钮，就会把用户对数据的修改写到数据库中，如果出错(可能是因为有重复的客户编号)，就会触发OnPostError事件。让我们来看看Customer表是怎样处理OnPostError事件的：
Procedure TDM.CustomerPostError(DataSet: TDataSet; E: EDatabaseError; var Action: TDataAction);
Begin
If (E is EDBEngineError) then
If (E as EDBEngineError).Errors[0].Errorcode = eKeyViol then
Begin
MessageDlg('Unable to post: Duplicate Customer ID.',mtWarning,[mbOK],0);
Abort;
End;
End;
其中，EDBEngineError是一个处理BDE错误的异常类，可以访问它的Errors数组来获取当前的错误代码。如果错误代码是eKeyViol的话，就显示一个对话框，告诉用户不能把数据写到数据库中，因为有重复的客户编号。然后调用Abort放弃此次操作。
在Customer表中删除记录时也有可能出错，因为被删除的客户在Orders表和Items表中还有记录，这种情况下，就会触发OnDeleteError事件。让我们来看看Customer表是怎样处理OnDeleteError事件的：
Procedure TDM.CustomerDeleteError(DataSet: TDataSet; E: EDatabaseError; var Action: TDataAction);
Begin
If (E is EDBEngineError) then
If (E as EDBEngineError).Errors[0].Errorcode = eDetailsExist then
Begin
MessageDlg('To delete this record, first delete related orders and items.',mtWarning, [mbOK], 0);
Abort;
End;
End;
读者可能发现，处理OnDeleteError事件的方式与处理OnPostError事件的方式差不多，首先判断错误代码是否是eDetailsExist，如果是的话，表示被删除的客户在Orders表和Items表中还有记录，就显示一个对话框告诉用户：要删除这条记录，先要删除Orders表和Items表中的相关记录。然后调用Abort放弃此次操作。
由于CustNo字段是Customer表的关键字段，当用户修改CustNo字段的值但还没有Post之前，为了防止显示Orders表和Items表的栅格出现混乱，最好调用DisableControls函数暂时禁止刷新数据，等程序调用Post或用户单击导航器上的Post按钮后，再调用EnableControls函数。
Procedure TDM.CustomerCustNoChange(Sender: TField);
Begin
Orders.DisableControls;
Items.DisableControls;
End;
当程序调用Post或用户单击导航器上的Post按钮后，将触发AfterPost事件。程序是这样处理Customer表的AfterPost事件的：
Procedure TDM.CustomerAfterPost(DataSet: TDataSet);
Begin
Dm.Orders.Refresh;
Dm.Items.Refresh;
Dm.Orders.EnableControls;
Dm.Items.EnableControls;
End;
对于Items表来说，处理OnPostError事件的方式与Customer表处理OnPostError事件的方式大致上是相同的：
Procedure TDM.ItemsPostError(DataSet: TDataSet; E: EDatabaseError; var Action: TDataAction);
Begin
If (E as EDBEngineError).Errors[0].Errorcode = eForeignKey then
Begin
MessageDlg('Part number is invalid', mtWarning,[mbOK],0);
Abort;
End;
End;
Orders表是这样处理OnPostError事件的：
Procedure TDM.OrdersPostError(DataSet: TDataSet; E: EDatabaseError; var Action: TDataAction);
var iDBIError: Integer;
Begin
If (E is EDBEngineError) then
Begin
iDBIError := (E as EDBEngineError).Errors[0].Errorcode;
Case iDBIError of
eRequiredFieldMissing:
{EmpNo字段必须有值}
Begin
MessageDlg('Please provide an Employee ID', mtWarning, [mbOK], 0);
Abort;
End;
eKeyViol:
{对于Orders表来说，关键字段是OrderNo}
Begin
MessageDlg('Unable to post. Duplicate Order Number', mtWarning,[mbOK], 0);
Abort;
End;
End;
End;
End;
由于Items表依赖于Orders表，因此，删除Orders表中的记录时也有可能出错。因此，程序处理了Orders表的OnDeleteError事件。不过，与处理Customer表的OnDeleteError事件不同的是，这里用一个对话框让用户选择是否要删除这条有“问题”的记录，如果用户回答Yes，就把Items表的记录全部删掉，然后把Action参数设为daRetry，表示等退出这个事件句柄后将重新尝试删除这条记录。如果用户回答No，就调用Abort放弃此次操作。
Procedure TDM.OrdersDeleteError(DataSet: TDataSet; E: EDatabaseError; var Action: TDataAction);
Begin
If E is EDBEngineError then
If (E as EDBEngineError).Errors[0].Errorcode = eDetailsExist then
Begin
If MessageDlg('Delete this order and related items?', mtConfirmation,
[mbYes, mbNo], 0) = mrYes then
Begin
While Items.RecordCount > 0 Do
Items.delete;Action := daRetry;
End
Else
Abort;
End;
End;
13.6 一个对数据集进行过滤的示范程序 这一节剖析一个对数据集进行过滤的示范程序，项目名称叫Filter，它可以在C:\Program Files\Borland\Delphi4\Demos\Db\Filter目录中找到。它的主窗体如图13.13所示。
这个示范程序演示了怎样通过修改Filter属性动态地设置过滤条件，怎样在处理OnFilterRecord事件的句柄中改变过滤条件，怎样通过TQuery构件的Datasource属性从另一个数据集中获取参数，一个栅格怎样动态地切换数据集。
我们还是从数据模块开始，因为几个关键的构件放在数据模块上。这个程序的数据模块叫DM1，如图13.14所示。
数据模块上有一个TTable构件叫Customer，用于访问Customer表。有一个TQuery构件叫SQLCustomer，通过SQL语句来访问Customer表，其SQL语句如下：
SELECT * FROM "CUSTOMER.DB"
数据模块上有一个TDataSource构件叫CustomerSource，它的DataSet属性既可以设为Customer，也可以设为SQLCustomer。
数据模块上还有一个TQuery构件叫SQLOrders，用于查询Orders表，SQL语句如下：
Select * From Orders Where CustNo = :CustNo
SQLOrders的DataSource属性设为CustomerSource，表示:CustNo参数取自于Customer表的CustNo字段。主窗体上有两个栅格，上面这个栅格叫DBGrid1，下面这个栅格叫DBGrid2。
DBGrid1的DataSource属性设为CustomerSource，而CustomerSource的DataSet属性既可以设为Customer，也可以设为SQLCustomer，这是通过“DataSet”框内的两个单选按钮来切换的。
Procedure TfmCustView.rgDataSetClick(Sender: TObject);
var
st: string;
Begin
With DM1, CustomerSource Do
Begin
If Dataset.Filtered then st := Dataset.Filter;
Case rgDataset.ItemIndex of
0: If Dataset <> SQLCustomer then Dataset := SQLCustomer;
1: If CustomerSource.Dataset <> Customer then Dataset := Customer;
End;
If st <> '' then BeginDataset.Filter := st;
Dataset.Filtered := True;
End;
End;
End;
当用户单击“Filter Customers”按钮，就打开一个窗口让用户设置过滤条件。关于这个窗口后面再讲。
Procedure TfmCustView.SpeedButton1Click(Sender: TObject);
Begin
fmFilterFrm.Show;
End;
DBGrid2显示Orders表的数据。用户可以通过一个复选框来选择是否要对数据集进行过滤，实际上就是修改SQLOrders的Filtered属性。
Procedure TfmCustView.cbFilterOrdersClick(Sender: TObject);
Begin
DM1.SQLOrders.Filtered := cbFilterOrders.Checked;
If cbFilterOrders.Checked then
Edit1Change(nil);
End;
如果选中这个复选框的话，就调用Edit1Change把“Amount Paid”框内输入的数值赋值给DM1单元中的一个公共变量叫OrdersFilterAmount，至于这个变量有什么作用，后面在介绍DM1单元时会讲到的。调用Refresh将触发SQLOrders的OnFilterRecord事件。如果在调用Refresh之前用户在“AmountPaid”框内键入了非数字字符，调用Refresh会触发EConvertError异常，因此，程序用Try匛xcept结构对这段代码进行了保护。
Procedure TfmCustView.Edit1Change(Sender: TObject);
Begin
If (cbFilterOrders.checked) and (Edit1.Text <> '') then
Try
DM1.OrdersFilterAmount := StrToFloat(fmCustView.Edit1.Text);
DM1.SQLOrders.Refresh;
ExceptOn EConvertError DoRaise Exception.Create('Threshold Amount must be a number')
End
End;
前面多次介绍了这样一个编程技巧，当一个导航器为几个数据集导航时，应当处理栅格的OnEnter事件，以便动态地切换TDBNavigator构件的DataSource属性。
Procedure TfmCustView.DBGrid1Enter(Sender: TObject);
Begin
DBNavigator1.DataSource := DBGrid1.DataSource;
End;
Procedure TfmCustView.DBGrid2Enter(Sender: TObject);
Begin
DBNavigator1.DataSource := DBGrid2.DataSource;
End;
此外，当用户选择“About”命令时，将显示About框。代码如下：
Procedure TfmCustView.About1Click(Sender: TObject);
Begin
With TFMAboutBox.Create(nil) do
Try
ShowModal;
Finally
Free;
End;
End;
这个程序还演示了怎样处理OnFilterRecord事件：
Procedure TDM1.SQLOrdersFilterRecord(DataSet: TDataSet; var Accept: Boolean);
Begin
Accept := SQLOrdersAmountPaid.Value >= OrdersFilterAmount;
End;
请读者注意，由于OrdersFilterAmount是一个变量，这意味着用户只要修改这个变量的值，就能使过滤条件动态地变化。当用户单击“Filter Customers”按钮，就打开一个对话框让用户设置过滤条件。这个对话框如图13.15所示。
最上面的“List”框是一个组合框，用于列出过去曾经输入过的过滤条件表达式。“ Condition”框是一个多行文本编辑器，用于输入过滤条件表达式。
“Fields”框是一个列表框，用于列出Customer表中的所有字段，因为过滤条件表达式中需要用到字段。因此，程序在处理这个窗口的OnCreate事件的句柄中首先要填充这个列表框。此外，程序还在“List”框中加入了两个过滤条件。
Procedure TfmFilterFrm. FormCreate(Sender: TObject);
var
I: Integer;
Begin
For I := 0 to DM1.CustomerSource.Dataset.FieldCount - 1 do
ListBox1.Items.Add(DM1.Customer.Fields[I].FieldName);
ComboBox1.Items.Add('LastInvoiceDate >= ''' +DateToStr(EncodeDate(1994, 09, 30)) + '''');
ComboBox1.Items.Add('Country = ''US'' and LastInvoiceDate > ''' +DateToStr(EncodeDate(1994, 06, 30)) + '''');
End;
当用户从“List”框中选择或输入一个过滤表达式，应当首先把下面的“Condition”框清空，然后把用户选择或输入的过滤表达式加到“Condition”框中。
Procedure TfmFilterFrm.ComboBox1Change(Sender: TObject);
Begin
Memo1.Lines.Clear;
Memo1.Lines.Add(ComboBox1.Text);
End;
当用户在“Fields”框中双击一个字段，就把该字段加到“Condition”框中。
Procedure TfmFilterFrm.AddFieldName(Sender: TObject);
Begin
If Memo1.Text <> '' then
Memo1.Text := Memo1.Text + ' ';
Memo1.Text := Memo1.Text + ListBox1.Items[ListBox1.ItemIndex];
End;
当用户在“Operators”框中双击一个运算符，就把该运算符加到“Condition”框中。
Procedure TfmFilterFrm.ListBox2DblClick(Sender: TObject);
Begin
If Memo1.Text <> '' thenMemo1.Text := Memo1.Text + ' '+ ListBox2.Items[ListBox2.ItemIndex];
End;
由于用户有可能把过滤条件表达式分成几行写，因此，程序需要把以行为单位的字符串转换为一个字符串列表，因为Filter属性是一个TStrings对象。
Procedure TfmFilterFrm.Memo1Change(Sender: TObject);
var I: Integer;
Begin
ComboBox1.Text := Memo1.Lines[0];
For I := 1 to Memo1.Lines.Count - 1 do
ComboBox1.Text := ComboBox1.Text + ' ' + Memo1.Lines[I];
End;
程序用两个复选框让用户设置过滤的选项。一个是“Case Sensitive”框，如果选中此框，FilterOptions属性中将包含foCaseInSensitive元素。另一个是“NoPartial Compare”框，如果选中此框，FilterOptions属性中将包含foNoPartialCompare元素。
Procedure TfmFilterFrm.cbCaseSensitiveClick(Sender: TObject);
Begin
With DM1.CustomerSource.Dataset Do
If cbCaseSensitive.checked then
FilterOptions := FilterOptions - [foCaseInSensitive]ElseFilterOptions := FilterOptions + [foCaseInsensitive];
End;
Procedure TfmFilterFrm.cbNoPartialCompareClick(Sender: TObject);
Begin
With DM1.CustomerSource.Dataset Do
If cbNoPartialCompare.checked then
FilterOptions := FilterOptions + [foNoPartialCompare]
Else
FilterOptions := FilterOptions - [foNoPartialCompare];
End;
当用户输入了过滤条件表达式并且设置了过滤选项，就可以单击“Apply”按钮把过滤条件表达式赋给Filter属性：
Procedure TfmFilterFrm.ApplyFilter(Sender: TObject);
Begin
With DM1.CustomerSource.Dataset Do
Begin
If ComboBox1.Text <> '' then
Begin
Filter := ComboBox1.Text;
Filtered := True;
fmCustView.Caption := 'Customers - Filtered';
End
Else
Begin
Filter := '';
Filtered := False;
fmCustView.Caption := 'Customers - Unfiltered'
End;
End;
End;
如果用户单击“Clear”按钮，就把“Condition”框清空，并把输入的过滤条件表达式加到“List”框中。
Procedure TfmFilterFrm.SBtnClearClick(Sender: TObject);
var st: string;
Begin
Memo1.Lines.Clear;
st := ComboBox1.Text;
ComboBox1.Text := '';
If ComboBox1.Items.IndexOf(st) = -1 then ComboBox1.Items.Add(st);
End;
当用户单击“Close”按钮，就关闭这个窗口。
Procedure TfmFilterFrm.SBtnCloseClick(Sender: TObject);
Begin
Close;
End;
13.9 一个复杂的数据库应用程序 这一节介绍一个复杂的数据库应用程序，项目名称叫Mastapp，它可以在C:\Program Files\Borland\Delphi4\Demos\Db\ Mastapp目录中找到。它的主窗体如图13.18所示。
图13.18 Mastapp的主窗体
这个程序比较复杂，读者一定要对它的程序结构搞清楚。我们先介绍主窗体。我们还是从处理OnCreate事件的句柄开始，因为这是应用程序的起点。
Procedure TMainForm.FormCreate(Sender: TObject);
Begin
ClientWidth := CloseBtn.Left + CloseBtn.Width + 1;
ClientHeight := CloseBtn.Top + CloseBtn.Height;
MainPanel.Align := alClient;
Left := 0;
Top := 0;
InitRSRUN;
End;
前面两行代码用于设置主窗口的宽度和高度。把Left属性和Top属性都设为0将使主窗口显示在屏幕的左上角。
注意：这个示范程序有一个错误是，从Delphi 3开始已经取消了ReportSmith，因此，这里调用InitRSRUN以及InitRSRUN中调用的UpdateRSConnect都是多余的。当用户使用“File”菜单上的“New Order”命令或单击工具栏上的“NewOrder”按钮，程序将打开“Order Form”窗口，代码如下：
Procedure TMainForm.NewOrder(Sender: TObject);
Begin
EdOrderForm.Enter;
End;
当用户使用“File”菜单上的“Print Report”命令，再选择“Customer List”，将调用PrintCustomerReport函数打印客户报表。
Procedure TMainForm.CustomerReport(Sender: TObject);
Begin
PrintCustomerReport(False);
End;
其中，PrintCustomerReport是这样定义的：
Procedure TMainForm.PrintCustomerReport(Preview: Boolean);
Begin
With MastData.CustByLastInvQuery Do
Begin
Open;
If Preview then CustomerByInvoiceReport.Preview
Else
CustomerByInvoiceReport.Print;
Close;
End;
End;
由于传递给Preview参数的值是False，因此，这里将打印而不是预览报表。当用户使用“File”菜单上的“Print Report”命令，再选择“Order History”，将调用PrintOrderReport函数打印定单报表。
Procedure TMainForm.OrderReport(Sender: TObject);
Begin
PrintOrderReport(False);
End;
其中，PrintOrderReport是这样定义的：
Procedure TMainForm.PrintOrderReport(Preview: Boolean);
Const FromToHeading = 'From ''%s'' To ''%s''';
Begin
With QueryCustDlg Do
Begin
MsgLab.Caption := 'Print all orders ranging:';
If FromDate = 0 then FromDate := EncodeDate(95, 01, 01);
If ToDate = 0 then ToDate := Now;
If ShowModal = mrOk then
With MastData.OrdersByDateQuery Do
Begin
Close;
Params.ParamByName('FromDate').AsDate := FromDate;
Params.ParamByName('ToDate').AsDate := ToDate;
Open;
OrdersByDateReport.FromToHeading.Caption :=Format(FromToHeading, [DateToStr(FromDate), DateToStr(ToDate)]);
If Preview then
OrdersByDateReport.Preview
Else OrdersByDateReport.Print;
Close;
End;
End;
End;
PrintOrderReport函数首先弹出一个如图13.19所示的对话框，让用户选择首尾日期。
图13.19 选择首尾日期
当用户选择了首尾日期并单击OK按钮，就预览报表，因为Preview参数是False。当用户使用“File”菜单上的“Print Report”命令，再选择“Invoice”，将调用PrintInvoiceReport函数打印发货单报表。
Procedure TMainForm.InvoiceReport(Sender: TObject);
Begin
PrintInvoiceReport(False);
End;
其中，PrintInvoiceReport是这样定义的：
Procedure TMainForm.PrintInvoiceReport(Preview: Boolean);
Begin
If PickOrderNoDlg.ShowModal = mrOk then
If Preview then
InvoiceByOrderNoReport.Preview
Else
InvoiceByOrderNoReport.Print;
End;
PrintInvoiceReport函数首先将弹出如图13.20所示的对话框，让用户选择定单编号。
图13.20 选择定单编号
当用户使用“File”菜单上的“Printer Setup”命令，将打开“打印设置”对话框。
Procedure TMainForm.PrinterSetupClick(Sender: TObject);
Begin
PrinterSetup.Execute;
End;
当用户使用“View”菜单上的“Orders”命令或者单击工具栏上的“Browse”按钮，程序将打开“Order By Customer”窗口，代码如下：
Procedure TMainForm.BrowseCustOrd(Sender: TObject);
Begin
Case GetDateOrder(ShortDateFormat) Of
doYMD: ShortDateFormat := 'yy/mm/dd';
doMDY: ShortDateFormat := 'mm/dd/yy';
doDMY: ShortDateFormat := 'dd/mm/yy';
End;
BrCustOrdForm.Show;
End;
BrowseCustOrd首先调用GetDateOrder函数返回日期的格式，然后弹出“OrderBy Customer”窗口。GetDateOrder函数是这样定义的：
Function GetDateOrder(const DateFormat: string): TDateOrder;
var I: Integer;
Begin
Result := doMDY;
I := 1;
While I <= Length(DateFormat) Do
Begin
Case Chr(Ord(DateFormat[I]) and $DF) of
'Y': Result := doYMD;
'M': Result := doMDY;
'D': Result := doDMY;
Else Inc(I);
Continue;
End;
Exit;
End;
Result := doMDY;
End;
当用户使用“View”菜单上的“Parts/Inventory”命令或单击工具栏上的“Parts”按钮，程序将打开“Browse Parts”窗口，代码如下：
Procedure TMainForm.BrowseParts(Sender: TObject);
Begin
BrPartsForm.Show;
End;
当用户使用“View”菜单上的“Stay On Top”命令，就使主窗口总是在屏幕的前端。
Procedure TMainForm.ToggleStayonTop(Sender: TObject);
Begin
With Sender as TMenuItem Do
Begin
Checked := not Checked;
If Checked then MainForm.FormStyle := fsStayOnTop
Else MainForm.FormStyle := fsNormal;
End;
End;
请读者注意一个编程技巧，即怎样使窗口总是在屏幕前端。
这个程序可以让用户选择用本地数据库还是远程数据库。当用户选择“View”菜单上的“Local Data(Paradox Data)”命令时，就使用本地数据库。当用户选择“View”菜单上的“Remote Data(Local Interbase)”命令时，就使用Interbase数据库。注意：选择后者时，必须保证已安装Interbase服务器并且正在运行，否则会触发异常。
Procedure TMainForm.ViewLocalClick(Sender: TObject);
Begin
CloseAllWindows;
MastData.UseLocalData;
ViewLocal.Checked := True;
Caption := Application.Title + ' (Paradox Data)';
End;
Procedure TMainForm.ViewRemoteClick(Sender: TObject);
Begin
CloseAllWindows;
MastData.UseRemoteData;
ViewRemote.Checked := True;
Caption := Application.Title + ' (Local Interbase)';
End;
其中，UseLocalData和UseRemoteData是在数据模块的单元中定义的。在切换数据库之前必须调用CloseAllWindows关闭所有打开的窗口。CloseAllWindows是这样定义的：
Procedure TMainForm.CloseAllWindows;
var I: Integer;
F: TForm;
Begin
For I := 0 to Application.ComponentCount - 1 Do
Begin
If Application.Components[I] is TForm then
Begin
F := TForm(Application.Components[I]);
If (F <> Self) and (F.Visible) then F.Close;
End;
End;
End;
当用户单击工具栏上的“Reports”按钮，就打开“Report Select”窗口，让用户选择要打印或预览哪个报表，代码如下：
Procedure TMainForm.ReportBtnClick(Sender: TObject);
Begin
With PickRpt Do
If ShowModal = mrOK then
Case ReportType.ItemIndex of
0: PrintCustomerReport( Preview );
1: PrintOrderReport( Preview );
2: PrintInvoiceReport( Preview );
End;
End;
本文地址：http://com.8s8s.com/it/it4679.htm