Logo New book: Delphi 2007 Handbook
My blog in online
Delphi tech support service: support.marcocantu.com
Google
  Web www.marcocantu.com

Menu for Development

Site Menu
Delphi 2007 Handbook
Mastering Borland Delphi 2005
Essential Pascal
Essential Delphi
Buy Books Online
Code Repository
Newsgroups
White Papers
Tools
Conferences
Training
Delphi Links
Contact Marco

My Other Sites
Italian Site (www.marcocantu.it)
Developers Newsgroups Browser (dev.newswhat.com)
My town (www.piazzacavalli.net)
the delphi search
Wintech Italia (my company)

Breaking News
Buy Mastering Borland Delphi 2005 from Amazon
Free ebook: Mastering Delphi Update for Delphi 2006

Advertising
Home My Blog Books My Bookstore Development Links Marco


Home: Code Repository: Mastering Delphi 6

Chapter 14 - Project transample

Project Structure

transample.dpr
program transample;

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

{$R *.RES}

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

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    DBGrid1: TDBGrid;
    Database1: TDatabase;
    Table1: TTable;
    DataSource1: TDataSource;
    grpIsolation: TRadioGroup;
    grpTransaction: TGroupBox;
    btnRollback: TButton;
    btnStart: TButton;
    btnCommit: TButton;
    btnRefresh: TButton;
    btnClose: TButton;
    grpUpdate: TRadioGroup;
    procedure grpIsolationClick(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure btnCommitClick(Sender: TObject);
    procedure btnRollbackClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure btnRefreshClick(Sender: TObject);
    procedure grpUpdateClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.grpIsolationClick(Sender: TObject);
begin
  Database1.TransIsolation := TTransIsolation(grpIsolation.ItemIndex);
end;

procedure TForm1.btnStartClick(Sender: TObject);
begin
  Database1.StartTransaction;
  btnStart.Enabled := False;
  btnCommit.Enabled := True;
  btnRollback.Enabled := True;
end;

procedure TForm1.btnCommitClick(Sender: TObject);
begin
  Database1.Commit;
  btnStart.Enabled := True;
  btnCommit.Enabled := False;
  btnRollback.Enabled := False;
end;

procedure TForm1.btnRollbackClick(Sender: TObject);
begin
  Database1.Rollback;
  btnStart.Enabled := True;
  btnCommit.Enabled := False;
  btnRollback.Enabled := False;
end;

procedure TForm1.btnCloseClick(Sender: TObject);
begin
  Close;
end;

procedure TForm1.btnRefreshClick(Sender: TObject);
begin
  Table1.Close;
  Table1.Open;
end;

procedure TForm1.grpUpdateClick(Sender: TObject);
begin
  Table1.UpdateMode := TUpdateMode(grpUpdate.ItemIndex);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Table1.Open;
end;

end.
main.dfm
object Form1: TForm1
  Left = 193
  Top = 119
  Width = 609
  Height = 375
  Caption = 'Transaction sample'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  Position = poDesktopCenter
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 601
    Height = 66
    Align = alTop
    BevelOuter = bvNone
    TabOrder = 0
    object grpIsolation: TRadioGroup
      Left = 4
      Top = 1
      Width = 208
      Height = 62
      Caption = 'Current transaction will see:'
      ItemIndex = 1
      Items.Strings = (
        'Uncommitted changes'
        'Only committed changes'
        'Same data when transaction started')
      TabOrder = 0
      OnClick = grpIsolationClick
    end
    object grpTransaction: TGroupBox
      Left = 344
      Top = 1
      Width = 169
      Height = 62
      Caption = 'Transaction'
      TabOrder = 2
      object btnRollback: TButton
        Left = 114
        Top = 20
        Width = 50
        Height = 25
        Caption = 'Rollback'
        Enabled = False
        TabOrder = 0
        OnClick = btnRollbackClick
      end
      object btnStart: TButton
        Left = 6
        Top = 20
        Width = 50
        Height = 25
        Caption = 'Start'
        TabOrder = 1
        OnClick = btnStartClick
      end
      object btnCommit: TButton
        Left = 60
        Top = 20
        Width = 50
        Height = 25
        Caption = 'Commit'
        Enabled = False
        TabOrder = 2
        OnClick = btnCommitClick
      end
    end
    object btnRefresh: TButton
      Left = 521
      Top = 6
      Width = 75
      Height = 25
      Anchors = [akRight]
      Caption = '&Refresh'
      TabOrder = 3
      OnClick = btnRefreshClick
    end
    object btnClose: TButton
      Left = 521
      Top = 37
      Width = 75
      Height = 25
      Anchors = [akRight]
      Caption = '&Close'
      TabOrder = 4
      OnClick = btnCloseClick
    end
    object grpUpdate: TRadioGroup
      Left = 214
      Top = 1
      Width = 128
      Height = 62
      Caption = 'Update Mode'
      ItemIndex = 0
      Items.Strings = (
        'All fields'
        'Changed fields'
        'Key fields')
      TabOrder = 1
      OnClick = grpUpdateClick
    end
  end
  object DBGrid1: TDBGrid
    Left = 0
    Top = 66
    Width = 601
    Height = 282
    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 Database1: TDatabase
    AliasName = 'IBLocal'
    DatabaseName = 'TestDB'
    LoginPrompt = False
    Params.Strings = (
      'USER NAME=SYSDBA'
      'OPEN MODE=READ/WRITE'
      'SCHEMA CACHE SIZE=8'
      'LANGDRIVER='
      'SQLQRYMODE='
      'SQLPASSTHRU MODE=SHARED AUTOCOMMIT'
      'SCHEMA CACHE TIME=-1'
      'MAX ROWS=-1'
      'BATCH COUNT=200'
      'ENABLE SCHEMA CACHE=FALSE'
      'SCHEMA CACHE DIR='
      'ENABLE BCD=FALSE'
      'BLOBS TO CACHE=64'
      'BLOB SIZE=32'
      'PASSWORD=masterkey')
    SessionName = 'Default'
    Left = 20
    Top = 300
  end
  object Table1: TTable
    DatabaseName = 'TestDB'
    TableName = 'CUSTOMER'
    Left = 60
    Top = 300
  end
  object DataSource1: TDataSource
    DataSet = Table1
    Left = 104
    Top = 300
  end
end