customerform.pas

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

  x := 0;
  while x < 150 do begin   //Loop if CustCtl table is locked.
    with tblCustCtl do begin
      try
        Open;
        Edit;
        if (tblCustCtlNextCustomerNo.Value < 1001) or (tblCustCtlNextCustomerNo.Value > 10000000) then tblCustCtlNextCustomerNo.Value := 1001;   //Start auto-assigned numbers here.
        tblCustomerCustomerNo.Value := tblCustCtlNextCustomerNo.AsString;
        tblCustCtlNextCustomerNo.Value := tblCustCtlNextCustomerNo.Value + 1;
        if tblCustCtlNextCustomerID.Value = 0 then tblCustCtlNextCustomerID.Value := 10000;   //Start at 10000 in case upgraded from v1.0 or 1.1 where autoincrement ID didn't use NextID on ctl table.
        tblCustomerCustomerID.Value := tblCustCtlNextCustomerID.value;
        tblCustCtlNextCustomerID.Value := tblCustCtlNextCustomerID.Value + 1;
        Post;
      except end;
      DbiSaveChanges(tblCustCtl.handle);
      Close;
      if tblCustomerCustomerNo.value <> '' then break;
      x := x+1;
    end;
  end;

  if frmBS1.tblCompanyDefaultCurrencyID.value > 0 then tblCustomerCurrencyID.value := frmBS1.tblCompanyDefaultCurrencyID.value;
  tblCustomerBilltoOnly.value := false;
  tblCustomerCOD.value := false;
  tblCustomerSuspended.value := false;
  tblCustomerPrintStatement.value := false;
  tblCustomerAllowBackorders.value := false;
end;

procedure TfrmCustomer.btnSalesmanClick(Sender: TObject);
var
  aComponent: TComponent;
begin
  screen.cursor := crHourglass;
  aComponent := Application.FindComponent('frmSalesmen');
  if not Assigned (aComponent) then frmSalesmen := TfrmSalesmen.Create(Application);
  if frmSalesmen.WindowState = wsMinimized then frmSalesmen.WindowState := wsNormal;
  if frmSalesmen.visible = true then frmSalesmen.FormShow(sender)
  else frmSalesmen.Show;
  if not frmSalesmen.tblSalesman.Locate('SalesmanID', tblCustomerSalesmanID.value, []) then frmSalesmen.tblSalesman.First;
  screen.cursor := crDefault;
end;

procedure TfrmCustomer.btnCustomerTypeClick(Sender: TObject);
var
  aComponent: TComponent;
begin
  screen.cursor := crHourglass;
  aComponent := Application.FindComponent('frmCusTypes');
  if not Assigned (aComponent) then frmCusTypes := TfrmCusTypes.Create(Application);
  if frmCusTypes.WindowState = wsMinimized then frmCusTypes.WindowState := wsNormal;
  if frmCusTypes.visible = true then frmCusTypes.FormShow(sender)
  else frmCusTypes.Show;
  if not frmCusTypes.tblCusType.Locate('CustomerTypeID', tblCustomerCustomerTypeID.value, []) then frmCusTypes.tblCusType.First;
  screen.cursor := crDefault;
end;

procedure TfrmCustomer.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 TfrmCustomer.cboBillToKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key = VK_Delete then begin
    tblCustomer.Edit;
    tblCustomerBillToNo.AsVariant := null;
  end;
end;

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

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

procedure TfrmCustomer.PageControl1Change(Sender: TObject);
begin
  //screen.cursor := crHourglass;
  case PageControl1.ActivePage.PageIndex of
    //1: begin tblBillTo.Active := true; tblCurrency.Active := true; end;   //Data Module used instead.
    1: begin tblBillTo.Active := true; end;
    2: begin dmLookUps.tblSalesman.Active := true; dmLookUps.tblCusType.Active := true; dmLookUps.tblTax.Active := true; end;
    3: tblCContact.Active := true;
  end;
  //screen.cursor := crDefault;
end;

procedure TfrmCustomer.tblCustomerBillToOnlyChange(Sender: TField);
begin
  if tblCustomerBillToOnly.value = true then begin
    tblCustomer.Edit;
    tblCustomerTax1ID.AsVariant := null;
    tblCustomerTax2ID.AsVariant := null;
    tblCustomerTax1ExemptionNo.AsVariant := null;
    tblCustomerTax2ExemptionNo.AsVariant := null;
    tblCustomerSalesmanID.AsVariant := null;
    tblCustomerCustomerTypeID.AsVariant := null;
    tblCustomerAllowBackorders.value := false;
  end;
end;

procedure TfrmCustomer.tblBillToFilterRecord(DataSet: TDataSet;
  var Accept: Boolean);
begin
  if tblBillToCustomerNo.value = tblCustomerCustomerNo.value then Accept := false
  else if tblBillToBillToNo.value <> '' then Accept := false
  else Accept := true;
