vendorsform.pas

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

unit VendorsForm;

interface

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

type
  TfrmVendors = class(TForm)
    Panel1: TPanel;
    MainMenu1: TMainMenu;
    tblVendor: TTable;
    dsVendor: TDataSource;
    DBGrid1: TDBGrid;
    cboFind: TComboBox;
    Label1: TLabel;
    mnuFile: TMenuItem;
    mnuView: TMenuItem;
    mnuHelp: TMenuItem;
    mnuFilter: TMenuItem;
    mnuSortBy: TMenuItem;
    N1: TMenuItem;
    mnuRefresh: TMenuItem;
    mnuVendorsHelp: TMenuItem;
    mnuPrint: TMenuItem;
    N2: TMenuItem;
    mnuExit: TMenuItem;
    Bevel1: TBevel;
    mnuSortName: TMenuItem;
    mnuSortVendorNo: TMenuItem;
    mnuSortBalance: TMenuItem;
    mnuSortPhone: TMenuItem;
    mnuSortContact: TMenuItem;
    mnuInvoices: TMenuItem;
    mnuCheques: TMenuItem;
    N4: TMenuItem;
    btnNew: TSpeedButton;
    btnEdit: TSpeedButton;
    btnDelete: TSpeedButton;
    editFind: TEdit;
    mnuRecords: TMenuItem;
    mnuNew: TMenuItem;
    mnuEdit: TMenuItem;
    mnuDelete: TMenuItem;
    qryVendor: TQuery;
    qryVendorVendorName: TStringField;
    qryVendorContact: TStringField;
    qryVendorPhone: TStringField;
    qryVendorBalance: TCurrencyField;
    tblVContact: TTable;
    qryVendorVendorNo: TStringField;
    tblVendorVendorNo: TStringField;
    tblVendorVendorName: TStringField;
    tblVendorVendorID: TAutoIncField;
    qryVendorVendorID: TIntegerField;
    tblVContactVendorID: TIntegerField;
    qryVendorSuspended: TBooleanField;
    tblVendorSuspended: TBooleanField;
    qryVendorCurrencyID: TIntegerField;
    tblVendorCurrencyID: TIntegerField;
    PopupMenu1: TPopupMenu;
    popInvoices: TMenuItem;
    popCheques: TMenuItem;
    popNew: TMenuItem;
    popEdit: TMenuItem;
    popDelete: TMenuItem;
    N3: TMenuItem;
    popPhone: TMenuItem;
    N5: TMenuItem;
    tblVBalance: TTable;
    tblVBalanceVendorID: TIntegerField;
    tblAPInv: TTable;
    tblAPInvVendorID: TIntegerField;
    popEMail: TMenuItem;
    qryVendorEMail: TStringField;
    btnFilter: TSpeedButton;
    procedure mnuRefreshClick(Sender: TObject);
    procedure tblVendorBeforeDelete(DataSet: TDataSet);
    procedure FormCreate(Sender: TObject);
    procedure Panel1DblClick(Sender: TObject);
    procedure cboFindDropDown(Sender: TObject);
    procedure cboFindKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure cboFindClick(Sender: TObject);
    procedure cboFindKeyPress(Sender: TObject; var Key: Char);
    procedure tblVendorAfterDelete(DataSet: TDataSet);
    procedure DBGrid1KeyPress(Sender: TObject; var Key: Char);
    procedure FormShow(Sender: TObject);
    procedure editFindKeyPress(Sender: TObject; var Key: Char);
    procedure mnuNewClick(Sender: TObject);
    procedure mnuEditClick(Sender: TObject);
    procedure mnuDeleteClick(Sender: TObject);
    procedure mnuExitClick(Sender: TObject);
    procedure mnuSortVendorNoClick(Sender: TObject);
    procedure mnuSortNameClick(Sender: TObject);
    procedure mnuSortPhoneClick(Sender: TObject);
    procedure mnuSortContactClick(Sender: TObject);
    procedure mnuSortBalanceClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure mnuFilterClick(Sender: TObject);
    procedure qryVendorFilterRecord(DataSet: TDataSet;
      var Accept: Boolean);
    procedure tblVendorFilterRecord(DataSet: TDataSet;
      var Accept: Boolean);
    procedure mnuPrintClick(Sender: TObject);
    procedure mnuInvoicesClick(Sender: TObject);
    procedure mnuChequesClick(Sender: TObject);
    procedure popPhoneClick(Sender: TObject);
    procedure mnuVendorsHelpClick(Sender: TObject);
    procedure popEMailClick(Sender: TObject);
    procedure dsVendorDataChange(Sender: TObject; Field: TField);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmVendors: TfrmVendors;
  
implementation

uses VendorForm, BS1Form, VendorsFilterForm, VendorsReport, APInvoicesForm,
  APInvoicesFilterForm, DialerForm, APChequesForm, APChequesFilterForm;

var
  intClientHeight, intClientWidth: Integer;
  cboFind_VendorIDs: TStringList;
  OldWindowState: TWindowState;

{$R *.DFM}

procedure cboFind_Load(const Tbl: TTable; const Cbo: TCombobox);
begin
  Cbo.Items.Clear;   //Populate "find" combobox.
  cboFind_VendorIDs.Clear;
  Tbl.First;
  while not Tbl.EOF do begin
    Cbo.Items.Add(Tbl['VendorName']);
    cboFind_VendorIDs.Add(Tbl['VendorID']);
    Tbl.Next;
  end;
  frmVendors_cboFind_RequeryRequired := false;
end;

procedure TfrmVendors.mnuRefreshClick(Sender: TObject);
var
  Bookmark: TBookmark;
