arinvoicespostform.pas

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

unit ARInvoicesPostForm;

interface

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

type
  TfrmARInvoicesPost = class(TForm)
    btnOK: TButton;
    btnCancel: TButton;
    qryARInv: 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;
    qryARInvInvoiceNo: TStringField;
    qryARInvInvoiceAmount: TCurrencyField;
    qryARInvGLPeriod: TSmallintField;
    qryARInvGLYear: TSmallintField;
    qryARInvPosted: TBooleanField;
    tblJVCtl: TTable;
    tblJVCtlNextJVID: TIntegerField;
    tblJV2: TTable;
    tblJVCtlNextJVNumber: TIntegerField;
    tblJV2GLYear: TSmallintField;
    tblJV2GLPeriod: TSmallintField;
    tblJV2JVNumber: TIntegerField;
    tblARInvDet: TTable;
    tblJVDet: TTable;
    tblJVDetJVID: TIntegerField;
    tblJVDetSeq: TIntegerField;
    tblJVDetGLAccount: TStringField;
    tblJVDetGLAmount: TCurrencyField;
    dsARInv: TDataSource;
    tblARInvDetSeq: TIntegerField;
    qryARInvCurrencyID: TIntegerField;
    tblARInv: TTable;
    tblARInvPosted: TBooleanField;
    tblCurrency: TTable;
    tblCurrencyCurrencyID: TAutoIncField;
    tblCurrencyExchangeRate: TFloatField;
    qryARInvARGLAccount: TStringField;
    qryARInvExchangeRate: TFloatField;
    qryARInvGainLossExchangeGLAccount: TStringField;
    tblCurrencyARGLAccount: TStringField;
    tblCurrencyGainLossExchangeGLAccount: TStringField;
    qryARInvARInvoiceID: TIntegerField;
    qryARInvBillToID: TIntegerField;
    tblARInvARInvoiceID: TIntegerField;
    tblJVCustomerID: TIntegerField;
    tblJVARInvoiceID: TIntegerField;
    tblARInvDetARInvoiceID: TIntegerField;
    tblARInvDetQuantity: TFloatField;
    tblARInvDetItemNo: TStringField;
    tblARInvDetUnitPrice: TCurrencyField;
    tblCBalanceCustomerID: TIntegerField;
    tblARInvDetExtAmount: TCurrencyField;
    tblItem: TTable;
    tblItemItemNo: TStringField;
    tblItemSalesGLAccount: TStringField;
    tblARInvDetSalesGLAccount: TStringField;
    qryARInvTax1Code: TStringField;
    qryARInvTax2Code: TStringField;
    qryARInvTax1Rate: TFloatField;
    qryARInvTax2Rate: TFloatField;
    qryARInvTaxableAmount1: TCurrencyField;
    qryARInvTaxableAmount2: TCurrencyField;
    qryARInvTaxableAmount3: TCurrencyField;
    qryARInvTaxableAmtCode1: TStringField;
    qryARInvTaxableAmtCode2: TStringField;
    qryARInvTaxableAmtCode3: TStringField;
    qryARInvTax1ID: TIntegerField;
    qryARInvTax2ID: TIntegerField;
    qryARInvTax1GLAccount: TStringField;
    qryARInvTax2GLAccount: TStringField;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure tblARInvDetCalcFields(DataSet: TDataSet);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmARInvoicesPost: TfrmARInvoicesPost;

implementation

uses BS1Form;

var
  RecordCount: integer;

{$R *.DFM}

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

procedure TfrmARInvoicesPost.FormCreate(Sender: TObject);
begin
  qryARInv.DatabaseName := strDatabaseName;
  tblARInv.DatabaseName := strDatabaseName;
  tblCBalance.DatabaseName := strDatabaseName;
  tblCurrency.DatabaseName := strDatabaseName;
  tblARInvDet.DatabaseName := strDatabaseName;
  tblItem.DatabaseName := strDatabaseName;
  tblJVCtl.DatabaseName := strDatabaseName;
  tblJV.DatabaseName := strDatabaseName;
  tblJV2.DatabaseName := strDatabaseName;
  tblJVDet.DatabaseName := strDatabaseName;
  qryARInv.Active := true;

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

procedure TfrmARInvoicesPost.btnOKClick(Sender: TObject);
var
  aComponent: TComponent;
  TotalExchange, Tax1Amount, Tax2Amount, TotalDebits: currency;
begin
  if license = '' then begin
    qryARInv.close;
    qryARInv.SQL[1] := 'WHERE I.Posted = true';
    qryARInv.open;
    {if (qryARInv.RecordCount >30) and (frmBS1.tblCompanyCompanyName.value <> 'Sample Data') then begin
      frmBS1.DemoMessage;
      ModalResult := mrCancel;
      exit;
    end;}
    if frmBS1.DemoLimitExceeded(qryARInv.RecordCount, 'invoice') then begin
      ModalResult := mrCancel;
      exit;
    end;
    repaint;
    qryARInv.close;
    qryARInv.SQL[1] := 'WHERE (I.Posted = false) and (I.Printed = true)';
    qryARInv.open;
  end;

  ModalResult := mrCancel;   //Set to mrCancel to prevent subsequent requery in case job can't be started.
  if RecordCount = 0 then exit;
  aComponent := Application.FindComponent('frmARInvoice');
  if Assigned (aComponent) then raise(Exception.Create('A conflicting program is running...' + #13 + 'Please close ' + '''' + 'AR Invoice' + '''' + ' 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
    tblARInv.Active := True;
    Break;   //If no error, exit the loop.
  except
    on EDatabaseError do if MessageDlg('Unable to open Invoices 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;