datamod.pas

Delphi利用MVC开发的典型例子

unit DataMod;

{ See the comments in MAIN.PAS for information about this project }

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DB, Variants, DBTables, patterns;

type
  TMastData = class(TDataModule)
    Database: TDatabase;
    NextCust: TTable;
    NextCustNewCust: TFloatField;
    Parts: TTable;
    PartsPartNo: TFloatField;
    PartsDescription: TStringField;
    PartsOnHand: TFloatField;
    PartsOnOrder: TFloatField;
    PartsSource: TDataSource;
    PartsQuery: TQuery;
    PartsQueryPartNo: TFloatField;
    PartsQueryDescription: TStringField;
    PartsQueryOnHand: TFloatField;
    PartsQueryOnOrder: TFloatField;
    VendorSource: TDataSource;
    Vendors: TTable;
    PartsVendorNo: TFloatField;
    PartsCost: TCurrencyField;
    PartsListPrice: TCurrencyField;
    PartsBackOrd: TBooleanField;
    PartsQueryVendorNo: TFloatField;
    PartsQueryCost: TCurrencyField;
    PartsQueryListPrice: TCurrencyField;
    PartsQueryBackOrd: TBooleanField;
    Orders: TTable;
    OrdersOrderNo: TFloatField;
    OrdersCustNo: TFloatField;
    OrdersSaleDate: TDateTimeField;
    OrdersShipDate: TDateTimeField;
    OrdersShipToContact: TStringField;
    OrdersShipToAddr1: TStringField;
    OrdersShipToAddr2: TStringField;
    OrdersShipToCity: TStringField;
    OrdersShipToState: TStringField;
    OrdersShipToZip: TStringField;
    OrdersShipToCountry: TStringField;
    OrdersShipToPhone: TStringField;
    OrdersShipVIA: TStringField;
    OrdersPO: TStringField;
    OrdersEmpNo: TIntegerField;
    OrdersTerms: TStringField;
    OrdersPaymentMethod: TStringField;
    OrdersItemsTotal: TCurrencyField;
    OrdersTaxRate: TFloatField;
    OrdersTaxTotal: TCurrencyField;
    OrdersFreight: TCurrencyField;
    OrdersAmountPaid: TCurrencyField;
    OrdersAmountDue: TCurrencyField;
    OrdersSource: TDataSource;
    CustByOrd: TTable;
    CustByOrdCustNo: TFloatField;
    CustByOrdCompany: TStringField;
    CustByOrdAddr1: TStringField;
    CustByOrdAddr2: TStringField;
    CustByOrdCity: TStringField;
    CustByOrdState: TStringField;
    CustByOrdZip: TStringField;
    CustByOrdCountry: TStringField;
    CustByOrdPhone: TStringField;
    CustByOrdFAX: TStringField;
    CustByOrdTaxRate: TFloatField;
    CustByOrdContact: TStringField;
    CustByOrdLastInvoiceDate: TDateTimeField;
    CustByOrdSrc: TDataSource;
    Items: TTable;
    ItemsItemNo: TFloatField;
    ItemsOrderNo: TFloatField;
    ItemsDescription: TStringField;
    ItemsSellPrice: TCurrencyField;
    ItemsQty: TIntegerField;
    ItemsDiscount: TFloatField;
    ItemsExtPrice: TCurrencyField;
    ItemsSource: TDataSource;
    NextOrd: TTable;
    NextOrdNewKey: TFloatField;
    Emps: TTable;
    EmpsEmpNo: TIntegerField;
    EmpsFullName: TStringField;
    EmpsLastName: TStringField;
    EmpsFirstName: TStringField;
    EmpsPhoneExt: TStringField;
    EmpsHireDate: TDateTimeField;
    EmpsSalary: TFloatField;
    EmpsSource: TDataSource;
    LastItemQuery: TQuery;
    Cust: TTable;
    CustCustNo: TFloatField;
    CustCompany: TStringField;
    CustPhone: TStringField;
    CustLastInvoiceDate: TDateTimeField;
    CustSource: TDataSource;
    CustQuery: TQuery;
    CustQueryCustNo: TFloatField;
    CustQueryCompany: TStringField;
    CustQueryPhone: TStringField;
    CustQueryLastInvoiceDate: TDateTimeField;
    OrdByCustSrc: TDataSource;
    OrdByCust: TTable;
    OrdByCustOrderNo: TFloatField;
    OrdByCustCustNo: TFloatField;
    OrdByCustSaleDate: TDateTimeField;
    OrdByCustShipDate: TDateTimeField;
    OrdByCustItemsTotal: TCurrencyField;
    OrdByCustTaxRate: TFloatField;
    OrdByCustFreight: TCurrencyField;
    OrdByCustAmountPaid: TCurrencyField;
    OrdByCustAmountDue: TCurrencyField;
    ItemsPartNo: TFloatField;
    CustAddr1: TStringField;
    CustAddr2: TStringField;
    CustCity: TStringField;
    CustState: TStringField;
    CustZip: TStringField;
    CustCountry: TStringField;
    CustFAX: TStringField;
    CustTaxRate: TFloatField;
    CustContact: TStringField;
    CustMasterSrc: TDataSource;
    CustByComp: TTable;
    CustByCompSrc: TDataSource;
    CustByLastInvQuery: TQuery;
    CustByLastInvQueryCustNo: TFloatField;
    CustByLastInvQueryCompany: TStringField;
    CustByLastInvQueryAddr1: TStringField;
    CustByLastInvQueryAddr2: TStringField;
    CustByLastInvQueryCity: TStringField;
    CustByLastInvQueryState: TStringField;
    CustByLastInvQueryZip: TStringField;
    CustByLastInvQueryCountry: TStringField;
    CustByLastInvQueryPhone: TStringField;
    CustByLastInvQueryFAX: TStringField;
    CustByLastInvQueryTaxRate: TFloatField;
    CustByLastInvQueryContact: TStringField;
    CustByLastInvQueryLastInvoiceDate: TDateTimeField;
    OrdersByDateQuery: TQuery;
    OrdersSalesPerson: TStringField;
    OrdersByDateQueryOrderNo: TFloatField;
    OrdersByDateQueryCustNo: TFloatField;
    OrdersByDateQuerySaleDate: TDateTimeField;
    OrdersByDateQueryShipDate: TDateTimeField;
    OrdersByDateQueryEmpNo: TIntegerField;
    OrdersByDateQueryShipToContact: TStringField;
    OrdersByDateQueryShipToAddr1: TStringField;
    OrdersByDateQueryShipToAddr2: TStringField;
    OrdersByDateQueryShipToCity: TStringField;
    OrdersByDateQueryShipToState: TStringField;
    OrdersByDateQueryShipToZip: TStringField;
    OrdersByDateQueryShipToCountry: TStringField;
    OrdersByDateQueryShipToPhone: TStringField;
    OrdersByDateQueryShipVIA: TStringField;
    OrdersByDateQueryPO: TStringField;
    OrdersByDateQueryTerms: TStringField;
    OrdersByDateQueryPaymentMethod: TStringField;
    OrdersByDateQueryItemsTotal: TCurrencyField;
    OrdersByDateQueryTaxRate: TFloatField;
    OrdersByDateQueryFreight: TCurrencyField;
    OrdersByDateQueryAmountPaid: TCurrencyField;
    OrdersByDateQueryCompany: TStringField;
    procedure PartsBeforeOpen(DataSet: TDataSet);
    procedure PartsCalcFields(DataSet: TDataSet);
    procedure PartsQueryCalcFields(DataSet: TDataSet);
    procedure OrdersAfterCancel(DataSet: TDataSet);
    procedure OrdersAfterPost(DataSet: TDataSet);
    procedure OrdersBeforeCancel(DataSet: TDataSet);
    procedure OrdersBeforeClose(DataSet: TDataSet);
    procedure OrdersBeforeDelete(DataSet: TDataSet);
    procedure OrdersBeforeInsert(DataSet: TDataSet);
    procedure OrdersBeforeOpen(DataSet: TDataSet);
    procedure OrdersCalcFields(DataSet: TDataSet);
    procedure OrdersNewRecord(DataSet: TDataSet);
    procedure ItemsAfterDelete(DataSet: TDataSet);
    procedure ItemsAfterPost(DataSet: TDataSet);
    procedure EnsureOrdersEdit(DataSet: TDataSet);
    procedure ItemsBeforeEdit(DataSet: TDataSet);
    procedure ItemsBeforeOpen(DataSet: TDataSet);
    procedure ItemsBeforePost(DataSet: TDataSet);
    procedure ItemsCalcFields(DataSet: TDataSet);
    procedure ItemsNewRecord(DataSet: TDataSet);
    procedure EmpsCalcFields(DataSet: TDataSet);
    procedure OrdersCustNoChange(Sender: TField);
    procedure ItemsQtyValidate(Sender: TField);
    procedure OrdersFreightValidate(Sender: TField);
    procedure ItemsPartNoValidate(Sender: TField);
    procedure OrdersSaleDateValidate(Sender: TField);
    procedure CustBeforeOpen(DataSet: TDataSet);
    procedure OrdByCustCalcFields(DataSet: TDataSet);
    procedure CustBeforePost(DataSet: TDataSet);
    procedure OrdersAfterDelete(DataSet: TDataSet);
    procedure OrdersBeforeEdit(DataSet: TDataSet);
    procedure EditUpdateError(DataSet: TDataSet; E: EDatabaseError;
      UpdateKind: TUpdateKind; var UpdateAction: TUpdateAction);
  private
    PrevPartNo: Double; { remembers Item's previous part# }
    PrevQty: Longint; { remembers Item's previous qty }
    DeletingItems: Boolean; { suppress totals calc. if deleting items }
    FItemNo: Integer;
    function DataDirectory: string;
    procedure SetDatabaseAlias(AliasName: string);
    procedure UpdateTotals;
    procedure DeleteItems;
    procedure UseLocalData;
    procedure UseRemoteData;
  public
    function DataSetApplyUpdates(DataSet: TDataSet; Apply: Boolean): Boolean;
    class function getInstance: TMastData;
  end;


  TControllerMastData = class(TController)
  protected
    procedure DoCommand(Command: string; const args: string=''); override;
  public
  end;


function Confirm(Msg: string): Boolean;

var
  MastData: TMastData;

implementation
uses commandlist;

{$R *.DFM}

class function TMastData.getInstance: TMastData;
begin
  if not assigned(mastData) then
    MastData := TMastData.Create(application);
  result := mastData;
end;

{ Utility Functions }

function Confirm(Msg: string): Boolean;
begin
  Result := MessageDlg(Msg, mtConfirmation, mbYesNoCancel, 0) = mrYes;
end;

function TMastData.DataDirectory: string;
begin
  { Assume data is in ..\..\data relative to where we are }
  Result := ExtractFilePath(ParamStr(0));
  Result := ExpandFileName(Result + '..\..\DATA\');
end;

{ This function switches the database to a different alias }

procedure TMastData.SetDatabaseAlias(AliasName: string);
begin
  Screen.Cursor := crHourGlass;
  try
    Database.Close;
    Database.AliasName := AliasName;
    Database.Open;
  finally
    Screen.Cursor := crDefault;
  end;
end;

{ Create an alias for the local data if needed, then swith the Database
  to use it }

procedure TMastData.UseLocalData;
var
  DataDir: string;
begin
  { See if the target alias exists, if not then add it. }
  if not Session.IsAlias('DBDEMOS') then
  begin
    DataDir := DataDirectory;
    if not FileExists(DataDir + 'ORDERS.DB') then
      raise Exception.Create('Cannot locate Paradox data files');
    Session.AddStandardAlias('DBDEMOS', DataDir, 'PARADOX');
  end;
  SetDatabaseAlias('DBDEMOS');
end;

{ Create an alias to point to the MastSQL.GDB file if needed }

procedure TMastData.UseRemoteData;
var
  Params: TStringList;
  DataFile: string;
begin

  { See if the alias exists.  if not then add it. }
  if not Session.IsAlias('MASTSQL') then
  begin
    DataFile := DataDirectory + 'MASTSQL.GDB';
    if not FileExists(DataFile) then
      raise Exception.Create('Cannot locate Interbase data file: MASTSQL.GDB');
    Params := TStringList.create;
    try
      Params.Values['SERVER NAME'] := DataFile;
      Params.Values['USER NAME'] := 'SYSDBA';
      Session.AddAlias('MASTSQL', 'INTRBASE', Params);
    finally
      Params.Free;
    end;
  end;
  SetDatabaseAlias('MASTSQL');
end;

{ Event Handlers }

procedure TMastData.PartsBeforeOpen(DataSet: TDataSet);
begin
  Vendors.Open;
end;

procedure TMastData.PartsCalcFields(DataSet: TDataSet);
begin
  PartsBackOrd.Value := PartsOnOrder.Value > PartsOnHand.Value;
end;

procedure TMastData.PartsQueryCalcFields(DataSet: TDataSet);
begin
  PartsQueryBackOrd.Value := PartsOnOrder.Value > PartsOnHand.Value;
end;

{ If user cancels the updates to the orders table, cancel the updates to
  the line items as well }

procedure TMastData.OrdersAfterCancel(DataSet: TDataSet);
begin
  Cust.CancelUpdates;
  Parts.CancelUpdates;
  Items.CancelUpdates;
  Orders.CancelUpdates;
end;

procedure TMastData.OrdersAfterDelete(DataSet: TDataSet);
begin
  Database.ApplyUpdates([Cust, Parts, Items, Orders]);
end;

{ Order Entry }

{ Post new LastInvoiceDate to CUST table. }

procedure TMastData.OrdersAfterPost(DataSet: TDataSet);

begin
  if Cust.Locate('CustNo', OrdersCustNo.Value, []) and
    (CustLastInvoiceDate.Value < OrdersShipDate.Value) then
  begin
    Cust.Edit;
    CustLastInvoiceDate.Value := OrdersShipDate.Value;
    Cust.Post;
  end;
  Database.ApplyUpdates([Orders, Items, Parts, Cust]);
end;

procedure TMastData.OrdersBeforeCancel(DataSet: TDataSet);
begin
  if (Orders.State = dsInsert) and not (Items.BOF and Items.EOF) then
    if not Confirm('Cancel order being inserted and delete all line items?') then
      Abort;
end;

procedure TMastData.OrdersBeforeClose(DataSet: TDataSet);
begin
  Items.Close;
  Emps.Close;