customerform.pas

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

    cboCustomerType.enabled := true; cboCustomerType.color := clWindow;
    chkAllowBackorders.enabled := true; chkAllowBackorders.caption := 'Allow Backorders:'; chkAllowBackorders.left := Trunc(20*FontFactor); chkAllowBackorders.width := Trunc(113*FontFactor);
    lblBillToOnlyMessage.visible := false;
  end else begin
    cboTax1.enabled := false; cboTax1.color := clSilver;
    cboTax2.enabled := false; cboTax2.color := clSilver;
    editTax1ExemptionNo.enabled := false; editTax1ExemptionNo.color := clSilver;
    editTax2ExemptionNo.enabled := false; editTax2ExemptionNo.color := clSilver;
    cboSalesman.enabled := false; cboSalesman.color := clSilver;
    cboCustomerType.enabled := false; cboCustomerType.color := clSilver;
    chkAllowBackorders.enabled := false; chkAllowBackorders.caption := ''; chkAllowBackorders.left := Trunc(113*FontFactor); chkAllowBackorders.width := Trunc(20*FontFactor);
    lblBillToOnlyMessage.visible := true;
  end;
end;

procedure TfrmCustomer.FormShow(Sender: TObject);
begin
  PageControl1.ActivePage := Tabsheet1;
  editCustomerNo.setfocus;
  if FontFactor <> 1 then begin   //If using large fonts, resize checkboxes (can't be done at form create).
    //chkCOD.width := Trunc(81*FontFactor);
    //chkCOD.left := Trunc(20*FontFactor);
    //chkPrintStatement.width := Trunc(81*FontFactor);
    //chkPrintStatement.left := Trunc(20*FontFactor);
    //chkBillToOnly.width := Trunc(75*FontFactor);
    //chkBillToOnly.left := Trunc(138*FontFactor);
    //chkAllowBackOrders.width := Trunc(113*FontFactor);
    //chkAllowBackOrders.left := Trunc(20*FontFactor);
  end;
end;

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

procedure TfrmCustomer.FormCreate(Sender: TObject);
var
  x, intDBGrid1Width: integer;
begin
  tblCustomer.DatabaseName := strDatabaseName;
  tblCustCtl.DatabaseName := strDatabaseName;
  tblBillTo.DatabaseName := strDatabaseName;
  tblCContact.DatabaseName := strDatabaseName;
  //tblCurrency.DatabaseName := strDatabaseName;
  qryARInv.DatabaseName := strDatabaseName;
  //tblSalesman.DatabaseName := strDatabaseName;
  //tblCusType.DatabaseName := strDatabaseName;
  //tblTax.DatabaseName := strDatabaseName;
  tblCustomer.Active := true;
  //tblBillTo.Active := true;   //Postpone till later to improve performance.
  //tblCContact.Active := true;
  //tblCurrency.Active := true;
  //dmLookUps.tblSalesman.Active := true;
  //dmLookUps.tblCusType.Active := true;
  //dmLookUps.tblTax.Active := true;

  if FontFactor <> 1 then begin   //If using large fonts, resize form.
    intDBGrid1Width := Trunc(20*FontFactor) + DBGrid1.Columns.Count -1;   //Row selector + scrollbar + grid lines.
    for x := 0 to DBGrid1.Columns.Count - 1 do begin
      DBGrid1.Columns[x].width := Trunc(DBGrid1.Columns[x].width*FontFactor);
      intDBGrid1Width := intDBGrid1Width + DBGrid1.Columns[x].width;
    end;
    DBGrid1.Width := intDBGrid1Width;
    ClientHeight := Trunc(ClientHeight*FontFactor);
    ClientWidth := Trunc(ClientWidth*FontFactor);
    PageControl1.TabWidth := Trunc(PageControl1.TabWidth*FontFactor);
  end;
  intClientHeight := ClientHeight;   //Store form size.
  intClientWidth := ClientWidth;
end;

procedure TfrmCustomer.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) and (ActiveControl.ClassType <> TDBGrid) 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 TfrmCustomer.dsCustomerUpdateData(Sender: TObject);
begin
  if tblCustomerCustomerNo.AsString = '' then begin
    with editCustomerNo do begin Show; SetFocus; end;
    raise(exception.create('Field ' + '''Customer no.''' + ' must have a value'));
  end;

  if tblCustomerCustomerName.AsString = '' then begin
    with editCustomerName do begin Show; SetFocus; end;
    raise(exception.create('Field ' + '''Customer Name''' + ' must have a value'));
  end;

  if (tblCustomerBillToNo.value = '') and (tblCustomerCurrencyID.AsInteger = 0) then begin
    tblBillTo.Active := true;
    //tblCurrency.Active := true;   //Data Module used instead.
    with cboCurrency do begin Show; SetFocus; end;
    raise(exception.create('Field ' + '''Currency''' + ' must have a value'));
  end;

  if (tblCustomerBillToOnly.value = false) and (tblCustomerSalesmanID.AsInteger = 0) then begin
    dmLookUps.tblSalesman.Active := true;
    dmLookUps.tblCusType.Active := true;
    dmLookUps.tblTax.Active := true;
    with cboSalesman do begin Show; SetFocus; end;
    raise(exception.create('Field ' + '''Salesman''' + ' must have a value'));
  end;

  dmLookUps.tblSalesman.Active := true;
  if (tblCustomerBillToOnly.value = false) and (dmLookUps.tblSalesman.Locate('SalesmanID', tblCustomerSalesmanID.value, []) <> true) then begin
    dmLookUps.tblCusType.Active := true;
    dmLookUps.tblTax.Active := true;
    with cboSalesman do begin Show; SetFocus; end;
    raise(exception.create('Salesman no longer exists'));   //Deleted by another user since this user selected on combobox.
  end;

  if (tblCustomerBillToOnly.value = false) and (tblCustomerCustomerTypeID.AsInteger = 0) then begin
    dmLookUps.tblSalesman.Active := true;
    dmLookUps.tblCusType.Active := true;
    dmLookUps.tblTax.Active := true;
    with cboCustomerType do begin Show; SetFocus; end;
    raise(exception.create('Field ' + '''Customer Type''' + ' must have a value'));
  end;

  dmLookUps.tblCusType.Active := true;
  if (tblCustomerBillToOnly.value = false) and (dmLookUps.tblCusType.Locate('CustomerTypeID', tblCustomerCustomerTypeID.value, []) <> true) then begin
    dmLookUps.tblSalesman.Active := true;
    dmLookUps.tblTax.Active := true;
    with cboCustomerType do begin Show; SetFocus; end;
    raise(exception.create('Customer Type no longer exists'));   //Deleted by another user since this user selected on combobox.
  end;
