Marco's Web Center

Menu for Development

Site Menu
Object Pascal Handbook
Delphi Handbooks Collection
Mastering Borland Delphi 2005
(Old) White Papers
(Old)Tools
(Old) Conferences

My Other Sites
Italian Site (www.marcocantu.it)
the delphi search

Spirit of delphi

Advertising
Home My Blog Books Object Pascal Marco

Home: Code Repository: Mastering Delphi 6

Chapter 13 - Project DbEvts

Project Structure

DbEvts.dpr
program DbEvts;

uses
  Forms,
  DbEvtsF in 'DbEvtsF.pas' {Form1};

{$R *.RES}

begin
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.
DbEvtsF.pas
unit DbEvtsF;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, DBTables, DB, Mask, DBCtrls, Grids, DBGrids,
  Menus, ExtCtrls;

type
  TForm1 = class(TForm)
    Table1: TTable;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    Table1Name: TStringField;
    Table1Capital: TStringField;
    Table1Continent: TStringField;
  Table1Population: TFloatField;
    Table1Area: TFloatField;
    ListBox1: TListBox;
    Splitter1: TSplitter;
    PopupList: TPopupMenu;
    Addblank1: TMenuItem;
    Clear1: TMenuItem;
    SaveToDisk1: TMenuItem;
    SaveDialog1: TSaveDialog;
    Timer1: TTimer;
    procedure Table1AfterCancel(DataSet: TDataset);
    procedure Table1AfterClose(DataSet: TDataset);
    procedure Table1AfterDelete(DataSet: TDataset);
    procedure Table1AfterEdit(DataSet: TDataset);
    procedure Table1AfterInsert(DataSet: TDataset);
    procedure Table1AfterOpen(DataSet: TDataset);
    procedure Table1AfterPost(DataSet: TDataset);
    procedure Table1BeforeCancel(DataSet: TDataset);
    procedure Table1BeforeClose(DataSet: TDataset);
    procedure Table1BeforeDelete(DataSet: TDataset);
    procedure Table1BeforeEdit(DataSet: TDataset);
    procedure Table1BeforeInsert(DataSet: TDataset);
    procedure Table1BeforeOpen(DataSet: TDataset);
    procedure Table1BeforePost(DataSet: TDataset);
    procedure Table1NewRecord(DataSet: TDataset);
    procedure DataSource1DataChange(Sender: TObject; Field: TField);
    procedure DataSource1StateChange(Sender: TObject);
    procedure DataSource1UpdateData(Sender: TObject);
    procedure DBGrid1ColEnter(Sender: TObject);
    procedure DBGrid1ColExit(Sender: TObject);
    procedure AddBlankClick(Sender: TObject);
    procedure ClearClick(Sender: TObject);
    procedure SaveToDiskClick(Sender: TObject);
    procedure Table1AfterScroll(DataSet: TDataSet);
    procedure Table1BeforeScroll(DataSet: TDataSet);
    procedure Table1DeleteError(DataSet: TDataSet; E: EDatabaseError;
      var Action: TDataAction);
    procedure Table1EditError(DataSet: TDataSet; E: EDatabaseError;
      var Action: TDataAction);
    procedure Table1FilterRecord(DataSet: TDataSet; var Accept: Boolean);
    procedure Table1CalcFields(DataSet: TDataSet);
    procedure Table1PostError(DataSet: TDataSet; E: EDatabaseError;
      var Action: TDataAction);
    procedure Table1UpdateError(DataSet: TDataSet; E: EDatabaseError;
      UpdateKind: TUpdateKind; var UpdateAction: TUpdateAction);
    procedure Table1UpdateRecord(DataSet: TDataSet;
      UpdateKind: TUpdateKind; var UpdateAction: TUpdateAction);
    procedure DBGrid1CellClick(Column: TColumn);
    procedure FieldChange(Sender: TField);
    procedure FieldValidate(Sender: TField);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    procedure AddToList (Str: string);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Table1AfterCancel(DataSet: TDataset);
begin
  AddToList ('Table: AfterCancel');
end;

procedure TForm1.Table1AfterClose(DataSet: TDataset);
begin
  AddToList ('Table: AfterClose');
end;

procedure TForm1.Table1AfterDelete(DataSet: TDataset);
begin
  AddToList ('Table: AfterDelete')
end;

procedure TForm1.Table1AfterEdit(DataSet: TDataset);
begin
  AddToList ('Table: AfterEdit');
end;

procedure TForm1.Table1AfterInsert(DataSet: TDataset);
begin
  AddToList ('Table: AfterInsert');
end;

procedure TForm1.Table1AfterOpen(DataSet: TDataset);
begin
  AddToList ('Table: AfterOpen');
end;

