yearendform.pas

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

unit YearEndForm;

interface

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

type
  TfrmYearEnd = class(TForm)
    btnOK: TButton;
    btnCancel: TButton;
    qryGLActual: TQuery;
    lblProcess: TLabel;
    ProgressBar1: TProgressBar;
    DBEdit1: TDBEdit;
    DBEdit2: TDBEdit;
    DBEdit3: TDBEdit;
    qryGLActualGLAccount: TStringField;
    qryGLActualGLYear: TSmallintField;
    qryGLActualOpeningBal: TCurrencyField;
    qryGLActualAmount1: TCurrencyField;
    qryGLActualAmount2: TCurrencyField;
    qryGLActualAmount3: TCurrencyField;
    qryGLActualAmount4: TCurrencyField;
    qryGLActualAmount5: TCurrencyField;
    qryGLActualAmount6: TCurrencyField;
    qryGLActualAmount7: TCurrencyField;
    qryGLActualAmount8: TCurrencyField;
    qryGLActualAmount9: TCurrencyField;
    qryGLActualAmount10: TCurrencyField;
    qryGLActualAmount11: TCurrencyField;
    qryGLActualAmount12: TCurrencyField;
    qryGLActualAccountType: TSmallintField;
    qryGLActualActualBudget: TStringField;
    tblGLActual: TTable;
    tblGLActualGLAccount: TStringField;
    tblGLActualGLYear: TSmallintField;
    tblGLActualActualBudget: TStringField;
    tblGLActualOpeningBal: TCurrencyField;
    qryGLActualClosingBal: TCurrencyField;
    qryRetEarnings: TQuery;
    qryRetEarningsGLAccount: TStringField;
    qryUnposted: TQuery;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure qryGLActualCalcFields(DataSet: TDataSet);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmYearEnd: TfrmYearEnd;

implementation

uses BS1Form;

{$R *.DFM}

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

procedure TfrmYearEnd.FormCreate(Sender: TObject);
begin
  qryGLActual.DatabaseName := strDatabaseName;
  tblGLActual.DatabaseName := strDatabaseName;
  qryRetEarnings.DatabaseName := strDatabaseName;
  qryUnposted.DatabaseName := strDatabaseName;
end;

procedure TfrmYearEnd.btnOKClick(Sender: TObject);
var
  NextYear: integer;
  NextYrOpeningBal, TotalRevAndExp, RetEarningsClosingBal: currency;
  RetEarningsRecordCount: integer;
