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;
フォームのデザイン
追加するコード
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のプロパティが即座に更新されます。
もっといい方法があれば教えてください。