apchequespostform.pas

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

unit APChequesPostForm;

interface

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

type
  TfrmAPChequesPost = class(TForm)
    btnOK: TButton;
    btnCancel: TButton;
    qryAPCheq: TQuery;
    lblRecordCount: TLabel;
    ProgressBar1: TProgressBar;
    dsAPCheq: TDataSource;
    tblAPCheq: TTable;
    tblAPCheqChequeID: TIntegerField;
    tblAPCheqPosted: TBooleanField;
    qryAPCheqChequeID: TIntegerField;
    qryAPCheqChequeNo: TIntegerField;
    qryAPCheqVendorID: TIntegerField;
    qryAPCheqBankID: TIntegerField;
    qryAPCheqGLYear: TSmallintField;
    qryAPCheqGLPeriod: TSmallintField;
    qryAPCheqChequeDate: TDateField;
    qryAPCheqChequeAmount: TCurrencyField;
    qryAPCheqReconciled: TBooleanField;
    qryAPCheqPosted: TBooleanField;
    qryAPCheqVoid: TBooleanField;
    qryAPCheqCurrencyID: TIntegerField;
    tblVBalance: TTable;
    tblVBalanceVendorID: TIntegerField;
    tblVBalanceBalance: TCurrencyField;
    tblJVCtl: TTable;
    tblJVCtlNextJVID: TIntegerField;
    tblJVCtlNextJVNumber: TIntegerField;
    tblCurrency: TTable;
    tblCurrencyCurrencyID: TAutoIncField;
    tblCurrencyAPGLAccount: TStringField;
    qryAPCheqAPGLAccount: TStringField;
    tblJV: TTable;
    tblJVJVID: TIntegerField;
    tblJVGLYear: TSmallintField;
    tblJVGLPeriod: TSmallintField;
    tblJVJVNumber: TIntegerField;
    tblJVSource: TStringField;
    tblJVTransType: TStringField;
    tblJVTransDate: TDateField;
    tblJVTransDescription: TStringField;
    tblJVVendorID: TIntegerField;
    tblJVJVAmount: TCurrencyField;
    tblJVPosted: TBooleanField;
    tblJVAutoReverse: TBooleanField;
    tblJV2: TTable;
    tblJV2GLYear: TSmallintField;
    tblJV2GLPeriod: TSmallintField;
    tblJV2JVNumber: TIntegerField;
    tblJVDet: TTable;
    tblJVDetJVID: TIntegerField;
    tblJVDetSeq: TIntegerField;
    tblJVDetGLAccount: TStringField;
    tblJVDetGLAmount: TCurrencyField;
    tblBank: TTable;
    tblBankBankID: TAutoIncField;
    tblBankBankGLAccount: TStringField;
    qryAPCheqBankGLAccount: TStringField;
    qryAPCheqAPDiscGLAccount: TStringField;
    tblAPInvChq: TTable;
    tblAPInvChqAPInvoiceID: TIntegerField;
    tblAPInvChqChequeID: TIntegerField;
    tblAPInvChqSeq: TIntegerField;
    tblAPInvChqPaymentAmount: TCurrencyField;
    tblAPInv: TTable;
    tblAPInvAPInvoiceID: TIntegerField;
    tblAPInvDiscountDate: TDateField;
    tblAPInvInvoiceAmount: TCurrencyField;
    tblAPInvPaidAmount: TCurrencyField;
    tblAPInvDiscountAmount: TCurrencyField;
    tblAPInvDiscountTaken: TBooleanField;
    tblAPInvOwing: TCurrencyField;
    tblJVChequeID: TIntegerField;
    tblCurrencyAPDiscGLAccount: TStringField;
    tblCurrencyExchangeRate: TFloatField;
    tblCurrencyGainLossExchangeGLAccount: TStringField;
    qryAPCheqExchangeRate: TFloatField;
    qryAPCheqGainLossExchangeGLAccount: TStringField;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmAPChequesPost: TfrmAPChequesPost;

implementation

uses BS1Form;

var
  RecordCount: integer;
{$R *.DFM}

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

