glbudgetaccountform.pas

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

unit GLBudgetAccountForm;

interface

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

type
  TfrmGLBudgetAccount = class(TForm)
    Panel1: TPanel;
    dsGLBudget: TDataSource;
    Panel3: TPanel;
    Panel2: TPanel;
    Panel4: TPanel;
    btnOK: TButton;
    btnCancel: TButton;
    tblGLBudget: TTable;
    tblGLBudgetGLAccount: TStringField;
    tblGLBudgetGLYear: TSmallintField;
    tblGLBudgetActualBudget: TStringField;
    tblGLBudgetOpeningBal: TCurrencyField;
    tblGLBudgetAmount1: TCurrencyField;
    tblGLBudgetAmount2: TCurrencyField;
    tblGLBudgetAmount3: TCurrencyField;
    tblGLBudgetAmount4: TCurrencyField;
    tblGLBudgetAmount5: TCurrencyField;
    tblGLBudgetAmount6: TCurrencyField;
    tblGLBudgetAmount7: TCurrencyField;
    tblGLBudgetAmount8: TCurrencyField;
    tblGLBudgetAmount9: TCurrencyField;
    tblGLBudgetAmount10: TCurrencyField;
    tblGLBudgetAmount11: TCurrencyField;
    tblGLBudgetAmount12: TCurrencyField;
    tblGLBudgetAccountName: TStringField;
    Label1: TLabel;
    editGLAccount: TDBEdit;
    editGLYear: TDBEdit;
    Label2: TLabel;
    cboGLAccount: TDBLookupComboBox;
    btnAPGLAccount: TSpeedButton;
    GroupBox1: TGroupBox;
    Label3: TLabel;
    editOpeningBal: TDBEdit;
    Label4: TLabel;
    editAmount1: TDBEdit;
    editAmount2: TDBEdit;
    Label5: TLabel;
    Label6: TLabel;
    editAmount3: TDBEdit;
    Label7: TLabel;
    editAmount4: TDBEdit;
    Label8: TLabel;
    editAmount5: TDBEdit;
    Label9: TLabel;
    editAmount6: TDBEdit;
    Label10: TLabel;
    editAmount7: TDBEdit;
    Label11: TLabel;
    editAmount8: TDBEdit;
    editAmount9: TDBEdit;
    Label12: TLabel;
    editAmount10: TDBEdit;
    Label13: TLabel;
    editAmount11: TDBEdit;
    Label14: TLabel;
    editAmount12: TDBEdit;
    Label15: TLabel;
    TrackBar0: TTrackBar;
    TrackBar1: TTrackBar;
    TrackBar2: TTrackBar;
    TrackBar3: TTrackBar;
    TrackBar4: TTrackBar;
    TrackBar5: TTrackBar;
    TrackBar6: TTrackBar;
    TrackBar7: TTrackBar;
    TrackBar8: TTrackBar;
    TrackBar9: TTrackBar;
    TrackBar10: TTrackBar;
    TrackBar11: TTrackBar;
    TrackBar12: TTrackBar;
    tblGLBudgetAccountType: TSmallintField;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure dsGLBudgetDataChange(Sender: TObject; Field: TField);
    procedure FormShow(Sender: TObject);
    procedure Panel2DblClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure btnOKClick(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure tblGLBudgetAfterPost(DataSet: TDataSet);
    procedure tblGLBudgetNewRecord(DataSet: TDataSet);
    procedure cboGLAccountKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure btnAPGLAccountClick(Sender: TObject);
    procedure tblGLBudgetGLYearGetText(Sender: TField; var Text: string;
      DisplayText: Boolean);
    procedure tblGLBudgetGLYearSetText(Sender: TField; const Text: string);
    procedure TrackBar0Change(Sender: TObject);
    procedure tblGLBudgetOpeningBalChange(Sender: TField);
    procedure tblGLBudgetAmount1Change(Sender: TField);
    procedure tblGLBudgetAmount2Change(Sender: TField);
    procedure tblGLBudgetAmount3Change(Sender: TField);
    procedure tblGLBudgetAmount4Change(Sender: TField);
    procedure tblGLBudgetAmount5Change(Sender: TField);
    procedure tblGLBudgetAmount6Change(Sender: TField);
    procedure tblGLBudgetAmount7Change(Sender: TField);
    procedure tblGLBudgetAmount8Change(Sender: TField);
    procedure tblGLBudgetAmount9Change(Sender: TField);
    procedure tblGLBudgetAmount10Change(Sender: TField);
    procedure tblGLBudgetAmount11Change(Sender: TField);
    procedure tblGLBudgetAmount12Change(Sender: TField);
    procedure TrackBar1Change(Sender: TObject);
    procedure TrackBar2Change(Sender: TObject);
    procedure TrackBar3Change(Sender: TObject);
    procedure TrackBar4Change(Sender: TObject);
    procedure TrackBar5Change(Sender: TObject);
    procedure TrackBar6Change(Sender: TObject);
    procedure TrackBar7Change(Sender: TObject);
    procedure TrackBar8Change(Sender: TObject);
    procedure TrackBar9Change(Sender: TObject);
    procedure TrackBar10Change(Sender: TObject);
    procedure TrackBar11Change(Sender: TObject);
    procedure TrackBar12Change(Sender: TObject);
    procedure tblGLBudgetGLAccountChange(Sender: TField);
    procedure tblGLBudgetGLYearChange(Sender: TField);
  private
    { Private declarations }
    TrackBarScale: currency;
  public
    { Public declarations }
  end;

var
  frmGLBudgetAccount: TfrmGLBudgetAccount;

implementation

uses BS1Form, GLBudgetForm, GLAccountsForm, GLAccountsFilterForm;

var
  intClientHeight, intClientWidth: Integer;

{$R *.DFM}

procedure TfrmGLBudgetAccount.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if tblGLBudget.State in [dsInsert, dsEdit] then btnOKClick(sender);
  try frmGLBudget.DBGrid1.Setfocus; except; end;
  Action := caFree;
end;

procedure TfrmGLBudgetAccount.dsGLBudgetDataChange(Sender: TObject;
  Field: TField);
begin
  //if (tblGLBudgetGLYear.AsVariant = null) then self.Caption := 'Budget'   //Moved to FormShow, GLAccountChange, & GLYearChange to prevent caption flickering when moving trackbars.
  //else self.Caption := tblGLBudgetGLYear.AsString + ' Budget';
  //if (tblGLBudgetAccountName.AsVariant <> null) then self.Caption := self.Caption + ': ' + tblGLBudgetAccountName.value;
end;

procedure TfrmGLBudgetAccount.FormShow(Sender: TObject);
var
  MaxAmount: currency;
begin
  editGLAccount.setfocus;

  if (tblGLBudgetGLYear.AsVariant = null) then self.Caption := 'Budget'
  else self.Caption := tblGLBudgetGLYear.AsString + ' Budget';
  if (tblGLBudgetAccountName.AsVariant <> null) then self.Caption := self.Caption + ': ' + tblGLBudgetAccountName.value;

  if tblGLBudget.state = dsInsert then begin
    TrackBarScale := 10000;
  end else begin
    MaxAmount := 0;
    if tblGLBudgetAccountType.value in [1,4] then begin   //Asset or expense (normally debits).
      if tblGLBudgetOpeningBal.value > MaxAmount then MaxAmount := tblGLBudgetOpeningBal.value;
      if tblGLBudgetAmount1.value > MaxAmount then MaxAmount := tblGLBudgetAmount1.value;
      if tblGLBudgetAmount2.value > MaxAmount then MaxAmount := tblGLBudgetAmount2.value;
      if tblGLBudgetAmount3.value > MaxAmount then MaxAmount := tblGLBudgetAmount3.value;
      if tblGLBudgetAmount4.value > MaxAmount then MaxAmount := tblGLBudgetAmount4.value;
      if tblGLBudgetAmount5.value > MaxAmount then MaxAmount := tblGLBudgetAmount5.value;
      if tblGLBudgetAmount6.value > MaxAmount then MaxAmount := tblGLBudgetAmount6.value;
      if tblGLBudgetAmount7.value > MaxAmount then MaxAmount := tblGLBudgetAmount7.value;
      if tblGLBudgetAmount8.value > MaxAmount then MaxAmount := tblGLBudgetAmount8.value;
      if tblGLBudgetAmount9.value > MaxAmount then MaxAmount := tblGLBudgetAmount9.value;
      if tblGLBudgetAmount10.value > MaxAmount then MaxAmount := tblGLBudgetAmount10.value;
      if tblGLBudgetAmount11.value > MaxAmount then MaxAmount := tblGLBudgetAmount11.value;
      if tblGLBudgetAmount12.value > MaxAmount then MaxAmount := tblGLBudgetAmount12.value;
    end else begin
      if tblGLBudgetOpeningBal.value < -MaxAmount then MaxAmount := -tblGLBudgetOpeningBal.value;
      if tblGLBudgetAmount1.value < -MaxAmount then MaxAmount := -tblGLBudgetAmount1.value;
      if tblGLBudgetAmount2.value < -MaxAmount then MaxAmount := -tblGLBudgetAmount2.value;
      if tblGLBudgetAmount3.value < -MaxAmount then MaxAmount := -tblGLBudgetAmount3.value;
      if tblGLBudgetAmount4.value < -MaxAmount then MaxAmount := -tblGLBudgetAmount4.value;
      if tblGLBudgetAmount5.value < -MaxAmount then MaxAmount := -tblGLBudgetAmount5.value;
      if tblGLBudgetAmount6.value < -MaxAmount then MaxAmount := -tblGLBudgetAmount6.value;
      if tblGLBudgetAmount7.value < -MaxAmount then MaxAmount := -tblGLBudgetAmount7.value;
      if tblGLBudgetAmount8.value < -MaxAmount then MaxAmount := -tblGLBudgetAmount8.value;
      if tblGLBudgetAmount9.value < -MaxAmount then MaxAmount := -tblGLBudgetAmount9.value;
      if tblGLBudgetAmount10.value < -MaxAmount then MaxAmount := -tblGLBudgetAmount10.value;
      if tblGLBudgetAmount11.value < -MaxAmount then MaxAmount := -tblGLBudgetAmount11.value;
      if tblGLBudgetAmount12.value < -MaxAmount then MaxAmount := -tblGLBudgetAmount12.value;
    end;

    MaxAmount := MaxAmount * 1.5;   //Allow room for expansion.
    if      MaxAmount < 2000   then TrackBarScale := 2000
    else if MaxAmount < 4000   then TrackBarScale := 4000
    else if MaxAmount < 10000  then TrackBarScale := 10000
    else if MaxAmount < 20000  then TrackBarScale := 20000
    else if MaxAmount < 40000  then TrackBarScale := 40000
    else if MaxAmount < 100000 then TrackBarScale := 100000
    else TrackBarScale := (1 + Trunc(MaxAmount/100000))*100000;   //Set to an even multiple of 100000.

    if tblGLBudgetAccountType.value in [1,4] then begin   //Asset or expense (normally debits).
      TrackBar0.Position := frmBS1.RoundIt((tblGLBudgetOpeningBal.value * 10000)/TrackBarScale);
      TrackBar1.Position := frmBS1.RoundIt((tblGLBudgetAmount1.value * 10000)/TrackBarScale);
      TrackBar2.Position := frmBS1.RoundIt((tblGLBudgetAmount2.value * 10000)/TrackBarScale);
      TrackBar3.Position := frmBS1.RoundIt((tblGLBudgetAmount3.value * 10000)/TrackBarScale);
      TrackBar4.Position := frmBS1.RoundIt((tblGLBudgetAmount4.value * 10000)/TrackBarScale);
      TrackBar5.Position := frmBS1.RoundIt((tblGLBudgetAmount5.value * 10000)/TrackBarScale);
      TrackBar6.Position := frmBS1.RoundIt((tblGLBudgetAmount6.value * 10000)/TrackBarScale);
      TrackBar7.Position := frmBS1.RoundIt((tblGLBudgetAmount7.value * 10000)/TrackBarScale);
      TrackBar8.Position := frmBS1.RoundIt((tblGLBudgetAmount8.value * 10000)/TrackBarScale);
      TrackBar9.Position := frmBS1.RoundIt((tblGLBudgetAmount9.value * 10000)/TrackBarScale);
      TrackBar10.Position := frmBS1.RoundIt((tblGLBudgetAmount10.value * 10000)/TrackBarScale);
      TrackBar11.Position := frmBS1.RoundIt((tblGLBudgetAmount11.value * 10000)/TrackBarScale);
      TrackBar12.Position := frmBS1.RoundIt((tblGLBudgetAmount12.value * 10000)/TrackBarScale);
    end else begin
      TrackBar0.Position := frmBS1.RoundIt((-tblGLBudgetOpeningBal.value * 10000)/TrackBarScale);
      TrackBar1.Position := frmBS1.RoundIt((-tblGLBudgetAmount1.value * 10000)/TrackBarScale);
      TrackBar2.Position := frmBS1.RoundIt((-tblGLBudgetAmount2.value * 10000)/TrackBarScale);
      TrackBar3.Position := frmBS1.RoundIt((-tblGLBudgetAmount3.value * 10000)/TrackBarScale);
      TrackBar4.Position := frmBS1.RoundIt((-tblGLBudgetAmount4.value * 10000)/TrackBarScale);
      TrackBar5.Position := frmBS1.RoundIt((-tblGLBudgetAmount5.value * 10000)/TrackBarScale);
      TrackBar6.Position := frmBS1.RoundIt((-tblGLBudgetAmount6.value * 10000)/TrackBarScale);
      TrackBar7.Position := frmBS1.RoundIt((-tblGLBudgetAmount7.value * 10000)/TrackBarScale);
      TrackBar8.Position := frmBS1.RoundIt((-tblGLBudgetAmount8.value * 10000)/TrackBarScale);
      TrackBar9.Position := frmBS1.RoundIt((-tblGLBudgetAmount9.value * 10000)/TrackBarScale);
      TrackBar10.Position := frmBS1.RoundIt((-tblGLBudgetAmount10.value * 10000)/TrackBarScale);
      TrackBar11.Position := frmBS1.RoundIt((-tblGLBudgetAmount11.value * 10000)/TrackBarScale);
      TrackBar12.Position := frmBS1.RoundIt((-tblGLBudgetAmount12.value * 10000)/TrackBarScale);
    end;
  end;
end;

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

procedure TfrmGLBudgetAccount.FormCreate(Sender: TObject);
begin
  tblGLBudget.DatabaseName := strDatabaseName;
  tblGLBudget.Active := true;

  if FontFactor <> 1 then begin   //If using large fonts, resize form.
    ClientHeight := Trunc(ClientHeight*FontFactor);
    ClientWidth := Trunc(ClientWidth*FontFactor);
    TrackBar7.left := TrackBar6.left;   //Fix Delphi bug: control resized wrong if large fonts.
    TrackBar7.width := TrackBar6.width;
    TrackBar7.height := TrackBar6.height;
  end;  
  intClientHeight := ClientHeight;   //Store form size.
  intClientWidth := ClientWidth;
end;

procedure TfrmGLBudgetAccount.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if key = #13 then begin   //Enter key: advance to next control.
    if (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;
  end;
end;

procedure TfrmGLBudgetAccount.btnOKClick(Sender: TObject);
begin
  if tblGLBudget.State in [dsInsert, dsEdit] then begin
    try tblGLBudget.post; DbiSaveChanges(tblGLBudget.handle);
    except
      on E: EDBEngineError do
        if E.Errors[E.ErrorCount - 1].ErrorCode = 9729 then begin   //Key violation (key already exists).
          with editGLAccount do begin Show; SetFocus; end;
          raise(exception.create('Budget for this account and year already exists'));
        end else raise;
    end;
    try
      with frmGLBudget.qryGLAccnt do begin close; open; end;   //Refresh.
      frmGLBudget.qryGLAccnt.Locate('GLAccount;GLYear', VarArrayOf([tblGLBudgetGLAccount.value, tblGLBudgetGLYear.value]), []);
    except; end;
  end;
  Close;
end;