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
|
Home:
Code Repository:
Mastering Delphi 5