currencyform.pas

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

unit CurrencyForm;

interface

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

type
  TfrmCurrency = class(TForm)
    Panel1: TPanel;
    PageControl1: TPageControl;
    dsCurrency: TDataSource;
    Panel3: TPanel;
    Panel2: TPanel;
    TabSheet1: TTabSheet;
    Label1: TLabel;
    editCurrencyName: TDBEdit;
    Panel4: TPanel;
    btnOK: TButton;
    btnCancel: TButton;
    Label2: TLabel;
    editExchangeRate: TDBEdit;
    Label3: TLabel;
    TabSheet2: TTabSheet;
    Label10: TLabel;
    editAPGLAccount: TDBEdit;
    cboAPGLAccount: TDBLookupComboBox;
    Label11: TLabel;
    editGainLossExchangeGLAccount: TDBEdit;
    cboGainLossExchangeGLAccount: TDBLookupComboBox;
    Label4: TLabel;
    editARGLAccount: TDBEdit;
    cboARGLAccount: TDBLookupComboBox;
    btnAPGLAccount: TSpeedButton;
    btnGainLossExchangeGLAccount: TSpeedButton;
    btnARGLAccount: TSpeedButton;
    Label6: TLabel;
    editAPDiscGLAccount: TDBEdit;
    cboAPDiscGLAccount: TDBLookupComboBox;
    btnAPDiscGLAccount: TSpeedButton;
    Label7: TLabel;
    editARDiscGLAccount: TDBEdit;
    cboARDiscGLAccount: TDBLookupComboBox;
    btnARDiscGLAccount: TSpeedButton;
    Label8: TLabel;
    editDfltWriteOffGLAccount: TDBEdit;
    cboDfltWriteOffGLAccount: TDBLookupComboBox;
    btnDfltWriteOffGLAccount: TSpeedButton;
    tblCurrency: TTable;
    tblCurrencyCurrencyID: TAutoIncField;
    tblCurrencyCurrencyName: TStringField;
    tblCurrencyExchangeRate: TFloatField;
    tblCurrencyAPGLAccount: TStringField;
    tblCurrencyGainLossExchangeGLAccount: TStringField;
    tblCurrencyAPDiscGLAccount: TStringField;
    tblCurrencyARGLAccount: TStringField;
    tblCurrencyARDiscGLAccount: TStringField;
    tblCurrencyDfltWriteOffGLAccount: TStringField;
    qryLastID: TQuery;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure dsCurrencyDataChange(Sender: TObject; Field: TField);
    procedure FormShow(Sender: TObject);
    procedure Panel2DblClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure dsCurrencyUpdateData(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure cboAPGLAccountKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure cboGainLossExchangeGLAccountKeyDown(Sender: TObject;
      var Key: Word; Shift: TShiftState);
    procedure cboARGLAccountKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure btnAPGLAccountClick(Sender: TObject);
    procedure btnARGLAccountClick(Sender: TObject);
    procedure btnGainLossExchangeGLAccountClick(Sender: TObject);
    procedure cboAPDiscGLAccountKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure cboARDiscGLAccountKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure btnAPDiscGLAccountClick(Sender: TObject);
    procedure btnARDiscGLAccountClick(Sender: TObject);
    procedure cboDfltWriteOffGLAccountKeyDown(Sender: TObject;
      var Key: Word; Shift: TShiftState);
    procedure btnDfltWriteOffGLAccountClick(Sender: TObject);
    procedure tblCurrencyAPGLAccountValidate(Sender: TField);
    procedure tblCurrencyGainLossExchangeGLAccountValidate(Sender: TField);
    procedure tblCurrencyAPDiscGLAccountValidate(Sender: TField);
    procedure tblCurrencyARGLAccountValidate(Sender: TField);
    procedure tblCurrencyARDiscGLAccountValidate(Sender: TField);
    procedure tblCurrencyDfltWriteOffGLAccountValidate(Sender: TField);
    procedure tblCurrencyBeforePost(DataSet: TDataSet);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmCurrency: TfrmCurrency;

implementation

uses CurrenciesForm, BS1Form, GLAccountsForm, GLAccountsFilterForm, LookUpsData;

var
  intClientHeight, intClientWidth: Integer;

{$R *.DFM}

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

procedure TfrmCurrency.dsCurrencyDataChange(Sender: TObject;
  Field: TField);
begin
  if (tblCurrencyCurrencyID.AsVariant = null) and (tblCurrencyCurrencyName.Value = '') then self.Caption := 'New Currency'
  else self.Caption := tblCurrencyCurrencyName.value;
end;

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

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

procedure TfrmCurrency.FormCreate(Sender: TObject);
begin
  tblCurrency.DatabaseName := strDatabaseName;
  qryLastID.DatabaseName := strDatabaseName;
  //tblGLAccnt.DatabaseName := strDatabaseName;
  //tblGLAccnt.Active := true;   //Data Module used instead.
  tblCurrency.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 TfrmCurrency.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 TfrmCurrency.dsCurrencyUpdateData(Sender: TObject);
begin
  if tblCurrencyCurrencyName.AsString = '' then begin
    with editCurrencyName do begin Show; SetFocus; end;
    raise(exception.create('Field ' + '''Currency Name''' + ' must have a value'));
  end;

  if tblCurrencyAPGLAccount.AsString = '' then begin
    with editAPGLAccount do begin Show; SetFocus; end;
    raise(exception.create('Field ' + '''AP Account''' + ' must have a value'));
  end;

  if (tblCurrencyExchangeRate.AsFloat <> 0) and (tblCurrencyGainLossExchangeGLAccount.AsString = '') then begin
    with editGainLossExchangeGLAccount do begin Show; SetFocus; end;
    raise(exception.create('Field ' + '''Gain/Loss Exchange Account''' + ' must have a value if rate is entered'));
  end;

  if tblCurrencyARGLAccount.AsString = '' then begin
    with editARGLAccount do begin Show; SetFocus; end;
    raise(exception.create('Field ' + '''AR Account''' + ' must have a value'));
  end;

  if tblCurrencyAPDiscGLAccount.AsString = '' then begin
    with editAPDiscGLAccount do begin Show; SetFocus; end;
    raise(exception.create('Field ' + '''AP Discounts GL Account''' + ' must have a value'));
  end;

  if tblCurrencyARDiscGLAccount.AsString = '' then begin
    with editARDiscGLAccount do begin Show; SetFocus; end;
    raise(exception.create('Field ' + '''AR Discounts GL Account''' + ' must have a value'));
  end;
end;

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

procedure TfrmCurrency.btnCancelClick(Sender: TObject);
begin
  tblCurrency.cancel;
  Close;
end;

procedure TfrmCurrency.cboAPGLAccountKeyDown(Sender: TObject;