financialstmtform.pas

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

unit FinancialStmtForm;

interface

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

type
  TfrmFinancialStmt = class(TForm)
    Panel1: TPanel;
    panelMiddle: TPanel;
    Panel2: TPanel;
    Panel4: TPanel;
    btnOK: TButton;
    btnCancel: TButton;
    tblFStmt: TTable;
    dsFStmt: TDataSource;
    tblFStmtLin: TTable;
    dsFStmtLin: TDataSource;
    lblDescription: TLabel;
    editStmtTitle: TDBEdit;
    panelLeft: TPanel;
    DBGrid1: TDBGrid;
    panelRight: TPanel;
    tblFStmtCtl: TTable;
    PopupMenu1: TPopupMenu;
    popNew: TMenuItem;
    popDelete: TMenuItem;
    tblFStmtCtlNextStmtID: TIntegerField;
    tblFStmtLinStmtID: TIntegerField;
    tblFStmtLinLineNo: TIntegerField;
    tblFStmtLinLineHeading: TStringField;
    tblFStmtStmtID: TIntegerField;
    tblFStmtStmtTitle: TStringField;
    Label2: TLabel;
    cboColumnFormat: TDBComboBox;
    popUp: TMenuItem;
    qryLastDetailLineNo: TQuery;
    btnUp: TSpeedButton;
    btnDown: TSpeedButton;
    popDown: TMenuItem;
    N1: TMenuItem;
    tblFStmtLinLineType: TStringField;
    tblFStmtColumnFormat: TStringField;
    N2: TMenuItem;
    popProperties: TMenuItem;
    tblFStmtLinSeq: TIntegerField;
    tblFStmtLAc: TTable;
    tblFStmtLAcStmtID: TIntegerField;
    tblFStmtLAcSeq: TIntegerField;
    tblFStmtLAcAccountFrom: TStringField;
    tblFStmtLAcAccountTo: TStringField;
    tblFStmtLTo: TTable;
    tblFStmtLToStmtID: TIntegerField;
    tblFStmtLToSeq: TIntegerField;
    tblFStmtLToTotalLineSeq: TIntegerField;
    tblFStmtLinT: TTable;
    tblFStmtLinTStmtID: TIntegerField;
    tblFStmtLinTLineHeading: TStringField;
    tblFStmtLinTLineType: TStringField;
    tblFStmtLToLineHeading: TStringField;
    dsFStmtLTo: TDataSource;
    tblFStmtLinTSeq: TIntegerField;
    tblFStmtLToSeqEntered: TAutoIncField;
    dsFStmtLAc: TDataSource;
    tblFStmtLTo2: TTable;
    tblFStmtLTo2StmtID: TIntegerField;
    tblFStmtLTo2TotalLineSeq: TIntegerField;
    btnHelp: TButton;
    btnProperties: TSpeedButton;
    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 FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure DBGrid1Exit(Sender: TObject);
    procedure DBGrid1Enter(Sender: TObject);
    procedure dsFStmtDataChange(Sender: TObject; Field: TField);
    procedure DBGrid1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure tblFStmtLinNewRecord(DataSet: TDataSet);
    procedure tblFStmtNewRecord(DataSet: TDataSet);
    procedure tblFStmtUpdateError(DataSet: TDataSet; E: EDatabaseError;
      UpdateKind: TUpdateKind; var UpdateAction: TUpdateAction);
    procedure tblFStmtLinUpdateError(DataSet: TDataSet; E: EDatabaseError;
      UpdateKind: TUpdateKind; var UpdateAction: TUpdateAction);
    procedure tblFStmtLinBeforeEdit(DataSet: TDataSet);
    procedure tblFStmtLinBeforeInsert(DataSet: TDataSet);
    procedure tblFStmtLinBeforeDelete(DataSet: TDataSet);
    procedure popDeleteClick(Sender: TObject);
    procedure popNewClick(Sender: TObject);
    procedure DBGrid1ColEnter(Sender: TObject);
    procedure tblFStmtBeforeEdit(DataSet: TDataSet);
    procedure tblFStmtBeforeInsert(DataSet: TDataSet);
    procedure tblFStmtLinBeforePost(DataSet: TDataSet);
    procedure btnUpClick(Sender: TObject);
    procedure btnDownClick(Sender: TObject);
    procedure tblFStmtLinLineTypeValidate(Sender: TField);
    procedure DBGrid1KeyPress(Sender: TObject; var Key: Char);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure popPropertiesClick(Sender: TObject);
    procedure tblFStmtAfterPost(DataSet: TDataSet);
    procedure tblFStmtLinAfterPost(DataSet: TDataSet);
    procedure tblFStmtLinAfterDelete(DataSet: TDataSet);
    procedure DBGrid1DblClick(Sender: TObject);
    procedure tblFStmtLinTFilterRecord(DataSet: TDataSet;
      var Accept: Boolean);
    procedure dsFStmtLinDataChange(Sender: TObject; Field: TField);
    procedure tblFStmtLAcAfterPost(DataSet: TDataSet);
    procedure tblFStmtLAcAfterDelete(DataSet: TDataSet);
    procedure tblFStmtLToAfterDelete(DataSet: TDataSet);
    procedure tblFStmtLToAfterPost(DataSet: TDataSet);
    procedure tblFStmtLAcBeforeEdit(DataSet: TDataSet);
    procedure tblFStmtLAcBeforeInsert(DataSet: TDataSet);
    procedure tblFStmtLAcBeforeDelete(DataSet: TDataSet);
    procedure tblFStmtLToBeforeDelete(DataSet: TDataSet);
    procedure tblFStmtLToBeforeEdit(DataSet: TDataSet);
    procedure tblFStmtLToBeforeInsert(DataSet: TDataSet);
    procedure tblFStmtLAcPostError(DataSet: TDataSet; E: EDatabaseError;
      var Action: TDataAction);
    procedure tblFStmtLToPostError(DataSet: TDataSet; E: EDatabaseError;
      var Action: TDataAction);
    procedure btnHelpClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmFinancialStmt: TfrmFinancialStmt;

