jvform.pas

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

unit JVForm;

interface

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

type
  TfrmJV = class(TForm)
    Panel1: TPanel;
    panelMiddle: TPanel;
    Panel2: TPanel;
    Panel4: TPanel;
    btnOK: TButton;
    btnCancel: TButton;
    tblJV: TTable;
    dsJV: TDataSource;
    tblJVDet: TTable;
    dsJVDet: TDataSource;
    Label2: TLabel;
    editJVNumber: TDBEdit;
    lblDescription: TLabel;
    editTransDescription: TDBEdit;
    lblInvoiceDate: TLabel;
    editTransDate: TDBEdit;
    lblGLPeriod: TLabel;
    editGLPeriod: TDBEdit;
    panelLeft: TPanel;
    DBGrid1: TDBGrid;
    panelRight: TPanel;
    editGLYear: TDBEdit;
    tblJVCtl: TTable;
    qryLastDetailLineNo: TQuery;
    btnTransDate: TSpeedButton;
    tblJVJVID: TIntegerField;
    tblJVGLYear: TSmallintField;
    tblJVGLPeriod: TSmallintField;
    tblJVJVNumber: TIntegerField;
    tblJVSource: TStringField;
    tblJVTransType: TStringField;
    tblJVTransDate: TDateField;
    tblJVVendorID: TIntegerField;
    tblJVAPInvoiceID: TIntegerField;
    tblJVJVAmount: TCurrencyField;
    tblJVPosted: TBooleanField;
    tblJVAutoReverse: TBooleanField;
    tblJVDetJVID: TIntegerField;
    tblJVDetSeq: TIntegerField;
    tblJVDetGLAccount: TStringField;
    tblJVDetGLAmount: TCurrencyField;
    tblJVDetAccountName: TStringField;
    tblJVCtlNextJVID: TIntegerField;
    chkAutoReverse: TDBCheckBox;
    lblTotals: TLabel;
    tblJVTransDescription: TStringField;
    PopupMenu1: TPopupMenu;
    mnuNew: TMenuItem;
    mnuDelete: TMenuItem;
    lblPosted: TLabel;
    tblJVCtlNextJVNumber: TIntegerField;
    tblJVCustomerID: TIntegerField;
    tblJVARInvoiceID: TIntegerField;
    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 DBGrid1ColExit(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure DBGrid1Exit(Sender: TObject);
    procedure DBGrid1Enter(Sender: TObject);
    procedure editTransDateKeyPress(Sender: TObject; var Key: Char);
    procedure dsJVDataChange(Sender: TObject; Field: TField);
    procedure DBGrid1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure tblJVDetNewRecord(DataSet: TDataSet);
    procedure tblJVNewRecord(DataSet: TDataSet);
    procedure tblJVUpdateError(DataSet: TDataSet; E: EDatabaseError;
      UpdateKind: TUpdateKind; var UpdateAction: TUpdateAction);
    procedure tblJVDetUpdateError(DataSet: TDataSet; E: EDatabaseError;
      UpdateKind: TUpdateKind; var UpdateAction: TUpdateAction);
    procedure tblJVDetGLAccountValidate(Sender: TField);
    procedure tblJVBeforeInsert(DataSet: TDataSet);
    procedure tblJVBeforeEdit(DataSet: TDataSet);
    procedure tblJVDetBeforePost(DataSet: TDataSet);
    procedure tblJVDetBeforeEdit(DataSet: TDataSet);
    procedure tblJVDetBeforeInsert(DataSet: TDataSet);
    procedure tblJVDetBeforeDelete(DataSet: TDataSet);
    procedure tblJVGLYearGetText(Sender: TField; var Text: string;
      DisplayText: Boolean);
    procedure tblJVGLYearSetText(Sender: TField; const Text: string);
    procedure tblJVBeforePost(DataSet: TDataSet);
    procedure tblJVDetAfterPost(DataSet: TDataSet);
    procedure tblJVDetAfterDelete(DataSet: TDataSet);
    procedure btnTransDateClick(Sender: TObject);
    procedure DBGrid1EditButtonClick(Sender: TObject);
    procedure DBGrid1KeyPress(Sender: TObject; var Key: Char);
    procedure mnuDeleteClick(Sender: TObject);
    procedure mnuNewClick(Sender: TObject);
    procedure DBGrid1ColEnter(Sender: TObject);
    procedure tblJVTransDescriptionGetText(Sender: TField;
      var Text: string; DisplayText: Boolean);
    procedure tblJVTransDateSetText(Sender: TField; const Text: string);
  private
    { Private declarations }
    NextDetailLineNo: Integer;
    TotalCredits, TotalDebits, OldGLAmount: Currency;  
  public
    { Public declarations }
  end;

var
  frmJV: TfrmJV;

implementation

uses BS1Form, JVsForm, CalendarForm, GLAccountSearchForm, LookUpsData;

var
  intClientHeight, intClientWidth: Integer;

{$R *.DFM}

procedure TfrmJV.btnOKClick(Sender: TObject);
begin
  if tblJV.State in [dsInsert, dsEdit] then tblJV.post;
  if tblJVDet.State in [dsInsert, dsEdit] then tblJVDet.post;
  tblJV.Database.ApplyUpdates([tblJV, tblJVDet]);
  DbiSaveChanges(tblJV.handle);
  DbiSaveChanges(tblJVDet.handle);
  try
    with frmJVs.qryJV do begin close; open; end;   //Refresh, etc.
    frmJVs.qryJV.Locate('JVID', tblJVJVID.value, []);
  except; end;
  if (tblJV.UpdatesPending = false) and (tblJVDet.UpdatesPending = false) then Close;
end;

procedure TfrmJV.btnCancelClick(Sender: TObject);
begin
  tblJV.DisableControls;
  tblJV.cancel;
  tblJV.CancelUpdates;
  tblJVDet.cancel;
  tblJVDet.CancelUpdates;
  Close;
end;

procedure TfrmJV.FormCreate(Sender: TObject);
var
  x: integer;
begin
  tblJV.DatabaseName := strDatabaseName;
  tblJVCtl.DatabaseName := strDatabaseName;
  tblJVDet.DatabaseName := strDatabaseName;
  //tblVendor.DatabaseName := strDatabaseName;
  //tblCustomer.DatabaseName := strDatabaseName;
  //tblGLAccnt.DatabaseName := strDatabaseName;
  qryLastDetailLineNo.DatabaseName := strDatabaseName;
  tblJV.Active := true;
  tblJVDet.Active := true;
  //tblVendor.Active := true;   //Data Module used instead.
  //tblGLAccnt.Active := true;   //Data Module used instead.
  tblJV.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 TfrmJV.Panel2DblClick(Sender: TObject);
begin
  ClientHeight := intClientHeight;   //Resize form.
  ClientWidth := intClientWidth;
end;

procedure TfrmJV.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if (tblJV.State in [dsInsert, dsEdit]) or (tblJVDet.State in [dsInsert, dsEdit])
  or (tblJV.UpdatesPending = true) or (tblJVDet.UpdatesPending = true) then btnOKClick(sender);
  try frmJVs.DBGrid1.Setfocus; except; end;
  Action := caFree;
end;

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

procedure TfrmJV.DBGrid1ColExit(Sender: TObject);
begin   //Exit grid if leaving 1st column on a new record & no data.  Actually if leaving column 1 (to another cell in the grid), and target cell is a record with no Seq (new record) or GLAmount.
  if (TDBGrid(ActiveControl).SelectedIndex = 0) and (tblJVDetSeq.AsVariant = Null) and (tblJVDetGLAmount.AsVariant = Null) and (tblJVDet.RecordCount > 0) then btnOK.setfocus;
end;

procedure TfrmJV.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;
      tblJVDet.First;
      DBGrid1.SelectedIndex := 0;
    end else begin
      tblJVDet.append;   //Move to new record on grid.
      DBGrid1.SelectedIndex := 0;
    end;  
  end;
end;

procedure TfrmJV.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.
  tblJVDet.First;
  DBGrid1.SelectedIndex := 0;
end;

procedure TfrmJV.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 TfrmJV.editTransDateKeyPress(Sender: TObject;
  var Key: Char);
begin
  if Key = ^J then begin   //Ctrl+Enter show calendar.
    btnTransDateClick(sender);
    Key := #0;
  end else if Key = '+' then begin   //Increase/decrease date via +/- keys.
    tblJV.Edit;
    if editTransDate.field.AsVariant = null then editTransDate.field.AsDateTime := Date;
    editTransDate.field.AsDateTime := editTransDate.field.AsDateTime + 1;
    key := #0;
  end else if Key = '-' then begin
    tblJV.Edit;
    if editTransDate.field.AsVariant = null then editTransDate.field.AsDateTime := Date;
    editTransDate.field.AsDateTime := editTransDate.field.AsDateTime - 1;
    key := #0;
  end;
end;

procedure TfrmJV.dsJVDataChange(Sender: TObject; Field: TField);
begin
  //if (tblJV.state = dsInsert) and (tblJVJVNumber.Value = 0) then self.Caption := 'New Journal Voucher'   //Suppressed because default JV Number already assigned.
  if (tblJV.state = dsInsert) and ((tblJVJVNumber.Value = 0) or (tblJVTransDescription.Value = '')) then self.Caption := 'New Journal Voucher'
  else self.Caption := 'JV ' + tblJVJVNumber.AsString;

  lblPosted.visible := tblJVPosted.value;
end;

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

procedure TfrmJV.tblJVDetNewRecord(DataSet: TDataSet);
begin