⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 salesmenform.pas

📁 功能全面的商业财会系统源码,清晰,很有参考价值.扩展性强.
💻 PAS
字号:
unit SalesmenForm;

interface

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

type
  TfrmSalesmen = class(TForm)
    Panel1: TPanel;
    MainMenu1: TMainMenu;
    tblSalesman: TTable;
    dsSalesman: TDataSource;
    DBGrid1: TDBGrid;
    mnuFile: TMenuItem;
    mnuView: TMenuItem;
    mnuHelp: TMenuItem;
    mnuRefresh: TMenuItem;
    mnuSalesmenHelp: TMenuItem;
    mnuPrint: TMenuItem;
    N2: TMenuItem;
    mnuExit: TMenuItem;
    Bevel1: TBevel;
    btnNew: TSpeedButton;
    btnEdit: TSpeedButton;
    btnDelete: TSpeedButton;
    mnuRecords: TMenuItem;
    mnuNew: TMenuItem;
    mnuEdit: TMenuItem;
    mnuDelete: TMenuItem;
    tblSalesmanSalesmanID: TAutoIncField;
    tblSalesmanLastName: TStringField;
    tblSalesmanFirstName: TStringField;
    tblSalesmanJobTitle: TStringField;
    tblSalesmanBusinessPhone: TStringField;
    tblSalesmanFullName: TStringField;
    PopupMenu1: TPopupMenu;
    popNew: TMenuItem;
    popEdit: TMenuItem;
    popDelete: TMenuItem;
    N1: TMenuItem;
    popPhone: TMenuItem;
    popEMail: TMenuItem;
    tblSalesmanEMail: TStringField;
    procedure mnuRefreshClick(Sender: TObject);
    procedure tblSalesmanBeforeDelete(DataSet: TDataSet);
    procedure FormCreate(Sender: TObject);
    procedure Panel1DblClick(Sender: TObject);
    procedure DBGrid1KeyPress(Sender: TObject; var Key: Char);
    procedure FormShow(Sender: TObject);
    procedure mnuNewClick(Sender: TObject);
    procedure mnuEditClick(Sender: TObject);
    procedure mnuDeleteClick(Sender: TObject);
    procedure mnuExitClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure tblSalesmanCalcFields(DataSet: TDataSet);
    procedure mnuPrintClick(Sender: TObject);
    procedure popPhoneClick(Sender: TObject);
    procedure mnuSalesmenHelpClick(Sender: TObject);
    procedure dsSalesmanDataChange(Sender: TObject; Field: TField);
    procedure popEMailClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmSalesmen: TfrmSalesmen;

implementation

uses BS1Form, SalesmanForm, SalesmenReport, DialerForm, LookUpsData;

var
  intClientHeight, intClientWidth: Integer;
  OldWindowState: TWindowState;

{$R *.DFM}

procedure TfrmSalesmen.mnuRefreshClick(Sender: TObject);
begin
  tblSalesman.refresh;
end;

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

  dmLookUps.tblCustomer.Active := true;
  if dmLookUps.tblCustomer.Locate('SalesmanID', tblSalesmanSalesmanID.value, []) = true then raise(Exception.Create('Unable to delete ' + '''' + tblSalesmanFullName.AsString + '''' + '...' + #13 + 'Customer(s) exist for this salesman'));
end;

procedure TfrmSalesmen.FormCreate(Sender: TObject);
var
  x: integer;
begin
  tblSalesman.DatabaseName := strDatabaseName;
  tblSalesman.Active := true;

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

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

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

procedure TfrmSalesmen.FormShow(Sender: TObject);
begin
  DBGrid1.setfocus;
  tblSalesman.First;   //Reset grid to start at 1st record.
end;

procedure TfrmSalesmen.mnuNewClick(Sender: TObject);
begin
  screen.cursor := crHourglass;
  application.createform (TfrmSalesman,frmSalesman);
  frmSalesman.tblSalesman.Insert;
  frmSalesman.Show;
  screen.cursor := crDefault;
end;

procedure TfrmSalesmen.mnuEditClick(Sender: TObject);
begin
  screen.cursor := crHourglass;
  application.createform (TfrmSalesman,frmSalesman);
  frmSalesman.tblSalesman.Locate('SalesmanID', tblSalesmanSalesmanID.value, []);
  frmSalesman.Show;
  screen.cursor := crDefault;
end;

procedure TfrmSalesmen.mnuDeleteClick(Sender: TObject);
begin
  tblSalesman.delete;
  DbiSaveChanges(tblSalesman.handle);
end;

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

procedure TfrmSalesmen.FormResize(Sender: TObject);
var
  Bookmark: TBookmark;
begin
  if (WindowState <> OldWindowState)   //Prevent grid resize bugs.
  and (WindowState <> wsMinimized)
  and (OldWindowState <> wsMinimized)
  then begin
    screen.cursor := crHourglass;
    Bookmark := tblSalesman.GetBookmark;
    tblSalesman.First;
    tblSalesman.refresh;
    try tblSalesman.GotoBookmark(Bookmark); except; end;
    tblSalesman.FreeBookmark(BookMark);
    screen.cursor := crDefault;
  end;
  OldWindowState := WindowState;
end;

procedure TfrmSalesmen.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 TfrmSalesmen.mnuPrintClick(Sender: TObject);
begin
  screen.cursor := crHourglass;
  application.createform (TrptSalesmen,rptSalesmen);
  screen.cursor := crDefault;
  rptSalesmen.QuickReport.Preview;
end;

procedure TfrmSalesmen.popPhoneClick(Sender: TObject);
begin
  with frmDialer do begin
    NameToDial := tblSalesmanFullName.value;
    NumberToDial := tblSalesmanBusinessPhone.value;
    ShowModal;
  end;
end;

procedure TfrmSalesmen.mnuSalesmenHelpClick(Sender: TObject);
begin
  Application.HelpContext(240);
end;

procedure TfrmSalesmen.dsSalesmanDataChange(Sender: TObject;
  Field: TField);
begin
  if tblSalesmanBusinessPhone.AsString = '' then popPhone.Enabled := False
  else popPhone.Enabled := True;
  if tblSalesmanEMail.AsString = '' then popEMail.Enabled := False
  else popEMail.Enabled := True;
end;

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

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -