Componentes.Terceros.RemObjects/official/5.0.23.613/Data Abstract for Delphi/Samples/Business Processor/BusinessProcessorClientUnit1.pas

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.