TLinkControlToFieldのOnAssignedValueイベントでPostすると無限ループになる問題を回避策について

LiveBindingsをつかっているとき、ユーザーが入力欄に入力すると、TLinkControlToFieldのOnAssignedValueイベントが発生します。

このときにTPrototypeBindSourceのPostメソッドでオブジェクトに入力内容を反映すると、無限ループに陥りします。

無限ループに陥る失敗例

procedure TForm1.LinkControlToField1AssignedValue(Sender: TObject;
  AssignValueRec: TBindingAssignValueRec; const Value: TValue);
begin
  if PrototypeBindSource1.Editing then
    PrototypeBindSource1.Post;
end;

TPrototypeBindSourceのPostメソッドが呼ばれるとTLinkControlToFieldのOnAssignedValueイベントが発生し、その中でまたTPrototypeBindSourceのPostメソッドがよばれて…
と無限ループになります。

回避策としては、フラグ変数を用意して最初のPostが終わるまでは、次のPostを呼ばれないようにします。

正しく動作する例

procedure TForm1.LinkControlToField1AssignedValue(Sender: TObject;
  AssignValueRec: TBindingAssignValueRec; const Value: TValue);
begin
  if PrototypeBindSource1.Editing then
  begin
    if not FAutoPosting then //FAutoPostingはBoolean型のフォームのメンバ変数
    begin
      FAutoPosting := True;
      try
        PrototypeBindSource1.Post;
      finally
        FAutoPosting := False;
      end;
    end;
  end;
end;

以下、サンプルプログラムです。

使用するオブジェクト。何でもいいです。

  TEmployee = class(TObject)
  private
    FLastName: String;
    FFirstName: String;
    FBirthDay: TDate;
  public
    constructor Create(const AFirstName, ALastName: String;
      ABirthDay: TDate); overload;
    property FirstName: String read FFirstName write FFirstName;
    property LastName: String read FLastName write FLastName;
    property BirthDay: TDate read FBirthDay write FBirthDay;
  end;

constructor TEmployee.Create(const AFirstName, ALastName: String;
  ABirthDay: TDate);
begin
  inherited Create;
  FFirstName := AFirstName;
  FLastName := ALastName;
  FBirthDay := ABirthDay;
end;

フォームのデザイン

フォームのデザイン

LiveBindingsデザイナ

追加するコード

  TForm1 = class(TForm)
  …
  private
    { private 宣言 }
    FEmployee: TEmployee;
    FAutoPosting: Boolean;
  public
    { public 宣言 }
    constructor Create(AOwner: TComponent); override;
  end;

constructor TForm1.Create(AOwner: TComponent);
begin
  FAutoPosting := False;
  FEmployee := TEmployee.Create('John', 'Anders', StrToDate('1980/01/01'));
  inherited;
end;

procedure TForm1.LinkControlToField1AssignedValue(Sender: TObject;
  AssignValueRec: TBindingAssignValueRec; const Value: TValue);
begin
  if PrototypeBindSource1.Editing then
  begin
    if not FAutoPosting then
    begin
      FAutoPosting := True;
      try
        PrototypeBindSource1.Post;
      finally
        FAutoPosting := False;
      end;
    end;
  end;
end;

procedure TForm1.PrototypeBindSource1CreateAdapter(Sender: TObject;
  var ABindSourceAdapter: TBindSourceAdapter);
begin
  ABindSourceAdapter := TObjectBindSourceAdapter<TEmployee>.Create
    (PrototypeBindSource1, FEmployee);
end;

プログラムを実行し、入力欄に入力すると、FEmployeeのプロパティが即座に更新されます。

実行画面

もっといい方法があれば教えてください。

コメントを残す

メールアドレスが公開されることはありません。 が付いている欄は必須項目です

このサイトはスパムを低減するために Akismet を使っています。コメントデータの処理方法の詳細はこちらをご覧ください