カスタムコントロール：独自イベントを作成するには？
お世話になります。
例えばクラス型のプロパティが変更した時に発生するイベントを定義するにはどうしたものでしょうか？
Delphiヘルプのカスタムコントロールのトピックを見てもわかりません。特にメッセージについてのところがなにがなんだか・・・
メッセージを定義するところまではいいのですが、その定義したメッセージをどのように発生させるのかがわかりません。
そもそもイベントについてまだ謎なところがあって、
Form1の上にLabel1があったときにそのLabel1のOnClickイベントを定義すると
procedure TMyForm.Label1Click(Sender:TObject)
が定義されますよね？
しかし、なぜこれだけで、TLabel1のOnClickイベントと結びつくのですか？前回質問事項もまだ解決できていませんが、都合で新規プロジェクトを作りまくってたときにふと疑問に思ったのです。イベントって謎ですね・・・
>なぜこれだけで、TLabel1のOnClickイベントと結びつくのですか？
DelphiのIDE で TLabel1選択時のオブジェクトインスペクタで
イベントタブ：OnClick欄にLabel1Clickが指定されているいるからじゃないですか？
コード上で指定する場合は、
Label1.OnClick := Label1Click;
でも、可能ですけど。
>プロパティが変更した時に発生するイベントを定義
こんな感じですか？
（動作確認していないので、もしかしたらおかしいところがあるかもしれませんが。）
TMyTreeView = class(TTreeView)
private
{ Private 宣言 }
FMyCheck: boolean;
FOnMyCheckChanged: TNotifyEvent;
procedure SetMyCheck(const Value: boolean);
public
{ Public 宣言 }
constructor Create(AOwner: TComponent); override;
published
{ Published 宣言 }
property MyCheck: boolean read FMyCheck write SetMyCheck default False;
property OnMyCheckChanged: TNotifyEvent read FOnMyCheckChanged write FOnMyCheckChanged;
end;
Constructor TMyTreeView.Create(AOwner: TComponent);
begin
Inherited Create(AOwner);
FMyCheck := False;
end;
procedure TMyTreeView.SetMyCheck(const Value: boolean);
begin
FMyCheck := Value;
if Assigned(FOnMyCheckChanged) then
OnMyCheckChanged(Self);
end;
>イベントを定義するにはどうしたものでしょうか
まず、メッセージは関係なく、カスタムコントロールも関係ありません。
これは、ただの言語機構で、関数呼び出しに過ぎないと思っていただければ
理解しやすいのではないかと思います。
Delphiは、クラス宣言で
TClassA = class
private
FValueA: string;
FB: string;
function GetA: string; //注目
procedure SetA( Value: string); //注目
public
property A: string read GetA write SetA; //注目
property B: string read FB write FB;
end;
のようにすると
var
ClassA: TClassA;
begin
ClassA:= TClassA.Create;
ClassA.A:='TEST'; // ...(1)
Writeln( ClassA.A) // ...(2)
ClassA.B:='TEST'; // ...(3)
Writeln( ClassA.B);// ...(4)
ClassA.Free;
end;
(1)で SetA が呼び出され
(2)で GetA が呼び出される
という機能があります。
また、read,writeで指定されたものが変数なら
その変数に代入したり参照したりできるようになります。
(3)で FBに代入
(4)で FBを参照
なので 「手続き SetA」で、「手続き Test」を
呼び出すようにプログラムを書いておけば
ClassA.Aに値を設定した時「手続き Test」も呼び出されます。
TClassA = class
private
FValueA: string;
function GetA: string;
function SetA( Value: string);
procedure Test( Sender: TObject); //追加
public
property A: string read GetA write SetA;
end;
function TClassA.SetA( Value: string); //※1
begin
if FValueA<>Value then
begin
FValueA:=ValueA;
Test(Self);
end;
end;
このままでは、容易にはクラスの外から Test()の内部で
実行させるコードを変更することができないので、
Test を外部クラスから任意のコードが実行できるように
Testを 空のオブジェクトにします。
それが、イベントと呼ばれていますが、実は、ただの関数の抜け殻です。
TClassA = class
private
FValueA: string;
FOnTest: TNotifyEvent; //追加
function GetA: string;
function SetA( Value: string);
// procedure Test( Sender: TObject); //削除
public
property A: string read GetA write SetA;
property Test: TNotifyEvent read FOnTest write FOnTest; //追加
end;
また、TNotifyEventの宣言は
TNotifyEvent = procedure( Sender:TObject) of object
となっています。
ので、これと引数があっていれば
Testの実体として与えることができるようになります。
procedure Form1.FormCreate(Sender: TObject);
begin
ClassA:= TClassA.Create;
ClassA.Test:= ClassATest; //注目
end;
procedure Form1.Button1Click(Sender:TObject);
begin
ClassA.A:='プロパティの値を変更します';
end;
procedure Form1.ClassATest( Sender: TObject); //注目
begin
MessageDlg('Testが実行されました',mtInformation,[mbOK],0);
end;
TNotifyEventなどと名前がついておりますが。
TProcedureObject = procedure of object;
に (Sender: TObject)という引数が加わっただけのオブジェクトのメソッドの型
に過ぎません。
最後に保護のために
※1 を以下のようにします。
function TClassA.SetA( Value: string);
begin
if FValueA<>Value then
begin
FValueA:=ValueA;
if Assigned( FOnTest) then FOnTest(Self); //これ
end;
end;
これで FOnTest=nil の時は実行しないようにできます。
蛇足ですが、一般的に
TClassA = class
public
Test: TNotifyEvent;
end;
とは、書かないほうが良いようです。
TClassA = class
private
FOnTest: TNotifyEvent;
public
property Test: TNotifyEvent read FOnTest write FOnTest; //追加
end;
スレッドとか、マルチタスクOSのメッセージプロシージャとか
そういう事との絡みだと思いますが・・・
なぜなのかは、その道のプロに聞いたほうが良いでしょう。
idyさんfさんありがとうございます。
TMyPersistent=class(TPersistent)
private
FOnChanging: TnotifyEvent;
FMyTag: Integer;
published
Property MyTag:Integer Read FMyTag write setMyTag ;
property OnChanging:TnotifyEvent read FOnChanging write FOnChanging ;
end;
TMyCustomControl = class(Tcustomcontrol)
private
FOnMyPersistentChange: TNotifyEvent;
FMyPersistent:TMyPersistent;
procedure SetMyPersistent(const Value:TMyPersistent);
protected
procedure MyPersistentChange(AObject:TObject);
published
property OnMyPersistentChange:TNotifyEvent Read FOnMyPersistentChange write FOnMyPersistentChange ;
property MyPersistent:TMyPersistent read FMyPersistent write SetMyPersistent ;
end;
{TMyPersistent}
procedure TMyPersistent.setMyTag(const Value: Integer);
begin
FMyTag := Value;
if assigned(FOnchanging) then FonChanging(self);
end;
{TMyCustomControl}
constructor TMyCustomControl.Create(AOwner: TComponent);
FOnMyPersistentChange:=MyPersistent.FOnChanging;
begin
procedure TMyCustomControl.MyPersistentChange(AObject: TObject);
begin
inherited ;
if assigned(FOnBlockChange) then FOnBlockChange(self);
Repaint;
end;
procedure SetMyPersistent(const Value:TMyPersistent);
begin
MyPersistent:=Value;
end;
上のようなコードで、結局のところMyPersistentプロパティが変更されるたびに再描画したかっただけなのですが、自分にはTMyPersistentに変更された時のイベントを定義して・・・
と、うだうだする方法しか思い浮かばなかったのです。しかし、上のコードではプロパティが変更されたときは再描画が施されません。
なので、MyPersistentプロパティが変更したときに、自前のメッセージを宣言して・・・また、うだうだするのかなぁと思ったんです。そのとき、メッセージの宣言まではなんとか理解しているつもりでいるのですが、どうもメッセージを宣言したところでそのメッセージがどのような具合に発信されるのかがいまいちわかりません。もし、TMyPersistentがメッセージを発信できるのならどのようにすればいいのか教えてください。そもそもメッセージの発信などという言葉があるのかは知りませんが、自分が何を勘違いしているのか、勘違いしているのかもわかりません。ただ、質問させていただいたのは、このような過程があったからです。もちろん、MyPersistentプロパティが変更したときに、再描画する方法が他にもあれば、それでいいといえばいいのですが、ここまで考えた手前、あまり気が進まないのです。よろしくお願いします。
荒らしたようでごめんなさい。
idyさんではigyさんでした。
また、
>MyPersistentプロパティが変更したときに、自前のメッセージを宣言して・
を細かく言うと、
TMyPersistentが変更されたとき自前メッセージを発信、
そのメッセージに対するメソッドをTMyCustomControlで作成
晴れて、再描画完了
という夢の道を描いたのです。
{
>MyPersistentプロパティが変更したときに
>procedure SetMyPersistent(const Value:TMyPersistent);
クラス指定子が無いのですが、これもクラスメソッドですよね？
イベントのアサイン先が逆っぽいなぁ。
TMyPersistentのプロパティの変化に応答したいのであれば、
TMyPersistent.OnChangeに TMyCustomControlのメソッドをアサインするのが
一般的なのではないかと思います。
直してみました
}
interface
TMyPersistent=class(TPersistent)
private
FOnChanging: TnotifyEvent;
FMyTag: Integer;
published
Property MyTag:Integer Read FMyTag write setMyTag ;
property OnChanging:TnotifyEvent read FOnChanging write FOnChanging ;
end;
TMyCustomControl = class(Tcustomcontrol)
private
//FOnMyPersistentChange: TNotifyEvent; //削除
FMyPersistent:TMyPersistent;
procedure SetMyPersistent(const Value:TMyPersistent);
protected
procedure MyPersistentChange(AObject:TObject);
published
property OnMyPersistentChange:TNotifyEvent Read FOnMyPersistentChange write FOnMyPersistentChange ;
property MyPersistent:TMyPersistent read FMyPersistent write SetMyPersistent ;
end;
implementation
{TMyPersistent}
procedure TMyPersistent.SetMyTag(const Value: Integer);
begin
if FMyTag<>Value then
begin
FMyTag := Value;
if Assigned(FOnChanging) then FOnChanging(Self);
end;
end;
{TMyCustomControl}
constructor TMyCustomControl.Create(AOwner: TComponent);
begin
//FOnMyPersistentChange:=MyPersistent.FOnChanging; // ？
FMyPersistent:= TMyPersistent.Create; //追加
FMyPersistent.OnChanging:= MyPersistentChange; //追加
end;
procedure TMyCustomControl.MyPersistentChange(AObject: TObject);
begin
//inherited ; //？
//AObjectってなんだろう
if assigned(FOnBlockChange) then FOnBlockChange(Self);
Repaint;
end;
procedure TMyCustomControl.SetMyPersistent(const Value:TMyPersistent);
begin
if not Assigned( Value) then
Raise Exception.Create('MyPersistent is nil');
if MyPersistent<>Value then
begin
MyPersistent.Assign(Value);
end;
//または
{
if MyPersistent<>Value then
begin
MyPersistent.Free;
MyPersistent:= Value;
end;
}
end;
ありがとうございます。大変さんこうになります。でも、まだ試してません。すいません。まずはお返事だけでもと思いまして（何せ忙しいもので…）。
Aobjectはコピーするときのミスです。すいません。
ところで、余談になるかもしれませんが・・・
procedure TMyCustomControl.SetMyPersistent(const Value:TMyPersistent);
begin
Refresh;
end;
とすると読みこみ違反が起きてしまいます。何がいけないのでしょうか？
再描画したいだけなのに…、それとも正しくコードをかけばそんな読みこみ違反はおきないのでしょうか。
どうかなさん。大変もうしわけありません。
結論から言うとできませんでしたです。スタックオーバーでDelphiが終了します・・・。
と、いうよりRepaintが原因なよう気がするのですが、そうでもないのでしょうか？
> 結論から言うとできませんでしたです。スタックオーバーでDelphiが終了します・・・。
そら、当然ですわ。
> procedure SetMyPersistent(const Value:TMyPersistent);
> begin
> MyPersistent:=Value;
> end;
これ、プロパティを再度更新しにいってます。
↓のように、再帰呼び出ししまくってるのと同じです。
procedure SetMyPersistent(const Value:TMyPersistent);
begin
SetMyPersistent(Value);
end;
↓のように、変数そのものを更新しないといけまへん。
procedure SetMyPersistent(const Value:TMyPersistent);
begin
FMyPersistent := Value;
end;
あごめん。俺のせい？
procedure TMyCustomControl.SetMyPersistent(const Value:TMyPersistent);
MyPersistent → FMyPersistent
じゃないと、スタックオーバーフローになりますね。
あははは（汗）
どうもです。できません。すいません。
オブジェクトインスペクタでMyPersistent型のプロパティを変えても一向に再描画されません。
コードでもいろいろ確認したのですが、新規プロジェクトにてOnMyPersistentChangeイベントに何か記述して、MyPersistent型のプロパティを変えても何も起きません。イベント自体が無意味に存在するだけみたいです。
参考になねかどうか判りませんが、最初のほうの内容を読んでいて、
んじゃ貼ってみようか・・な感じです。
まだ途中なんですが・・。自分も、あまり詳しくないので、どこかおかしいかも・・。
// ダイス途中版
// Delphi を立ち上げて、「全上書き」してください。
// ラベルをクリックしても動き出しますが、再度クリックしても止まりません。
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
private
{ Private 宣言 }
Bt2: TButton;
Bt3: TButton;
public
{ Public 宣言 }
procedure Srart(Sender: TObject);
procedure Stop(Sender: TObject);
constructor Create(AOwner: TComponent); override;
end;
TDice = class(TLabel)
ATimer: TTimer;
private
FOnClick: TNotifyEvent;
FOnTimer: TNotifyEvent;
public
constructor Create(AOwner: TComponent); override;
procedure Click; override;
procedure Start;
procedure Stop;
procedure Timer(Sender: TObject);
published
property OnClick: TNotifyEvent read FOnClick write FOnClick;
property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
end;
var
Form1: TForm1;
DDD0: TDice;
DDD1: TDice;
DDD2: TDice;
implementation
{$R *.dfm}
// TDice クラス定義 ------------------------------
constructor TDice.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ATimer := TTimer.Create(AOwner);
ATimer.Enabled := False;
ATimer.Interval := 100;
// ATimer.OnTimer := OnTimer; // ???????
ATimer.OnTimer := Timer;/////////////
Color := clRed;
AutoSize := False;
Alignment := taCenter;
Height := 50;
Width := 50;
Font.Size := 35;
Caption := '0';
end;
procedure TDice.Click;
begin
inherited Click; { 継承メソッドを呼び出す }
ATimer.Enabled := True;
end;
procedure TDice.Start;
begin
Click;
end;
procedure TDice.Stop;
begin
ATimer.Enabled := False;
end;
procedure TDice.Timer;
begin
Caption := IntToStr(Random(6)+1);
end;
/////////
// TForm1 クラス定義 --------------------------------
constructor TForm1.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Bt2 := TButton.Create(self);
with Bt2 do begin
Parent := self;
Left := 200;
Top := 5;
Caption := 'スタート';
OnClick := Srart;
end;
Bt3 := TButton.Create(self);
with Bt3 do begin
Parent := self;
Left := 200;
Top := 35;
Caption := 'ストップ';
OnClick := Stop;
end;
DDD0 := TDice.Create(self);
DDD0.Parent := self;
DDD1 := TDice.Create(self);
DDD1.Parent := self;
DDD1.Left := DDD1.Width + 4;
DDD2 := TDice.Create(self);
DDD2.Parent := self;
DDD2.Left := DDD1.Width*2 + 4*2;
end;
procedure TForm1.Srart;
begin
DDD0.Start;
DDD1.Start;
DDD2.Start;
end;
procedure TForm1.Stop;
begin
DDD0.Stop;
DDD1.Stop;
DDD2.Stop;
end;
end.
いまいち方向性がわかりませんが、メッセージなんて使わなくても（たぶん）希望の動作は実現できるでしょう。
一応、自分が書くなら、こうなるのをコピペします。
コンパイルしていないので、多少のミスは多めに見てください。
---[宣言部]---
//クラス型のプロパティ
TMyPersistent=class(TPersistent)
private
//本クラスプロパティが変化した時に発生するイベント
FOnChanging: TNotifyEvent;
//本クラスのプロパティ
FMyTag: Integer;
protected
//他のクラスからプロパティをコピるとき用
procedure Assign(aSource:TPersistent); override;
//プロパティ
procedure SetMyTag(aValue: Integer);
protected
//TMyCustomControl からのみ参照するイベントとするため
//protected でよい
//なぜなら、TMyCustomControl.OnMyPersistentChange が、
//実質のプロパティ変更イベントとして利用可能であるから
property OnChanging:TnotifyEvent read FOnChanging write FOnChanging;
published
property MyTag:Integer Read FMyTag write SetMyTag;
end;
TMyCustomControl = class(TCustomControl)
private
FOnMyPersistentChange: TNotifyEvent;
FMyPersistent:TMyPersistent;
public
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
private
//クラス型プロパティ更新処理
procedure SetMyPersistent(const aValue:TMyPersistent);
procedure MyPersistentChange(aObject:TObject);
published
//プロパティ
property MyPersistent:TMyPersistent read FMyPersistent write SetMyPersistent;
//イベント
property OnMyPersistentChange:TNotifyEvent Read FOnMyPersistentChange write FOnMyPersistentChange;
end;
たぶんクラス型プロパティの使い方以前に、クラスのインスタンスとInteger型のような
普通の変数の使い方とごっちゃになっている部分があるんじゃないかと思います。
コメントに対するつっこみは大歓迎なので、上級者の方でもおかしいと思ったら、ゼヒつっこみいれてください。
---[実装部]---
{TMyPersistent}
//他のクラスからプロパティをコピるとき用
procedure TMyPersistent.Assign(aSource:TPersistent);
begin
inherited Assign(aSource);
if aSource is TMyPersistent then begin
//aSource が TMyPersistent クラスか、その継承クラスであれば
//TMyPersistentで新たに定義したプロパティのみ更新する。
//TMyPersistentからさらに継承したクラスは、そのクラスで定義
//されたプロパティのみ更新するようにしておけばいい。
//そのための 「inherited Assign(aSource);」
MyTag := TMyPersistent(aSource).MyTag;
end;
end;
procedure TMyPersistent.SetMyTag(const Value: Integer);
begin
//通常は、値に変化があったときのみ更新する。
//不要なイベントが発生させないためでもある。
if FMyTag <> Value then begin
FMyTag := Value;
if Assigned(FOnChanging) then FOnChanging(Self);
end;
end;
{TMyCustomControl}
constructor TMyCustomControl.Create(aOwner: TComponent);
begin
//きっちり inherited 入れておく
inherited Create(AOwner);
//クラス型プロパティのインスタンスは、自分で生成しておかないと
//いけません。
FMyPersistent := TMyPersistent.Create;
//TMyPersistent のプロパティ変更イベントは、このクラスで受け取ります。
//このクラスを使用するフォーム？とかでイベントを設定しません。
//TMyPersistentは、TMyCustomControlの影に隠れる方が望ましいでしょう。
FMyPersistent.OnChanging := MyPersistentChange;
end;
destructor TMyCustomControl.Destroy;
begin
//当然、破棄も自分で面倒をみます
FMyPersistent.Free;
//忘れずに...
inherited Destory;
end;
procedure TMyCustomControl.SetMyPersistent(const aValue:TMyPersistent);
begin
//FMyPersistent := aValue;
//↑これでは、自分で用意したインスタンスが失われていまいます。
//クラス型プロパティは、基本的にプロパティ値の複写のみ行い、
//変数そのものを置き換えることはしません。
//それは一般的に Assign メソッドで行われます。
FMyPersistent.Assign(aValue);
//FMyPersistent := aValue; とした時点で、FMyPersistent <> nil だった場合、
//それまでの MyPersistent はどこにいくのでしょう？
//誰からも参照されず、いわゆるメモリーリークです。
//状況により、FMyPersistent := aValue; とする記述もありですが、
//クラスのインスタンスは、所有者をはっきりさせておくべきです。
end;
procedure TMyCustomControl.MyPersistentChange(aObject: TObject);
begin
//inherited ;
//↑上位クラスに同名メソッドがある場合にしか使用できません
//ここで発生するイベントは、TMyCustomControlを貼り付けたフォーム等で
//設計時に記述可能です。
if Assigned(FOnMyPersistentChange) then FOnMyPersistentChange(Aelf);
Repaint;
end;
イベントの書き方の超基本
type
TMyClass = class
private
FTag: integer;
FOnChange: TNotifyEvent;
procedure SetTag(const Value: integer);
public
property Tag: integer read FTag write SetTag;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
end;
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Edit1: TEdit;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private 宣言 }
FMyClass: TMyClass;
public
{ Public 宣言 }
procedure Form1MyClassChange( Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
{ TMyClass }
procedure TMyClass.SetTag(const Value: integer);
begin
if FTag<>Value then
begin
FTag := Value;
if Assigned( FOnChange) then FOnChange(Self);
end;
end;
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
FMyClass:=TMyClass.Create;
FMyClass.OnChange:= Form1MyClassChange;
end;
procedure TForm1.Form1MyClassChange(Sender: TObject);
begin
Edit1.Text:= IntToStr(FMyClass.Tag);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
FMyClass.Tag:= 10;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
FMyClass.Tag:= 20;
end;
動作
TForm1のボタンをクリックした時に TMyClass.Tag が変わって
そのOnChangeで Edit1.Textの値を書き換える
fさん
mikeさん
ん？さん
超基本さん
ありがとうございます。かなり参考になります。
| ツイート |  |