喫茶XRAYトップページ

[スレッド全体
]

[11076] Re7:procedure手続きを手続き名で検索できますか返信 削除
2017/4/11 (火) 13:24:15 igy
▼ takiさん
> 動的に生成したイベントの手続き、もしくは標準的なイベントでない?場合は
> Form1.MethodAddress()がnilしか返してくれません。



ヘルプみたら、
> MethodAddress メソッドは,パブリッシュメソッドのアドレスを返します。
って書いてましたね。失礼しました。

なので、


  TForm1 = class(TForm)
    Button1: TButton;
    Panel1: TPanel;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure MyEvent(Sender: TObject);   // <===== ここに移動
  private
    { Private 宣言 }
    MyButton:TButton;
    function GetComponentByName(AName:String):TComponent;
  public
    { Public 宣言 }
  end;


だったら、 Beepが鳴るかもしれません。


[11077] Re8:procedure手続きを手続き名で検索できますか返信 削除
2017/4/11 (火) 13:58:53 taki
▼ igyさん
> ▼ takiさん
> > 動的に生成したイベントの手続き、もしくは標準的なイベントでない?場合は
> > Form1.MethodAddress()がnilしか返してくれません。
>
>
> ヘルプみたら、
> > MethodAddress メソッドは,パブリッシュメソッドのアドレスを返します。
> って書いてましたね。失礼しました。
>
> なので、
>
>
>   TForm1 = class(TForm)
>     Button1: TButton;
>     Panel1: TPanel;
>     Button2: TButton;
>     procedure Button1Click(Sender: TObject);
>     procedure Button2Click(Sender: TObject);
>     procedure MyEvent(Sender: TObject);   // <===== ここに移動
>   private
>     { Private 宣言 }
>     MyButton:TButton;
>     function GetComponentByName(AName:String):TComponent;
>   public
>     { Public 宣言 }
>   end;
>
>
> だったら、 Beepが鳴るかもしれません。


Beep鳴りました。
ありがとうございます。

ヘルプの
「名前を指定すると、クラス メソッドのアドレスを返します。」
がパブリッシュメソッドの事だったのでしょうか。

とにかく、先が開けました。


[11078] Re9:procedure手続きを手続き名で検索できますか返信 削除
2017/4/11 (火) 14:40:17 taki
> とにかく、先が開けました。

OnClickイベントの他にOnMouseUpイベントも動くようになりました。

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Panel1: TPanel;
    Button2: TButton;
    Label1: TLabel;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure MyEventClick(Sender: TObject);
    procedure MyEventMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
  private
    { Private 宣言 }
    MyButton:TButton;
    function GetComponentByName(AName:String):TComponent;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function TForm1.GetComponentByName(AName:String):TComponent;
var
  i:integer;
begin
//  result := nil;
  result := self;     // 無かったらForm1
  if Form1.ComponentCount = 0 then exit;
  for i := 0 to Form1.ComponentCount - 1 do begin
    if Form1.Components[i].Name = AName then begin
      result := Form1.Components[i];
      exit;
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  method: TMethod;
begin
  MyButton := TButton.Create(Self);
  MyButton.Parent := GetComponentByName('Panel1') as TWinControl;
  MyButton.Top := 20;
  MyButton.Left := 20;
  MyButton.Caption := '私のボタン';
// ----------
  method.Code := Form1.MethodAddress('MyEventClick');
  method.Data := Pointer(Form1);
  MyButton.OnClick := TNotifyEvent(method);

  method.Code := Form1.MethodAddress('MyEventMouseUp');
  method.Data := Pointer(Form1);
  MyButton.OnMouseUp := TMouseEvent(method);
// ----------
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if MyButton <> nil then FreeAndNil(MyButton);
end;

// OnClickの場合
procedure TForm1.MyEventClick(Sender: TObject);
begin
  beep;
end;

// OnMouseUpの場合
// 引数を TForm1.Button?MouseUp に真似て作成
procedure TForm1.MyEventMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  showmessage('座標 ' + inttostr(X) + ' ' + inttostr(Y));
end;

end.


[11079] Re8:procedure手続きを手続き名で検索できますか返信 削除
2017/4/11 (火) 14:47:21 Mr.XRAY
▼ igyさん

>   TForm1 = class(TForm)
>     Button1: TButton;
>     Panel1: TPanel;
>     Button2: TButton;
>     procedure Button1Click(Sender: TObject);
>     procedure Button2Click(Sender: TObject);
>     procedure MyEvent(Sender: TObject);   // <===== ここに移動
>   private


なるほど,これなら RTTI のテーブルにのりますね.
確認しました.
RTTI にのれば何でもやり放題 !!


[▼次のスレッド]
INCM/CMT
Cyclamen v3.82