end;

procedure TfrmCustomer.btnOKClick(Sender: TObject);
begin
  if tblCustomer.State in [dsInsert, dsEdit] then
    try tblCustomer.post; DbiSaveChanges(tblCustomer.handle);
    except
      on E: EDBEngineError do
        if E.Errors[E.ErrorCount - 1].ErrorCode = 9729 then begin   //Key violation (key already exists).
          with editCustomerNo do begin Show; SetFocus; end;
          raise(exception.create('Customer no. already exists'));
        end else raise;
    end;
  Close;
end;

procedure TfrmCustomer.btnCancelClick(Sender: TObject);
begin
  tblCustomer.DisableControls;
  tblCustomer.cancel;
  Close;
end;

procedure TfrmCustomer.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 TfrmCustomer.btnPhoneClick(Sender: TObject);
begin
  with frmDialer do begin
    NameToDial := tblCustomerCustomerName.value;
    NumberToDial := tblCustomerPhone.value;
    ShowModal;
  end;
end;

procedure TfrmCustomer.cboCurrencyKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key = VK_Delete then begin
    tblCustomer.Edit;
    tblCustomerCurrencyID.AsVariant := null;
  end;
end;

procedure TfrmCustomer.tblCustomerAfterPost(DataSet: TDataSet);
begin
  frmCustomers_cboFind_RequeryRequired := true;
  frmARInvoices_cboFindCustomer_RequeryRequired := true;
  frmARPayments_cboFindCustomer_RequeryRequired := true;
  try   //Refresh, etc.
    with frmCustomers.qryCustomer do begin close; open; end;
    frmCustomers.qryCustomer.Locate('CustomerID', tblCustomerCustomerID.value, []);
  except; end;
end;

procedure TfrmCustomer.btnCurrencyClick(Sender: TObject);
var
  aComponent: TComponent;
begin
  screen.cursor := crHourglass;
  aComponent := Application.FindComponent('frmCurrencies');
  if not Assigned (aComponent) then frmCurrencies := TfrmCurrencies.Create(Application);
  if frmCurrencies.WindowState = wsMinimized then frmCurrencies.WindowState := wsNormal;
  if frmCurrencies.visible = true then frmCurrencies.FormShow(sender)
  else frmCurrencies.Show;
  if not frmCurrencies.tblCurrency.Locate('CurrencyID', tblCustomerCurrencyID.value, []) then frmCurrencies.tblCurrency.First;
  screen.cursor := crDefault;
end;

procedure TfrmCustomer.btnDeleteClick(Sender: TObject);
begin
  tblCContact.delete;
  DbiSaveChanges(tblCContact.handle);
end;

procedure TfrmCustomer.btnNewClick(Sender: TObject);
begin
  if (tblCustomer.State = dsInsert) then begin
    if MessageDlg('New customer must be saved before entering contacts...' + #13 + 'Save now?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
      try tblCustomer.post; DbiSaveChanges(tblCustomer.handle);
      except
        on E: EDBEngineError do
          if E.Errors[0].ErrorCode = 9729 then begin   //Key violation (key already exists).
            with editCustomerNo do begin Show; SetFocus; end;
            raise(exception.create('Customer no. already exists'));
          end else raise;
      end
    else raise(EAbort.create(''));  //Silent Exception: "abort;" replaced by "raise etc" since abort conflicts with BDE (required by DbiSaveChanges).
  end;
  screen.cursor := crHourglass;
  application.createform (TfrmCContact,frmCContact);
  frmCContact.tblCContact.Insert;
  frmCContact.tblCContactCustomerID.value := tblCustomerCustomerID.value;
  frmCContact.Show;
  screen.cursor := crDefault;
end;

procedure TfrmCustomer.btnEditClick(Sender: TObject);
begin
  if tblCContactContactID.AsVariant = null then btnNewClick(sender)   //Can happen if no contacts yet.  
  else begin
    screen.cursor := crHourglass;
    application.createform (TfrmCContact,frmCContact);
    if frmCContact.tblCContact.Locate('ContactID', tblCContactContactID.value, []) = true then frmCContact.Show
    else tblCContact.refresh;   //Contact was deleted.
    screen.cursor := crDefault;
  end;
end;

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

procedure TfrmCustomer.tblCContactBeforeDelete(DataSet: TDataSet);
begin
  if MessageDlg('Delete ' + '''' + tblCContactFullName.AsString + '''' + '?',mtConfirmation,mbOKCancel,0) <> mrOK then raise(EAbort.create(''));  //Silent Exception: "abort;" replaced by "raise etc" since abort conflicts with BDE (required by DbiSaveChanges).
end;

procedure TfrmCustomer.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 TfrmCustomer.tblCustomerNewRecord(DataSet: TDataSet);
var
  x: integer;
begin