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 5

Project ADOEMPL

Project Structure


ADOEMPL.DPR

program AdoEmpl;

uses
  Forms,
  AEForm in 'AEForm.pas' {AdoEmplForm};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TAdoEmplForm, AdoEmplForm);
  Application.Run;
end.

AEFORM.PAS

unit AEForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db, DBTables, StdCtrls, Mask, DBCtrls, ExtCtrls, Grids, DBGrids, ComCtrls,
  ADODB;

type
  TAdoEmplForm = class(TForm)
    AdoTable: TADOTable;
    DataSource1: TDataSource;
    ADOConnection: TADOConnection;
    PageControl2: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet3: TTabSheet;
    cbLock: TCheckBox;
    EditName: TEdit;
    btnFind: TButton;
    btnTotal: TButton;
    BtnStart: TButton;
    BtnCommit: TButton;
    BtnRollback: TButton;
    DBGrid1: TDBGrid;
    procedure FormCreate(Sender: TObject);
    procedure btnTotalClick(Sender: TObject);
    procedure btnFindClick(Sender: TObject);
    procedure cbLockClick(Sender: TObject);
    procedure AdoTableBeforeEdit(DataSet: TDataSet);
    procedure BtnCommitClick(Sender: TObject);
    procedure BtnRollbackClick(Sender: TObject);
    procedure BtnStartClick(Sender: TObject);
  private
    { Private declarations }
  end;

var
  AdoEmplForm: TAdoEmplForm;

implementation

{$R *.DFM}

procedure TAdoEmplForm.FormCreate(Sender: TObject);
begin
  // open the new or existing table
  AdoTable.Open;
end;

procedure TAdoEmplForm.btnTotalClick(Sender: TObject);
var
  Bookmark: TBookmark;
  Total: Real;
begin
  {store the current position, crating a new bookmark}
  Bookmark := AdoTable.GetBookmark;
  // AdoTable.DisableControls;
  AdoTable.BlockReadSize := 10;
  Total := 0;
  try
    AdoTable.First;
    while not AdoTable.EOF do
    begin
      Total := Total + AdoTable.FieldByName('Salary').Value;
      AdoTable.Next;
    end;
  finally
    {go back to the bookmark and destroy it}
    AdoTable.GotoBookmark (Bookmark);
    AdoTable.FreeBookmark (Bookmark);
    // AdoTable.EnableControls;
    AdoTable.BlockReadSize := 0;
  end;
  MessageDlg ('Sum of new salaries is ' +
    Format ('%m', [Total]), mtInformation, [mbOk], 0);
end;

procedure TAdoEmplForm.btnFindClick(Sender: TObject);
begin
  if not AdoTable.Locate ('LastName', EditName.Text, []) then
    MessageDlg ('Name not found', mtError, [mbOk], 0);
end;

procedure TAdoEmplForm.cbLockClick(Sender: TObject);
begin
  AdoTable.Close;
  if not cbLock.Checked then
    AdoTable.LockType := ltPessimistic
  else
    AdoTable.LockType := ltOptimistic;
  AdoTable.Open;
end;

procedure TAdoEmplForm.AdoTableBeforeEdit(DataSet: TDataSet);
begin
  // start a transaction, if not already started
  if not AdoConnection.InTransaction then
    BtnStartClick (Self);
end;

procedure TAdoEmplForm.BtnCommitClick(Sender: TObject);
begin
  if AdoTable.State = dsEdit then
    AdoTable.Post;
  AdoConnection.CommitTrans;
  // set buttons
  BtnStart.Enabled := True;
  BtnCommit.Enabled := False;
  BtnRollback.Enabled := False;
end;

procedure TAdoEmplForm.BtnRollbackClick(Sender: TObject);
begin
  AdoTable.Cancel;
  AdoConnection.RollbackTrans;
  // refresh
  AdoTable.Requery;
  // set buttons
  BtnStart.Enabled := True;
  BtnCommit.Enabled := False;
  BtnRollback.Enabled := False;
end;

