Marco Cantù 1998, Mastering Delphi 4
Project: TOTAL.DPR
Project Structure
TOTAL.DPR
program Total;
uses
Forms,
TotalF in 'TotalF.pas' {SearchForm};
{$R *.RES}
begin
Application.CreateForm(TSearchForm, SearchForm);
Application.Run;
end.
TOTALF.PAS
unit TotalF;
interface
uses
SysUtils, Windows, Messages, Classes, Graphics, Controls,
StdCtrls, Forms, DBCtrls, DB, Buttons, DBTables, Mask, ExtCtrls,
Dialogs, Spin, DBActns, ActnList;
type
TSearchForm = class(TForm)
ScrollBox: TScrollBox;
Label1: TLabel;
EditEmpNo: TDBEdit;
Label2: TLabel;
EditLastName: TDBEdit;
Label3: TLabel;
EditFirstName: TDBEdit;
Label4: TLabel;
EditPhoneExt: TDBEdit;
Label5: TLabel;
EditHireDate: TDBEdit;
Label6: TLabel;
EditSalary: TDBEdit;
Panel1: TPanel;
DataSource1: TDataSource;
Panel2: TPanel;
Table1: TTable;
SpeedButtonFirst: TSpeedButton;
SpeedButtonPrior: TSpeedButton;
SpeedButtonNext: TSpeedButton;
SpeedButtonLast: TSpeedButton;
EditName: TEdit;
SpeedButtonGoto: TSpeedButton;
SpeedButtonGoNear: TSpeedButton;
Table1EmpNo: TIntegerField;
Table1LastName: TStringField;
Table1FirstName: TStringField;
Table1PhoneExt: TStringField;
Table1HireDate: TDateTimeField;
SpinEdit1: TSpinEdit;
SpeedButtonIncrease: TSpeedButton;
SpeedButtonTotal: TSpeedButton;
Table1Salary: TCurrencyField;
ActionList1: TActionList;
First1: TDataSetFirst;
Last1: TDataSetLast;
Next1: TDataSetNext;
Prior1: TDataSetPrior;
procedure FormCreate(Sender: TObject);
procedure SpeedButtonGotoClick(Sender: TObject);
procedure SpeedButtonGoNearClick(Sender: TObject);
procedure SpeedButtonIncreaseClick(Sender: TObject);
procedure SpeedButtonTotalClick(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
SearchForm: TSearchForm;
implementation
{$R *.DFM}
procedure TSearchForm.FormCreate(Sender: TObject);
begin
Table1.IndexFieldNames := 'LastName';
Table1.First;
end;
procedure TSearchForm.SpeedButtonGotoClick(Sender: TObject);
begin
// short-hand
if not Table1.FindKey ([EditName.Text]) then
MessageDlg ('Name not found', mtError, [mbOk], 0);
// alternative code:
{Table1.SetKey;
Table1.FieldByName('LastName').AsString := EditName.Text;
Table1.KeyFieldCount := 1;
if not Table1.GotoKey then
MessageDlg ('Name not found', mtError, [mbOk], 0);}
end;
procedure TSearchForm.SpeedButtonGoNearClick(Sender: TObject);
begin
// short-hand
Table1.FindNearest ([EditName.Text]);
// alternative code:
{Table1.SetKey;
Table1.FieldByName('LastName').AsString := EditName.Text;
Table1.GotoNearest;}
end;
procedure TSearchForm.SpeedButtonIncreaseClick(Sender: TObject);
var
Bookmark: TBookmark;
Total: Real;
begin
{store the current position, crating a new bookmark}
Bookmark := Table1.GetBookmark;
Table1.DisableControls;
Total := 0;
{start edit mode}
try
Table1.First;
while not Table1.EOF do
begin
Table1.Edit;
Table1Salary.Value := Round (Table1Salary.Value *
SpinEdit1.Value) / 100;
Total := Total + Table1Salary.Value;
Table1.Next;
end;
finally
{go back to the bookmark and destroy it}
Table1.GotoBookmark (Bookmark);
Table1.FreeBookmark (Bookmark);
Table1.EnableControls;
end;
MessageDlg ('Sum of new salaries is ' +
Format ('%m', [Total]), mtInformation, [mbOk], 0);
end;
procedure TSearchForm.SpeedButtonTotalClick(Sender: TObject);
var
Bookmark: TBookmark;
Total: Real;
begin
{store the current position, crating a new bookmark}
Bookmark := Table1.GetBookmark;
Table1.DisableControls;
Total := 0;
try
Table1.First;
while not Table1.EOF do
begin
Total := Total + Table1Salary.Value;
Table1.Next;
end;
finally
{go back to the bookmark and destroy it}
Table1.GotoBookmark (Bookmark);
Table1.FreeBookmark (Bookmark);
Table1.EnableControls;
end;
MessageDlg ('Sum of new salaries is ' +
Format ('%m', [Total]), mtInformation, [mbOk], 0);
end;
end.
TOTALF.DFM
object SearchForm: TSearchForm
Left = 224
Top = 187
Width = 491
Height = 187
ActiveControl = Panel1
Caption = 'Table Search'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = True
Position = poScreenCenter
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Panel1: TPanel
Left = 0
Top = 0
Width = 483
Height = 41
Align = alTop
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Height = -13
Font.Name = 'Arial'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 0
object SpeedButtonFirst: TSpeedButton
Left = 8
Top = 8
Width = 40
Height = 25
Action = First1
end
object SpeedButtonGoto: TSpeedButton
Left = 304
Top = 8
Width = 25
Height = 25
Caption = '->'
OnClick = SpeedButtonGotoClick
end
object SpeedButtonGoNear: TSpeedButton
Left = 328
Top = 8
Width = 25
Height = 25
Caption = '~>'
OnClick = SpeedButtonGoNearClick
end
object SpeedButtonIncrease: TSpeedButton
Left = 368
Top = 8
Width = 25
Height = 25
Caption = '%'
OnClick = SpeedButtonIncreaseClick
end
object SpeedButtonTotal: TSpeedButton
Left = 448
Top = 8
Width = 25
Height = 25
Caption = '$$'
OnClick = SpeedButtonTotalClick
end
object SpeedButtonPrior: TSpeedButton
Left = 48
Top = 8
Width = 40
Height = 25
Action = Prior1
end
object SpeedButtonNext: TSpeedButton
Left = 88
Top = 8
Width = 40
Height = 25
Action = Next1
end
object SpeedButtonLast: TSpeedButton
Left = 128
Top = 8
Width = 40
Height = 25
Action = Last1
end
object EditName: TEdit
Left = 183
Top = 11
Width = 122
Height = 21
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 0
Text = 'Williams'
end
object SpinEdit1: TSpinEdit
Left = 392
Top = 10
Width = 49
Height = 22
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Increment = 5
MaxValue = 200
MinValue = 50
ParentFont = False
TabOrder = 1
Value = 105
end
end
object Panel2: TPanel
Left = 0
Top = 41
Width = 483
Height = 119
Align = alClient
BevelInner = bvLowered
BorderWidth = 4
Caption = 'Panel2'
TabOrder = 1
object ScrollBox: TScrollBox
Left = 6
Top = 6
Width = 471
Height = 107
HorzScrollBar.Margin = 6
VertScrollBar.Margin = 6
Align = alClient
BorderStyle = bsNone
TabOrder = 0
object Label1: TLabel
Left = 230
Top = 17
Width = 60
Height = 13
Alignment = taRightJustify
AutoSize = False
Caption = '&Emp No'
FocusControl = EditEmpNo
end
object Label2: TLabel
Left = 14
Top = 15
Width = 60
Height = 13
Alignment = taRightJustify
AutoSize = False
Caption = '&Last Name'
FocusControl = EditLastName
end
object Label3: TLabel
Left = 14
Top = 36
Width = 60
Height = 13
Alignment = taRightJustify
AutoSize = False
Caption = '&First Name'
FocusControl = EditFirstName
end
object Label4: TLabel
Left = 14
Top = 58
Width = 60
Height = 13
Alignment = taRightJustify
AutoSize = False
Caption = '&Phone Ext'
FocusControl = EditPhoneExt
end
object Label5: TLabel
Left = 230
Top = 39
Width = 60
Height = 13
Alignment = taRightJustify
AutoSize = False
Caption = '&Hire Date'
FocusControl = EditHireDate
end
object Label6: TLabel
Left = 14
Top = 79
Width = 60
Height = 13
Alignment = taRightJustify
AutoSize = False
Caption = '&Salary'
FocusControl = EditSalary
end
object EditEmpNo: TDBEdit
Left = 296
Top = 14
Width = 57
Height = 21
DataField = 'EmpNo'
DataSource = DataSource1
TabOrder = 0
end
object EditLastName: TDBEdit
Left = 80
Top = 12
Width = 97
Height = 21
DataField = 'LastName'
DataSource = DataSource1
TabOrder = 1
end
object EditFirstName: TDBEdit
Left = 80
Top = 33
Width = 97
Height = 21
DataField = 'FirstName'
DataSource = DataSource1
TabOrder = 2
end
object EditPhoneExt: TDBEdit
Left = 80
Top = 55
Width = 97
Height = 21
DataField = 'PhoneExt'
DataSource = DataSource1
TabOrder = 3
end
object EditHireDate: TDBEdit
Left = 296
Top = 36
Width = 57
Height = 21
DataField = 'HireDate'
DataSource = DataSource1
TabOrder = 4
end
object EditSalary: TDBEdit
Left = 80
Top = 76
Width = 97
Height = 21
DataField = 'Salary'
DataSource = DataSource1
TabOrder = 5
end
end
end
object DataSource1: TDataSource
DataSet = Table1
Left = 263
Top = 109
end
object Table1: TTable
Active = True
DatabaseName = 'DBDEMOS'
TableName = 'employee.db'
Left = 316
Top = 109
object Table1EmpNo: TIntegerField
FieldName = 'EmpNo'
end
object Table1LastName: TStringField
FieldName = 'LastName'
end
object Table1FirstName: TStringField
FieldName = 'FirstName'
Size = 15
end
object Table1PhoneExt: TStringField
FieldName = 'PhoneExt'
Size = 4
end
object Table1HireDate: TDateTimeField
FieldName = 'HireDate'
end
object Table1Salary: TCurrencyField
FieldName = 'Salary'
end
end
object ActionList1: TActionList
Left = 366
Top = 111
object First1: TDataSetFirst
Category = 'Dataset'
Caption = '&First'
Hint = 'First'
ImageIndex = 0
DataSource = DataSource1
end
object Last1: TDataSetLast
Category = 'Dataset'
Caption = '&Last'
Hint = 'Last'
ImageIndex = 3
DataSource = DataSource1
end
object Next1: TDataSetNext
Category = 'Dataset'
Caption = '&Next'
Hint = 'Next'
ImageIndex = 2
DataSource = DataSource1
end
object Prior1: TDataSetPrior
Category = 'Dataset'
Caption = '&Prior'
Hint = 'Prior'
ImageIndex = 1
DataSource = DataSource1
end
end
end
Copyright Marco Cantù 1998