多層數據庫開發十三:剖析幾個數據庫應用程序

2019-11-18 18:10:55

字體：大中小

來源：轉載

供稿：網友

第十三章剖析幾個數據庫應用程序
　　前面已經詳細講述了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;

上一篇：多層數據庫開發十四:剖析幾個MIDAS示范程序

下一篇：多層數據庫開發十二:使用數據控件

學習交流

索泰發布一款GTX 1070 Mini迷你版本:小機

索泰發布一款GTX 1070 Mini迷你版本:小機箱大愛...

熱門圖片

猜你喜歡的新聞

猜你喜歡的關注