arpaymentform.pas

功能全面的商业财会系统源码,清晰,很有参考价值.扩展性强.

unit ARPaymentForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Grids, DBGrids, ExtCtrls, DB, DBTables, Mask, DBCtrls, Buttons,
  Menus, BDE;

type
  TfrmARPayment = class(TForm)
    Panel1: TPanel;
    panelMiddle: TPanel;
    Panel2: TPanel;
    Panel4: TPanel;
    btnOK: TButton;
    btnCancel: TButton;
    tblARPmt: TTable;
    dsARPmt: TDataSource;
    tblARInvPmt: TTable;
    dsARInvPmt: TDataSource;
    Label2: TLabel;
    editChequeNo: TDBEdit;
    lblInvoiceDate: TLabel;
    editPaymentDate: TDBEdit;
    lblGLPeriod: TLabel;
    editGLPeriod: TDBEdit;
    panelLeft: TPanel;
    tblCustomer: TTable;
    dsCustomer: TDataSource;
    DBGrid1: TDBGrid;
    tblCustomerCustomerName: TStringField;
    tblCustomerAddressLine1: TStringField;
    panelRight: TPanel;
    txtAddress: TDBText;
    tblCustomerAddressLine2: TStringField;
    tblCustomerCity: TStringField;
    tblCustomerStateProv: TStringField;
    tblCustomerAddress: TStringField;
    tblCustomerZipCode: TStringField;
    tblCustomerCountry: TStringField;
    editGLYear: TDBEdit;
    tblARPmtCtl: TTable;
    tblCustomerCustomerID: TAutoIncField;
    tblCustomerCustomerNo: TStringField;
    btnPaymentDate: TSpeedButton;
    PopupMenu1: TPopupMenu;
    mnuNew: TMenuItem;
    mnuDelete: TMenuItem;
    lblPosted: TLabel;
    tblARPmtPaymentID: TAutoIncField;
    tblARPmtBillToID: TIntegerField;
    tblARPmtBankID: TIntegerField;
    tblARPmtGLYear: TSmallintField;
    tblARPmtGLPeriod: TSmallintField;
    tblARPmtPaymentDate: TDateField;
    tblARPmtChequeAmount: TCurrencyField;
    tblARPmtPosted: TBooleanField;
    tblARInvPmtARInvoiceID: TIntegerField;
    tblARInvPmtPaymentID: TIntegerField;
    tblARInvPmtPaymentAmount: TCurrencyField;
    Label1: TLabel;
    editChequeAmount: TDBEdit;
    tblARInv: TTable;
    tblARInvARInvoiceID: TIntegerField;
    tblARInvBillToID: TIntegerField;
    tblARInvInvoiceNo: TStringField;
    tblARInvInvoiceDate: TDateField;
    tblARInvInvoiceAmount: TCurrencyField;
    tblARInvOwing: TCurrencyField;
    tblARInvPosted: TBooleanField;
    tblARInvPmtInvoiceNo: TStringField;
    tblARInvPmtSeq: TIntegerField;
    qryLastDetailLineNo: TQuery;
    tblARInvPmt2: TTable;
    tblARInvPmt2ARInvoiceID: TIntegerField;
    tblARInvPmt2PaymentID: TIntegerField;
    tblARInvPmt2Seq: TIntegerField;
    tblARInvPmtOwing: TCurrencyField;
    tblARInvPmtInvoiceDate: TDateField;
    tblARInvPmtInvoiceAmount: TCurrencyField;
    Label3: TLabel;
    editBillToNo: TEdit;
    cboBillTo: TDBLookupComboBox;
    tblARPmtBillToNo: TStringField;
    btnBillTo: TSpeedButton;
    cboBank: TDBLookupComboBox;
    Label4: TLabel;
    btnBank: TSpeedButton;
    tblCustomerCurrencyID: TIntegerField;
    tblARPmtCurrencyIDofBank: TIntegerField;
    tblARPmtCurrencyIDofBillTo: TIntegerField;
    tblARPmtCtlNextPaymentID: TIntegerField;
    tblARInvPmtDiscTakenAmount: TCurrencyField;
    tblARInvPmtWriteOffAmount: TCurrencyField;
    tblARInvPmtWriteOffGLAccount: TStringField;
    tblARPmtAddress: TStringField;
    tblARInvPmtAccountName: TStringField;
    tblARPmtChequeNo: TStringField;
    popPayDiscNo: TMenuItem;
    N1: TMenuItem;
    popPayDiscYes: TMenuItem;
    popWriteOff: TMenuItem;
    popPayDiscIf: TMenuItem;
    tblARInvDiscPC: TFloatField;
    tblARInvDiscDays: TSmallintField;
    tblARInvPmtDiscPC: TFloatField;
    tblARInvPmtDiscDays: TIntegerField;
    tblARInvPmtDiscountAmount: TCurrencyField;
    tblARInvPmtDiscountDate: TDateField;
    procedure btnOKClick(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Panel2DblClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure DBGrid1ColExit(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure DBGrid1Exit(Sender: TObject);
    procedure DBGrid1Enter(Sender: TObject);
    procedure tblCustomerCalcFields(DataSet: TDataSet);
    procedure editPaymentDateKeyPress(Sender: TObject; var Key: Char);
    procedure dsARPmtDataChange(Sender: TObject; Field: TField);
    procedure DBGrid1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure tblARInvPmtNewRecord(DataSet: TDataSet);
    procedure tblARPmtNewRecord(DataSet: TDataSet);
    procedure tblARPmtUpdateError(DataSet: TDataSet; E: EDatabaseError;
      UpdateKind: TUpdateKind; var UpdateAction: TUpdateAction);
    procedure tblARInvPmtUpdateError(DataSet: TDataSet; E: EDatabaseError;
      UpdateKind: TUpdateKind; var UpdateAction: TUpdateAction);
    procedure tblARPmtBeforeEdit(DataSet: TDataSet);
    procedure tblARInvPmtBeforeEdit(DataSet: TDataSet);
    procedure tblARInvPmtBeforeInsert(DataSet: TDataSet);
    procedure tblARInvPmtBeforeDelete(DataSet: TDataSet);
    procedure tblARPmtGLYearGetText(Sender: TField; var Text: string;
      DisplayText: Boolean);
    procedure tblARPmtGLYearSetText(Sender: TField; const Text: string);
    procedure tblARPmtBeforePost(DataSet: TDataSet);
    procedure tblARInvPmtAfterPost(DataSet: TDataSet);
    procedure tblARInvPmtAfterDelete(DataSet: TDataSet);
    procedure btnPaymentDateClick(Sender: TObject);
    procedure mnuDeleteClick(Sender: TObject);
    procedure mnuNewClick(Sender: TObject);
    procedure tblARPmtBeforeInsert(DataSet: TDataSet);
    procedure tblARInvPmtBeforePost(DataSet: TDataSet);
    procedure tblARInvPmtARInvoiceIDValidate(Sender: TField);
    procedure tblARInvPmtARInvoiceIDChange(Sender: TField);
    procedure editBillToNoExit(Sender: TObject);
    procedure editBillToNoKeyPress(Sender: TObject; var Key: Char);
    procedure cboBillToKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure btnBillToClick(Sender: TObject);
    procedure cboBankKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure btnBankClick(Sender: TObject);
    procedure tblARInvFilterRecord(DataSet: TDataSet; var Accept: Boolean);
    procedure tblARPmtBillToIDValidate(Sender: TField);
    procedure tblARPmtBillToIDChange(Sender: TField);
    procedure dsARPmtUpdateData(Sender: TObject);
    procedure tblARInvPmtWriteOffGLAccountValidate(Sender: TField);
    procedure DBGrid1EditButtonClick(Sender: TObject);
    procedure DBGrid1KeyPress(Sender: TObject; var Key: Char);
    procedure tblARInvPmtWriteOffAmountChange(Sender: TField);
    procedure popWriteOffClick(Sender: TObject);
    procedure popPayDiscNoClick(Sender: TObject);
    procedure tblARInvPmtCalcFields(DataSet: TDataSet);
    procedure popPayDiscYesClick(Sender: TObject);
    procedure popPayDiscIfClick(Sender: TObject);
    procedure tblARPmtPaymentDateSetText(Sender: TField;
      const Text: string);
  private
    { Private declarations }
    NextDetailLineNo: Integer;
    TotalPaymentAmount, OldPaymentAmount: Currency;
    ARInvoiceIDs, Seqs: TStringList;  OldSeq: Integer;
  public
    { Public declarations }
  end;

var
  frmARPayment: TfrmARPayment;

implementation

uses BS1Form, ARPaymentsForm, CalendarForm, CustomersForm, CustomersFilterForm,
  BanksForm, LookUpsData, GLAccountSearchForm;

var
  intClientHeight, intClientWidth: Integer;

{$R *.DFM}

procedure TfrmARPayment.btnOKClick(Sender: TObject);
begin
  if tblARPmt.State in [dsInsert, dsEdit] then tblARPmt.post;
  if tblARInvPmt.State in [dsInsert, dsEdit] then tblARInvPmt.post;
  tblARPmt.Database.ApplyUpdates([tblARPmt, tblARInvPmt]);
  DbiSaveChanges(tblARPmt.handle);
  DbiSaveChanges(tblARInvPmt.handle);
  try
    with frmARPayments.qryARPmt do begin close; open; end;   //Refresh, etc.
    frmARPayments.qryARPmt.Locate('PaymentID', tblARPmtPaymentID.value, []);
  except; end;
  if (tblARPmt.UpdatesPending = false) and (tblARInvPmt.UpdatesPending = false) then Close;
end;

procedure TfrmARPayment.btnCancelClick(Sender: TObject);
begin
  tblARPmt.DisableControls;
  tblARPmt.cancel;
  tblARPmt.CancelUpdates;
  tblARInvPmt.cancel;
  tblARInvPmt.CancelUpdates;
  Close;
end;

procedure TfrmARPayment.FormCreate(Sender: TObject);
var
  x: integer;
begin
  tblARPmt.DatabaseName := strDatabaseName;
  tblARPmtCtl.DatabaseName := strDatabaseName;
  tblARInvPmt.DatabaseName := strDatabaseName;
  tblARInvPmt2.DatabaseName := strDatabaseName;
  tblARInv.DatabaseName := strDatabaseName;
  tblCustomer.DatabaseName := strDatabaseName;
  //tblBank.DatabaseName := strDatabaseName;   //Data Module used instead.
  qryLastDetailLineNo.DatabaseName := strDatabaseName;
  dmLookUps.tblBank.Active := true;
  tblARPmt.Active := true;
  tblARInv.Active := true;
  tblARInvPmt.Active := true;
  //tblARInvPmt2.Active := true;
  tblCustomer.Active := true;
  tblARPmt.Database.TransIsolation := tiDirtyRead;

  if FontFactor <> 1 then begin   //If using large fonts, resize form.
    for x := 0 to DBGrid1.Columns.Count - 1 do DBGrid1.Columns[x].width := Trunc(DBGrid1.Columns[x].width*FontFactor);
    ClientHeight := Trunc(ClientHeight*FontFactor);
    ClientWidth := Trunc(ClientWidth*FontFactor);
  end;  
  intClientHeight := ClientHeight;   //Store form size.
  intClientWidth := ClientWidth;

  ARInvoiceIDs := TStringList.create;   //Create TStringLists to store ARInvoiceIDs & Seqs for this cheque, to prevent invoices occurring more than once.
  Seqs := TStringList.create;
end;

procedure TfrmARPayment.Panel2DblClick(Sender: TObject);
begin
  ClientHeight := intClientHeight;   //Resize form.
  ClientWidth := intClientWidth;
end;

procedure TfrmARPayment.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if (tblARPmt.State in [dsInsert, dsEdit]) or (tblARInvPmt.State in [dsInsert, dsEdit])
  or (tblARPmt.UpdatesPending = true) or (tblARInvPmt.UpdatesPending = true) then btnOKClick(sender);
  try frmARPayments.DBGrid1.Setfocus; except; end;
  Action := caFree;
end;

procedure TfrmARPayment.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if key = #13 then begin   //Enter key: advance to next control.
    if not (ActiveControl is TDBGrid) and (ActiveControl.ClassType <> TDBMemo) and (ActiveControl.ClassType <> TDBLookupCombobox) then begin
      Key := #0;
      if (ActiveControl.name = 'editBillToNo') and (editBillToNo.text <> '') then editChequeNo.setfocus
      else Perform(WM_NEXTDLGCTL, 0, 0);
    end else if (ActiveControl.ClassType = TDBLookupComboBox) and (TDBLookupComboBox(ActiveControl).ListVisible = false) then begin
      Key := #0;
      Perform(WM_NEXTDLGCTL, 0, 0);
    end else if (ActiveControl is TDBGrid) then begin
      key := #0;
      //Exit grid if on a new record & no data... replaced by ColExit event (as this event can't see whether data is being entered in the current cell).
      //if (TDBGrid(ActiveControl).selectedindex = 1) and (tblARInvPmtInvoiceID.AsVariant = Null) and (tblARInvPmtGLAmount.AsVariant = Null) then Perform(WM_NEXTDLGCTL, 0, 0)
      //else}
      with TDBGrid(ActiveControl) do
        if selectedindex < 3 then selectedindex := 3   //If on an invoice field, skip to payment.
        else if (selectedindex = 6) and (tblARInvPmtWriteOffAmount.value = 0) and (tblARInvPmtWriteOffGLAccount.AsVariant = null) then begin   //If on W/O GL Account & no W/O data, move to next record.
          selectedindex := 0;
          tblARInvPmt.next;
          if tblARInvPmt.eof = true then tblARInvPmt.append;
        end else if selectedindex < (fieldcount - 1) then selectedindex := selectedindex + 1   //Increment the field.
        else begin   //Move to next record.
          selectedindex := 0;
          tblARInvPmt.next;
          if tblARInvPmt.eof = true then tblARInvPmt.append;
        end;
    end;
  end;
end;

procedure TfrmARPayment.DBGrid1ColExit(Sender: TObject);
begin   //Exit grid if leaving 1st column on a new record & no data.  Actually if leaving column 1 (to another cell in the grid), and target cell is a record with no InvoiceID (new record) or PaymentAmount.
  if (TDBGrid(ActiveControl).SelectedIndex = 0) and (tblARInvPmtARInvoiceID.AsVariant = Null) and (tblARInvPmtPaymentAmount.AsVariant = Null) and (tblARInvPmt.RecordCount > 0) then btnOK.setfocus;
end;

procedure TfrmARPayment.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (key = VK_Next) then begin   //PageDown
    key := 0;