多层数据库开发十三:剖析几个数据库应用程序

类别:Delphi 点击:0 评论:0 推荐:
                            第十三章 剖析几个数据库应用程序
  前面已经详细讲述了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