vendorsform.pas

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

end;

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

procedure TfrmVendors.mnuNewClick(Sender: TObject);
begin
  screen.cursor := crHourglass;
  application.createform (TfrmVendor,frmVendor);
  frmVendor.tblVendor.Insert;
  frmVendor.Show;
  screen.cursor := crDefault;
end;

procedure TfrmVendors.mnuEditClick(Sender: TObject);
begin
  if qryVendorVendorID.AsVariant = null then mnuNewClick(sender)   //Can happen if no records yet.
  else begin
    screen.cursor := crHourglass;
    application.createform (TfrmVendor,frmVendor);
    frmVendor.tblVendor.Locate('VendorID', qryVendorVendorID.value, []);
    frmVendor.Show;
    screen.cursor := crDefault;
  end;
end;

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

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

procedure TfrmVendors.mnuSortVendorNoClick(Sender: TObject);
begin
  screen.cursor := crHourglass;
  mnuSortVendorNo.checked := true;
  qryVendor.close;
  qryVendor.sql.clear;
  qryVendor.sql.add('SELECT V.*, B.Balance FROM Vendor V LEFT OUTER JOIN VBalance B ON V.VendorID = B.VendorID');
  qryVendor.sql.add('ORDER BY V.VendorNo');
  qryVendor.open;
  screen.cursor := crDefault;
end;

procedure TfrmVendors.mnuSortNameClick(Sender: TObject);
begin
  screen.cursor := crHourglass;
  mnuSortName.checked := true;
  qryVendor.close;
  qryVendor.sql.clear;
  qryVendor.sql.add('SELECT V.*, B.Balance FROM Vendor V LEFT OUTER JOIN VBalance B ON V.VendorID = B.VendorID');
  qryVendor.sql.add('ORDER BY V.VendorName');
  qryVendor.open;
  screen.cursor := crDefault;
end;

procedure TfrmVendors.mnuSortPhoneClick(Sender: TObject);
begin
  screen.cursor := crHourglass;
  mnuSortPhone.checked := true;
  qryVendor.close;
  qryVendor.sql.clear;
  qryVendor.sql.add('SELECT V.*, B.Balance FROM Vendor V LEFT OUTER JOIN VBalance B ON V.VendorID = B.VendorID');
  qryVendor.sql.add('ORDER BY V.Phone');
  qryVendor.open;
  screen.cursor := crDefault;
end;

procedure TfrmVendors.mnuSortContactClick(Sender: TObject);
begin
  screen.cursor := crHourglass;
  mnuSortContact.checked := true;
  qryVendor.close;
  qryVendor.sql.clear;
  qryVendor.sql.add('SELECT V.*, B.Balance FROM Vendor V LEFT OUTER JOIN VBalance B ON V.VendorID = B.VendorID');
  qryVendor.sql.add('ORDER BY V.Contact');
  qryVendor.open;
  screen.cursor := crDefault;
end;

procedure TfrmVendors.mnuSortBalanceClick(Sender: TObject);
begin
  screen.cursor := crHourglass;
  mnuSortBalance.checked := true;
  qryVendor.close;
  qryVendor.sql.clear;
  qryVendor.sql.add('SELECT V.*, B.Balance FROM Vendor V LEFT OUTER JOIN VBalance B ON V.VendorID = B.VendorID');
  qryVendor.sql.add('ORDER BY B.Balance DESC');
  qryVendor.open;
  screen.cursor := crDefault;
end;

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

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

procedure TfrmVendors.qryVendorFilterRecord(DataSet: TDataSet;
  var Accept: Boolean);
begin
  Accept := true;   //Default.
  try  //Try in case filter form not loaded.
    if (frmVendorsFilter.optSuspendedYes.checked = true) and (qryVendorSuspended.value <> true) then Accept := false
    else if (frmVendorsFilter.optSuspendedNo.checked = true) and (qryVendorSuspended.value <> false) then Accept := false;
    if (frmVendorsFilter.CurrencyID > 0) and (qryVendorCurrencyID.value <> frmVendorsFilter.CurrencyID) then Accept := false;
  except; end;
end;

procedure TfrmVendors.tblVendorFilterRecord(DataSet: TDataSet;
  var Accept: Boolean);
begin
  Accept := true;   //Default.
  try  //Try in case filter form not loaded.
    if (frmVendorsFilter.optSuspendedYes.checked = true) and (tblVendorSuspended.value <> true) then Accept := false
    else if (frmVendorsFilter.optSuspendedNo.checked = true) and (tblVendorSuspended.value <> false) then Accept := false;
    if (frmVendorsFilter.CurrencyID > 0) and (tblVendorCurrencyID.value <> frmVendorsFilter.CurrencyID) then Accept := false;
  except; end;
end;

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

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

  aComponent := Application.FindComponent('frmAPInvoicesFilter');
  if Assigned (aComponent) then try frmAPInvoicesFilter.btnResetClick(sender); except; end
  else begin
    frmAPInvoicesFilter := TfrmAPInvoicesFilter.Create(Application);
    frmAPInvoicesFilter.FormShow(sender);   //Set up cboVendorIDs so SetVendorID will work.
  end;
  frmAPInvoicesFilter.VendorID := qryVendorVendorID.value;
  frmAPInvoices.mnuFilter.Checked := true;
  frmAPInvoices.qryAPInv.Filtered := true;
  frmAPInvoices.qryAPInv.close; frmAPInvoices.qryAPInv.open;

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

procedure TfrmVendors.mnuChequesClick(Sender: TObject);
var
  aComponent: TComponent;
begin
  screen.cursor := crHourglass;
  aComponent := Application.FindComponent('frmAPCheques');
  if not Assigned (aComponent) then frmAPCheques := TfrmAPCheques.Create(Application);
  
  aComponent := Application.FindComponent('frmAPChequesFilter');
  if Assigned (aComponent) then try frmAPChequesFilter.btnResetClick(sender); except; end
  else begin
    frmAPChequesFilter := TfrmAPChequesFilter.Create(Application);
    frmAPChequesFilter.FormShow(sender);   //Set up cboVendorIDs so SetVendorID will work.
  end;
  frmAPChequesFilter.VendorID := qryVendorVendorID.value;
  frmAPCheques.mnuFilter.Checked := true;
  frmAPCheques.qryAPCheq.Filtered := true;
  frmAPCheques.qryAPCheq.close; frmAPCheques.qryAPCheq.open;

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

procedure TfrmVendors.popPhoneClick(Sender: TObject);
begin
  with frmDialer do begin
    NameToDial := qryVendorVendorName.value;
    NumberToDial := qryVendorPhone.value;
    ShowModal;
  end;  
end;

procedure TfrmVendors.mnuVendorsHelpClick(Sender: TObject);
begin
  Application.HelpContext(110);
end;

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

end.