Chapter 17 - Project ThinCli2 |
Project Structure
| ThinCli2.dpr |
program ThinCli2;
uses
Forms,
ThinForm in 'ThinForm.pas' ,
DeltForm in 'DeltForm.pas' ,
Reconc in 'Reconc.pas' ;
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.CreateForm(TFormDelta, FormDelta);
Application.Run;
end.
| ThinForm.pas |
unit ThinForm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Db, DBClient, Grids, DBGrids, StdCtrls, ExtCtrls, ComCtrls, MConnect,
MidasCon;
type
TForm1 = class(TForm)
ClientDataSet1: TClientDataSet;
DataSource1: TDataSource;
Panel1: TPanel;
ButtonUpdate: TButton;
ButtonSnap: TButton;
ButtonReload: TButton;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
ClientDataSet2: TClientDataSet;
ButtonDelta: TButton;
ButtonUndo: TButton;
DBGrid1: TDBGrid;
DCOMConnection1: TDCOMConnection;
ClientDataSet1DEPT_NO: TStringField;
ClientDataSet1EMP_NO: TSmallintField;
ClientDataSet1FIRST_NAME: TStringField;
ClientDataSet1HIRE_DATE: TSQLTimeStampField;
ClientDataSet1JOB_CODE: TStringField;
ClientDataSet1JOB_COUNTRY: TStringField;
ClientDataSet1JOB_GRADE: TSmallintField;
ClientDataSet1LAST_NAME: TStringField;
ClientDataSet1PHONE_EXT: TStringField;
ClientDataSet1Status: TStringField;
procedure ButtonUpdateClick(Sender: TObject);
procedure ButtonSnapClick(Sender: TObject);
procedure ButtonReloadClick(Sender: TObject);
procedure ButtonDeltaClick(Sender: TObject);
procedure ClientDataSet1CalcFields(DataSet: TDataSet);
procedure ButtonUndoClick(Sender: TObject);
procedure ClientDataSet1ReconcileError(DataSet: TClientDataSet;
E: EReconcileError; UpdateKind: TUpdateKind;
var Action: TReconcileAction);
procedure ClientDataSet1AfterPost(DataSet: TDataSet);
procedure Form1Create(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
uses
TypInfo, Reconc, DeltForm;
procedure TForm1.ButtonUpdateClick(Sender: TObject);
begin
ClientDataSet1.ApplyUpdates (-1);
FormDelta.Hide;
end;
procedure TForm1.ButtonSnapClick(Sender: TObject);
begin
if SaveDialog1.Execute then
ClientDataSet1.SaveToFile (SaveDialog1.FileName);
end;
procedure TForm1.ButtonReloadClick(Sender: TObject);
begin
if OpenDialog1.Execute then
ClientDataSet1.LoadFromFile (OpenDialog1.FileName);
end;
procedure TForm1.ButtonDeltaClick(Sender: TObject);
begin
if ClientDataSet1.ChangeCount > 0 then
begin
ClientDataSet2.Data :=
ClientDataSet1.Delta;
ClientDataSet2.Open;
FormDelta.DataSource1.DataSet :=
ClientDataSet2;
FormDelta.Show;
end
else
FormDelta.Hide;
end;
procedure TForm1.ClientDataSet1CalcFields(DataSet: TDataSet);
begin
ClientDataSet1Status.AsString :=
GetEnumName (TypeInfo(TUpdateStatus),
Integer (ClientDataSet1.UpdateStatus));
end;
procedure TForm1.ButtonUndoClick(Sender: TObject);
begin
ClientDataSet1.UndoLastChange (True);
ClientDataSet1.RefreshRecord;
end;
procedure TForm1.ClientDataSet1ReconcileError(DataSet: TClientDataSet;
E: EReconcileError; UpdateKind: TUpdateKind;
var Action: TReconcileAction);
begin
Action := HandleReconcileError(DataSet, UpdateKind, E);
end;
procedure TForm1.ClientDataSet1AfterPost(DataSet: TDataSet);
begin
if FormDelta.Visible and
(ClientDataSet1.ChangeCount > 0) then
begin
ClientDataSet2.Data := ClientDataSet1.Delta;
end;
end;
procedure TForm1.Form1Create(Sender: TObject);
begin
ClientDataSet1.Open;
end;
end.
| DeltForm.pas |
unit DeltForm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Db, Grids, DBGrids;
type
TFormDelta = class(TForm)
DBGrid1: TDBGrid;
DataSource1: TDataSource;
private
public
end;
var
FormDelta: TFormDelta;
implementation
end.
| Reconc.pas |
unit Reconc;
interface
uses
SysUtils, Windows, Variants, Messages, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids, DB, DBClient, Provider, ExtCtrls;
const
ActionStr: array[TReconcileAction] of string = ('Skip', 'Abort', 'Merge',
'Correct', 'Cancel', 'Refresh');
UpdateKindStr: array[TUpdateKind] of string = ('Modified', 'Inserted',
'Deleted');
SCaption = 'Update Error - %s';
SUnchanged = '<Unchanged>';
SBinary = '(Binary)';
SFieldName = 'Field Name';
SOriginal = 'Original Value';
SConflict = 'Conflicting Value';
SValue = ' Value';
SNoData = '<No Records>';
SNew = 'New';
type
TReconcileErrorForm = class(TForm)
UpdateType: TLabel;
UpdateData: TStringGrid;
ActionGroup: TRadioGroup;
CancelBtn: TButton;
OKBtn: TButton;
ConflictsOnly: TCheckBox;
IconImage: TImage;
ErrorMsg: TMemo;
ChangedOnly: TCheckBox;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure UpdateDataSetEditText(Sender: TObject; ACol, ARow: Integer;
const Value: string);
procedure DisplayFieldValues(Sender: TObject);
procedure UpdateDataSelectCell(Sender: TObject; Col, Row: Integer;
var CanSelect: Boolean);
private
FDataSet: TDataSet;
FError: EReconcileError;
FUpdateKind: TUpdateKind;
FDataFields: TList;
FCurColIdx: Integer;
FNewColIdx: Integer;
FOldColIdx: Integer;
procedure AdjustColumnWidths;
procedure InitDataFields;
procedure InitUpdateData(HasCurValues: Boolean);
procedure InitReconcileActions;
procedure SetFieldValues(DataSet: TDataSet);
public
constructor CreateForm(DataSet: TDataSet; UpdateKind: TUpdateKind;
Error: EReconcileError);
end;
function HandleReconcileError(DataSet: TDataSet; UpdateKind: TUpdateKind;
ReconcileError: EReconcileError): TReconcileAction;
implementation
type
PFieldData = ^TFieldData;
TFieldData = record
Field: TField;
NewValue: string;
OldValue: string;
CurValue: string;
EditValue: string;
Edited: Boolean;
end;
function HandleReconcileError(DataSet: TDataSet; UpdateKind: TUpdateKind;
ReconcileError: EReconcileError): TReconcileAction;
var
UpdateForm: TReconcileErrorForm;
begin
UpdateForm := TReconcileErrorForm.CreateForm(DataSet, UpdateKind, ReconcileError);
with UpdateForm do
try
if ShowModal = mrOK then
begin
Result := TReconcileAction(ActionGroup.Items.Objects[ActionGroup.ItemIndex]);
if Result = raCorrect then SetFieldValues(DataSet);
end else
Result := raAbort;
finally
Free;
end;
end;
function VarToString(V: Variant; DataType: TFieldType): string;
const
BinaryDataTypes: set of TFieldType = [ftBytes, ftVarBytes, ftBlob,
ftGraphic..ftCursor];
begin
try
if VarIsClear(V) then
Result := SUnchanged
else if DataType in BinaryDataTypes then
Result := SBinary
else
Result := VarToStr(V);
except
on E: Exception do
Result := E.Message;
end;
end;
constructor TReconcileErrorForm.CreateForm(DataSet: TDataSet;
UpdateKind: TUpdateKind; Error: EReconcileError);
begin
FDataSet := DataSet;
FUpdateKind := UpdateKind;
FError := Error;
inherited Create(Application);
end;
procedure TReconcileErrorForm.InitDataFields;
var
I: Integer;
FD: PFieldData;
V: Variant;
HasCurValues: Boolean;
begin
HasCurValues := False;
for I := 0 to FDataSet.FieldCount - 1 do
with FDataset.Fields[I] do
begin
if (FieldKind <> fkData) then Continue;
FD := New(PFieldData);
try
FD.Field := FDataset.Fields[I];
FD.Edited := False;
if FUpdateKind <> ukDelete then
FD.NewValue := VarToString(NewValue, DataType);
V := CurValue;
if not VarIsClear(V) then HasCurValues := True;
FD.CurValue := VarToString(CurValue, DataType);
if FUpdateKind <> ukInsert then
FD.OldValue := VarToString(OldValue, DataType);
FDataFields.Add(FD);
except
Dispose(FD);
raise;
end;
end;
InitUpdateData(HasCurValues);
end;
procedure TReconcileErrorForm.InitUpdateData(HasCurValues: Boolean);
var
FColCount: Integer;
begin
FColCount := 1;
UpdateData.ColCount := 4;
UpdateData.Cells[0,0] := SFieldName;
if FUpdateKind <> ukDelete then
begin
FNewColIdx := FColCount;
Inc(FColCount);
UpdateData.Cells[FNewColIdx,0] := UpdateKindStr[FUpdateKind] + SValue;
end else
begin
FOldColIdx := FColCount;
Inc(FColCount);
UpdateData.Cells[FOldColIdx,0] := SOriginal;
end;
if HasCurValues then
begin
FCurColIdx := FColCount;
Inc(FColCount);
UpdateData.Cells[FCurColIdx,0] := SConflict;
end;
if FUpdateKind = ukModify then
begin
FOldColIdx := FColCount;
Inc(FColCount);
UpdateData.Cells[FOldColIdx,0] := SOriginal;
end;
UpdateData.ColCount := FColCount;
end;
procedure TReconcileErrorForm.InitReconcileActions;
procedure AddAction(Action: TReconcileAction);
begin
ActionGroup.Items.AddObject(ActionStr[Action], TObject(Action));
end;
begin
AddAction(raSkip);
AddAction(raCancel);
AddAction(raCorrect);
if FCurColIdx > 0 then
begin
AddAction(raRefresh);
AddAction(raMerge);
end;
ActionGroup.ItemIndex := 0;
end;
procedure TReconcileErrorForm.DisplayFieldValues(Sender: TObject);
var
I: Integer;
CurRow: Integer;
Action: TReconcileAction;
begin
if not Visible then Exit;
Action := TReconcileAction(ActionGroup.Items.Objects[ActionGroup.ItemIndex]);
UpdateData.Col := 1;
UpdateData.Row := 1;
CurRow := 1;
UpdateData.RowCount := 2;
UpdateData.Cells[0, CurRow] := SNoData;
for I := 1 to UpdateData.ColCount - 1 do
UpdateData.Cells[I, CurRow] := '';
for I := 0 to FDataFields.Count - 1 do
with PFieldData(FDataFields[I])^ do
begin
if ConflictsOnly.Checked and (CurValue = SUnChanged) then Continue;
if ChangedOnly.Checked and (NewValue = SUnChanged) then Continue;
UpdateData.RowCount := CurRow + 1;
UpdateData.Cells[0, CurRow] := Field.DisplayName;
if FNewColIdx > 0 then
begin
case Action of
raCancel, raRefresh:
UpdateData.Cells[FNewColIdx, CurRow] := SUnChanged;
raCorrect:
if Edited then
UpdateData.Cells[FNewColIdx, CurRow] := EditValue else
UpdateData.Cells[FNewColIdx, CurRow] := NewValue;
else
UpdateData.Cells[FNewColIdx, CurRow] := NewValue;
end;
UpdateData.Objects[FNewColIdx, CurRow] := FDataFields[I];
end;
if FCurColIdx > 0 then
UpdateData.Cells[FCurColIdx, CurRow] := CurValue;
if FOldColIdx > 0 then
if (Action in [raMerge, raRefresh]) and (CurValue <> SUnchanged) then
UpdateData.Cells[FOldColIdx, CurRow] := CurValue else
UpdateData.Cells[FOldColIdx, CurRow] := OldValue;
Inc(CurRow);
end;
AdjustColumnWidths;
end;
procedure TReconcileErrorForm.SetFieldValues(DataSet: TDataSet);
var
I: Integer;
begin
for I := 0 to FDataFields.Count - 1 do
with PFieldData(FDataFields[I])^ do
if Edited then Field.NewValue := EditValue;
end;
procedure TReconcileErrorForm.AdjustColumnWidths;
var
NewWidth, I: integer;
begin
with UpdateData do
begin
NewWidth := (ClientWidth - ColWidths[0]) div (ColCount - 1);
for I := 1 to ColCount - 1 do
ColWidths[I] := NewWidth - 1;
end;
end;
procedure TReconcileErrorForm.FormCreate(Sender: TObject);
begin
if FDataSet = nil then Exit;
FDataFields := TList.Create;
InitDataFields;
Caption := Format(SCaption, [FDataSet.Name]);
UpdateType.Caption := UpdateKindStr[FUpdateKind];
ErrorMsg.Text := FError.Message;
if FError.Context <> '' then
ErrorMsg.Lines.Add(FError.Context);
ConflictsOnly.Enabled := FCurColIdx > 0;
ConflictsOnly.Checked := ConflictsOnly.Enabled;
ChangedOnly.Enabled := FNewColIdx > 0;
InitReconcileActions;
UpdateData.DefaultRowHeight := UpdateData.Canvas.TextHeight('SWgjp') + 7;
end;
procedure TReconcileErrorForm.FormDestroy(Sender: TObject);
var
I: Integer;
begin
if Assigned(FDataFields) then
begin
for I := 0 to FDataFields.Count - 1 do
Dispose(PFieldData(FDataFields[I]));
FDataFields.Destroy;
end;
end;
procedure TReconcileErrorForm.UpdateDataSetEditText(Sender: TObject; ACol,
ARow: Integer; const Value: string);
begin
PFieldData(UpdateData.Objects[ACol, ARow]).EditValue := Value;
PFieldData(UpdateData.Objects[ACol, ARow]).Edited := True;
end;
procedure TReconcileErrorForm.UpdateDataSelectCell(Sender: TObject; Col,
Row: Integer; var CanSelect: Boolean);
begin
if (Col = FNewColIdx) and
(TReconcileAction(ActionGroup.Items.Objects[ActionGroup.ItemIndex]) = raCorrect) then
UpdateData.Options := UpdateData.Options + [goEditing] else
UpdateData.Options := UpdateData.Options - [goEditing];
end;
end.
| ThinForm.dfm |
object Form1: TForm1
Left = 208
Top = 119
Width = 514
Height = 278
Caption = 'ThinCli2'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = True
OnCreate = Form1Create
PixelsPerInch = 96
TextHeight = 13
object Panel1: TPanel
Left = 0
Top = 0
Width = 506
Height = 41
Align = alTop
TabOrder = 0
object ButtonUpdate: TButton
Left = 8
Top = 8
Width = 75
Height = 25
Caption = 'Update'
TabOrder = 0
OnClick = ButtonUpdateClick
end
object ButtonSnap: TButton
Left = 88
Top = 8
Width = 75
Height = 25
Caption = 'SnapShot...'
TabOrder = 1
OnClick = ButtonSnapClick
end
object ButtonReload: TButton
Left = 168
Top = 8
Width = 75
Height = 25
Caption = 'Reload...'
TabOrder = 2
OnClick = ButtonReloadClick
end
object ButtonDelta: TButton
Left = 248
Top = 8
Width = 75
Height = 25
Caption = 'Show Delta'
TabOrder = 3
OnClick = ButtonDeltaClick
end
object ButtonUndo: TButton
Left = 328
Top = 8
Width = 75
Height = 25
Caption = 'Undo'
TabOrder = 4
OnClick = ButtonUndoClick
end
end
object DBGrid1: TDBGrid
Left = 0
Top = 41
Width = 506
Height = 210
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 ClientDataSet1: TClientDataSet
Aggregates = <>
PacketRecords = 5
Params = <>
ProviderName = 'DataSetProvider1'
RemoteServer = DCOMConnection1
AfterPost = ClientDataSet1AfterPost
OnCalcFields = ClientDataSet1CalcFields
Left = 136
Top = 72
object ClientDataSet1Status: TStringField
FieldKind = fkInternalCalc
FieldName = 'Status'
end
object ClientDataSet1DEPT_NO: TStringField
FieldName = 'DEPT_NO'
Required = True
FixedChar = True
Size = 3
end
object ClientDataSet1EMP_NO: TSmallintField
FieldName = 'EMP_NO'
Required = True
end
object ClientDataSet1FIRST_NAME: TStringField
FieldName = 'FIRST_NAME'
Required = True
Size = 15
end
object ClientDataSet1HIRE_DATE: TSQLTimeStampField
FieldName = 'HIRE_DATE'
Required = True
end
object ClientDataSet1JOB_CODE: TStringField
FieldName = 'JOB_CODE'
Required = True
Size = 5
end
object ClientDataSet1JOB_COUNTRY: TStringField
FieldName = 'JOB_COUNTRY'
Required = True
Size = 15
end
object ClientDataSet1JOB_GRADE: TSmallintField
FieldName = 'JOB_GRADE'
Required = True
end
object ClientDataSet1LAST_NAME: TStringField
FieldName = 'LAST_NAME'
Required = True
end
object ClientDataSet1PHONE_EXT: TStringField
FieldName = 'PHONE_EXT'
Size = 4
end
end
object DataSource1: TDataSource
DataSet = ClientDataSet1
Left = 216
Top = 72
end
object OpenDialog1: TOpenDialog
DefaultExt = 'CDS'
Filter = 'Client DataSet (*.cds)|*.cds|Any file (*.*)|*.*'
Left = 137
Top = 121
end
object SaveDialog1: TSaveDialog
DefaultExt = 'CDS'
Filter = 'Client DataSet (*.cds)|*.cds|Any file (*.*)|*.*'
Left = 56
Top = 120
end
object ClientDataSet2: TClientDataSet
Aggregates = <>
Params = <>
Left = 302
Top = 71
end
object DCOMConnection1: TDCOMConnection
Connected = True
ServerGUID = '{C5DDE903-2214-11D1-98D0-444553540000}'
ServerName = 'AppServTwo.RdmCount'
Left = 56
Top = 72
end
end
| DeltForm.dfm |
object FormDelta: TFormDelta
Left = 207
Top = 407
Width = 513
Height = 237
Caption = 'ClientDataSet Delta'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = True
PixelsPerInch = 96
TextHeight = 13
object DBGrid1: TDBGrid
Left = 0
Top = 0
Width = 505
Height = 210
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 DataSource1: TDataSource
Left = 40
Top = 24
end
end
| Reconc.dfm |
object ReconcileErrorForm: TReconcileErrorForm
Left = 282
Top = 151
BorderStyle = bsDialog
Caption = 'Update Error'
ClientHeight = 311
ClientWidth = 527
Color = clBtnFace
ParentFont = True
OldCreateOrder = False
Position = poScreenCenter
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = DisplayFieldValues
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 57
Top = 13
Width = 65
Height = 13
Caption = 'Update Type:'
end
object UpdateType: TLabel
Left = 134
Top = 13
Width = 49
Height = 13
Caption = 'Modified'
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Height = -11
Font.Name = 'Default'
Font.Style = [fsBold]
ParentFont = False
end
object Label3: TLabel
Left = 57
Top = 33
Width = 71
Height = 13
Caption = 'Error Message:'
end
object IconImage: TImage
Left = 12
Top = 12
Width = 34
Height = 34
Picture.Data =
end
object UpdateData: TStringGrid
Left = 9
Top = 140
Width = 504
Height = 131
ColCount = 4
DefaultColWidth = 119
RowCount = 2
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goThumbTracking]
TabOrder = 1
OnSelectCell = UpdateDataSelectCell
OnSetEditText = UpdateDataSetEditText
end
object ActionGroup: TRadioGroup
Left = 410
Top = 10
Width = 102
Height = 113
Caption = ' Reconcile Action '
TabOrder = 0
OnClick = DisplayFieldValues
end
object CancelBtn: TButton
Left = 438
Top = 281
Width = 75
Height = 25
Cancel = True
Caption = 'Cancel'
ModalResult = 2
TabOrder = 5
end
object OKBtn: TButton
Left = 350
Top = 281
Width = 75
Height = 25
Caption = 'OK'
Default = True
ModalResult = 1
TabOrder = 4
end
object ConflictsOnly: TCheckBox
Left = 11
Top = 282
Width = 153
Height = 17
Caption = 'Show conflicting fields only'
TabOrder = 2
OnClick = DisplayFieldValues
end
object ErrorMsg: TMemo
Left = 56
Top = 52
Width = 342
Height = 71
TabStop = False
Color = clBtnFace
ReadOnly = True
TabOrder = 6
end
object ChangedOnly: TCheckBox
Left = 185
Top = 282
Width = 141
Height = 17
Caption = 'Show changed fields only'
TabOrder = 3
OnClick = DisplayFieldValues
end
end
|
|