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 AFREMOTE

Project Structure


AFREMOTE.DPR

library AfRemote;

uses
  ComServ,
  AfRemote_TLB in 'AfRemote_TLB.pas',
  Remote in 'Remote.pas' {ActiveRemote: TActiveForm} {ActiveRemote: CoClass},
  ReconDlg in 'ReconDlg.pas' {ReconcileErrorForm};

exports
  DllGetClassObject,
  DllCanUnloadNow,
  DllRegisterServer,
  DllUnregisterServer;

{$R *.TLB}

{$R *.RES}

{$E ocx}

begin
end.

AFREMOTE_TLB.PAS

unit AfRemote_TLB;

{ This file contains pascal declarations imported from a type library.
  This file will be written during each import or refresh of the type
  library editor.  Changes to this file will be discarded during the
  refresh process. }

{ AfRemote Library }
{ Version 1.0 }

{ Conversion log:
  Hint: Class is not registered.  Ambient properties cannot be determined.
 }

interface

uses Windows, ActiveX, Classes, Graphics, OleCtrls, StdVCL;

const
  LIBID_AfRemote: TGUID = '{CBF29741-2472-11D1-98D0-444553540000}';

const

{ TxActiveFormBorderStyle }

  afbNone = 0;
  afbSingle = 1;
  afbSunken = 2;
  afbRaised = 3;

{ TxPrintScale }

  poNone = 0;
  poProportional = 1;
  poPrintToFit = 2;

{ TxMouseButton }

  mbLeft = 0;
  mbRight = 1;
  mbMiddle = 2;

{ TxWindowState }

  wsNormal = 0;
  wsMinimized = 1;
  wsMaximized = 2;

const

{ Component class GUIDs }
  Class_ActiveRemote: TGUID = '{CBF29744-2472-11D1-98D0-444553540000}';

type

{ Forward declarations: Interfaces }
  IActiveRemote = interface;
  IActiveRemoteDisp = dispinterface;
  IActiveRemoteEvents = dispinterface;

{ Forward declarations: CoClasses }
  ActiveRemote = IActiveRemote;

{ Forward declarations: Enums }
  TxActiveFormBorderStyle = TOleEnum;
  TxPrintScale = TOleEnum;
  TxMouseButton = TOleEnum;
  TxWindowState = TOleEnum;

{ Dispatch interface for ActiveRemote Control }

  IActiveRemote = interface(IDispatch)
    ['{CBF29742-2472-11D1-98D0-444553540000}']
    function Get_AutoScroll: WordBool; safecall;
    procedure Set_AutoScroll(Value: WordBool); safecall;
    function Get_AxBorderStyle: TxActiveFormBorderStyle; safecall;
    procedure Set_AxBorderStyle(Value: TxActiveFormBorderStyle); safecall;
    function Get_Caption: WideString; safecall;
    procedure Set_Caption(const Value: WideString); safecall;
    function Get_Color: TColor; safecall;
    procedure Set_Color(Value: TColor); safecall;
    function Get_Font: Font; safecall;
    procedure Set_Font(const Value: Font); safecall;
    function Get_KeyPreview: WordBool; safecall;
    procedure Set_KeyPreview(Value: WordBool); safecall;
    function Get_PixelsPerInch: Integer; safecall;
    procedure Set_PixelsPerInch(Value: Integer); safecall;
    function Get_PrintScale: TxPrintScale; safecall;
    procedure Set_PrintScale(Value: TxPrintScale); safecall;
    function Get_Scaled: WordBool; safecall;
    procedure Set_Scaled(Value: WordBool); safecall;
    function Get_Active: WordBool; safecall;
    function Get_DropTarget: WordBool; safecall;
    procedure Set_DropTarget(Value: WordBool); safecall;
    function Get_HelpFile: WideString; safecall;
    procedure Set_HelpFile(const Value: WideString); safecall;
    function Get_WindowState: TxWindowState; safecall;
    procedure Set_WindowState(Value: TxWindowState); safecall;
    function Get_Visible: WordBool; safecall;
    procedure Set_Visible(Value: WordBool); safecall;
    function Get_Enabled: WordBool; safecall;
    procedure Set_Enabled(Value: WordBool); safecall;
    function Get_Cursor: Smallint; safecall;
    procedure Set_Cursor(Value: Smallint); safecall;
    property AutoScroll: WordBool read Get_AutoScroll write Set_AutoScroll;
    property AxBorderStyle: TxActiveFormBorderStyle read Get_AxBorderStyle write Set_AxBorderStyle;
    property Caption: WideString read Get_Caption write Set_Caption;
    property Color: TColor read Get_Color write Set_Color;
    property Font: Font read Get_Font write Set_Font;
    property KeyPreview: WordBool read Get_KeyPreview write Set_KeyPreview;
    property PixelsPerInch: Integer read Get_PixelsPerInch write Set_PixelsPerInch;
    property PrintScale: TxPrintScale read Get_PrintScale write Set_PrintScale;
    property Scaled: WordBool read Get_Scaled write Set_Scaled;
    property Active: WordBool read Get_Active;
    property DropTarget: WordBool read Get_DropTarget write Set_DropTarget;
    property HelpFile: WideString read Get_HelpFile write Set_HelpFile;
    property WindowState: TxWindowState read Get_WindowState write Set_WindowState;
    property Visible: WordBool read Get_Visible write Set_Visible;
    property Enabled: WordBool read Get_Enabled write Set_Enabled;
    property Cursor: Smallint read Get_Cursor write Set_Cursor;
  end;

