Marco Web Center |
Home: Code Repository: Mastering Delphi 5Project AFREMOTE
Project StructureAFREMOTE.DPRlibrary 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.PASunit 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.PASunit 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.DFMobject 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.DFMobject 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
|
||
© Copyright Marco Cantù, 1995-2020, All rights reserved |