procedure TForm1.Table1AfterPost(DataSet: TDataset);
begin
  AddToList ('Table: AfterPost');
end;

procedure TForm1.Table1BeforeCancel(DataSet: TDataset);
begin
  AddToList ('Table: BeforeCancel');
end;

procedure TForm1.Table1BeforeClose(DataSet: TDataset);
begin
  AddToList ('Table: BeforeClose');
end;

procedure TForm1.Table1BeforeDelete(DataSet: TDataset);
begin
  AddToList ('Table: BeforeDelete');
end;

procedure TForm1.Table1BeforeEdit(DataSet: TDataset);
begin
  AddToList ('Table: BeforeEdit');
end;

procedure TForm1.Table1BeforeInsert(DataSet: TDataset);
begin
  AddToList ('Table: BeforeInsert');
end;

procedure TForm1.Table1BeforeOpen(DataSet: TDataset);
begin
  AddToList ('Table: BeforeOpen');
end;

procedure TForm1.Table1BeforePost(DataSet: TDataset);
begin
  AddToList ('Table: BeforePost');
end;

procedure TForm1.Table1NewRecord(DataSet: TDataset);
begin
  AddToList ('Table: OnNewRecord');
end;

procedure TForm1.DataSource1DataChange(Sender: TObject; Field: TField);
begin
  AddToList ('DataSource: OnDataChange');
end;

const
  States: array [0..5] of string =
  ('dsInactive', 'dsBrowse', 'dsEdit',
 'dsInsert', 'dsSetKey', 'dsCalcFields');

procedure TForm1.DataSource1StateChange(Sender: TObject);
var
  CurrState: string;
begin
  CurrState := States [
    Integer (DataSource1.State)];
  AddToList (
    'DataSource: StateChange (' + CurrState + ')');
end;

procedure TForm1.DataSource1UpdateData(Sender: TObject);
begin
  AddToList ('DataSource: UpdateData')
end;

procedure TForm1.DBGrid1ColEnter(Sender: TObject);
begin
  AddToList ('DBGrid: OnColEnter')
end;

procedure TForm1.DBGrid1ColExit(Sender: TObject);
begin
  AddToList ('DBGrid: OnColExit')
end;

procedure TForm1.AddBlankClick(Sender: TObject);
begin
  AddToList ('');
end;

procedure TForm1.ClearClick(Sender: TObject);
begin
  Listbox1.Items.Clear;
end;

procedure TForm1.SaveToDiskClick(Sender: TObject);
begin
  if SaveDialog1.Execute then
    ListBox1.Items.SaveToFile (SaveDialog1.FileName);
end;

procedure TForm1.AddToList(Str: string);
begin
  // add item and select it
  Listbox1.ItemIndex :=
    Listbox1.Items.Add (Str);
end;

procedure TForm1.Table1AfterScroll(DataSet: TDataSet);
begin
  AddToList ('Table: AfterScroll');
end;

procedure TForm1.Table1BeforeScroll(DataSet: TDataSet);
begin
  AddToList ('Table: BeforeScroll');
end;

procedure TForm1.Table1DeleteError(DataSet: TDataSet; E: EDatabaseError;
  var Action: TDataAction);
begin
  AddToList ('Table: OnDeleteError');
end;

procedure TForm1.Table1EditError(DataSet: TDataSet; E: EDatabaseError;
  var Action: TDataAction);
begin
  AddToList ('Table: OnEditError');
end;

procedure TForm1.Table1FilterRecord(DataSet: TDataSet;
  var Accept: Boolean);
begin
  AddToList ('Table: OnFilterRecord');
end;

procedure TForm1.Table1CalcFields(DataSet: TDataSet);
begin
  AddToList ('Table: OnCalcFields');
end;

procedure TForm1.Table1PostError(DataSet: TDataSet; E: EDatabaseError;
  var Action: TDataAction);
begin
  AddToList ('Table: OnPostError');
end;

procedure TForm1.Table1UpdateError(DataSet: TDataSet; E: EDatabaseError;
  UpdateKind: TUpdateKind; var UpdateAction: TUpdateAction);
begin
  AddToList ('Table: OnUpdateError');
end;

procedure TForm1.Table1UpdateRecord(DataSet: TDataSet;
  UpdateKind: TUpdateKind; var UpdateAction: TUpdateAction);
begin
  AddToList ('Table: OnUpdateRecord');
end;

procedure TForm1.DBGrid1CellClick(Column: TColumn);
begin
  AddToList ('DBGrid: OnCellClick');
end;

procedure TForm1.FieldChange(Sender: TField);
begin
  AddToList ('Field ' + Sender.FieldName + ': OnChange');
end;