procedure TAdoEmplForm.BtnStartClick(Sender: TObject);
begin
  AdoConnection.BeginTrans;
  // set buttons
  BtnStart.Enabled := False;
  BtnCommit.Enabled := True;
  BtnRollback.Enabled := True;
end;

end.

AEFORM.DFM

object AdoEmplForm: TAdoEmplForm
  Left = 275
  Top = 134
  Width = 520
  Height = 361
  Caption = 'AdoEmpl'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object PageControl2: TPageControl
    Left = 0
    Top = 0
    Width = 512
    Height = 60
    ActivePage = TabSheet1
    Align = alTop
    TabOrder = 0
    object TabSheet1: TTabSheet
      Caption = 'Main'
      object cbLock: TCheckBox
        Left = 331
        Top = 8
        Width = 61
        Height = 17
        Caption = '&Lock'
        TabOrder = 0
        OnClick = cbLockClick
      end
      object EditName: TEdit
        Left = 200
        Top = 6
        Width = 121
        Height = 21
        TabOrder = 1
        Text = 'Lee'
      end
      object btnFind: TButton
        Left = 112
        Top = 4
        Width = 75
        Height = 25
        Caption = '&Find'
        TabOrder = 2
        OnClick = btnFindClick
      end
      object btnTotal: TButton
        Left = 8
        Top = 4
        Width = 89
        Height = 25
        Caption = '&Total'
        TabOrder = 3
        OnClick = btnTotalClick
      end
    end
    object TabSheet3: TTabSheet
      Caption = 'Transactions'
      ImageIndex = 1
      object BtnStart: TButton
        Left = 8
        Top = 3
        Width = 75
        Height = 25
        Caption = 'Start'
        TabOrder = 0
        OnClick = BtnStartClick
      end
      object BtnCommit: TButton
        Left = 88
        Top = 3
        Width = 75
        Height = 25
        Caption = 'Commit'
        Enabled = False
        TabOrder = 1
        OnClick = BtnCommitClick
      end
      object BtnRollback: TButton
        Left = 168
        Top = 3
        Width = 75
        Height = 25
        Caption = 'Rollback'
        Enabled = False
        TabOrder = 2
        OnClick = BtnRollbackClick
      end
    end
  end
  object DBGrid1: TDBGrid
    Left = 0
    Top = 60
    Width = 512
    Height = 274
    Align = alClient
    DataSource = DataSource1
    TabOrder = 1
    TitleFont.Charset = DEFAULT_CHARSET
    TitleFont.Color = clWindowText
    TitleFont.Height = -11
    TitleFont.Name = 'MS Sans Serif'
    TitleFont.Style = []
  end
  object AdoTable: TADOTable
    CacheSize = 50
    Connection = ADOConnection
    CursorLocation = clUseServer
    MaxRecords = 50
    BeforeEdit = AdoTableBeforeEdit
    TableDirect = True
    TableName = 'Employees'
    Left = 40
    Top = 144
  end
  object DataSource1: TDataSource
    DataSet = AdoTable
    Left = 120
    Top = 88
  end
  object ADOConnection: TADOConnection
    ConnectionString =
       'Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;Data Source=c:\md' +
      '5code\Part3\12\data\MdData.mdb;Mode=Share Deny None;Extended Pro' +
      'perties="";Locale Identifier=1033;Persist Security Info=False;Je' +
      't OLEDB:System database="";Jet OLEDB:Registry Path="";Jet OLEDB:' +
      'Database Password="";Jet OLEDB:Engine Type=4;Jet OLEDB:Database ' +
      'Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Glo' +
      'bal Bulk Transactions=1;Jet OLEDB:New Database Password="";Jet O' +
      'LEDB:Create System Database=False;Jet OLEDB:Encrypt Database=Fal' +
      'se;Jet OLEDB:Don''t Copy Locale on Compact=False;Jet OLEDB:Compac'    +
      't Without Replica Repair=False;Jet OLEDB:SFP=False'
    CursorLocation = clUseServer
    LoginPrompt = False
    Provider = 'Microsoft.Jet.OLEDB.4.0'
    Left = 40
    Top = 88
  end
end