bankform.pas

来自「功能全面的商业财会系统源码,清晰,很有参考价值.扩展性强.」· PAS 代码 · 共 266 行

unit BankForm;

interface

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

type
  TfrmBank = class(TForm)
    Panel1: TPanel;
    PageControl1: TPageControl;
    dsBank: TDataSource;
    Panel3: TPanel;
    Panel2: TPanel;
    TabSheet1: TTabSheet;
    Label1: TLabel;
    editBankName: TDBEdit;
    Panel4: TPanel;
    btnOK: TButton;
    btnCancel: TButton;
    Label2: TLabel;
    Label3: TLabel;
    cboCurrency: TDBLookupComboBox;
    btnCurrency: TSpeedButton;
    qryAPCheq: TQuery;
    editBankGLAccount: TDBEdit;
    Label10: TLabel;
    cboBankGLAccount: TDBLookupComboBox;
    btnBankGLAccount: TSpeedButton;
    tblBank: TTable;
    tblBankBankID: TAutoIncField;
    tblBankBankName: TStringField;
    tblBankBankGLAccount: TStringField;
    tblBankCurrencyID: TIntegerField;
    qryLastID: TQuery;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure dsBankDataChange(Sender: TObject; Field: TField);
    procedure FormShow(Sender: TObject);
    procedure Panel2DblClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure dsBankUpdateData(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure cboBankGLAccountKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure cboCurrencyKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure btnCurrencyClick(Sender: TObject);
    procedure btnBankGLAccountClick(Sender: TObject);
    procedure tblBankCurrencyIDValidate(Sender: TField);
    procedure tblBankBankGLAccountValidate(Sender: TField);
    procedure tblBankBeforePost(DataSet: TDataSet);
    procedure tblBankAfterPost(DataSet: TDataSet);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmBank: TfrmBank;

implementation

uses BanksForm, BS1Form, CurrenciesForm, GLAccountsForm,
  GLAccountsFilterForm, LookUpsData;

var
  intClientHeight, intClientWidth: Integer;

{$R *.DFM}

procedure TfrmBank.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if tblBank.State in [dsInsert, dsEdit] then btnOKClick(sender);
  Action := caFree;
end;

procedure TfrmBank.dsBankDataChange(Sender: TObject;
  Field: TField);
begin
  if (tblBankBankID.AsVariant = null) and (tblBankBankName.Value = '') then self.Caption := 'New Bank'
  else self.Caption := tblBankBankName.value;
end;

procedure TfrmBank.FormShow(Sender: TObject);
begin
  PageControl1.ActivePage := Tabsheet1;
  editBankName.setfocus;
end;

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

procedure TfrmBank.FormCreate(Sender: TObject);
begin
  tblBank.DatabaseName := strDatabaseName;
  qryLastID.DatabaseName := strDatabaseName;
  dmLookUps.tblCurrency.DatabaseName := strDatabaseName;
  dmLookUps.tblGLAccnt.DatabaseName := strDatabaseName;
  qryAPCheq.DatabaseName := strDatabaseName;
  dmLookUps.tblCurrency.Active := true;
  dmLookUps.tblGLAccnt.Active := true;
  tblBank.Active := true;

  if FontFactor <> 1 then begin   //If using large fonts, resize form.
    ClientHeight := Trunc(ClientHeight*FontFactor);
    ClientWidth := Trunc(ClientWidth*FontFactor);
    PageControl1.TabWidth := Trunc(PageControl1.TabWidth*FontFactor);
  end;
  intClientHeight := ClientHeight;   //Store form size.
  intClientWidth := ClientWidth;
end;

procedure TfrmBank.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 TfrmBank.dsBankUpdateData(Sender: TObject);
begin
  if tblBankBankName.AsString = '' then begin
    with editBankName do begin Show; SetFocus; end;
    raise(exception.create('Field ' + '''Bank Name''' + ' must have a value'));
  end;

  if tblBankCurrencyID.AsInteger = 0 then begin
    with cboCurrency do begin Show; SetFocus; end;
    raise(exception.create('Field ' + '''Currency''' + ' must have a value'));
  end;

  if tblBankBankGLAccount.AsString = '' then begin
    with editBankGLAccount do begin Show; SetFocus; end;
    raise(exception.create('Field ' + '''Bank GL Account''' + ' must have a value'));
  end;
end;

procedure TfrmBank.btnOKClick(Sender: TObject);
begin
  if tblBank.State in [dsInsert, dsEdit] then begin
    try tblBank.post; DbiSaveChanges(tblBank.handle);
    except
      on E: EDBEngineError do
        if E.Errors[E.ErrorCount - 1].ErrorCode = 9729 then begin   //Key violation (key already exists).
          with editBankName do begin Show; SetFocus; end;
          raise(exception.create('Bank already exists'));
        end else raise;
    end;
    try
      frmBanks.tblBank.refresh;
      frmBanks.tblBank.Locate('BankID', tblBankBankID.AsInteger, []);
      frmBanks.DBGrid1.Setfocus;
    except; end;
  end;
  Close;
end;

procedure TfrmBank.btnCancelClick(Sender: TObject);
begin
  tblBank.cancel;
  Close;
end;

procedure TfrmBank.cboBankGLAccountKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
  if key = VK_Delete then begin
    tblBank.Edit;
    tblBankBankGLAccount.AsVariant := null;
  end;
end;

procedure TfrmBank.cboCurrencyKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key = VK_Delete then begin
    tblBank.Edit;
    tblBankCurrencyID.AsVariant := null;
  end;
end;

procedure TfrmBank.btnCurrencyClick(Sender: TObject);
var
  aComponent: TComponent;
begin
  screen.cursor := crHourglass;
  aComponent := Application.FindComponent('frmCurrencies');
  if not Assigned (aComponent) then frmCurrencies := TfrmCurrencies.Create(Application);
  if frmCurrencies.WindowState = wsMinimized then frmCurrencies.WindowState := wsNormal;
  if frmCurrencies.visible = true then frmCurrencies.FormShow(sender)
  else frmCurrencies.Show;
  if not frmCurrencies.tblCurrency.Locate('CurrencyID', tblBankCurrencyID.value, []) then frmCurrencies.tblCurrency.First;
  screen.cursor := crDefault;
end;

procedure TfrmBank.btnBankGLAccountClick(Sender: TObject);
var
  aComponent: TComponent;
begin
  screen.cursor := crHourglass;
  aComponent := Application.FindComponent('frmGLAccounts');
  if not Assigned (aComponent) then frmGLAccounts := TfrmGLAccounts.Create(Application);

  aComponent := Application.FindComponent('frmGLAccountsFilter');
  if Assigned (aComponent) then try frmGLAccountsFilter.btnResetClick(sender); except; end;
  frmGLAccounts.mnuFilter.Checked := false;
  frmGLAccounts.qryGLAccnt.Filtered := false;
  frmGLAccounts.tblGLAccnt.Filtered := false;

  if frmGLAccounts.WindowState = wsMinimized then frmGLAccounts.WindowState := wsNormal;
  if frmGLAccounts.visible = true then frmGLAccounts.FormShow(sender)
  else frmGLAccounts.Show;
  if not frmGLAccounts.qryGLAccnt.Locate('GLAccount', tblBankBankGLAccount.value, []) then frmGLAccounts.qryGLAccnt.First;
  screen.cursor := crDefault;
end;

procedure TfrmBank.tblBankCurrencyIDValidate(Sender: TField);
begin
  with qryAPCheq do begin
    close; open;
    if Fields[0].value > 0 then raise(exception.create('Currency cannot be changed... ' + #13 + 'AP cheque(s) already exist'));
  end;
end;

procedure TfrmBank.tblBankBankGLAccountValidate(Sender: TField);
begin
  if (editBankGLAccount.text <> '') and (dmLookUps.tblGLAccnt.Locate('GLAccount', editBankGLAccount.Text, []) <> true) then raise(Exception.Create('GL Account ' + '''' + editBankGLAccount.Text + '''' + ' not found'));
end;

procedure TfrmBank.tblBankBeforePost(DataSet: TDataSet);
begin
  dmLookUps.tblCurrency.Active := true;
  if dmLookUps.tblCurrency.Locate('CurrencyID', tblBankCurrencyID.value, []) <> true then begin
    with cboCurrency do begin Show; SetFocus; end;
    raise(exception.create('Currency no longer exists'));   //Deleted by another user since this user selected.
  end;

  if tblBank.state = dsInsert then begin
    qryLastID.close;
    qryLastID.open;
    with qryLastID.Fields[0] do
      if IsNull then tblBankBankID.value := 1
      else tblBankBankID.value := AsInteger + 1;
  end;
end;

procedure TfrmBank.tblBankAfterPost(DataSet: TDataSet);
begin
  frmBankBook_cboFind_RequeryRequired := true;
end;

end.