begin
  repeat   //Exclusive open to prevent locking Delphi 2 locking bug.
  try
    tblGLActual.Active := True;
    Break;   //If no error, exit the loop.
  except
    on EDatabaseError do if MessageDlg('Unable to open GL Actual table exclusively.', mtError, [mbRetry, mbCancel], 0) <> mrRetry then begin
      ModalResult := mrCancel;
      raise;
    end;
  end;
  until False;

  lblProcess.caption := 'Checking data...';
  lblProcess.repaint;
  qryUnposted.SQL[0] := 'SELECT COUNT(*) FROM JV';
  qryUnposted.Params[0].AsInteger := frmBS1.tblCompanyFiscalYear.value;
  qryUnposted.open;
  if qryUnposted.Fields[0].AsInteger > 0 then begin
    ModalResult := mrCancel;
    raise(exception.create('Unable to run year-end...' + #13 + 'Unposted JVs exist for year to be closed'));
  end;

  qryUnposted.close;
  qryUnposted.SQL[0] := 'SELECT COUNT(*) FROM APInv';
  qryUnposted.open;
  if qryUnposted.Fields[0].AsInteger > 0 then begin
    ModalResult := mrCancel;
    raise(exception.create('Unable to run year-end...' + #13 + 'Unposted AP invoices exist for year to be closed'));
  end;

  qryUnposted.close;
  qryUnposted.SQL[0] := 'SELECT COUNT(*) FROM APCheq';
  qryUnposted.open;
  if qryUnposted.Fields[0].AsInteger > 0 then begin
    ModalResult := mrCancel;
    raise(exception.create('Unable to run year-end...' + #13 + 'Unposted AP cheques exist for year to be closed'));
  end;

  qryUnposted.close;
  qryUnposted.SQL[0] := 'SELECT COUNT(*) FROM ARInv';
  qryUnposted.open;
  if qryUnposted.Fields[0].AsInteger > 0 then begin
    ModalResult := mrCancel;
    raise(exception.create('Unable to run year-end...' + #13 + 'Unposted AR invoices exist for year to be closed'));
  end;

  qryUnposted.close;
  qryUnposted.SQL[0] := 'SELECT COUNT(*) FROM ARPmt';
  qryUnposted.open;
  if qryUnposted.Fields[0].AsInteger > 0 then begin
    ModalResult := mrCancel;
    raise(exception.create('Unable to run year-end...' + #13 + 'Unposted AR payments exist for year to be closed'));
  end;

  qryRetEarnings.Active := true;
  RetEarningsRecordCount := qryRetEarnings.RecordCount;
  if RetEarningsRecordCount = 0 then begin
    ModalResult := mrCancel;
    raise(exception.create('Unable to run year-end...' + #13 + 'No retained earnings account found.' + #13 + #13 + 'Please set up a GL Account of type "Retained Earnings"'));
  end else if RetEarningsRecordCount > 1 then begin
    ModalResult := mrCancel;
    raise(exception.create('Unable to run year-end...' + #13 + 'Multiple retained earnings accounts found.' + #13 + #13 + 'There must be only one GL Account of type "Retained Earnings"'));
  end;
  lblProcess.caption := 'GL: Carry forward balances, etc.';
  lblProcess.repaint;

  qryGLActual.Params[0].AsInteger := frmBS1.tblCompanyFiscalYear.value;
  qryGLActual.Active := true;
  if qryGLActual.RecordCount = 0 then begin
    ModalResult := mrOK;
    exit;
  end;

  screen.cursor := crHourglass;
  ProgressBar1.max := qryGLActual.RecordCount;
  ProgressBar1.step := 1;
  NextYear := frmBS1.tblCompanyFiscalYear.value + 1;
  TotalRevAndExp := 0;
  RetEarningsClosingBal := 0;
  try
    qryGLActual.First;
    while not qryGLActual.EOF do begin

      if qryGLActualAccountType.value in [3, 4] then begin   //Revenue & expenses.
        NextYrOpeningBal := 0;
        TotalRevAndExp := TotalRevAndExp + qryGLActualClosingBal.AsCurrency;
      end else if qryGLActualAccountType.value = 5 then RetEarningsClosingBal := qryGLActualClosingBal.AsCurrency   //Retained earnings: carry forward later.
      else NextYrOpeningBal := qryGLActualClosingBal.AsCurrency;   //Assets & liabilities.

      if tblGLActual.Locate('GLAccount;GLYear', VarArrayOf([qryGLActualGLAccount.value,NextYear]), []) = true then begin   //Update tblGLActual.
        try
          tblGLActual.Edit;
          tblGLActualOpeningBal.AsCurrency := NextYrOpeningBal;
          tblGLActual.Post;
        except raise; end;
      end else begin
        try
          tblGLActual.Insert;
          tblGLActualGLAccount.value := qryGLActualGLAccount.value;
          tblGLActualGLYear.value := NextYear;
          tblGLActualActualBudget.value := qryGLActualActualBudget.value;
          tblGLActualOpeningBal.AsCurrency := NextYrOpeningBal;
          tblGLActual.Post;
        except raise; end;
      end;

      ProgressBar1.StepIt;
      qryGLActual.next;
    end;
    
    if tblGLActual.Locate('GLAccount;GLYear', VarArrayOf([qryRetEarningsGLAccount.value,NextYear]), []) = true then begin   //Update tblGLActual.
      try
        tblGLActual.Edit;
        tblGLActualOpeningBal.AsCurrency := RetEarningsClosingBal + TotalRevAndExp;
        tblGLActual.Post;
      except raise; end;
    end else begin
      try
        tblGLActual.Insert;
        tblGLActualGLAccount.value := qryRetEarningsGLAccount.value;
        tblGLActualGLYear.value := NextYear;
        tblGLActualActualBudget.value := qryGLActualActualBudget.value;
        tblGLActualOpeningBal.AsCurrency := RetEarningsClosingBal + TotalRevAndExp;
        tblGLActual.Post;
      except raise; end;
    end;
    ModalResult := mrOK;
  finally
    DbiSaveChanges(tblGLActual.handle);
    tblGLActual.Close;
    screen.cursor := crDefault;
  end;
end;

procedure TfrmYearEnd.qryGLActualCalcFields(DataSet: TDataSet);
begin
  qryGLActualClosingBal.AsCurrency := qryGLActualOpeningBal.AsCurrency + qryGLActualAmount1.AsCurrency
                                                                       + qryGLActualAmount2.AsCurrency
                                                                       + qryGLActualAmount3.AsCurrency
                                                                       + qryGLActualAmount4.AsCurrency
                                                                       + qryGLActualAmount5.AsCurrency
                                                                       + qryGLActualAmount6.AsCurrency
                                                                       + qryGLActualAmount7.AsCurrency
                                                                       + qryGLActualAmount8.AsCurrency
                                                                       + qryGLActualAmount9.AsCurrency
                                                                       + qryGLActualAmount10.AsCurrency
                                                                       + qryGLActualAmount11.AsCurrency
                                                                       + qryGLActualAmount12.AsCurrency;
end;

end.