itemform.pas

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

unit ItemForm;

interface

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

type
  TfrmItem = class(TForm)
    Panel1: TPanel;
    PageControl1: TPageControl;
    TabSheet2: TTabSheet;
    dsItem: TDataSource;
    memoNotes: TDBMemo;
    Panel3: TPanel;
    Panel2: TPanel;
    TabSheet1: TTabSheet;
    Label1: TLabel;
    editItemDescription: TDBEdit;
    Panel4: TPanel;
    btnOK: TButton;
    btnCancel: TButton;
    Label16: TLabel;
    editItemNo: TDBEdit;
    tblItem: TTable;
    chkSuspended: TDBCheckBox;
    tblItemItemNo: TStringField;
    tblItemItemDescription: TStringField;
    tblItemSalesGLAccount: TStringField;
    tblItemTaxCodes: TStringField;
    tblItemUnitPrice: TCurrencyField;
    tblItemSuspended: TBooleanField;
    tblItemNotes: TMemoField;
    TabSheet3: TTabSheet;
    Label10: TLabel;
    editSalesGLAccount: TDBEdit;
    cboSalesGLAccount: TDBLookupComboBox;
    btnSalesGLAccount: TSpeedButton;
    Label2: TLabel;
    editUnitPrice: TDBEdit;
    Label3: TLabel;
    editTaxCodes: TDBEdit;
    tblItemCtl: TTable;
    tblItemCtlNextItemNo: TIntegerField;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure dsItemDataChange(Sender: TObject; Field: TField);
    procedure FormShow(Sender: TObject);
    procedure Panel2DblClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure dsItemUpdateData(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure tblItemAfterPost(DataSet: TDataSet);
    procedure cboSalesGLAccountKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure btnSalesGLAccountClick(Sender: TObject);
    procedure tblItemSalesGLAccountValidate(Sender: TField);
    procedure tblItemNewRecord(DataSet: TDataSet);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmItem: TfrmItem;

implementation

uses BS1Form, ItemsForm, GLAccountsForm, GLAccountsFilterForm, LookUpsData;

var
  intClientHeight, intClientWidth: Integer;

{$R *.DFM}

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

procedure TfrmItem.dsItemDataChange(Sender: TObject;
  Field: TField);
begin
  if (tblItem.state = dsInsert) and (tblItemItemDescription.Value = '') then self.Caption := 'New Item'
  else self.Caption := tblItemItemDescription.value;
end;

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

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

procedure TfrmItem.FormCreate(Sender: TObject);
begin
  tblItem.DatabaseName := strDatabaseName;
  tblItemCtl.DatabaseName := strDatabaseName;
  //tblGLAccnt.DatabaseName := strDatabaseName;
  tblItem.Active := true;
  //tblGLAccnt.Active := true;   //Data Module used instead.

  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 TfrmItem.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 TfrmItem.dsItemUpdateData(Sender: TObject);
begin
  if tblItemItemNo.AsString = '' then begin
    with editItemNo do begin Show; SetFocus; end;
    raise(exception.create('Field ' + '''Item no.''' + ' must have a value'));
  end;

  if tblItemItemDescription.AsString = '' then begin
    with editItemDescription do begin Show; SetFocus; end;
    raise(exception.create('Field ' + '''Description''' + ' must have a value'));
  end;

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

procedure TfrmItem.btnOKClick(Sender: TObject);
begin
  if tblItem.State in [dsInsert, dsEdit] then begin
    try tblItem.post; DbiSaveChanges(tblItem.handle);
    except
      on E: EDBEngineError do
        if E.Errors[E.ErrorCount - 1].ErrorCode = 9729 then begin   //Key violation (key already exists).
          with editItemNo do begin Show; SetFocus; end;
          raise(exception.create('Item no. already exists'));
        end else raise;
    end;
    try
      with frmItems.qryItem do begin close; open; end;   //Refresh.
      frmItems.qryItem.Locate('ItemNo', tblItemItemNo.AsString, []);
    except; end;
  end;
  Close;
end;

procedure TfrmItem.btnCancelClick(Sender: TObject);
begin
  tblItem.DisableControls;
  tblItem.cancel;
  Close;
end;

procedure TfrmItem.tblItemAfterPost(DataSet: TDataSet);
begin
  frmItems_cboFind_RequeryRequired := true;
end;

procedure TfrmItem.cboSalesGLAccountKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key = VK_Delete then begin
    tblItem.Edit;
    tblItemSalesGLAccount.AsVariant := null;
  end;
end;

procedure TfrmItem.btnSalesGLAccountClick(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;

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

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

procedure TfrmItem.tblItemNewRecord(DataSet: TDataSet);
var
  x: integer;
begin
  x := 0;
  while x < 150 do begin   //Loop if ItemCtl table is locked.
    with tblItemCtl do begin
      try
        Open;
        Edit;
        if (tblItemCtlNextItemNo.Value < 1001) or (tblItemCtlNextItemNo.Value > 10000000) then tblItemCtlNextItemNo.Value := 1001;   //Start auto-assigned numbers here.
        tblItemItemNo.Value := tblItemCtlNextItemNo.AsString;
        tblItemCtlNextItemNo.Value := tblItemCtlNextItemNo.Value + 1;
        Post;
      except end;
      DbiSaveChanges(tblItemCtl.handle);
      Close;
      if tblItemItemNo.value <> '' then break;
      x := x+1;
    end;
  end;

  if frmBS1.tblCompanyDfltSalesGLAccount.value <> '' then tblItemSalesGLAccount.value := frmBS1.tblCompanyDfltSalesGLAccount.value;
end;

end.