ccontactform.pas

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

unit CContactForm;

interface

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

type
  TfrmCContact = class(TForm)
    Panel1: TPanel;
    Panel3: TPanel;
    Panel2: TPanel;
    dsCContact: 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;
    tblCustomer: TTable;
    GroupBox1: TGroupBox;
    editFirstName: TDBEdit;
    Label3: TLabel;
    Label1: TLabel;
    editLastName: TDBEdit;
    btnCellular: TSpeedButton;
    btnPager: TSpeedButton;
    btnHomePhone: TSpeedButton;
    tblCustomerCustomerName: TStringField;
    tblCustomerCustomerID: TAutoIncField;
    Label8: TLabel;
    editBusinessPhoneExt: TDBEdit;
    Label9: TLabel;
    editBusinessPhone2Ext: TDBEdit;
    Label10: TLabel;
    editBusinessPhone2: TDBEdit;
    btnBusinessPhone2: TSpeedButton;
    tblCContact: TTable;
    tblCContactCustomerID: TIntegerField;
    tblCContactContactID: TAutoIncField;
    tblCContactLastName: TStringField;
    tblCContactFirstName: TStringField;
    tblCContactJobTitle: TStringField;
    tblCContactBusinessPhone: TStringField;
    tblCContactBusinessPhoneExt: TStringField;
    tblCContactBusinessPhone2: TStringField;
    tblCContactBusinessPhone2Ext: TStringField;
    tblCContactHomePhone: TStringField;
    tblCContactFax: TStringField;
    tblCContactCellular: TStringField;
    tblCContactPager: TStringField;
    tblCContactEMail: TStringField;
    tblCContactNotes: TMemoField;
    tblCContactFullName: TStringField;
    tblCContactCustomerName: 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 dsCContactDataChange(Sender: TObject; Field: TField);
    procedure dsCContactUpdateData(Sender: TObject);
    procedure btnCellularClick(Sender: TObject);
    procedure btnPagerClick(Sender: TObject);
    procedure btnHomePhoneClick(Sender: TObject);
    procedure btnBusinessPhone2Click(Sender: TObject);
    procedure tblCContactCalcFields(DataSet: TDataSet);
    procedure btnEmailClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmCContact: TfrmCContact;

implementation

uses CustomerForm, BS1Form, DialerForm;

var
  intClientHeight, intClientWidth: Integer;

{$R *.DFM}

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

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

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

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

procedure TfrmCContact.btnCancelClick(Sender: TObject);
begin
  tblCContact.cancel;
  Close;
end;

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

procedure TfrmCContact.dsCContactDataChange(Sender: TObject;
  Field: TField);
begin
  if (tblCContactContactID.AsVariant = null) and (tblCContactFullName.value = '') then self.Caption := 'New Contact at ' + tblCContactCustomerName.value
  else self.Caption := tblCContactFullName.value + ' at ' + tblCContactCustomerName.value;

  if tblCContactBusinessPhone.AsString = '' then btnBusinessPhone.Enabled := False
  else btnBusinessPhone.Enabled := True;
  if tblCContactBusinessPhone2.AsString = '' then btnBusinessPhone2.Enabled := False
  else btnBusinessPhone2.Enabled := True;
  if tblCContactCellular.AsString = '' then btnCellular.Enabled := False
  else btnCellular.Enabled := True;
  if tblCContactPager.AsString = '' then btnPager.Enabled := False
  else btnPager.Enabled := True;
  if tblCContactHomePhone.AsString = '' then btnHomePhone.Enabled := False
  else btnHomePhone.Enabled := True;
  if tblCContactEMail.AsString = '' then btnEMail.Enabled := False
  else btnEMail.Enabled := True;
end;

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

procedure TfrmCContact.btnCellularClick(Sender: TObject);
begin
  with frmDialer do begin
    NameToDial := tblCContactFullName.value;
    NumberToDial := tblCContactCellular.value;
    ShowModal;
  end;
end;

procedure TfrmCContact.btnPagerClick(Sender: TObject);
begin
  with frmDialer do begin
    NameToDial := tblCContactFullName.value;
    NumberToDial := tblCContactPager.value;
    ShowModal;
  end;
end;

procedure TfrmCContact.btnHomePhoneClick(Sender: TObject);
begin
  with frmDialer do begin
    NameToDial := tblCContactFullName.value;
    NumberToDial := tblCContactHomePhone.value;
    ShowModal;
  end;
end;

procedure TfrmCContact.btnBusinessPhone2Click(Sender: TObject);
begin
  with frmDialer do begin
    NameToDial := tblCContactFullName.value;
    NumberToDial := tblCContactBusinessPhone2.value;
    ShowModal;
  end;
end;

procedure TfrmCContact.tblCContactCalcFields(DataSet: TDataSet);
begin
  if (tblCContactFirstName.Value <> '') and (tblCContactLastName.Value <> '') then tblCContactFullName.AsString := tblCContactFirstName.AsString + ' ' + tblCContactLastName.AsString
  else                                                                             tblCContactFullName.AsString := tblCContactFirstName.AsString + tblCContactLastName.AsString;
end;

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