グラフィックコントロールの問題

解決

おおさわ 2005-08-24 02:05:46 No: 17227

質問です。次のようなコードを書き、TSampleControl をフォームに貼り付けると、実行終了時に EPrivilege 例外が発生してしまいます。
どこがいけないのかご教授いただけないでしょうか？

unit cmp;

interface

uses
Controls, Classes;

type
  TChildControl = class(TGraphicControl)
  protected
    procedure Paint; override;
  end;

  TSampleControl = class(TGraphicControl)
  protected
    FChildControl: TChildControl;
    procedure Paint; override;
    procedure SetParent(AParent: TWinControl); override;
    procedure SetChildControl(Value: TChildControl);
  public
    constructor Create(AOwner: TComponent); override;
  published
    property ChildControl: TChildControl read FChildControl write SetChildControl;
  end;

  TBaseControl = class(TWinControl)
  private
    FSampleControl: TSampleControl;
    procedure SetSampleControl(Value: TSampleControl);
  public
    constructor Create(AOwner: TComponent); override;
  published
    property SampleControl: TSampleControl read FSampleControl write SetSampleControl;
  end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('sample', [TBaseControl]);
end;

procedure TChildControl.Paint;
begin
inherited;
Canvas.Rectangle(ClientRect);
end;

constructor TSampleControl.Create(AOwner: TComponent);
begin
  inherited;
  FChildControl:= TChildControl.Create(Self);
  FChildControl.Name:= 'ChildControl';
  FChildControl.Width:= 100;
  FChildControl.Height:= 100;
end;

procedure TSampleControl.Paint;
begin
inherited;
Canvas.Rectangle(ClientRect);
end;

procedure TSampleControl.SetParent(AParent: TWinControl);
begin
  inherited;
  if Assigned(FChildControl) then begin
    FChildControl.Parent:= AParent;
    FChildControl.Visible:= True;
  end;
end;

procedure TSampleControl.SetChildControl(Value: TChildControl);
begin
FChildControl:= Value;
end;

end.

おおさわ 2005-08-24 02:06:51 No: 17228

すみません。
RegisterComponents('sample', [TBaseControl]);
⇒ RegisterComponents('sample', [TSampleControl]);

です。

メラトニン 2005-08-25 23:11:58 No: 17229

不思議な設計ですが…
constructor TSampleControl.Create(AOwner: TComponent);
begin
  inherited;
  FChildControl:= TChildControl.Create(AOwner); //変更
  //FChildControl.Name:= 'ChildControl'; //重複します
  FChildControl.Width:= 20;
  FChildControl.Height:= 20;
end;

メラトニン 2005-08-25 23:21:11 No: 17230

スミマセンうそ書きました。

せみ元気 2005-08-25 23:37:29 No: 17231

TSampleControlのコンストラクタでFChildControlをCreateしているのだから
デストラクタでをFreeしないとＡＶが出ると思う。

内部でCreateしているのに
TSampleControl.SetChildControlで設定できるというのも、ちょっと変。

ふむふむふむの助 2005-08-26 00:45:42 No: 17232

> TSampleControlのコンストラクタでFChildControlをCreateしているのだから
> デストラクタでをFreeしないとＡＶが出ると思う。
メモリーリークするだけで、ＡＶは出ないでしょう。

> 内部でCreateしているのに
> TSampleControl.SetChildControlで設定できるというのも、ちょっと変。
インスタンスを入れ替えしたいのか、ChildControlの設定をコピーしたいのか、
やりたいことによって書き方は異なるが、インスタンスの入れ替えをするのなら、
Notificationをoverrideして、ChildControlがFreeされたとき、TSampleControlで
参照しているインスタンスをnilにすることが必要。

全コードが貼り付けてないようだが、設計がおかしい(と思う)点を除けば、エラーになる理由は不明。

フォームに貼り付けて、実行→即終了でもエラーがでますか？
エラーの内容は？アクセス違反？