implementation

uses BS1Form, GLReportsForm, FinancialStmtLineForm;

var
  intClientHeight, intClientWidth: Integer;
  NextDetailSeq, NextDetailLineNo: Integer;
  OldLineType: string;

{$R *.DFM}

procedure TfrmFinancialStmt.btnOKClick(Sender: TObject);
begin
  if tblFStmt.State in [dsInsert, dsEdit] then tblFStmt.post;
  if tblFStmtLin.State in [dsInsert, dsEdit] then tblFStmtLin.post;
  //tblFStmt.Database.ApplyUpdates([tblFStmt, tblFStmtLin]);
  DbiSaveChanges(tblFStmt.handle);
  DbiSaveChanges(tblFStmtLin.handle);
  DbiSaveChanges(tblFStmtLAc.handle);
  DbiSaveChanges(tblFStmtLTo.handle);
  DbiSaveChanges(tblFStmtLTo2.handle);
  try
    frmGLReports.tblFStmt.refresh;
    frmGLReports.tblFStmt.Locate('StmtID', tblFStmtStmtID.value, []);
  except; end;
  //if (tblFStmt.UpdatesPending = false) and (tblFStmtLin.UpdatesPending = false) then Close;
  Close;
end;

procedure TfrmFinancialStmt.btnCancelClick(Sender: TObject);
begin
  try   //try may be required? Cancel btn crashed system: was editing a new stmt, tried to close window, then cancel btn. 
    tblFStmt.DisableControls;
    tblFStmt.cancel;
    //tblFStmt.CancelUpdates;
    tblFStmtLin.cancel;
    //tblFStmtLin.CancelUpdates;
  finally
    Close;
  end;
end;

procedure TfrmFinancialStmt.FormCreate(Sender: TObject);
var
  x: integer;
begin
  tblFStmt.DatabaseName := strDatabaseName;
  tblFStmtCtl.DatabaseName := strDatabaseName;
  tblFStmtLin.DatabaseName := strDatabaseName;
  tblFStmtLinT.DatabaseName := strDatabaseName;
  tblFStmtLAc.DatabaseName := strDatabaseName;
  tblFStmtLTo.DatabaseName := strDatabaseName;
  tblFStmtLTo2.DatabaseName := strDatabaseName;
  qryLastDetailLineNo.DatabaseName := strDatabaseName;
  tblFStmt.Active := true;
  tblFStmtLin.Active := true;
  //tblFStmt.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;
end;

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

procedure TfrmFinancialStmt.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //try frmFinancialStmtLine.release; except; end;   //Sometimes get Access violataion here: maybe close before release will help...
  try frmFinancialStmtLine.close; frmFinancialStmtLine.release; except; end;

  if (tblFStmt.State in [dsInsert, dsEdit]) or (tblFStmtLin.State in [dsInsert, dsEdit])
  //or (tblFStmt.UpdatesPending = true) or (tblFStmtLin.UpdatesPending = true) then btnOKClick(sender);
  then btnOKClick(sender);
  try frmGLReports.grdStmts.Setfocus; except; end;
  Action := caFree;
end;