{ DispInterface declaration for Dual Interface IActiveRemote }

  IActiveRemoteDisp = dispinterface
    ['{CBF29742-2472-11D1-98D0-444553540000}']
    property AutoScroll: WordBool dispid 1;
    property AxBorderStyle: TxActiveFormBorderStyle dispid 2;
    property Caption: WideString dispid 3;
    property Color: TColor dispid 4;
    property Font: Font dispid 5;
    property KeyPreview: WordBool dispid 6;
    property PixelsPerInch: Integer dispid 7;
    property PrintScale: TxPrintScale dispid 8;
    property Scaled: WordBool dispid 9;
    property Active: WordBool readonly dispid 10;
    property DropTarget: WordBool dispid 11;
    property HelpFile: WideString dispid 12;
    property WindowState: TxWindowState dispid 13;
    property Visible: WordBool dispid 14;
    property Enabled: WordBool dispid 15;
    property Cursor: Smallint dispid 16;
  end;

{ Events interface for ActiveRemote Control }

  IActiveRemoteEvents = dispinterface
    ['{CBF29743-2472-11D1-98D0-444553540000}']
    procedure OnActivate; dispid 1;
    procedure OnClick; dispid 2;
    procedure OnCreate; dispid 3;
    procedure OnDblClick; dispid 4;
    procedure OnDestroy; dispid 5;
    procedure OnDeactivate; dispid 6;
    procedure OnKeyPress(var Key: Smallint); dispid 7;
    procedure OnPaint; dispid 8;
  end;

