Home: Code Repository: Mastering Delphi 5

Project TRANSAMPLE

Project Structure

TRANSAMPLE.DPR
MAIN.PAS
MAIN.DFM

program transample;

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

{$R *.RES}

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

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.

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