procedure TForm1.FieldValidate(Sender: TField);
begin
  AddToList ('Field ' + Sender.FieldName + ': OnValidate');
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  // if the last item is not an empty line
  if ListBox1.Items [ListBox1.Items.Count -1] <> '' then
    // add one without moving the current selection
    ListBox1.Items.Add ('');
end;

end.
DbEvtsF.dfm
object Form1: TForm1
  Left = 192
  Top = 109
  Width = 665
  Height = 460
  Caption = 'Database Events'
  Color = clBtnFace
  Font.Charset = ANSI_CHARSET
  Font.Color = clWindowText
  Font.Height = -12
  Font.Name = 'Arial'
  Font.Style = [fsBold]
  OldCreateOrder = True
  PixelsPerInch = 96
  TextHeight = 15
  object Splitter1: TSplitter
    Left = 449
    Top = 0
    Width = 4
    Height = 433
    Cursor = crHSplit
  end
  object DBGrid1: TDBGrid
    Left = 0
    Top = 0
    Width = 449
    Height = 433
    Align = alLeft
    DataSource = DataSource1
    TabOrder = 0
    TitleFont.Charset = ANSI_CHARSET
    TitleFont.Color = clWindowText
    TitleFont.Height = -12
    TitleFont.Name = 'Arial'
    TitleFont.Style = [fsBold]
    OnCellClick = DBGrid1CellClick
    OnColEnter = DBGrid1ColEnter
    OnColExit = DBGrid1ColExit
  end
  object ListBox1: TListBox
    Left = 453
    Top = 0
    Width = 204
    Height = 433
    Align = alClient
    ItemHeight = 15
    PopupMenu = PopupList
    TabOrder = 1
  end
  object Table1: TTable
    Active = True
    BeforeOpen = Table1BeforeOpen
    AfterOpen = Table1AfterOpen
    BeforeClose = Table1BeforeClose
    AfterClose = Table1AfterClose
    BeforeInsert = Table1BeforeInsert
    AfterInsert = Table1AfterInsert
    BeforeEdit = Table1BeforeEdit
    AfterEdit = Table1AfterEdit
    BeforePost = Table1BeforePost
    AfterPost = Table1AfterPost
    BeforeCancel = Table1BeforeCancel
    AfterCancel = Table1AfterCancel
    BeforeDelete = Table1BeforeDelete
    AfterDelete = Table1AfterDelete
    BeforeScroll = Table1BeforeScroll
    AfterScroll = Table1AfterScroll
    OnCalcFields = Table1CalcFields
    OnDeleteError = Table1DeleteError
    OnEditError = Table1EditError
    OnNewRecord = Table1NewRecord
    OnPostError = Table1PostError
    OnUpdateError = Table1UpdateError
    OnUpdateRecord = Table1UpdateRecord
    DatabaseName = 'DBDEMOS'
    OnFilterRecord = Table1FilterRecord
    TableName = 'COUNTRY.DB'
    Left = 8
    Top = 8
    object Table1Name: TStringField
      DisplayLabel = 'Country'
      DisplayWidth = 15
      FieldName = 'Name'
      OnChange = FieldChange
      OnValidate = FieldValidate
      Size = 24
    end
    object Table1Capital: TStringField
      DisplayWidth = 17
      FieldName = 'Capital'
      OnChange = FieldChange
      OnValidate = FieldValidate
      Size = 24
    end
    object Table1Continent: TStringField
      DisplayWidth = 24
      FieldName = 'Continent'
      OnChange = FieldChange
      OnValidate = FieldValidate
      Size = 24
    end
    object Table1Population: TFloatField
      DisplayWidth = 10
      FieldName = 'Population'
      OnChange = FieldChange
      OnValidate = FieldValidate
    end
    object Table1Area: TFloatField
      FieldName = 'Area'
      OnChange = FieldChange
      OnValidate = FieldValidate
    end
  end
  object DataSource1: TDataSource
    DataSet = Table1
    OnStateChange = DataSource1StateChange
    OnDataChange = DataSource1DataChange
    OnUpdateData = DataSource1UpdateData
    Left = 40
    Top = 8
  end
  object PopupList: TPopupMenu
    Left = 488
    Top = 16
    object Addblank1: TMenuItem
      Caption = 'Add blank'
      OnClick = AddBlankClick
    end
    object Clear1: TMenuItem
      Caption = 'Clear'
      OnClick = ClearClick
    end
    object SaveToDisk1: TMenuItem
      Caption = 'Save To Disk...'
      OnClick = SaveToDiskClick
    end
  end
  object SaveDialog1: TSaveDialog
    DefaultExt = 'TXT'
    Filter = 'Text file (*.txt)|*.txt'
    Left = 32
    Top = 64
  end
  object Timer1: TTimer
    OnTimer = Timer1Timer
    Left = 552
    Top = 16
  end
end