{ ActiveRemoteControl }

  TActiveRemoteOnKeyPress = procedure(Sender: TObject; var Key: Smallint) of object;

  TActiveRemote = class(TOleControl)
  private
    FOnActivate: TNotifyEvent;
    FOnClick: TNotifyEvent;
    FOnCreate: TNotifyEvent;
    FOnDblClick: TNotifyEvent;
    FOnDestroy: TNotifyEvent;
    FOnDeactivate: TNotifyEvent;
    FOnKeyPress: TActiveRemoteOnKeyPress;
    FOnPaint: TNotifyEvent;
    FIntf: IActiveRemote;
  protected
    procedure InitControlData; override;
    procedure InitControlInterface(const Obj: IUnknown); override;
  public
    property ControlInterface: IActiveRemote read FIntf;
    property Active: WordBool index 10 read GetWordBoolProp;
  published
    property AutoScroll: WordBool index 1 read GetWordBoolProp write SetWordBoolProp stored False;
    property AxBorderStyle: TxActiveFormBorderStyle index 2 read GetTOleEnumProp write SetTOleEnumProp stored False;
    property Caption: WideString index 3 read GetWideStringProp write SetWideStringProp stored False;
    property Color: TColor index 4 read GetTColorProp write SetTColorProp stored False;
    property Font: TFont index 5 read GetTFontProp write SetTFontProp stored False;
    property KeyPreview: WordBool index 6 read GetWordBoolProp write SetWordBoolProp stored False;
    property PixelsPerInch: Integer index 7 read GetIntegerProp write SetIntegerProp stored False;
    property PrintScale: TxPrintScale index 8 read GetTOleEnumProp write SetTOleEnumProp stored False;
    property Scaled: WordBool index 9 read GetWordBoolProp write SetWordBoolProp stored False;
    property DropTarget: WordBool index 11 read GetWordBoolProp write SetWordBoolProp stored False;
    property HelpFile: WideString index 12 read GetWideStringProp write SetWideStringProp stored False;
    property WindowState: TxWindowState index 13 read GetTOleEnumProp write SetTOleEnumProp stored False;
    property Visible: WordBool index 14 read GetWordBoolProp write SetWordBoolProp stored False;
    property Enabled: WordBool index 15 read GetWordBoolProp write SetWordBoolProp stored False;
    property Cursor: Smallint index 16 read GetSmallintProp write SetSmallintProp stored False;
    property OnActivate: TNotifyEvent read FOnActivate write FOnActivate;
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
    property OnCreate: TNotifyEvent read FOnCreate write FOnCreate;
    property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
    property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
    property OnDeactivate: TNotifyEvent read FOnDeactivate write FOnDeactivate;
    property OnKeyPress: TActiveRemoteOnKeyPress read FOnKeyPress write FOnKeyPress;
    property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
  end;

procedure Register;

implementation

uses ComObj;

procedure TActiveRemote.InitControlData;
const
  CEventDispIDs: array[0..7] of Integer = (
    $00000001, $00000002, $00000003, $00000004, $00000005, $00000006,
    $00000007, $00000008);
  CTFontIDs: array [0..0] of Integer = (
    $00000005);
  CControlData: TControlData = (
    ClassID: '{CBF29744-2472-11D1-98D0-444553540000}';
    EventIID: '{CBF29743-2472-11D1-98D0-444553540000}';
    EventCount: 8;
    EventDispIDs: @CEventDispIDs;
    LicenseKey: nil;
    Flags: $00000000;
    Version: 300;
    FontCount: 1;
    FontIDs: @CTFontIDs);
begin
  ControlData := @CControlData;
end;

procedure TActiveRemote.InitControlInterface(const Obj: IUnknown);
begin
  FIntf := Obj as IActiveRemote;
end;


procedure Register;
begin
  RegisterComponents('ActiveX', [TActiveRemote]);
end;

end.

REMOTE.PAS

unit Remote;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ActiveX, AxCtrls, AfRemote_TLB, StdCtrls, Db, DBClient, ExtCtrls, Grids,
  DBGrids, MIDASCon, MConnect, SConnect;