おおさわ 2005-08-26 06:40:11 No: 17233

回答ありがとうございます。まず、コードの内容に不備があったので、訂正します。

unit cmp;

interface

uses
Controls, Classes;

type
  TChildControl = class(TGraphicControl)
  protected
    procedure Paint; override;
  end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('sample', [TSampleControl]);
end;

procedure TChildControl.Paint;
begin
inherited;
Canvas.Rectangle(ClientRect);
end;

procedure TSampleControl.Paint;
begin
inherited;
Canvas.Rectangle(ClientRect);
end;

procedure TSampleControl.SetParent(AParent: TWinControl);
begin
  inherited;
  if Assigned(FChildControl) then begin
    FChildControl.Parent:= AParent;
    FChildControl.Visible:= True;
  end;
end;

procedure TSampleControl.SetChildControl(Value: TChildControl);
begin
FChildControl:= Value;
end;

end.

これが全コードです。

> インスタンスを入れ替えしたいのか、ChildControlの設定をコピーしたいのか、
ChildControl の設定をコピーしたい方です。

> フォームに貼り付けて、実行→即終了でもエラーがでますか？
> エラーの内容は？アクセス違反？
はい。エラーの内容は特権命令違反のようです。

「FChildControl.Parent:= AParent;」をコメントアウトするとエラーは発生しなくなるので、これに何らかの原因があるのだと思います。
ただ、コメントアウトしても直接的な解決にはならないので、これ以外のエラー回避の方法を教えていただけると幸いです。

おおさわ 2005-08-26 07:21:55 No: 17234

せみ元気さん
> TSampleControlのコンストラクタでFChildControlをCreateしているのだから
> デストラクタでをFreeしないとＡＶが出ると思う。

確か DestroyComponents という、所有コンポーネントを破棄するメソッドが自動的に内部で呼び出されるはずなので、その必要はなかった気がするのですが…。

Mr.XRAY URL 2005-08-26 10:01:44 No: 17235

>実行終了時に EPrivilege 例外が発生してしまいます

実行終了時，つまり，コンポーネントが削除される時には，SetParentの
AParentがなくなっています．そこで例外が発生すると思われます．
以下のコードでテストしました．これですと例外は発生しません．

procedure TChildControl.Paint;
begin
inherited;
Canvas.Rectangle(ClientRect);
end;

constructor TSampleControl.Create(AOwner: TComponent);
begin
inherited;
end;

procedure TSampleControl.Paint;
begin
inherited;
Canvas.Rectangle(ClientRect);
end;

procedure TSampleControl.SetParent(AParent: TWinControl);
begin
inherited;

//AParent=nilでは(コン削除時も含む)では何もしない (*ここがミソ)
if AParent=nil then exit;

  if not Assigned(FChildControl) then begin
    FChildControl:= TChildControl.Create(Self);
    FChildControl.Name:= 'ChildControl';
    FChildControl.Width:= 100;
    FChildControl.Height:= 100;

    FChildControl.Parent:= AParent;
    FChildControl.Visible:= True;
  end;
end;

procedure TSampleControl.SetChildControl(Value: TChildControl);
begin
FChildControl:= Value;
end;

Mr.XRAY URL 2005-08-26 10:07:49 No: 17236

>  if not Assigned(FChildControl) then begin
>    FChildControl:= TChildControl.Create(Self);
>    FChildControl.Name:= 'ChildControl';
>    FChildControl.Width:= 100;
>    FChildControl.Height:= 100;>

>    FChildControl.Parent:= AParent;
>    FChildControl.Visible:= True;
>  end;

FChildControl関係を一つにまとめたのは，その方が見通しがいいからです．

おおさわ 2005-08-29 03:53:07 No: 17237

> Mr.XRAY さん
ありがとうございます。ドンピシャリです。
どうやら破棄時にも SetParent が呼び出されているみたいですね。盲点でした。