end;

procedure TfrmCustomer.popPhoneClick(Sender: TObject);
begin
  with frmDialer do begin
    NameToDial := tblCContactFullName.value;
    NumberToDial := tblCContactBusinessPhone.value;
    ShowModal;
  end;
end;

procedure TfrmCustomer.tblCustomerCurrencyIDValidate(Sender: TField);
begin
  with qryARInv do begin
    close; open;
    if Fields[0].value > 0 then raise(exception.create('Currency cannot be changed... ' + #13 + 'Invoice(s) already exist'));
  end;
end;

procedure TfrmCustomer.tblCustomerBillToNoChange(Sender: TField);
begin
  if tblCustomerBillToNo.AsVariant <> null then begin
    tblCustomer.Edit;
    tblCustomerDiscPC.AsVariant := null;
    tblCustomerDiscDays.AsVariant := null;
    tblCustomerNetDays.AsVariant := null;
    tblCustomerCOD.value := false;
    tblCustomerCreditLimit.AsVariant := null;
    tblCustomerCurrencyID.AsVariant := null;
    tblCustomerMessage.clear;
    tblCustomerPrintStatement.value := false;
    tblCustomerBillToOnly.value := false;
  end; 
end;

procedure TfrmCustomer.tblCustomerBillToNoValidate(Sender: TField);
begin
  if editBillToNo.text <> '' then begin
    if editBillToNo.text = tblCustomerCustomerNo.value then raise(Exception.Create('Customer no. ' + '''' + editBillToNo.Text + '''' + ' is this customer...' + #13 + 'Leave blank if this customer is a bill-to'));
    tblBillTo.filtered := false;
    try
      if tblBillTo.Locate('CustomerNo', editBillToNo.Text, []) <> true then raise(Exception.Create('Customer no. ' + '''' + editBillToNo.Text + '''' + ' not found'));
      if tblBillToBillToNo.value <> '' then raise(Exception.Create('Customer ' + '''' + editBillToNo.Text + ': ' + tblBillToCustomerName.value + '''' + ' is not a bill-to'));
    finally tblBillTo.filtered := true; end;
  end;
end;

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

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

procedure TfrmCustomer.btnTax1Click(Sender: TObject);
var
  aComponent: TComponent;
begin
  screen.cursor := crHourglass;
  aComponent := Application.FindComponent('frmTaxes');
  if not Assigned (aComponent) then frmTaxes := TfrmTaxes.Create(Application);
  if frmTaxes.WindowState = wsMinimized then frmTaxes.WindowState := wsNormal;
  if frmTaxes.visible = true then frmTaxes.FormShow(sender)
  else frmTaxes.Show;
  if not frmTaxes.tblTax.Locate('TaxID', tblCustomerTax1ID.value, []) then frmTaxes.tblTax.First;
  screen.cursor := crDefault;
end;

procedure TfrmCustomer.btnTax2Click(Sender: TObject);
var
  aComponent: TComponent;
begin
  screen.cursor := crHourglass;
  aComponent := Application.FindComponent('frmTaxes');
  if not Assigned (aComponent) then frmTaxes := TfrmTaxes.Create(Application);
  if frmTaxes.WindowState = wsMinimized then frmTaxes.WindowState := wsNormal;
  if frmTaxes.visible = true then frmTaxes.FormShow(sender)
  else frmTaxes.Show;
  if not frmTaxes.tblTax.Locate('TaxID', tblCustomerTax2ID.value, []) then frmTaxes.tblTax.First;
  screen.cursor := crDefault;
end;

procedure TfrmCustomer.tblCustomerBeforePost(DataSet: TDataSet);
begin
  dmLookUps.tblCurrency.Active := true;
  if (tblCustomerBillToNo.value = '') and (dmLookUps.tblCurrency.Locate('CurrencyID', tblCustomerCurrencyID.value, []) <> true) then begin
    with cboCurrency do begin Show; SetFocus; end;
    raise(exception.create('Currency no longer exists'));   //Deleted by another user since this user selected.
  end;
end;

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

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

procedure TfrmCustomer.tblCustomerWebPageSetText(Sender: TField;
  const Text: string);
begin
  if Text = '' then tblCustomerWebPage.AsVariant := null else begin   //Remove leading "http://".
    if pos('http://', Text) >0 then tblCustomerWebPage.value := copy(Text,8,22)
    else tblCustomerWebPage.value := Text;
  end;
end;

procedure TfrmCustomer.dsCContactDataChange(Sender: TObject;
  Field: TField);
begin
  if tblCContactBusinessPhone.AsString = '' then popPhone.Enabled := False
  else popPhone.Enabled := True;
  if tblCContactEMail.AsString = '' then popEMail.Enabled := False
  else popEMail.Enabled := True;
end;

procedure TfrmCustomer.popEMailClick(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.