type
  TActiveRemote = class(TActiveForm, IActiveRemote)
    DBGrid1: TDBGrid;
    Panel1: TPanel;
    ClientDataSet1: TClientDataSet;
    DataSource1: TDataSource;
    CheckActive: TCheckBox;
    BtnApply: TButton;
    SocketConnection1: TSocketConnection;
    procedure BtnApplyClick(Sender: TObject);
    procedure CheckActiveClick(Sender: TObject);
    procedure ClientDataSet1ReconcileError(DataSet: TClientDataSet;
      E: EReconcileError; UpdateKind: TUpdateKind;
      var Action: TReconcileAction);
  private
    { Private declarations }
    FEvents: IActiveRemoteEvents;
    procedure ActivateEvent(Sender: TObject);
    procedure ClickEvent(Sender: TObject);
    procedure CreateEvent(Sender: TObject);
    procedure DblClickEvent(Sender: TObject);
    procedure DeactivateEvent(Sender: TObject);
    procedure DestroyEvent(Sender: TObject);
    procedure KeyPressEvent(Sender: TObject; var Key: Char);
    procedure PaintEvent(Sender: TObject);
  protected
    { Protected declarations }
    procedure EventSinkChanged(const EventSink: IUnknown); override;
    procedure Initialize; override;
    function Get_Active: WordBool; safecall;
    function Get_AutoScroll: WordBool; safecall;
    function Get_AxBorderStyle: TxActiveFormBorderStyle; safecall;
    function Get_Caption: WideString; safecall;
    function Get_Color: TColor; safecall;
    function Get_Cursor: Smallint; safecall;
    function Get_DropTarget: WordBool; safecall;
    function Get_Enabled: WordBool; safecall;
    function Get_Font: Font; safecall;
    function Get_HelpFile: WideString; safecall;
    function Get_KeyPreview: WordBool; safecall;
    function Get_PixelsPerInch: Integer; safecall;
    function Get_PrintScale: TxPrintScale; safecall;
    function Get_Scaled: WordBool; safecall;
    function Get_Visible: WordBool; safecall;
    function Get_WindowState: TxWindowState; safecall;
    procedure Set_AutoScroll(Value: WordBool); safecall;
    procedure Set_AxBorderStyle(Value: TxActiveFormBorderStyle); safecall;
    procedure Set_Caption(const Value: WideString); safecall;
    procedure Set_Color(Value: TColor); safecall;
    procedure Set_Cursor(Value: Smallint); safecall;
    procedure Set_DropTarget(Value: WordBool); safecall;
    procedure Set_Enabled(Value: WordBool); safecall;
    procedure Set_Font(const Value: Font); safecall;
    procedure Set_HelpFile(const Value: WideString); safecall;
    procedure Set_KeyPreview(Value: WordBool); safecall;
    procedure Set_PixelsPerInch(Value: Integer); safecall;
    procedure Set_PrintScale(Value: TxPrintScale); safecall;
    procedure Set_Scaled(Value: WordBool); safecall;
    procedure Set_Visible(Value: WordBool); safecall;
    procedure Set_WindowState(Value: TxWindowState); safecall;
  public
    { Public declarations }
  end;

implementation

uses ComServ, ReconDlg;

{$R *.DFM}

{ TActiveRemote }

procedure TActiveRemote.EventSinkChanged(const EventSink: IUnknown);
begin
  FEvents := EventSink as IActiveRemoteEvents;
end;

procedure TActiveRemote.Initialize;
begin
  OnActivate := ActivateEvent;
  OnClick := ClickEvent;
  OnCreate := CreateEvent;
  OnDblClick := DblClickEvent;
  OnDeactivate := DeactivateEvent;
  OnDestroy := DestroyEvent;
  OnKeyPress := KeyPressEvent;
  OnPaint := PaintEvent;
end;

function TActiveRemote.Get_Active: WordBool;
begin
  Result := Active;
end;

function TActiveRemote.Get_AutoScroll: WordBool;
begin
  Result := AutoScroll;
end;

function TActiveRemote.Get_AxBorderStyle: TxActiveFormBorderStyle;
begin
  Result := Ord(AxBorderStyle);
end;

function TActiveRemote.Get_Caption: WideString;
begin
  Result := WideString(Caption);
end;

function TActiveRemote.Get_Color: TColor;
begin
  Result := Color;
end;

function TActiveRemote.Get_Cursor: Smallint;
begin
  Result := Smallint(Cursor);
end;

function TActiveRemote.Get_DropTarget: WordBool;
begin
  Result := DropTarget;
end;

function TActiveRemote.Get_Enabled: WordBool;
begin
  Result := Enabled;
end;

function TActiveRemote.Get_Font: Font;
begin
  GetOleFont(Font, Result);
end;

function TActiveRemote.Get_HelpFile: WideString;
begin
  Result := WideString(HelpFile);
end;

function TActiveRemote.Get_KeyPreview: WordBool;
begin
  Result := KeyPreview;
end;

