arpaymentspostform.pas

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

unit ARPaymentsPostForm;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
  Buttons, ExtCtrls, ComCtrls, DB, DBTables, Mask, DBCtrls, Dialogs, BDE;

type
  TfrmARPaymentsPost = class(TForm)
    btnOK: TButton;
    btnCancel: TButton;
    qryARPmt: TQuery;
    lblRecordCount: TLabel;
    ProgressBar1: TProgressBar;
    tblCBalance: TTable;
    tblCBalanceBalance: TCurrencyField;
    tblJV: TTable;
    tblJVJVID: TIntegerField;
    tblJVGLYear: TSmallintField;
    tblJVGLPeriod: TSmallintField;
    tblJVJVNumber: TIntegerField;
    tblJVSource: TStringField;
    tblJVTransType: TStringField;
    tblJVTransDate: TDateField;
    tblJVTransDescription: TStringField;
    tblJVJVAmount: TCurrencyField;
    tblJVPosted: TBooleanField;
    tblJVAutoReverse: TBooleanField;
    qryARPmtChequeNo: TStringField;
    qryARPmtChequeAmount: TCurrencyField;
    qryARPmtGLPeriod: TSmallintField;
    qryARPmtGLYear: TSmallintField;
    qryARPmtPosted: TBooleanField;
    tblJVCtl: TTable;
    tblJVCtlNextJVID: TIntegerField;
    tblJV2: TTable;
    tblJVCtlNextJVNumber: TIntegerField;
    tblJV2GLYear: TSmallintField;
    tblJV2GLPeriod: TSmallintField;
    tblJV2JVNumber: TIntegerField;
    tblARInvPmt: TTable;
    tblJVDet: TTable;
    tblJVDetJVID: TIntegerField;
    tblJVDetSeq: TIntegerField;
    tblJVDetGLAccount: TStringField;
    tblJVDetGLAmount: TCurrencyField;
    dsARPmt: TDataSource;
    qryARPmtCurrencyID: TIntegerField;
    tblARPmt: TTable;
    tblARPmtPosted: TBooleanField;
    tblCurrency: TTable;
    tblCurrencyCurrencyID: TAutoIncField;
    tblCurrencyExchangeRate: TFloatField;
    qryARPmtARGLAccount: TStringField;
    qryARPmtExchangeRate: TFloatField;
    qryARPmtGainLossExchangeGLAccount: TStringField;
    tblCurrencyARGLAccount: TStringField;
    tblCurrencyGainLossExchangeGLAccount: TStringField;
    qryARPmtPaymentID: TIntegerField;
    qryARPmtBillToID: TIntegerField;
    tblJVCustomerID: TIntegerField;
    tblCBalanceCustomerID: TIntegerField;
    tblJVPaymentID: TIntegerField;
    tblARPmtPaymentID: TIntegerField;
    tblCurrencyARDiscGLAccount: TStringField;
    qryARPmtBankID: TIntegerField;
    tblARInvPmtPaymentID: TIntegerField;
    tblARInvPmtSeq: TIntegerField;
    tblARInvPmtPaymentAmount: TCurrencyField;
    tblARInvPmtDiscTakenAmount: TCurrencyField;
    tblARInvPmtWriteOffAmount: TCurrencyField;
    tblARInvPmtWriteOffGLAccount: TStringField;
    tblARInvPmtARInvoiceID: TIntegerField;
    qryARPmtARDiscGLAccount: TStringField;
    tblARInv: TTable;
    tblARInvARInvoiceID: TIntegerField;
    tblARInvInvoiceAmount: TCurrencyField;
    tblARInvPaidAmount: TCurrencyField;
    tblARInvDiscTakenAmount: TCurrencyField;
    tblARInvWriteOffAmount: TCurrencyField;
    tblARInvOwing: TCurrencyField;
    tblBank: TTable;
    tblBankBankID: TAutoIncField;
    tblBankBankGLAccount: TStringField;
    qryARPmtBankGLAccount: TStringField;
    qryARPmtPaymentDate: TDateField;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmARPaymentsPost: TfrmARPaymentsPost;

implementation

uses BS1Form;

var
  RecordCount: integer;

{$R *.DFM}

procedure TfrmARPaymentsPost.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Action := caFree;
end;

