salesmanform.pas

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

unit SalesmanForm;

interface

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

type
  TfrmSalesman = class(TForm)
    Panel1: TPanel;
    Panel3: TPanel;
    Panel2: TPanel;
    dsSalesman: TDataSource;
    Panel4: TPanel;
    btnOK: TButton;
    btnCancel: TButton;
    popNotes: TPopupMenu;
    popWordWrap: TMenuItem;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    btnBusinessPhone: TSpeedButton;
    editJobTitle: TDBEdit;
    editBusinessPhone: TDBEdit;
    editFax: TDBEdit;
    editCellular: TDBEdit;
    editPager: TDBEdit;
    editEMail: TDBEdit;
    TabSheet2: TTabSheet;
    memoNotes: TDBMemo;
    editHomePhone: TDBEdit;
    Label2: TLabel;
    Label7: TLabel;
    GroupBox1: TGroupBox;
    editFirstName: TDBEdit;
    Label3: TLabel;
    Label1: TLabel;
    editLastName: TDBEdit;
    btnCellular: TSpeedButton;
    btnPager: TSpeedButton;
    btnHomePhone: TSpeedButton;
    editBusinessPhoneExt: TDBEdit;
    Label8: TLabel;
    editBusinessPhone2Ext: TDBEdit;
    Label9: TLabel;
    Label10: TLabel;
    editBusinessPhone2: TDBEdit;
    btnBusinessPhone2: TSpeedButton;
    tblSalesman: TTable;
    tblSalesmanSalesmanID: TAutoIncField;
    tblSalesmanLastName: TStringField;
    tblSalesmanFirstName: TStringField;
    tblSalesmanJobTitle: TStringField;
    tblSalesmanBusinessPhone: TStringField;
    tblSalesmanBusinessPhoneExt: TStringField;
    tblSalesmanBusinessPhone2: TStringField;
    tblSalesmanBusinessPhone2Ext: TStringField;
    tblSalesmanHomePhone: TStringField;
    tblSalesmanFax: TStringField;
    tblSalesmanCellular: TStringField;
    tblSalesmanPager: TStringField;
    tblSalesmanEMail: TStringField;
    tblSalesmanNotes: TMemoField;
    tblSalesmanFullName: TStringField;
    qryLastID: TQuery;
    btnEmail: TSpeedButton;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure Panel2DblClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure btnOKClick(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure popWordWrapClick(Sender: TObject);
    procedure btnBusinessPhoneClick(Sender: TObject);
    procedure dsSalesmanDataChange(Sender: TObject; Field: TField);
    procedure dsSalesmanUpdateData(Sender: TObject);
    procedure btnCellularClick(Sender: TObject);
    procedure btnPagerClick(Sender: TObject);
    procedure btnHomePhoneClick(Sender: TObject);
    procedure btnBusinessPhone2Click(Sender: TObject);
    procedure tblSalesmanCalcFields(DataSet: TDataSet);
    procedure tblSalesmanBeforePost(DataSet: TDataSet);
    procedure btnEmailClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmSalesman: TfrmSalesman;

implementation

uses BS1Form, SalesmenForm, DialerForm;

var
  intClientHeight, intClientWidth: Integer;

{$R *.DFM}

procedure TfrmSalesman.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if tblSalesman.State in [dsInsert, dsEdit] then btnOKClick(sender);
  try frmSalesmen.DBGrid1.SetFocus; except; end;
  Action := caFree;
end;

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

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

procedure TfrmSalesman.FormCreate(Sender: TObject);
begin
  tblSalesman.DatabaseName := strDatabaseName;
  qryLastID.DatabaseName := strDatabaseName;
  tblSalesman.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 TfrmSalesman.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 TfrmSalesman.btnOKClick(Sender: TObject);
begin
  if tblSalesman.State in [dsInsert, dsEdit] then begin
    tblSalesman.post; DbiSaveChanges(tblSalesman.handle);
    //try tblSalesman.post; DbiSaveChanges(tblSalesman.handle);
    //except
    //  on E: EDBEngineError do
    //    if E.Errors[E.ErrorCount - 1].ErrorCode = 9729 then begin   //Key violation (key already exists).
    //      with editFirstName do begin Show; SetFocus; end;
    //      raise(exception.create('Salesman already exists'));
    //    end else raise;
    //end;
    try
      frmSalesmen.tblSalesman.refresh;
      frmSalesmen.tblSalesman.Locate('SalesmanID', tblSalesmanSalesmanID.AsInteger, []);
    except; end;
  end;
  Close;
end;

procedure TfrmSalesman.btnCancelClick(Sender: TObject);
begin
  tblSalesman.cancel;
  Close;
end;

procedure TfrmSalesman.popWordWrapClick(Sender: TObject);
begin
  if popWordWrap.checked = true then begin
    popWordWrap.checked := false;
    memoNotes.WordWrap := false;
    memoNotes.ScrollBars := ssBoth;
  end else begin
    popWordWrap.checked := true;
    memoNotes.WordWrap := true;
    memoNotes.ScrollBars := ssVertical;
  end;
end;

procedure TfrmSalesman.btnBusinessPhoneClick(Sender: TObject);
begin
  with frmDialer do begin
    NameToDial := tblSalesmanFullName.value;
    NumberToDial := tblSalesmanBusinessPhone.value;
    ShowModal;
  end;
end;

procedure TfrmSalesman.dsSalesmanDataChange(Sender: TObject;
  Field: TField);
begin
  if (tblSalesmanSalesmanID.AsVariant = null) and (tblSalesmanFullName.value = '') then self.Caption := 'New Salesman'
  else self.Caption := tblSalesmanFullName.value;

  if tblSalesmanBusinessPhone.AsString = '' then btnBusinessPhone.Enabled := False
  else btnBusinessPhone.Enabled := True;
  if tblSalesmanBusinessPhone2.AsString = '' then btnBusinessPhone2.Enabled := False
  else btnBusinessPhone2.Enabled := True;
  if tblSalesmanCellular.AsString = '' then btnCellular.Enabled := False
  else btnCellular.Enabled := True;
  if tblSalesmanPager.AsString = '' then btnPager.Enabled := False
  else btnPager.Enabled := True;
  if tblSalesmanHomePhone.AsString = '' then btnHomePhone.Enabled := False
  else btnHomePhone.Enabled := True;
  if tblSalesmanEMail.AsString = '' then btnEMail.Enabled := False
  else btnEMail.Enabled := True;
end;

procedure TfrmSalesman.dsSalesmanUpdateData(Sender: TObject);
begin
  if tblSalesmanFullName.AsString = '' then begin
    with editFirstName do begin Show; SetFocus; end;
    raise(exception.create('Field ' + '''Salesman Name''' + ' must have a value'));
  end;
end;

procedure TfrmSalesman.btnCellularClick(Sender: TObject);
begin
  with frmDialer do begin
    NameToDial := tblSalesmanFullName.value;
    NumberToDial := tblSalesmanCellular.value;
    ShowModal;
  end;
end;

procedure TfrmSalesman.btnPagerClick(Sender: TObject);
begin
  with frmDialer do begin
    NameToDial := tblSalesmanFullName.value;
    NumberToDial := tblSalesmanPager.value;
    ShowModal;
  end;
end;

procedure TfrmSalesman.btnHomePhoneClick(Sender: TObject);
begin
  with frmDialer do begin
    NameToDial := tblSalesmanFullName.value;
    NumberToDial := tblSalesmanHomePhone.value;
    ShowModal;
  end;
end;

procedure TfrmSalesman.btnBusinessPhone2Click(Sender: TObject);
begin
  with frmDialer do begin
    NameToDial := tblSalesmanFullName.value;
    NumberToDial := tblSalesmanBusinessPhone2.value;
    ShowModal;
  end;
end;

procedure TfrmSalesman.tblSalesmanCalcFields(DataSet: TDataSet);
begin
  if (tblSalesmanFirstName.Value <> '') and (tblSalesmanLastName.Value <> '') then tblSalesmanFullName.AsString := tblSalesmanFirstName.AsString + ' ' + tblSalesmanLastName.AsString
  else                                                                             tblSalesmanFullName.AsString := tblSalesmanFirstName.AsString + tblSalesmanLastName.AsString;
end;

procedure TfrmSalesman.tblSalesmanBeforePost(DataSet: TDataSet);
begin
  if tblSalesman.state = dsInsert then begin
    qryLastID.close;
    qryLastID.open;
    with qryLastID.Fields[0] do
      if IsNull then tblSalesmanSalesmanID.value := 1
      else tblSalesmanSalesmanID.value := AsInteger + 1;
  end;
end;

procedure TfrmSalesman.btnEmailClick(Sender: TObject);
var
  zFileName, zParams, zDir: array[0..79] of Char;
begin
  ShellExecute(Application.MainForm.Handle, nil,
  StrPCopy(zFileName, 'mailto:' + tblSalesmanEMail.value),   {filename}
  StrPCopy(zParams, ' '),   {command line perameters}
  StrPCopy(zDir, ''),   {default directory}
  SW_SHOW);   {SW_SHOW Normal window.  or SW_SHOWMINIMIZED, SW_HIDE, etc}
end;

end.