开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
TotalF.pas
资源名称：delphi.rar　[点击查看]
上传用户：fh681027
上传日期：2022-07-23
资源大小：1959k
文件大小：4k
源码类别：

Delphi控件源码

开发平台：

Delphi

TotalF.pas：源码内容
  1. unit TotalF;
  3. interface
  5. uses
  6.   SysUtils, Windows, Messages, Classes, Graphics, Controls,
  7.   StdCtrls, Forms, DBCtrls, DB, Buttons, DBTables, Mask, ExtCtrls,
  8.   Dialogs, Spin, DBActns, ActnList, ImgList, ComCtrls, ToolWin;
  10. type
  11.   TSearchForm = class(TForm)
  12.     DataSource1: TDataSource;
  13.     Table1: TTable;
  14.     Table1EmpNo: TIntegerField;
  15.     Table1LastName: TStringField;
  16.     Table1FirstName: TStringField;
  17.     Table1PhoneExt: TStringField;
  18.     Table1HireDate: TDateTimeField;
  19.     Table1Salary: TCurrencyField;
  20.     ScrollBox: TScrollBox;
  21.     Label1: TLabel;
  22.     Label2: TLabel;
  23.     Label3: TLabel;
  24.     Label4: TLabel;
  25.     Label5: TLabel;
  26.     Label6: TLabel;
  27.     EditEmpNo: TDBEdit;
  28.     EditLastName: TDBEdit;
  29.     EditFirstName: TDBEdit;
  30.     EditPhoneExt: TDBEdit;
  31.     EditHireDate: TDBEdit;
  32.     EditSalary: TDBEdit;
  33.     ToolBar1: TToolBar;
  34.     ToolButton1: TToolButton;
  35.     ToolButton2: TToolButton;
  36.     ToolButton3: TToolButton;
  37.     ToolButton4: TToolButton;
  38.     ToolButton5: TToolButton;
  39.     EditName: TEdit;
  40.     ToolButton7: TToolButton;
  41.     ActionList: TActionList;
  42.     DataSetFirst1: TDataSetFirst;
  43.     DataSetLast1: TDataSetLast;
  44.     DataSetNext1: TDataSetNext;
  45.     DataSetPrior1: TDataSetPrior;
  46.     ActionGoto: TAction;
  47.     ImageList: TImageList;
  48.     ToolButton8: TToolButton;
  49.     SpinEdit1: TSpinEdit;
  50.     ToolButton9: TToolButton;
  51.     ToolButton10: TToolButton;
  52.     ActionTotal: TAction;
  53.     ActionIncrease: TAction;
  54.     procedure FormCreate(Sender: TObject);
  55.     procedure ActionIncreaseExecute(Sender: TObject);
  56.     procedure ActionTotalExecute(Sender: TObject);
  57.     procedure ActionGotoExecute(Sender: TObject);
  58.     procedure ActionGotoUpdate(Sender: TObject);
  59.   private
  60.     { private declarations }
  61.   public
  62.     { public declarations }
  63.   end;
  65. var
  66.   SearchForm: TSearchForm;
  68. implementation
  70. {$R *.DFM}
  72. procedure TSearchForm.FormCreate(Sender: TObject);
  73. begin
  74.   Table1.IndexFieldNames := 'LastName';
  75.   Table1.First;
  76. end;
  78. procedure TSearchForm.ActionIncreaseExecute(Sender: TObject);
  79. var
  80.   Bookmark: TBookmarkStr;
  81.   Total: Real;
  82. begin
  83.   // store the current position in a bookmark
  84.   Bookmark := Table1.Bookmark;
  85.   Table1.DisableControls;
  86.   Total := 0;
  87.   try
  88.     Table1.First;
  89.     while not Table1.EOF do
  90.     begin
  91.       // start edit mode
  92.       Table1.Edit;
  93.       Table1Salary.Value := Round (Table1Salary.Value *
  94.         SpinEdit1.Value) / 100;
  95.       Total := Total + Table1Salary.Value;
  96.       Table1.Next;
  97.     end;
  98.   finally
  99.     // go back to the bookmark
  100.     Table1.Bookmark := Bookmark;
  101.     Table1.EnableControls;
  102.   end;
  103.   MessageDlg ('Sum of new salaries is ' +
  104.     Format ('%m', [Total]), mtInformation, [mbOk], 0);
  105. end;
  107. procedure TSearchForm.ActionTotalExecute(Sender: TObject);
  108. var
  109.   Bookmark: TBookmarkStr;
  110.   Total: Real;
  111. begin
  112.   // store the current position in a bookmark
  113.   Bookmark := Table1.Bookmark;
  114.   Table1.DisableControls;
  115.   Total := 0;
  116.   try
  117.     Table1.First;
  118.     while not Table1.EOF do
  119.     begin
  120.       Total := Total + Table1Salary.Value;
  121.       Table1.Next;
  122.     end;
  123.   finally
  124.     // go back to the bookmark
  125.     Table1.Bookmark := Bookmark;
  126.     Table1.EnableControls;
  127.   end;
  128.   MessageDlg ('Sum of new salaries is ' +
  129.     Format ('%m', [Total]), mtInformation, [mbOk], 0);
  130. end;
  132. procedure TSearchForm.ActionGotoExecute(Sender: TObject);
  133. begin
  134.   if not Table1.Locate ('LastName', EditName.Text, []) then
  135.     MessageDlg ('Name not found', mtError, [mbOk], 0);
  136. end;
  138. procedure TSearchForm.ActionGotoUpdate(Sender: TObject);
  139. begin
  140.   ActionGoto.Enabled := EditName.Text <> '';
  141. end;
  143. end.