procedure TfrmARPaymentsPost.FormCreate(Sender: TObject);
begin
  qryARPmt.DatabaseName := strDatabaseName;
  tblARPmt.DatabaseName := strDatabaseName;
  tblCBalance.DatabaseName := strDatabaseName;
  tblCurrency.DatabaseName := strDatabaseName;
  tblBank.DatabaseName := strDatabaseName;
  tblARInvPmt.DatabaseName := strDatabaseName;
  tblARInv.DatabaseName := strDatabaseName;
  tblJVCtl.DatabaseName := strDatabaseName;
  tblJV.DatabaseName := strDatabaseName;
  tblJV2.DatabaseName := strDatabaseName;
  tblJVDet.DatabaseName := strDatabaseName;
  qryARPmt.Active := true;

  RecordCount := qryARPmt.RecordCount;
  lblRecordCount.caption := IntToStr(RecordCount) + ' payment(s) to be posted';
end;

procedure TfrmARPaymentsPost.btnOKClick(Sender: TObject);
var
  aComponent: TComponent;
  TotalExchange, TotalDiscountTaken, TotalDiscountTakenCvt, TotalPayDiscWriteOff, TotalDebits, TotalDebitsWOExch: currency;
begin
  ModalResult := mrCancel;   //Set to mrCancel to prevent subsequent requery in case job can't be started.
  if RecordCount = 0 then exit;
  aComponent := Application.FindComponent('frmARPayment');
  if Assigned (aComponent) then raise(Exception.Create('A conflicting program is running...' + #13 + 'Please close ' + '''' + 'AR Payment' + '''' + ' form'));

  repeat   //Exclusive open to prevent locking Delphi 2 locking bug.
  try
    tblJVCtl.Active := True;
    Break;   //If no error, exit the loop.
  except
    on EDatabaseError do if MessageDlg('Unable to open JV Control table exclusively.', mtError, [mbRetry, mbCancel], 0) <> mrRetry then raise;
  end;
  until False;

  repeat   //Exclusive open to prevent locking Delphi 2 locking bug.
  try
    tblARPmt.Active := True;
    Break;   //If no error, exit the loop.
  except
    on EDatabaseError do if MessageDlg('Unable to open Payments table exclusively.', mtError, [mbRetry, mbCancel], 0) <> mrRetry then raise;
  end;
  until False;

  repeat   //Exclusive open to prevent locking Delphi 2 locking bug.
  try
    tblCBalance.Active := True;
    Break;   //If no error, exit the loop.
  except
    on EDatabaseError do if MessageDlg('Unable to open Customer Balance table exclusively.', mtError, [mbRetry, mbCancel], 0) <> mrRetry then raise;
  end;
  until False;

  ModalResult := mrOK;
  screen.cursor := crHourglass;
  ProgressBar1.max := qryARPmt.RecordCount;
  ProgressBar1.step := 1;
  tblARInv.Active := true;
  tblARInvPmt.Active := true;
  tblBank.Active := true;
  tblCurrency.Active := true;
  tblJV.Active := true;
  tblJV2.Active := true;
  tblJVDet.Active := true;
  try
    qryARPmt.First;
    while not qryARPmt.EOF do begin
      with tblARPmt do begin   //Update tblARPmt.
        try
          Edit;
          FieldValues['Posted'] := true;
          Post;
        except raise; end;
      end;

      tblARInvPmt.First;   //Update ARInv + calculate total discount taken & total payments+discounts+write-offs.
      TotalDiscountTaken := 0;
      TotalPayDiscWriteOff := 0;
      While not tblARInvPmt.eof do begin
        if tblARInv.Locate('ARInvoiceID', tblARInvPmtARInvoiceID.value, []) = true then begin
          try
            tblARInv.Edit;
            tblARInvPaidAmount.AsCurrency := tblARInvPaidAmount.Value + tblARInvPmtPaymentAmount.Value;
            tblARInvDiscTakenAmount.AsCurrency := tblARInvDiscTakenAmount.Value + tblARInvPmtDiscTakenAmount.Value;
            tblARInvWriteOffAmount.AsCurrency := tblARInvWriteOffAmount.Value + tblARInvPmtWriteOffAmount.Value;
            tblARInvOwing.AsCurrency := tblARInvInvoiceAmount.value - tblARInvPaidAmount.value - tblARInvDiscTakenAmount.value - tblARInvWriteOffAmount.value;
            tblARInv.Post;
            TotalDiscountTaken := TotalDiscountTaken + tblARInvPmtDiscTakenAmount.Value;
            TotalPayDiscWriteOff := TotalPayDiscWriteOff + tblARInvPmtPaymentAmount.Value + tblARInvPmtDiscTakenAmount.Value + tblARInvPmtWriteOffAmount.Value;
          except raise; end;
        end;
        tblARInvPmt.next;
      end;

      if tblCBalance.Locate('CustomerID', qryARPmtBillToID.value, []) = true then begin   //Update tblCBalance.
        try
          tblCBalance.Edit;
          tblCBalanceBalance.AsCurrency := tblCBalanceBalance.value - TotalPayDiscWriteOff;
          tblCBalance.Post;
        except raise; end;
      end else begin
        try
          tblCBalance.Insert;
          tblCBalanceCustomerID.value := qryARPmtBillToID.value;
          tblCBalanceBalance.AsCurrency := -TotalPayDiscWriteOff;
          tblCBalance.Post;
        except raise; end;
      end;

      TotalExchange := 0;   //Create JV: adjust for any write-offs & exchange later.
      TotalDebitsWOExch := 0;
      if (qryARPmtExchangeRate.value = 0) or (qryARPmtExchangeRate.value = 1) then TotalDiscountTakenCvt := TotalDiscountTaken
      else begin
        //TotalDiscountTakenCvt := TotalDiscountTaken * qryARPmtExchangeRate.value;   //Prevent Delphi 2 bug: rounds .5 down.
        TotalDiscountTakenCvt := frmBS1.RoundIt(TotalDiscountTaken * qryARPmtExchangeRate.value * 100)/100;
        TotalExchange := TotalExchange + (TotalDiscountTakenCvt - TotalDiscountTaken);
      end;
      try
        tblJV.Insert;
          tblJVCtl.Edit;
          tblJVJVID.Value := tblJVCtlNextJVID.Value;
          tblJVCtlNextJVID.Value := tblJVCtlNextJVID.Value + 1;
          if (tblJVCtlNextJVNumber.Value < 1001) or (tblJVCtlNextJVNumber.Value > 10000000) then tblJVCtlNextJVNumber.Value := 1001;   //Start auto-assigned numbers here.
          while true do begin
            if tblJV2.Locate('GLYear;GLPeriod;JVNumber', VarArrayOf([qryARPmtGLYear.value,qryARPmtGLPeriod.value,tblJVCtlNextJVNumber.Value]), []) = true then tblJVCtlNextJVNumber.Value := tblJVCtlNextJVNumber.Value + 1
            else break;   //Exit loop.
          end;
          tblJVJVNumber.Value := tblJVCtlNextJVNumber.Value;
          tblJVCtlNextJVNumber.Value := tblJVCtlNextJVNumber.Value + 1;
          tblJVCtl.Post;
        tblJVGLYear.value := qryARPmtGLYear.value;
        tblJVGLPeriod.value := qryARPmtGLPeriod.value;
        tblJVSource.value := 'AR';
        tblJVTransType.value := 'Pmt';
        //tblJVTransDate.value := Date;
        tblJVTransDate.value := qryARPmtPaymentDate.value;   //Use payment date so bank book sorts properly.
        tblJVTransDescription.value := 'AR Cheque ' + qryARPmtChequeNo.value;
        tblJVCustomerID.value := qryARPmtBillToID.value;
        tblJVPaymentID.value := qryARPmtPaymentID.value;
        TotalDebits := 0;
        if qryARPmtChequeAmount.AsCurrency > 0 then TotalDebits := TotalDebits + qryARPmtChequeAmount.value;   //Bank.
        if TotalDiscountTakenCvt >0 then TotalDebits := TotalDebits + TotalDiscountTakenCvt;   //Discount.
        if TotalPayDiscWriteOff < 0 then TotalDebits := TotalDebits + TotalPayDiscWriteOff;   //AR.
        tblJVJVAmount.AsCurrency := TotalDebits;
        tblJVPosted.value := false;
        tblJVAutoReverse.value := false;
        tblJV.Post;
      except raise; end;

      if TotalPayDiscWriteOff <> 0 then begin   //Create JV detail: AR.
        try
          tblJVDet.Insert;
          tblJVDetJVID.Value := tblJVJVID.Value;
          tblJVDetSeq.Value := 1;
          tblJVDetGLAmount.AsCurrency := -TotalPayDiscWriteOff;
          tblJVDetGLAccount.Value := qryARPmtARGLAccount.value;
          tblJVDet.Post;
        except raise; end;
      end;
      if qryARPmtChequeAmount.AsCurrency <> 0 then begin   //Create JV detail: bank.
        try
          tblJVDet.Insert;
          tblJVDetJVID.Value := tblJVJVID.Value;
          tblJVDetSeq.Value := 2;
          tblJVDetGLAmount.AsCurrency := qryARPmtChequeAmount.value;
          tblJVDetGLAccount.Value := qryARPmtBankGLAccount.value;
          tblJVDet.Post;
        except raise; end;
      end;
      if TotalDiscountTaken <> 0 then begin   //Create JV detail: discount.
        try
          tblJVDet.Insert;
          tblJVDetJVID.Value := tblJVJVID.Value;
          tblJVDetSeq.Value := 3;
          tblJVDetGLAmount.AsCurrency := TotalDiscountTakenCvt;
          tblJVDetGLAccount.Value := qryARPmtARDiscGLAccount.value;
          tblJVDet.Post;
        except raise; end;
      end;

      tblARInvPmt.First;   //Create JV detail: write-offs.
      While not tblARInvPmt.eof do begin
        if tblARInvPmtWriteOffAmount.AsCurrency <> 0 then begin
          try
            tblJVDet.Insert;
            tblJVDetJVID.Value := tblJVJVID.Value;
            tblJVDetSeq.Value := tblARInvPmtSeq.Value + 3;
            if (qryARPmtExchangeRate.value = 0) or (qryARPmtExchangeRate.value = 1) then tblJVDetGLAmount.AsCurrency := tblARInvPmtWriteOffAmount.Value
            else begin
              //tblJVDetGLAmount.AsCurrency := tblARInvPmtWriteOffAmount.Value * qryARPmtExchangeRate.value;   //Prevent Delphi 2 bug: rounds .5 down.
              tblJVDetGLAmount.AsCurrency := frmBS1.RoundIt(tblARInvPmtWriteOffAmount.Value * qryARPmtExchangeRate.value * 100)/100;
              TotalExchange := TotalExchange + (tblJVDetGLAmount.Value - tblARInvPmtWriteOffAmount.Value);
            end;
            if tblJVDetGLAmount.AsCurrency >0 then TotalDebitsWOExch := TotalDebitsWOExch + tblJVDetGLAmount.value;
            tblJVDetGLAccount.Value := tblARInvPmtWriteOffGLAccount.Value;
            tblJVDet.Post;
          except raise; end;
        end;
        tblARInvPmt.next;
      end;
      if TotalExchange <> 0 then begin   //Create JV detail: exchange.
        try
          tblJVDet.Insert;
          tblJVDetJVID.Value := tblJVJVID.Value;
          tblJVDetSeq.Value := tblARInvPmtSeq.Value + 4;
          tblJVDetGLAmount.AsCurrency := -TotalExchange;
          if tblJVDetGLAmount.AsCurrency >0 then TotalDebitsWOExch := TotalDebitsWOExch + tblJVDetGLAmount.value;
          tblJVDetGLAccount.Value := qryARPmtGainLossExchangeGLAccount.value;
          tblJVDet.Post;
        except raise; end;
      end;
      if TotalDebitsWOExch <> 0 then begin   //Update JV: write-offs & exchange.
        try
          tblJV.Edit;
          tblJVJVAmount.AsCurrency := tblJVJVAmount.value + TotalDebitsWOExch;
          tblJV.Post;
        except raise; end;
      end;

      ProgressBar1.StepIt;
      qryARPmt.next;
    end;
  finally
    DbiSaveChanges(tblJVCtl.handle);
    DbiSaveChanges(tblJV.handle);
    DbiSaveChanges(tblJVDet.handle);
    DbiSaveChanges(tblARInv.handle);
    DbiSaveChanges(tblARPmt.handle);
    DbiSaveChanges(tblCBalance.handle);
    tblJVCtl.Close;
    tblARPmt.Close;
    tblCBalance.Close;
    screen.cursor := crDefault;
  end;
end;

end.