Home: Code Repository: Mastering Delphi 5

Project CACHEUPD

Project Structure

CACHEUPD.DPR
CACHEF.PAS
ERRORF.PAS
CACHEF.DFM
ERRORF.DFM

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.

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.

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.

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

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