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 CACHEUPD

Project Structure


CACHEUPD.DPR

program CacheUpd;

uses
  Forms,
  CacheF in 'CacheF.pas' {Form1},
  ErrorF in 'ErrorF.pas' {ErrorsForm};

{$R *.RES}

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

CACHEF.PAS

unit CacheF;

interface

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

type
  TForm1 = class(TForm)
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    Panel1: TPanel;
    BtnApply: TButton;
    BtnCancel: TButton;
    Query1: TQuery;
    StatusBar1: TStatusBar;
    procedure BtnApplyClick(Sender: TObject);
    procedure BtnCancelClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Query1AfterPost(DataSet: TDataSet);
    procedure Query1UpdateError(DataSet: TDataSet; E: EDatabaseError;
      UpdateKind: TUpdateKind; var UpdateAction: TUpdateAction);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Query1AfterScroll(DataSet: TDataSet);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  ErrorF;

{$R *.DFM}

procedure TForm1.BtnApplyClick(Sender: TObject);
begin
  try
    // apply the updates and empty the cache
    Query1.ApplyUpdates;
    Query1.CommitUpdates;
    // set buttons
    BtnApply.Enabled := False;
    BtnCancel.Enabled := False;
  except;
    // silent exception
  end;
end;

procedure TForm1.BtnCancelClick(Sender: TObject);
begin
  Query1.CancelUpdates;
  // set buttons
  BtnApply.Enabled := False;
  BtnCancel.Enabled := False;
end;

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

procedure TForm1.Query1AfterPost(DataSet: TDataSet);
begin
  // enables the two buttons
  BtnApply.Enabled := True;
  BtnCancel.Enabled := True;
end;

procedure TForm1.Query1UpdateError(DataSet: TDataSet;
  E: EDatabaseError; UpdateKind: TUpdateKind;
  var UpdateAction: TUpdateAction);
var
  strDescr: string;
  I, nRow: Integer;
begin
  nRow := 0;
  // create the dialog box
  ErrorsForm := TErrorsForm.Create (nil);
  try
    // set the caption to a description of the record
    ErrorsForm.Caption := 'Record: ' +
      DataSet.FieldByName('LastName').AsString;

    // for each modified field
    for I := 0 to DataSet.FieldCount - 1 do
      if DataSet.Fields [I].OldValue <>
          DataSet.Fields [I].NewValue then
        begin
          // add a row to the string grid
          Inc (nRow);
          ErrorsForm.StringGrid1.RowCount := nRow + 1;
          // copy the data to the new row
          with ErrorsForm.StringGrid1, DataSet.Fields[I] do
          begin
            Cells [0, nRow] := FieldName;
            Cells [1, nRow] := string (OldValue);
            Cells [2, nRow] := string (NewValue);
          end;
        end;

    // if new items were added, show the dialog
    if (nRow > 0) and
      (ErrorsForm.ShowModal = mrOk) then
    begin
      // revert the record and hide the message
      (DataSet as TQuery).RevertRecord;
      UpdateAction := uaAbort
    end
    else
      // skip the record, keeping it in the cache
      UpdateAction := uaSkip;
  finally
    ErrorsForm.Free;
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  // if there are pending changes, ask the user what to do
  if Query1.UpdatesPending and
      (MessageDlg ('Apply the pending updates?',
      mtConfirmation, [mbYes, mbNo], 0) = mrYes) then
    Query1.ApplyUpdates;
end;

procedure TForm1.Query1AfterScroll(DataSet: TDataSet);
begin
  // show the record update status in the status bar
  case Query1.UpdateStatus of
    usUnmodified:
      StatusBar1.SimpleText := 'Non Modified';
    usModified:
      StatusBar1.SimpleText := 'Modified';
    usInserted:
      StatusBar1.SimpleText := 'Inserted';
  end;
end;

end.

ERRORF.PAS

unit ErrorF;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, CheckLst, Buttons, Grids;

type
  TErrorsForm = class(TForm)
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Label1: TLabel;
    StringGrid1: TStringGrid;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  ErrorsForm: TErrorsForm;

implementation

{$R *.DFM}

procedure TErrorsForm.FormCreate(Sender: TObject);
begin
  StringGrid1.Cells [0, 0] := 'Field Name';
  StringGrid1.Cells [1, 0] := 'Old Value';
  StringGrid1.Cells [2, 0] := 'New Value';
end;

end.

CACHEF.DFM

object Form1: TForm1
  Left = 194
  Top = 109
  Width = 533
  Height = 291
  Caption = 'CacheUpd'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  OnClose = FormClose
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object DBGrid1: TDBGrid
    Left = 0
    Top = 41
    Width = 525
    Height = 204
    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 BtnApply: TButton
      Left = 16
      Top = 8
      Width = 97
      Height = 25
      Caption = 'Apply Updates'
      Enabled = False
      TabOrder = 0
      OnClick = BtnApplyClick
    end
    object BtnCancel: TButton
      Left = 120
      Top = 8
      Width = 97
      Height = 25
      Caption = 'Cancel Updates'
      Enabled = False
      TabOrder = 1
      OnClick = BtnCancelClick
    end
  end
  object StatusBar1: TStatusBar
    Left = 0
    Top = 245
    Width = 525
    Height = 19
    Panels = <>
    SimplePanel = True
  end
  object DataSource1: TDataSource
    DataSet = Query1
    Left = 448
  end
  object Query1: TQuery
    CachedUpdates = True
    AfterPost = Query1AfterPost
    AfterScroll = Query1AfterScroll
    OnUpdateError = Query1UpdateError
    DatabaseName = 'DBDEMOS'
    RequestLive = True
    SQL.Strings = (
      'select * from Employee')
    Left = 400
    ParamData = <>
  end
end

ERRORF.DFM

object ErrorsForm: TErrorsForm
  Left = 366
  Top = 265
  BorderStyle = bsDialog
  Caption = 'Update Errors'
  ClientHeight = 229
  ClientWidth = 381
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 8
    Top = 8
    Width = 70
    Height = 13
    Caption = 'Modified fields:'
  end
  object BitBtn1: TBitBtn
    Left = 112
    Top = 192
    Width = 75
    Height = 25
    Caption = 'Revert'
    TabOrder = 0
    Kind = bkOK
  end
  object BitBtn2: TBitBtn
    Left = 200
    Top = 192
    Width = 75
    Height = 25
    Caption = 'Skip'
    TabOrder = 1
    Kind = bkCancel
  end
  object StringGrid1: TStringGrid
    Left = 8
    Top = 24
    Width = 369
    Height = 161
    ColCount = 3
    DefaultColWidth = 120
    RowCount = 2
    Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine]
    TabOrder = 2
  end
end