function TActiveRemote.Get_PixelsPerInch: Integer;
begin
  Result := PixelsPerInch;
end;

function TActiveRemote.Get_PrintScale: TxPrintScale;
begin
  Result := Ord(PrintScale);
end;

function TActiveRemote.Get_Scaled: WordBool;
begin
  Result := Scaled;
end;

function TActiveRemote.Get_Visible: WordBool;
begin
  Result := Visible;
end;

function TActiveRemote.Get_WindowState: TxWindowState;
begin
  Result := Ord(WindowState);
end;

procedure TActiveRemote.Set_AutoScroll(Value: WordBool);
begin
  AutoScroll := Value;
end;

procedure TActiveRemote.Set_AxBorderStyle(Value: TxActiveFormBorderStyle);
begin
  AxBorderStyle := TActiveFormBorderStyle(Value);
end;

procedure TActiveRemote.Set_Caption(const Value: WideString);
begin
  Caption := TCaption(Value);
end;

procedure TActiveRemote.Set_Color(Value: TColor);
begin
  Color := Value;
end;

procedure TActiveRemote.Set_Cursor(Value: Smallint);
begin
  Cursor := TCursor(Value);
end;

procedure TActiveRemote.Set_DropTarget(Value: WordBool);
begin
  DropTarget := Value;
end;

procedure TActiveRemote.Set_Enabled(Value: WordBool);
begin
  Enabled := Value;
end;

procedure TActiveRemote.Set_Font(const Value: Font);
begin
  SetOleFont(Font, Value);
end;

procedure TActiveRemote.Set_HelpFile(const Value: WideString);
begin
  HelpFile := String(Value);
end;

procedure TActiveRemote.Set_KeyPreview(Value: WordBool);
begin
  KeyPreview := Value;
end;

procedure TActiveRemote.Set_PixelsPerInch(Value: Integer);
begin
  PixelsPerInch := Value;
end;

procedure TActiveRemote.Set_PrintScale(Value: TxPrintScale);
begin
  PrintScale := TPrintScale(Value);
end;

procedure TActiveRemote.Set_Scaled(Value: WordBool);
begin
  Scaled := Value;
end;

procedure TActiveRemote.Set_Visible(Value: WordBool);
begin
  Visible := Value;
end;

procedure TActiveRemote.Set_WindowState(Value: TxWindowState);
begin
  WindowState := TWindowState(Value);
end;

procedure TActiveRemote.ActivateEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnActivate;
end;

procedure TActiveRemote.ClickEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnClick;
end;

procedure TActiveRemote.CreateEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnCreate;
end;

procedure TActiveRemote.DblClickEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnDblClick;
end;

procedure TActiveRemote.DeactivateEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnDeactivate;
end;

procedure TActiveRemote.DestroyEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnDestroy;
end;

procedure TActiveRemote.KeyPressEvent(Sender: TObject; var Key: Char);
var
  TempKey: Smallint;
begin
  TempKey := Smallint(Key);
  if FEvents <> nil then FEvents.OnKeyPress(TempKey);
  Key := Char(TempKey);
end;

procedure TActiveRemote.PaintEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnPaint;
end;

procedure TActiveRemote.BtnApplyClick(Sender: TObject);
begin
  if ClientDataSet1.Active then
    ClientDataSet1.ApplyUpdates (-1);
end;

procedure TActiveRemote.CheckActiveClick(Sender: TObject);
begin
  if CheckActive.Checked and not SocketConnection1.Connected then
    SocketConnection1.Connected := True;
  ClientDataSet1.Active := CheckActive.Checked;
end;

procedure TActiveRemote.ClientDataSet1ReconcileError(
  DataSet: TClientDataSet; E: EReconcileError; UpdateKind: TUpdateKind;
  var Action: TReconcileAction);
begin
  Action := HandleReconcileError (DataSet, UpdateKind, E);
end;

initialization
  TActiveFormFactory.Create(
    ComServer,
    TActiveFormControl,
    TActiveRemote,
    Class_ActiveRemote,
    1,
    '',
    OLEMISC_SIMPLEFRAME or OLEMISC_ACTSLIKELABEL);