begin
  screen.cursor := crHourglass;
  Bookmark := qryVendor.GetBookmark;
  with qryVendor do begin close; open; end;   //Refresh.
  try qryVendor.GotoBookmark(Bookmark); except; end;
  qryVendor.FreeBookmark(BookMark);
  screen.cursor := crDefault;
end;

procedure TfrmVendors.tblVendorBeforeDelete(DataSet: TDataSet);
begin
  if MessageDlg('Delete ' + '''' + tblVendorVendorNo.AsString + ': ' + tblVendorVendorName.AsString + '''' + '?',mtConfirmation,mbOKCancel,0) <> mrOK then raise(EAbort.create(''));   //Silent Exception: "abort;" replaced by "raise etc" since abort conflicts with BDE (required by DbiSaveChanges).
  repaint;
  
  tblAPInv.Active := true;
  if tblAPInv.Locate('VendorID', tblVendorVendorID.value, []) = true then raise(Exception.Create('Unable to delete ' + '''' + tblVendorVendorNo.AsString + ': ' + tblVendorVendorName.AsString + '''' + '...' + #13 + 'Invoice(s) exist for this vendor'));

  tblVBalance.Active := true;   //Delete balance.
  if tblVBalance.Locate('VendorID', tblVendorVendorID.value, []) = true then tblVBalance.Delete;

  with tblVContact do begin   //Delete contacts for this vendor.
    Active := true;
    First;
    while not eof do Delete;
  end;
end;

procedure TfrmVendors.FormCreate(Sender: TObject);
var
  x: integer;
  //StartTime, EndTime: TDateTime;
begin
  //StartTime := now();
  qryVendor.DatabaseName := strDatabaseName;
  tblVendor.DatabaseName := strDatabaseName;
  tblVBalance.DatabaseName := strDatabaseName;
  tblVContact.DatabaseName := strDatabaseName;
  tblAPInv.DatabaseName := strDatabaseName;
  qryVendor.Active := true;
  tblVendor.Active := true;
  //tblVBalance.Active := true;   ...pospone until required (delete).
  //tblVContact.Active := true;   ...pospone until required (delete).
  //tblAPInv.Active := true;   ...pospone until required (delete).

  cboFind_VendorIDs := TStringList.create;   //Create a TStringList to store VendorIDs for the "find" combobox.
  cboFind_Load(tblVendor, cboFind);   //Populate "find" combobox.

  if FontFactor <> 1 then begin   //If using large fonts, resize grid columns.
    intClientWidth := Trunc(20*FontFactor) + DBGrid1.Columns.Count -1;   //Scrollbar + grid lines.
    for x := 0 to DBGrid1.Columns.Count - 1 do begin
      DBGrid1.Columns[x].width := Trunc(DBGrid1.Columns[x].width*FontFactor);
      intClientWidth := intClientWidth + DBGrid1.Columns[x].width;
    end;
    ClientWidth := intClientWidth;
  end;
  intClientHeight := ClientHeight;   //Store form size.
  intClientWidth := ClientWidth;
  //EndTime := now();
  //Showmessage(DateTimeToStr(StartTime) + ' ' + DateTimeToStr(EndTime) + ' ' + FloatToStr(EndTime - StartTime));
end;

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

procedure TfrmVendors.cboFindDropDown(Sender: TObject);
begin
  if frmVendors_cboFind_RequeryRequired = true then cboFind_Load(tblVendor, cboFind);   //Populate "find" combobox.
end;

procedure TfrmVendors.cboFindKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if frmVendors_cboFind_RequeryRequired = true then cboFind_Load(tblVendor, cboFind);   //Populate "find" combobox.
end;

procedure TfrmVendors.cboFindClick(Sender: TObject);
begin
  if cboFind.Text = '' then exit;
  editFind.text := '';
  if cboFind.Items.IndexOf(cboFind.Text) < 0 then raise(Exception.Create('Choose an item from the list'));
  if qryVendor.Locate('VendorID', cboFind_VendorIDs[cboFind.ItemIndex], []) <> true then raise(Exception.Create('''' + cboFind.Text + '''' + ' not found'));
end;

procedure TfrmVendors.cboFindKeyPress(Sender: TObject; var Key: Char);
begin
  if key = #13 then begin
    Key := #0;   //Cancel Enter key.
    if (cboFind.Text = '') or (cboFind.Text = '<Vendor name>') then begin
      Perform(WM_NEXTDLGCTL, 0, 0);   //Advance to next control.
      exit;
    end;
    cboFindClick(Sender);   //Trigger click event (in case partial text was entered then combobox opened: item would show as selected, but Enter wouldn't process it).
    Perform(WM_NEXTDLGCTL, 0, 0);   //Advance to next control.
  end;
end;

procedure TfrmVendors.tblVendorAfterDelete(DataSet: TDataSet);
begin
  frmVendors_cboFind_RequeryRequired := true;
  frmAPInvoices_cboFindVendor_RequeryRequired := true;
  cboFind.text := '';
end;

procedure TfrmVendors.DBGrid1KeyPress(Sender: TObject; var Key: Char);
begin
  if key = #13 then begin
    mnuEditClick(Sender);
    Key := #0;   //Cancel Enter key.
  end;
end;

procedure TfrmVendors.FormShow(Sender: TObject);
begin
  cboFind.ItemIndex := 0;   //Reset selected item to 1st (so down arrow scrolls from start).
  cboFind.text := '<Vendor name>';   //Clear selection.
  editFind.text := '<Vendor no.>';
  editFind.setfocus;
  editFind.SelectAll;
  qryVendor.First;   //Reset grid to start at 1st record.
  if mnuFilter.checked = true then caption := 'Vendors (Filtered)'
  else                             caption := 'Vendors';