Marco Web Center

[an error occurred while processing this directive]

Home: Code Repository: Mastering Delphi 5

Project TRANSACT

Project Structure


TRANSACT.DPR

program transact;

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

{$R *.RES}

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

TRANFORM.PAS

unit Tranform;

interface

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

type
  TForm1 = class(TForm)
    Database1: TDatabase;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    Panel1: TPanel;
    BtnStart: TButton;
    BtnCommit: TButton;
    BtnRollback: TButton;
    Query1: TQuery;
    procedure BtnStartClick(Sender: TObject);
    procedure BtnCommitClick(Sender: TObject);
    procedure BtnRollbackClick(Sender: TObject);
    procedure Query1BeforeEdit(DataSet: TDataSet);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.BtnStartClick(Sender: TObject);
begin
  Database1.StartTransaction;
  // set buttons
  BtnStart.Enabled := False;
  BtnCommit.Enabled := True;
  BtnRollback.Enabled := True;
end;

procedure TForm1.BtnCommitClick(Sender: TObject);
begin
  Query1.Post;
  Database1.Commit;
  // set buttons
  BtnStart.Enabled := True;
  BtnCommit.Enabled := False;
  BtnRollback.Enabled := False;
end;

procedure TForm1.BtnRollbackClick(Sender: TObject);
begin
  Query1.Cancel;
  Database1.Rollback;
  // refresh
  Query1.Refresh;
  // set buttons
  BtnStart.Enabled := True;
  BtnCommit.Enabled := False;
  BtnRollback.Enabled := False;
end;

procedure TForm1.Query1BeforeEdit(DataSet: TDataSet);
begin
  // start a transaction, if not already started
  if not Database1.InTransaction then
    BtnStartClick (Self);
end;

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

end.

TRANFORM.DFM

object Form1: TForm1
  Left = 194
  Top = 109
  Width = 533
  Height = 291
  Caption = 'Transact'
  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 DBGrid1: TDBGrid
    Left = 0
    Top = 41
    Width = 525
    Height = 223
    Align = alClient
    DataSource = DataSource1
    TabOrder = 0
    TitleFont.Charset = DEFAULT_CHARSET
    TitleFont.Color = clWindowText
    TitleFont.Height = -11
    TitleFont.Name = 'MS Sans Serif'
    TitleFont.Style = []
  end
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 525
    Height = 41
    Align = alTop
    TabOrder = 1
    object BtnStart: TButton
      Left = 8
      Top = 8
      Width = 75
      Height = 25
      Caption = 'Start'
      TabOrder = 0
      OnClick = BtnStartClick
    end
    object BtnCommit: TButton
      Left = 88
      Top = 8
      Width = 75
      Height = 25
      Caption = 'Commit'
      Enabled = False
      TabOrder = 1
      OnClick = BtnCommitClick
    end
    object BtnRollback: TButton
      Left = 168
      Top = 8
      Width = 75
      Height = 25
      Caption = 'Rollback'
      Enabled = False
      TabOrder = 2
      OnClick = BtnRollbackClick
    end
  end
  object Database1: TDatabase
    AliasName = 'DBDEMOS'
    Connected = True
    DatabaseName = 'MyData'
    SessionName = 'Default'
    TransIsolation = tiDirtyRead
    Left = 352
  end
  object DataSource1: TDataSource
    DataSet = Query1
    Left = 448
  end
  object Query1: TQuery
    BeforeEdit = Query1BeforeEdit
    DatabaseName = 'MyData'
    RequestLive = True
    SQL.Strings = (
      'select * from Employee')
    Left = 400
  end
end