end.

RECONDLG.PAS


{*******************************************************}
{                                                       }
{       Delphi Visual Component Library                 }
{       ClientDataSet Standard Reconcile Error Dialog   }
{                                                       }
{       Copyright (c) 1997 Borland International        }
{                                                       }
{*******************************************************}

{ Note: To use this dialog you should add a call to HandleReconcileError in
  the OnReconcileError event handler of TClientDataSet (see the Client dataset
  demos for an example).  Also, after adding this unit to your project you must
  go into the Project Options dialog and remove this form from the list of
  Auto-created forms or an error will occur when compiling. }

unit ReconDlg;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Grids, DB, DBTables, DBClient, 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

{$R *.DFM}

type
  PFieldData = ^TFieldData;
  TFieldData = record
    Field: TField;
    NewValue: string;
    OldValue: string;
    CurValue: string;
    EditValue: string;
    Edited: Boolean;
  end;

{ Public and Private Methods }

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;

{ Routine to convert a variant value into a string.
  Handles binary fields types and "empty" (Unchanged) field values specially }

function VarToStr(V: Variant; DataType: TFieldType): string;
const
  BinaryDataTypes: set of TFieldType = [ftBytes, ftVarBytes, ftBlob,
    ftGraphic..ftCursor];
begin
  try
    if VarIsEmpty(V) then
      Result := SUnchanged
    else if DataType in BinaryDataTypes then
      Result := SBinary
    else
      Result := System.VarToStr(V);
  except
    on E: Exception do
      Result := E.Message;
  end;
end;

{ TReconcileErrorForm }

constructor TReconcileErrorForm.CreateForm(DataSet: TDataSet;
  UpdateKind: TUpdateKind; Error: EReconcileError);
begin
  FDataSet := DataSet;
  FUpdateKind := UpdateKind;
  FError := Error;
  inherited Create(Application);
end;

{ Create a list of the data fields in the dataset, and store string values
  associated with NewValue, OldValue, and CurValue in string variables
  to make display switching faster }

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 := VarToStr(NewValue, DataType);
      V := CurValue;
      if not VarIsEmpty(V) then HasCurValues := True;
      FD.CurValue := VarToStr(CurValue, DataType);
      if FUpdateKind <> ukInsert then
        FD.OldValue := VarToStr(OldValue, DataType);
      FDataFields.Add(FD);
    except
      Dispose(FD);
      raise;
    end;
  end;
  InitUpdateData(HasCurValues);
end;

{ Initialize the column indexes and grid titles }

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;

{ Update the reconcile action radio group based on the valid reconcile actions }

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;

{ Update the grid based on the current display options }

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.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;

{ For fields that the user has edited, copy the changes back into the
  NewValue property of the associated field }

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;

{ Event handlers }

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; { Do not localize }
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;

{ Set the Edited flag in the DataField list and save the value }

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;

{ Enable the editing in the grid if we are on the NewValue column and the
  current reconcile action is raCorrect }

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.

REMOTE.DFM

object ActiveRemote: TActiveRemote
  Left = 200
  Top = 108
  Width = 354
  Height = 251
  Caption = 'ActiveRemote'
  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 = 33
    Width = 346
    Height = 191
    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 = 346
    Height = 33
    Align = alTop
    TabOrder = 1
    object CheckActive: TCheckBox
      Left = 120
      Top = 8
      Width = 65
      Height = 17
      Caption = 'Active'
      TabOrder = 0
      OnClick = CheckActiveClick
    end
    object BtnApply: TButton
      Left = 9
      Top = 4
      Width = 96
      Height = 25
      Caption = 'Apply Updates'
      TabOrder = 1
      OnClick = BtnApplyClick
    end
  end
  object ClientDataSet1: TClientDataSet
    Aggregates = <>
    Params = <>
    ProviderName = 'DataSetProvider1'
    RemoteServer = SocketConnection1
    OnReconcileError = ClientDataSet1ReconcileError
    Left = 40
    Top = 80
  end
  object DataSource1: TDataSource
    DataSet = ClientDataSet1
    Left = 40
    Top = 136
  end
  object SocketConnection1: TSocketConnection
    ServerGUID = '{C5DDE903-2214-11D1-98D0-444553540000}'
    ServerName = 'AppServTwo.RdmCount'
    Address = '127.0.0.1'
    Left = 40
    Top = 24
  end
