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