unit BusinessProcessorClientUnit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, uDADelta, uDADataTable, DB, BizSchemaClient, uDARemoteDataAdapter; type TBusinessProcessorClientForm2 = class(TForm) ScrollBox: TScrollBox; BottomPanel: TPanel; TopPanel: TPanel; OkButton: TButton; CancelButton: TButton; CloseButton: TButton; procedure FormCreate(Sender: TObject); procedure OkButtonClick(Sender: TObject); procedure CancelButtonClick(Sender: TObject); private { Private declarations } dbeditHeight, labelheight: integer; FChange: TDADeltaChange; Datasource: TDADataSource; procedure Setup; procedure GenerateControls; procedure ApplyErrorMessage(BizErrorMessage: TBizErrorMessage); procedure OnFieldValueChanged(Sender: TObject); public { Public declarations } end; procedure ReconcileDialogShowDetails(AChange: TDADeltaChange; aTable: TDADataTable;var AAction: TDAReconcileDialogAction); implementation uses uDAInterfaces, uROClasses, dbCtrls; {$R *.dfm} const labelWidth = 100; editWidth = 200; c_Color: TColor = clMoneyGreen; procedure ReconcileDialogShowDetails(AChange: TDADeltaChange; aTable: TDADataTable;var AAction: TDAReconcileDialogAction); var FFiltered: Boolean; FMasterDS: TDADataSource; FRemoteFetchEnabled: Boolean; FMasterFields: string; begin with TBusinessProcessorClientForm2.Create(Application) do try FChange := AChange; FFiltered := ATable.Filtered; FMasterDS := aTable.MasterSource; FMasterFields := aTable.MasterFields; FRemoteFetchEnabled := aTable.RemoteFetchEnabled; try ATable.Filtered := False; aTable.MasterSource := nil; aTable.MasterFields := ''; aTable.RemoteFetchEnabled := False; DataSource.DataTable := aTable; Setup; case ShowModal() of mrOk: AAction := rdlgSkip; mrCancel: AAction := rdlgCancel; else AAction := rdlgNone; end; finally aTable.RemoteFetchEnabled := FRemoteFetchEnabled; aTable.Filtered := FFiltered; aTable.MasterSource := FMasterDS; aTable.MasterFields := FMasterFields end; finally Release; end; end; { TShowDetailsForm } procedure TBusinessProcessorClientForm2.Setup; var BizErrorMessage: TBizErrorMessage; begin if FChange.ChangeType <> ctDelete then with DataSource.DataTable do if not Locate(RecIDFieldName, FChange.RecID, []) then RaiseError('Couldn''t find record #' + FormatRecIDString(FChange.RecID)); GenerateControls; BizErrorMessage := TBizErrorMessage.Create; try BizErrorMessage.AsString := FChange.Message; ApplyErrorMessage(BizErrorMessage); finally BizErrorMessage.Free; end; if Screen.Height > Self.Height + (ScrollBox.VertScrollBar.Range - ScrollBox.Height) then Self.Height := Self.Height + (ScrollBox.VertScrollBar.Range - ScrollBox.Height) else Self.Height := Screen.Height; case FChange.ChangeType of ctInsert: OkButton.Caption := 'Skip'; ctUpdate: OkButton.Caption := 'Skip'; ctDelete: OkButton.Caption := 'Skip'; end; end; procedure TBusinessProcessorClientForm2.GenerateControls; var i: integer; aField: string; aTop, aleft: integer; FLabel: TLabel; FdbEdit: TDBEdit; FEdit: TEdit; begin aleft := 7; aTop := 7; for i := 0 to FChange.Delta.LoggedFieldCount - 1 do begin aField := FChange.Delta.LoggedFieldNames[i]; aTop := 7 + (3 + dbeditHeight) * i; aleft := 7; FLabel := TLabel.Create(Self); with FLabel do begin Parent := ScrollBox; Name := 'l_' + aField; Caption := aField; Left := aleft; Top := (dbeditHeight - Height) div 2 + aTop + 1; Width := labelWidth; aleft := aleft + 7 + labelWidth; end; if FChange.ChangeType in [ctInsert, ctUpdate] then begin if Self.DataSource.DataTable.FieldByName(aField).DataType = datBlob then begin FEdit := TEdit.Create(Self); with FEdit do begin Name := 'dbe_' + aField; Parent := ScrollBox; Left := aleft; aleft := aleft + 7 + editWidth; Top := aTop; Width := editWidth; ReadOnly := True; Text := '[blob]'; end; end else begin FdbEdit := TDBEdit.Create(Self); with FdbEdit do begin Name := 'dbe_' + aField; DataSource := Self.DataSource; Parent := ScrollBox; DataField := aField; Left := aleft; Top := aTop; Width := editWidth; OnChange := OnFieldValueChanged; aleft := aleft + 7 + editWidth; if (FChange.ChangeType = ctUpdate) and not ROVariantsEqual(FChange.OldValues[i], FChange.NewValues[i]) then Color := c_Color; end; end; end; if FChange.ChangeType in [ctUpdate, ctDelete] then begin FEdit := TEdit.Create(Self); with FEdit do begin Name := 'e_' + aField; Parent := ScrollBox; Left := aleft; aleft := aleft + 7 + editWidth; Top := aTop; Width := editWidth; ReadOnly := True; Color := clBtnFace; if Self.DataSource.DataTable.FieldByName(aField).DataType = datBlob then begin Text := '[blob]' end else begin case FChange.ChangeType of ctDelete: text := VarToStr(FChange.OldValues[i]); ctUpdate: begin if not Self.DataSource.DataTable.HasReducedDelta then text := VarToStr(FChange.OldValues[i]) else if not VarIsEmpty(FChange.OldValues[i]) then text := VarToStr(FChange.OldValues[i]) else text := Self.DataSource.DataTable.FieldByName(aField).AsString; end; end; end; end; end; end; inc(aTop, 20); inc(aLeft, 7); //ScrollBox.HorzScrollBar.Range := aleft; Self.ClientWidth := aleft + ScrollBox.VertScrollBar.Size + 2; Self.Constraints.MinWidth := Self.Width; Self.Constraints.MaxWidth := Self.Width; ScrollBox.VertScrollBar.Range := aTop; end; procedure TBusinessProcessorClientForm2.FormCreate(Sender: TObject); begin inherited; with TDBEdit.Create(Self) do try dbeditHeight := Height; finally free; end; with TLabel.Create(Self) do try labelheight := Height; finally free; end; Datasource := TDADataSource.Create(Self); end; procedure TBusinessProcessorClientForm2.OkButtonClick(Sender: TObject); begin if DataSource.DataTable.State in [dsEdit, dsInsert] then DataSource.DataTable.Post; end; procedure TBusinessProcessorClientForm2.CancelButtonClick(Sender: TObject); begin if DataSource.DataTable.State in [dsEdit, dsInsert] then DataSource.DataTable.Cancel; end; procedure TBusinessProcessorClientForm2.ApplyErrorMessage( BizErrorMessage: TBizErrorMessage); var i: integer; FLabel: TLabel; Fcomp: TComponent; aTop: integer; begin ShowHint := True; Caption := Datasource.DataTable.LogicalName; FLabel := TLabel.Create(Self); with FLabel do begin Parent := TopPanel; i := pos(sLineBreak, BizErrorMessage.Message); if i = 0 then Caption := BizErrorMessage.Message else Caption := copy(BizErrorMessage.Message, 1, i-1); Hint := Caption; Left := 7; Top := 7; AutoSize := true; WordWrap := True; AutoSize := False; Height:= labelheight * (Width div (Parent.ClientWidth - Left * 2)+1); Width := Parent.ClientWidth - Left * 2; { if BizErrorMessage.ItemCount = 0 then Height := labelheight * 4 else Height := labelheight; } aTop := Height + Top + 3; Anchors := Anchors + [akRight]; end; for i := 0 to BizErrorMessage.ItemCount - 1 do begin with BizErrorMessage.Items[i] do begin Fcomp := Self.FindComponent('l_' + Field); if Fcomp <> nil then TLabel(Fcomp).Font.Color := clRed; FLabel := TLabel.Create(Self); with FLabel do begin Parent := TopPanel; Name := 'error_' + Field; Caption := ErrorMessage; Left := 7; Top := aTop; AutoSize := True; Font.Color := clRed; aTop := Height + Top + 3; end; end; end; TopPanel.ClientHeight := aTop; end; procedure TBusinessProcessorClientForm2.OnFieldValueChanged( Sender: TObject); begin OkButton.Caption := 'Update'; end; end.