end

RECONDLG.DFM

object ReconcileErrorForm: TReconcileErrorForm
  Left = 225
  Top = 159
  BorderStyle = bsDialog
  Caption = 'Update Error'
  ClientHeight = 311
  ClientWidth = 527
  Color = clBtnFace
  ParentFont = True
  OldCreateOrder = True
  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 = {
      055449636F6E0000010002002020100000000000E80200002600000020200200
      00000000300100000E0300002800000020000000400000000100040000000000
      0002000000000000000000000000000000000000000000000000800000800000
      00808000800000008000800080800000C0C0C000808080000000FF0000FF0000
      00FFFF00FF000000FF00FF00FFFF0000FFFFFF00000008888888888888888888
      8888880000008888888888888888888888888880003000000000000000000000
      0008888803BBBBBBBBBBBBBBBBBBBBBBBB7088883BBBBBBBBBBBBBBBBBBBBBBB
      BBB708883BBBBBBBBBBBBBBBBBBBBBBBBBBB08883BBBBBBBBBBBB7007BBBBBBB
      BBBB08803BBBBBBBBBBBB0000BBBBBBBBBB7088003BBBBBBBBBBB0000BBBBBBB
      BBB0880003BBBBBBBBBBB7007BBBBBBBBB708800003BBBBBBBBBBBBBBBBBBBBB
      BB088000003BBBBBBBBBBB0BBBBBBBBBB70880000003BBBBBBBBB707BBBBBBBB
      B08800000003BBBBBBBBB303BBBBBBBB7088000000003BBBBBBBB000BBBBBBBB
      0880000000003BBBBBBB70007BBBBBB708800000000003BBBBBB30003BBBBBB0
      88000000000003BBBBBB00000BBBBB70880000000000003BBBBB00000BBBBB08
      800000000000003BBBBB00000BBBB7088000000000000003BBBB00000BBBB088
      0000000000000003BBBB00000BBB708800000000000000003BBB70007BBB0880
      00000000000000003BBBBBBBBBB70880000000000000000003BBBBBBBBB08800
      000000000000000003BBBBBBBB7088000000000000000000003BBBBBBB088000
      0000000000000000003BBBBBB708800000000000000000000003BBBBB0880000
      00000000000000000003BBBB70800000000000000000000000003BB700000000
      0000000000000000000003330000000000000000F8000003F0000001C0000000
      80000000000000000000000000000001000000018000000380000003C0000007
      C0000007E000000FE000000FF000001FF000001FF800003FF800003FFC00007F
      FC00007FFE0000FFFE0000FFFF0001FFFF0001FFFF8003FFFF8003FFFFC007FF
      FFC007FFFFE00FFFFFE01FFFFFF07FFFFFF8FFFF280000002000000040000000
      0100010000000000800000000000000000000000000000000000000000000000
      FFFFFF000000000000000000000000003FFFFFC07FFFFFE07FFFFFF07FFCFFF0
      7FF87FE03FF87FE03FFCFFC01FFFFFC01FFDFF800FFDFF800FFDFF0007F8FF00
      07F8FE0003F8FE0003F07C0001F07C0001F0780000F0780000F070000078F000
      007FE000003FE000003FC000001FC000001F8000000F8000000F000000060000
      00000000FFFFFFFFFFFFFFFFC000001F8000000F000000070000000700000007
      000000078000000F8000000FC000001FC000001FE000003FE000003FF000007F
      F000007FF80000FFF80000FFFC0001FFFC0001FFFE0003FFFE0003FFFF0007FF
      FF0007FFFF800FFFFF800FFFFFC01FFFFFC01FFFFFE03FFFFFE03FFFFFF07FFF
      FFF8FFFF}
  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