vcontactform.pas

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

unit VContactForm;

interface

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

type
  TfrmVContact = class(TForm)
    Panel1: TPanel;
    Panel3: TPanel;
    Panel2: TPanel;
    dsVContact: 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;
    tblVendor: TTable;
    GroupBox1: TGroupBox;
    editFirstName: TDBEdit;
    Label3: TLabel;
    Label1: TLabel;
    editLastName: TDBEdit;
    btnCellular: TSpeedButton;
    btnPager: TSpeedButton;
    btnHomePhone: TSpeedButton;
    tblVendorVendorID: TAutoIncField;
    tblVendorVendorName: TStringField;
    editBusinessPhoneExt: TDBEdit;
    Label8: TLabel;
    Label9: TLabel;
    editBusinessPhone2Ext: TDBEdit;
    Label10: TLabel;
    editBusinessPhone2: TDBEdit;
    btnBusinessPhone2: TSpeedButton;
    tblVContact: TTable;
    tblVContactVendorID: TIntegerField;
    tblVContactContactID: TAutoIncField;
    tblVContactLastName: TStringField;
    tblVContactFirstName: TStringField;
    tblVContactJobTitle: TStringField;
    tblVContactBusinessPhone: TStringField;
    tblVContactBusinessPhoneExt: TStringField;
    tblVContactBusinessPhone2: TStringField;
    tblVContactBusinessPhone2Ext: TStringField;
    tblVContactHomePhone: TStringField;
    tblVContactFax: TStringField;
    tblVContactCellular: TStringField;
    tblVContactPager: TStringField;
    tblVContactEMail: TStringField;
    tblVContactNotes: TMemoField;
    tblVContactFullName: TStringField;
    tblVContactVendorName: TStringField;
    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 dsVContactDataChange(Sender: TObject; Field: TField);
    procedure dsVContactUpdateData(Sender: TObject);
    procedure btnCellularClick(Sender: TObject);
    procedure btnPagerClick(Sender: TObject);
    procedure btnHomePhoneClick(Sender: TObject);
    procedure btnBusinessPhone2Click(Sender: TObject);
    procedure tblVContactCalcFields(DataSet: TDataSet);
    procedure btnEmailClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmVContact: TfrmVContact;

implementation

uses VendorForm, BS1Form, DialerForm;

var
  intClientHeight, intClientWidth: Integer;

{$R *.DFM}

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

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

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

procedure TfrmVContact.FormCreate(Sender: TObject);
begin
  tblVContact.DatabaseName := strDatabaseName;
  tblVendor.DatabaseName := strDatabaseName;
  tblVContact.Active := true;
  tblVendor.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 TfrmVContact.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 TfrmVContact.btnOKClick(Sender: TObject);
begin
  if tblVContact.State in [dsInsert, dsEdit] then begin
    tblVContact.post;
    DbiSaveChanges(tblVContact.handle);
    try
      frmVendor.tblVContact.refresh;
      frmVendor.tblVContact.Locate('ContactID', tblVContactContactID.AsInteger, []);
    except; end;
  end;
  Close;
end;

procedure TfrmVContact.btnCancelClick(Sender: TObject);
begin
  tblVContact.cancel;
  Close;
end;

procedure TfrmVContact.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 TfrmVContact.btnBusinessPhoneClick(Sender: TObject);
begin
  with frmDialer do begin
    NameToDial := tblVContactFullName.value;
    NumberToDial := tblVContactBusinessPhone.value;
    ShowModal;
  end;
end;

procedure TfrmVContact.dsVContactDataChange(Sender: TObject;
  Field: TField);
begin
  if (tblVContactContactID.AsVariant = null) and (tblVContactFullName.value = '') then self.Caption := 'New Contact at ' + tblVContactVendorName.value
  else self.Caption := tblVContactFullName.value + ' at ' + tblVContactVendorName.value;

  if tblVContactBusinessPhone.AsString = '' then btnBusinessPhone.Enabled := False
  else btnBusinessPhone.Enabled := True;
  if tblVContactBusinessPhone2.AsString = '' then btnBusinessPhone2.Enabled := False
  else btnBusinessPhone2.Enabled := True;
  if tblVContactCellular.AsString = '' then btnCellular.Enabled := False
  else btnCellular.Enabled := True;
  if tblVContactPager.AsString = '' then btnPager.Enabled := False
  else btnPager.Enabled := True;
  if tblVContactHomePhone.AsString = '' then btnHomePhone.Enabled := False
  else btnHomePhone.Enabled := True;
  if tblVContactEMail.AsString = '' then btnEMail.Enabled := False
  else btnEMail.Enabled := True;
end;

procedure TfrmVContact.dsVContactUpdateData(Sender: TObject);
begin
  if tblVContactFullName.AsString = '' then begin
    with editFirstName do begin Show; SetFocus; end;
    raise(exception.create('Field ' + '''Contact Name''' + ' must have a value'));
  end;
end;

procedure TfrmVContact.btnCellularClick(Sender: TObject);
begin
  with frmDialer do begin
    NameToDial := tblVContactFullName.value;
    NumberToDial := tblVContactCellular.value;
    ShowModal;
  end;
end;

procedure TfrmVContact.btnPagerClick(Sender: TObject);
begin
  with frmDialer do begin
    NameToDial := tblVContactFullName.value;
    NumberToDial := tblVContactPager.value;
    ShowModal;
  end;
end;

procedure TfrmVContact.btnHomePhoneClick(Sender: TObject);
begin
  with frmDialer do begin
    NameToDial := tblVContactFullName.value;
    NumberToDial := tblVContactHomePhone.value;
    ShowModal;
  end;
end;

procedure TfrmVContact.btnBusinessPhone2Click(Sender: TObject);
begin
  with frmDialer do begin
    NameToDial := tblVContactFullName.value;
    NumberToDial := tblVContactBusinessPhone2.value;
    ShowModal;
  end;
end;

procedure TfrmVContact.tblVContactCalcFields(DataSet: TDataSet);
begin
  if (tblVContactFirstName.Value <> '') and (tblVContactLastName.Value <> '') then tblVContactFullName.AsString := tblVContactFirstName.AsString + ' ' + tblVContactLastName.AsString
  else                                                                             tblVContactFullName.AsString := tblVContactFirstName.AsString + tblVContactLastName.AsString;
end;

procedure TfrmVContact.btnEmailClick(Sender: TObject);
var
  zFileName, zParams, zDir: array[0..79] of Char;
begin
  ShellExecute(Application.MainForm.Handle, nil,
  StrPCopy(zFileName, 'mailto:' + tblVContactEMail.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.