procedure TfrmFinancialStmt.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;
      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 (tblFStmtLinSeq.AsVariant = Null) and (tblFStmtLinGLAmount.AsVariant = Null) then Perform(WM_NEXTDLGCTL, 0, 0)
      //else}
      with TDBGrid(ActiveControl) do
        if selectedindex < (fieldcount - 1) then   //Increment the field.
          selectedindex := selectedindex + 1
        else begin   //Move to next record.
          selectedindex := 0;
          tblFStmtLin.next;
          if tblFStmtLin.eof = true then tblFStmtLin.append;
        end;
    end;
  end;
end;

procedure TfrmFinancialStmt.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (key = VK_Next) then begin   //PageDown
    key := 0;
    if not (ActiveControl is TDBGrid) then begin   //Move to 1st record on grid.
      DBGrid1.Setfocus;
      tblFStmtLin.First;
      DBGrid1.SelectedIndex := 0;
    end else begin
      tblFStmtLin.append;   //Move to new record on grid.
      DBGrid1.SelectedIndex := 0;
    end;  
  end;
end;

procedure TfrmFinancialStmt.DBGrid1Exit(Sender: TObject);
begin
  DBGrid1.Options := [dgEditing,dgTitles,dgIndicator,dgColumnResize,dgColLines,dgRowLines,dgTabs,dgConfirmDelete,dgCancelOnExit];   //Toggle dgAlwaysShowEditor to prevent 1st field from being left-justified if always dgAlwaysShowEditor.
  //tblFStmtLin.First;   //Causes post which then disables btnCancel, even if exit caused by clicking on btnCancel.
  DBGrid1.SelectedIndex := 0;
end;

procedure TfrmFinancialStmt.DBGrid1Enter(Sender: TObject);
begin
  DBGrid1.SelectedIndex := 0;   //Fix problem caused when ColExit event causes exit from grid with pending Enter setting selected index to 2nd column.
end;

procedure TfrmFinancialStmt.dsFStmtDataChange(Sender: TObject; Field: TField);
begin
  if (tblFStmt.state = dsInsert) and (tblFStmtStmtTitle.AsVariant = null) then self.Caption := 'New Financial Statement'
  else self.Caption := tblFStmtStmtTitle.value;
end;

procedure TfrmFinancialStmt.DBGrid1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (shift = [ssShift]) and (key = VK_Tab) and (DBGrid1.SelectedIndex = 0) then begin
    if (tblFStmtLin.bof = true) or (tblFStmtLin.Recno = 1) then cboColumnFormat.setfocus;
  end;
end;

procedure TfrmFinancialStmt.tblFStmtLinNewRecord(DataSet: TDataSet);
begin
  tblFStmtLinStmtID.value := tblFStmtStmtID.value;
end;

procedure TfrmFinancialStmt.tblFStmtNewRecord(DataSet: TDataSet);
begin
  with tblFStmtCtl do begin
    Open;
    try
      Edit;
      tblFStmtStmtID.Value := tblFStmtCtlNextStmtID.Value;
      tblFStmtCtlNextStmtID.Value := tblFStmtCtlNextStmtID.Value + 1;
      Post;
    finally
      DbiSaveChanges(tblFStmtCtl.handle);
      Close;
    end;
  end;
end;

procedure TfrmFinancialStmt.tblFStmtUpdateError(DataSet: TDataSet;
  E: EDatabaseError; UpdateKind: TUpdateKind;
  var UpdateAction: TUpdateAction);
begin
  {if E is EDBEngineError then
    with EDBEngineError(E) do
    begin
      if Errors[ErrorCount - 1].ErrorCode = 9729 then begin   //Key violation (key already exists).
        with editStmtTitle do begin Show; SetFocus; end;
        Application.MessageBox(PChar('Statement Name already exists.'), PChar(Application.Title), mb_OK + mb_DefButton1 + mb_IconStop);
        UpdateAction := uaAbort;
      end else begin
        Application.MessageBox(PChar(IntToStr(Errors[ErrorCount - 1].ErrorCode) + ': ' + E.Message + '.'), PChar(Application.Title), mb_OK + mb_DefButton1 + mb_IconStop);
        UpdateAction := uaAbort;
      end;
    end;}
end;

procedure TfrmFinancialStmt.tblFStmtLinUpdateError(DataSet: TDataSet;
  E: EDatabaseError; UpdateKind: TUpdateKind;
  var UpdateAction: TUpdateAction);
begin
  {if (tblFStmt.UpdatesPending = true) then UpdateAction := uaAbort   //Master record not posted yet (had error).
  else if E is EDBEngineError then
    with EDBEngineError(E) do begin
      //if (Errors[ErrorCount - 1].ErrorCode = 9733) then begin    //Master record missing.
        //Application.MessageBox(PChar('Master record does not exist.'), PChar(Application.Title), mb_OK + mb_DefButton1 + mb_IconStop);
        //UpdateAction := uaAbort;