customersform.pas

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

  if mnuFilter.checked = true then caption := 'Customers (Filtered)'
  else                             caption := 'Customers';
end;

procedure TfrmCustomers.editFindKeyPress(Sender: TObject; var Key: Char);
begin
  if key = #13 then begin
    Key := #0;   //Cancel Enter key.
    if (editFind.Text = '') or (editFind.Text = '<Cust. no.>') then begin
      Perform(WM_NEXTDLGCTL, 0, 0);   //Advance to next control.
      exit;
    end;
    cboFind.text := '';
    if qryCustomer.Locate('CustomerNo', editFind.Text, []) <> true then begin
      editFind.SelectAll;
      raise(Exception.Create('Customer no. ' + '''' + editFind.Text + '''' + ' not found'));
    end else DBGrid1.setfocus;
  end;
end;

procedure TfrmCustomers.mnuNewClick(Sender: TObject);
begin
  screen.cursor := crHourglass;
  application.createform (TfrmCustomer,frmCustomer);
  frmCustomer.tblCustomer.Insert;
  frmCustomer.Show;
  screen.cursor := crDefault;
end;

procedure TfrmCustomers.mnuEditClick(Sender: TObject);
begin
  if qryCustomerCustomerID.AsVariant = null then mnuNewClick(sender)   //Can happen if no records yet.  
  else begin
    screen.cursor := crHourglass;
    application.createform (TfrmCustomer,frmCustomer);
    frmCustomer.tblCustomer.Locate('CustomerID', qryCustomerCustomerID.value, []);
    frmCustomer.Show;
    screen.cursor := crDefault;
  end;
end;

procedure TfrmCustomers.mnuDeleteClick(Sender: TObject);
var
  Bookmark: TBookmark;
begin
  if tblCustomer.Locate('CustomerID', qryCustomerCustomerID.value, []) = true then begin
    tblCustomer.delete;   //Delete from table as query is read-only.
    DbiSaveChanges(tblCBalance.handle);
    DbiSaveChanges(tblCContact.handle);
    DbiSaveChanges(tblCustomer.handle);
  end;
  Bookmark := qryCustomer.GetBookmark;
  with qryCustomer do begin close; open; end;   //Refresh.
  try qryCustomer.GotoBookmark(Bookmark); except; end;
  qryCustomer.FreeBookmark(BookMark);
  if qryCustomerCustomerID.AsVariant = null then qryCustomer.first;   //If deleting last record, prevent blank record with focus after last record (move to 1st record as per other grids).
end;

procedure TfrmCustomers.mnuExitClick(Sender: TObject);
begin
  Close;
end;

procedure TfrmCustomers.mnuSortCustomerNoClick(Sender: TObject);
begin
  screen.cursor := crHourglass;
  mnuSortCustomerNo.checked := true;
  qryCustomer.close;
  qryCustomer.sql.clear;
  qryCustomer.sql.add('SELECT C.*, B.Balance FROM Customer C LEFT OUTER JOIN CBalance B ON C.CustomerID = B.CustomerID');
  qryCustomer.sql.add('ORDER BY C.CustomerNo');
  qryCustomer.open;
  screen.cursor := crDefault;
end;

procedure TfrmCustomers.mnuSortNameClick(Sender: TObject);
begin
  screen.cursor := crHourglass;
  mnuSortName.checked := true;
  qryCustomer.close;
  qryCustomer.sql.clear;
  qryCustomer.sql.add('SELECT C.*, B.Balance FROM Customer C LEFT OUTER JOIN CBalance B ON C.CustomerID = B.CustomerID');
  qryCustomer.sql.add('ORDER BY C.CustomerName');
  qryCustomer.open;
  screen.cursor := crDefault;
end;

procedure TfrmCustomers.mnuSortPhoneClick(Sender: TObject);
begin
  screen.cursor := crHourglass;
  mnuSortPhone.checked := true;
  qryCustomer.close;
  qryCustomer.sql.clear;
  qryCustomer.sql.add('SELECT C.*, B.Balance FROM Customer C LEFT OUTER JOIN CBalance B ON C.CustomerID = B.CustomerID');
  qryCustomer.sql.add('ORDER BY C.Phone');
  qryCustomer.open;
  screen.cursor := crDefault;
end;

procedure TfrmCustomers.mnuSortContactClick(Sender: TObject);
begin
  screen.cursor := crHourglass;
  mnuSortContact.checked := true;
  qryCustomer.close;
  qryCustomer.sql.clear;
  qryCustomer.sql.add('SELECT C.*, B.Balance FROM Customer C LEFT OUTER JOIN CBalance B ON C.CustomerID = B.CustomerID');
  qryCustomer.sql.add('ORDER BY C.Contact');
  qryCustomer.open;
  screen.cursor := crDefault;
end;

procedure TfrmCustomers.mnuSortBalanceClick(Sender: TObject);
begin
  screen.cursor := crHourglass;
  mnuSortBalance.checked := true;
  qryCustomer.close;
  qryCustomer.sql.clear;
  qryCustomer.sql.add('SELECT C.*, B.Balance FROM Customer C LEFT OUTER JOIN CBalance B ON C.CustomerID = B.CustomerID');
  qryCustomer.sql.add('ORDER BY B.Balance DESC');
  qryCustomer.open;
  screen.cursor := crDefault;
end;

procedure TfrmCustomers.FormResize(Sender: TObject);
begin
  if (WindowState <> OldWindowState)   //Prevent grid resize bugs.
  and (WindowState <> wsMinimized)
  and (OldWindowState <> wsMinimized)
  then mnuRefreshClick(sender);
  OldWindowState := WindowState;
end;

procedure TfrmCustomers.mnuFilterClick(Sender: TObject);
var
  aComponent: TComponent;
begin
  aComponent := Application.FindComponent('frmCustomersFilter');
  if not Assigned (aComponent) then frmCustomersFilter := TfrmCustomersFilter.Create(Application);
  frmCustomersFilter.ShowModal;
end;

procedure TfrmCustomers.qryCustomerFilterRecord(DataSet: TDataSet;
  var Accept: Boolean);
begin
  Accept := true;   //Default.
  try  //Try in case filter form not loaded.
    if (frmCustomersFilter.optSuspendedYes.checked = true) and (qryCustomerSuspended.value <> true) then Accept := false
    else if (frmCustomersFilter.optSuspendedNo.checked = true) and (qryCustomerSuspended.value <> false) then Accept := false;
    if (frmCustomersFilter.CurrencyID > 0) and (qryCustomerCurrencyID.value <> frmCustomersFilter.CurrencyID) then Accept := false;
  except; end;
end;

procedure TfrmCustomers.tblCustomerFilterRecord(DataSet: TDataSet;
  var Accept: Boolean);
begin
  Accept := true;   //Default.
  try  //Try in case filter form not loaded.
    if (frmCustomersFilter.optSuspendedYes.checked = true) and (tblCustomerSuspended.value <> true) then Accept := false
    else if (frmCustomersFilter.optSuspendedNo.checked = true) and (tblCustomerSuspended.value <> false) then Accept := false;
    if (frmCustomersFilter.CurrencyID > 0) and (tblCustomerCurrencyID.value <> frmCustomersFilter.CurrencyID) then Accept := false;
  except; end;
end;

procedure TfrmCustomers.mnuPrintClick(Sender: TObject);
var
  strWHERE: string;
begin
  screen.cursor := crHourglass;
  application.createform (TrptCustomers,rptCustomers);
  rptCustomers.qryCustomer.SQL := frmCustomers.qryCustomer.SQL;
  if mnuFilter.checked = true then begin
    strWHERE := ' WHERE (1 = 1)';
    try  //Try in case filter form not loaded.
      if (frmCustomersFilter.optSuspendedYes.checked = true) then strWHERE := strWHERE + ' AND (Suspended = true)'
      else if (frmCustomersFilter.optSuspendedNo.checked = true) then strWHERE := strWHERE + ' AND (Suspended = false)';
      if (frmCustomersFilter.CurrencyID > 0) then strWHERE := strWHERE + ' AND (CurrencyID = ' + IntToStr(frmCustomersFilter.CurrencyID) + ')';
    except; end;
    rptCustomers.qryCustomer.SQL[0] := rptCustomers.qryCustomer.SQL[0] + strWHERE;
  end;
  rptCustomers.qryCustomer.Active := true;
  screen.cursor := crDefault;
  rptCustomers.QuickReport.Preview;
end;

procedure TfrmCustomers.mnuInvoicesClick(Sender: TObject);
var
  aComponent: TComponent;
begin
  screen.cursor := crHourglass;
  aComponent := Application.FindComponent('frmARInvoices');
  if not Assigned (aComponent) then frmARInvoices := TfrmARInvoices.Create(Application);

  aComponent := Application.FindComponent('frmARInvoicesFilter');
  if Assigned (aComponent) then try frmARInvoicesFilter.btnResetClick(sender); except; end
  else begin
    frmARInvoicesFilter := TfrmARInvoicesFilter.Create(Application);
    frmARInvoicesFilter.FormShow(sender);   //Set up cboCustomerIDs so SetCustomerID will work.
  end;
  frmARInvoicesFilter.CustomerID := qryCustomerCustomerID.value;
  frmARInvoices.mnuFilter.Checked := true;
  frmARInvoices.qryARInv.Filtered := true;
  frmARInvoices.qryARInv.close; frmARInvoices.qryARInv.open;

  if frmARInvoices.WindowState = wsMinimized then frmARInvoices.WindowState := wsNormal;
  if frmARInvoices.visible = true then frmARInvoices.FormShow(sender)
  else frmARInvoices.Show;
  screen.cursor := crDefault;
end;

procedure TfrmCustomers.mnuPaymentsClick(Sender: TObject);
var
  aComponent: TComponent;
begin
  screen.cursor := crHourglass;
  aComponent := Application.FindComponent('frmARPayments');
  if not Assigned (aComponent) then frmARPayments := TfrmARPayments.Create(Application);

  aComponent := Application.FindComponent('frmARPaymentsFilter');
  if Assigned (aComponent) then try frmARPaymentsFilter.btnResetClick(sender); except; end
  else begin
    frmARPaymentsFilter := TfrmARPaymentsFilter.Create(Application);
    frmARPaymentsFilter.FormShow(sender);   //Set up cboCustomerIDs so SetCustomerID will work.
  end;
  frmARPaymentsFilter.CustomerID := qryCustomerCustomerID.value;
  frmARPayments.mnuFilter.Checked := true;
  frmARPayments.qryARPmt.Filtered := true;
  frmARPayments.qryARPmt.close; frmARPayments.qryARPmt.open;

  if frmARPayments.WindowState = wsMinimized then frmARPayments.WindowState := wsNormal;
  if frmARPayments.visible = true then frmARPayments.FormShow(sender)
  else frmARPayments.Show;
  screen.cursor := crDefault;
end;

procedure TfrmCustomers.popPhoneClick(Sender: TObject);
begin
  with frmDialer do begin
    NameToDial := qryCustomerCustomerName.value;
    NumberToDial := qryCustomerPhone.value;
    ShowModal;
  end;
end;

procedure TfrmCustomers.mnuCustomersHelpClick(Sender: TObject);
begin
  Application.HelpContext(210);
end;

procedure TfrmCustomers.popEMailClick(Sender: TObject);
var
  zFileName, zParams, zDir: array[0..79] of Char;
begin
  ShellExecute(Application.MainForm.Handle, nil,
  StrPCopy(zFileName, 'mailto:' + qryCustomerEMail.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 TfrmCustomers.dsCustomerDataChange(Sender: TObject;
  Field: TField);
begin
  if qryCustomerPhone.AsString = '' then popPhone.Enabled := False
  else popPhone.Enabled := True;
  if qryCustomerEMail.AsString = '' then popEMail.Enabled := False
  else popEMail.Enabled := True;
end;

end.