procedure TfrmAPChequesPost.FormCreate(Sender: TObject);
begin
  qryAPCheq.DatabaseName := strDatabaseName;
  tblAPCheq.DatabaseName := strDatabaseName;
  tblVBalance.DatabaseName := strDatabaseName;
  tblCurrency.DatabaseName := strDatabaseName;
  tblBank.DatabaseName := strDatabaseName;
  tblAPInvChq.DatabaseName := strDatabaseName;
  tblAPInv.DatabaseName := strDatabaseName;
  tblJVCtl.DatabaseName := strDatabaseName;
  tblJV.DatabaseName := strDatabaseName;
  tblJV2.DatabaseName := strDatabaseName;
  tblJVDet.DatabaseName := strDatabaseName;
  qryAPCheq.Active := true;

  RecordCount := qryAPCheq.RecordCount;
  lblRecordCount.caption := IntToStr(RecordCount) + ' printed cheque(s) to be posted';
end;

procedure TfrmAPChequesPost.btnOKClick(Sender: TObject);
var
  aComponent: TComponent;
  TotalExchange, TotalDiscountTaken, TotalDiscountTakenCvt, PaidAndDisc, TotalPaidAndDisc, TotalDebits: 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('frmAPCheque');
  if Assigned (aComponent) then raise(Exception.Create('A conflicting program is running...' + #13 + 'Please close ' + '''' + 'AP Cheque' + '''' + ' 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
    tblAPCheq.Active := True;
    Break;   //If no error, exit the loop.
  except
    on EDatabaseError do if MessageDlg('Unable to open Cheques table exclusively.', mtError, [mbRetry, mbCancel], 0) <> mrRetry then raise;
  end;
  until False;

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

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

      tblAPInvChq.First;   //Update APInv + calculate total discount taken.
      TotalDiscountTaken := 0;
      While not tblAPInvChq.eof do begin
        if tblAPInv.Locate('APInvoiceID', tblAPInvChqAPInvoiceID.value, []) = true then begin
          try
            tblAPInv.Edit;
            tblAPInvPaidAmount.AsCurrency := tblAPInvPaidAmount.Value + tblAPInvChqPaymentAmount.Value;
            if (tblAPInvDiscountTaken.Value <> true) and (tblAPInvDiscountAmount.Value <> 0) and (qryAPCheqChequeDate.value <= tblAPInvDiscountDate.value) then begin
              PaidAndDisc := tblAPInvPaidAmount.value + tblAPInvDiscountAmount.value;   //Prevent strange Delphi 2 bug where the following expression doesn't work if frmJVs is open.
              if ((tblAPInvInvoiceAmount.value >0) and (PaidAndDisc >= tblAPInvInvoiceAmount.value))
              or ((tblAPInvInvoiceAmount.value <0) and (PaidAndDisc <= tblAPInvInvoiceAmount.value)) then begin
                tblAPInvDiscountTaken.Value := true;
                TotalDiscountTaken := TotalDiscountTaken + tblAPInvDiscountAmount.Value;
              end;
            end;
            tblAPInvOwing.AsCurrency := tblAPInvInvoiceAmount.value - tblAPInvPaidAmount.value;
            if tblAPInvDiscountTaken.value = true then tblAPInvOwing.AsCurrency := tblAPInvOwing.value - tblAPInvDiscountAmount.value;
            tblAPInv.Post;
          except raise; end;
        end;
        tblAPInvChq.next;
      end;

      if qryAPCheqVoid.value <> true then begin
        if tblVBalance.Locate('VendorID', qryAPCheqVendorID.value, []) = true then begin   //Update tblVBalance.
          try
            tblVBalance.Edit;
            tblVBalanceBalance.AsCurrency := tblVBalanceBalance.value - qryAPCheqChequeAmount.value - TotalDiscountTaken;
            tblVBalance.Post;
          except raise; end;
        end else begin
          try
            tblVBalance.Insert;
            tblVBalanceVendorID.value := qryAPCheqVendorID.value;
            tblVBalanceBalance.AsCurrency := -qryAPCheqChequeAmount.value  - TotalDiscountTaken;
            tblVBalance.Post;
          except raise; end;
        end;
      end;

      if not ((qryAPCheqChequeAmount.value = 0) and (TotalDiscountTaken = 0)) then begin
        TotalPaidAndDisc := qryAPCheqChequeAmount.Value + TotalDiscountTaken;
        TotalExchange := 0;
        if (qryAPCheqExchangeRate.value = 0) or (qryAPCheqExchangeRate.value = 1) then TotalDiscountTakenCvt := TotalDiscountTaken
        else begin
          //TotalDiscountTakenCvt := TotalDiscountTaken * qryAPCheqExchangeRate.value;   //Prevent Delphi 2 bug: rounds .5 down.
          TotalDiscountTakenCvt := frmBS1.RoundIt(TotalDiscountTaken * qryAPCheqExchangeRate.value * 100)/100;
          TotalExchange := TotalExchange + (TotalDiscountTakenCvt - TotalDiscountTaken);
        end;
        try   //Create JV.
          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([qryAPCheqGLYear.value,qryAPCheqGLPeriod.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 := qryAPCheqGLYear.value;
          tblJVGLPeriod.value := qryAPCheqGLPeriod.value;
          tblJVSource.value := 'AP';
          tblJVTransType.value := 'Chq';
          //tblJVTransDate.value := Date;
          tblJVTransDate.value := qryAPCheqChequeDate.value;   //Use cheque date so bank book sorts properly.
          tblJVTransDescription.value := 'AP Cheque ' + qryAPCheqChequeNo.AsString;
          tblJVVendorID.value := qryAPCheqVendorID.value;
          tblJVChequeID.value := qryAPCheqChequeID.value;
          TotalDebits := 0;
          if qryAPCheqChequeAmount.AsCurrency < 0 then TotalDebits := TotalDebits - qryAPCheqChequeAmount.value;   //Bank.
          if TotalDiscountTakenCvt < 0 then TotalDebits := TotalDebits - TotalDiscountTakenCvt;   //Discount.
          if TotalPaidAndDisc > 0 then TotalDebits := TotalDebits + TotalPaidAndDisc;   //AP.
          if TotalExchange > 0 then TotalDebits := TotalDebits + TotalExchange;   //Exchange.
          tblJVJVAmount.AsCurrency := TotalDebits;
          tblJVPosted.value := false;
          tblJVAutoReverse.value := false;
          tblJV.Post;
        except raise; end;

        if TotalPaidAndDisc <> 0 then begin   //Create JV detail: AP GLAccount.
          try
            tblJVDet.Insert;
            tblJVDetJVID.Value := tblJVJVID.Value;
            tblJVDetSeq.Value := 1;
            tblJVDetGLAmount.AsCurrency := TotalPaidAndDisc;
            tblJVDetGLAccount.value := qryAPCheqAPGLAccount.value;
            tblJVDet.Post;
          except raise; end;
        end;
        if qryAPCheqChequeAmount.Value <> 0 then begin   //Bank GLAccount.
          try
            tblJVDet.Insert;
            tblJVDetJVID.Value := tblJVJVID.Value;
            tblJVDetSeq.Value := 2;
            tblJVDetGLAmount.AsCurrency := -qryAPCheqChequeAmount.Value;
            tblJVDetGLAccount.Value := qryAPCheqBankGLAccount.value;
            tblJVDet.Post;
          except raise; end;
        end;
        if TotalDiscountTaken <> 0 then begin   //AP Discount GLAccount.
          try
            tblJVDet.Insert;
            tblJVDetJVID.Value := tblJVJVID.Value;
            tblJVDetSeq.Value := 3;
            tblJVDetGLAmount.AsCurrency := -TotalDiscountTakenCvt;
            tblJVDetGLAccount.Value := qryAPCheqAPDiscGLAccount.value;
            tblJVDet.Post;
          except raise; end;
        end;
        if TotalExchange <> 0 then begin   //AP Exchange GLAccount.
          try
            tblJVDet.Insert;
            tblJVDetJVID.Value := tblJVJVID.Value;
            tblJVDetSeq.Value := 4;
            tblJVDetGLAmount.AsCurrency := TotalExchange;
            tblJVDetGLAccount.Value := qryAPCheqGainLossExchangeGLAccount.value;
            tblJVDet.Post;
          except raise; end;
        end;
      end;

      ProgressBar1.StepIt;
      qryAPCheq.next;
    end;
  finally
    DbiSaveChanges(tblJVCtl.handle);
    DbiSaveChanges(tblJV.handle);
    DbiSaveChanges(tblJVDet.handle);
    DbiSaveChanges(tblAPInv.handle);
    DbiSaveChanges(tblAPCheq.handle);
    DbiSaveChanges(tblVBalance.handle);
    tblJVCtl.Close;
    tblAPCheq.Close;
    tblVBalance.Close;
    screen.cursor := crDefault;
  end;
end;

end.