Форум: "Начинающим";
Текущий архив: 2017.08.13;
Скачать: [xml.tar.bz2];

Вниз

Возможно ли имея имя класса в переменной обратится   Найти похожие ветки 

← →
dmk ©   (2015-03-16 16:53) [0]

к строке как к классу в рантайм не делая кучу условий?
Например:
s := "TEdit";
s.text := "something";

---

← →
RWolf ©   (2015-03-16 16:55) [1]

(FindComponent("Edit1") as TEdit).Text := "something";

---

← →
Германн ©   (2015-03-17 02:41) [2]

> FindComponent

И это смотря как сей компонент был создан.

---

← →
Leonid Troyanovsky ©   (2015-03-17 10:02) [3]

> dmk ©   (16.03.15 16:53)

> s.text := "something";

https://groups.google.com/d/msg/fido7.ru.delphi/Y9ft2Vo4hdc/megvcaJyAXMJ

--
Regards, LVT.

---

← →
Palladin ©   (2015-03-17 18:08) [4]

такой большой, а классы от объектов не отличаешь

---

← →
dmk ©   (2015-03-17 23:44) [5]

Palladin ©   (17.03.15 18:08) [4]
ассемблер развращает :)

---

← →
dmk ©   (2015-03-17 23:52) [6]

если начистоту:

 TEdit = class(TCustomEdit)
 strict private
   class constructor Create;
   class destructor Destroy;
 published
   property Align; .....

---

← →
DVM ©   (2015-03-18 10:22) [7]

> dmk ©   (17.03.15 23:52) [6]

Это класс. К классу и так можно обращаться в рантайм не делая кучу условий. Но только к классовым переменным и функциям, например, TMyClass.MyClassMethod();

А вот это:
MyEdit := TEdit.Create(...)

MyEdit - это экземпляр класса, который иногда называют объектом (но мне не нравится, т.к. возникает путаница с ключевым словом object из паскаля).

У экземпляра нет имени вообще то. Имя есть у переменной, ссылающейся на класс, к ней тоже можно в рантайм обращаться без кучи условий. Но надо быть уверенным точно на экземпляр какого класса она ссылается. Иначе перед обращением все же нужно выяснить что за класс.

У НЕКОТОРЫХ классов есть поле с именем. Туда можно записать имя так как это делает VCL для наследников TComponent. Чтобы затем как раз искать по этому имени. Но для того чтобы искать, надо все экземпляры с их именами зарегистрировать в каком-нибудь реестре, а потом не забывать удалять оттуда.

---

← →
DVM ©   (2015-03-18 10:33) [8]

>  dmk ©

А вот это:

type
 T = class of  TCustomEdit;
var
 A: T;

Это ссылка на класс. По ссылке на класс, можно создавать его экземпляр так:

A := TEdit;
B = A.Create();

Если опять таки зарегистрировать где то все ссылки на класс с именами классов, то появится возможность создавать экземпляры по имени класса, представленного строкой.

Вот теперь думай, что с этим всем можно сделать.

---

← →
dmk ©   (2015-03-18 11:54) [9]

На самом деле я делаю конструктор форм (как в Delphi) и мне нужно на форму помещать некоторые компоненты. Вся сложность в том, как сделать это более компактно и универсально, чтобы не получалось куча "полотен" вроде:
       if s = "TEdit" then
       begin
         TEdit(w).OnMouseUp := OnMouseUp;
         TEdit(w).OnMouseDown := OnMouseDown;
         TEdit(w).OnMouseMove := OnMouseMove;
         TEdit(w).OnMouseLeave := OnMouseLeave;
         TEdit(w).OnMouseEnter := OnMouseEnter;
         TEdit(w).PopupMenu := ConstructorPopup;
       end;

       if s = "TStaticText" then
       begin
         TStaticText(w).OnMouseUp := OnMouseUp;
         TStaticText(w).OnMouseDown := OnMouseDown;
         TStaticText(w).OnMouseMove := OnMouseMove;
         TStaticText(w).OnMouseLeave := OnMouseLeave;
         TStaticText(w).OnMouseEnter := OnMouseEnter;
       end;
или
   case ClassIndex of
     0: TEdit(FActiveWinControl).Text := SValue;
     1: TStaticText(FActiveWinControl).Caption := SValue;
     2: TGroupBox(FActiveWinControl).Caption := SValue;
     3: TButton(FActiveWinControl).Caption := SValue;
     4: TMemo(FActiveWinControl).Text := SValue;
     5: TCheckBox(FActiveWinControl).Caption := SValue;
     6: TPanel(FActiveWinControl).Caption := SValue;
   end;//case

---

← →
dmk ©   (2015-03-18 11:59) [10]

Хочется, чтобы если я решил добавить класс, то он вписываля в код без изменений кода. Просто строчкой, например:
 FComponentList := TStringList.Create;
 FComponentList.Add("TEdit");
 FComponentList.Add("TStaticText");
 FComponentList.Add("TGroupBox");
 FComponentList.Add("TButton");
 FComponentList.Add("TMemo");
 FComponentList.Add("TCheckBox");
 FComponentList.Add("TPanel");

На самом деле мне Леонид [3] уже помог с PropInfo. Это то, что искалось.

---

← →
MBo ©   (2015-03-18 13:04) [11]

А какая версия Дельфи? Если что, то начиная с BDS2010 система RTTI умеет намного больше.

---

← →
dmk ©   (2015-03-18 13:20) [12]

Версия XE6 Prof

---

← →
dmk ©   (2015-03-19 01:33) [13]

Не получается что-то заменить метод. AV выскакивает:
if IsPublishedProp(w, "OnMouseDown") then
begin
  SetMethodProperty(w, "OnMouseDown", @Self.OnMouseDown);
end;

---

← →
dmk ©   (2015-03-19 01:34) [14]

w: TControl;

---

← →
dmk ©   (2015-03-19 01:35) [15]

Вернее метод назначается, по внутренней переменной видно, а при обращении к контролу выскакивает AV.

---

← →
Leonid Troyanovsky ©   (2015-03-19 09:34) [16]

> dmk ©   (19.03.15 01:33) [13]

>  @Self.OnMouseDown);

Тут д.б. что-то вроде @TFormX.FormMouseDown,
т.е., адрес метода (кода), а не свойства (поля?)


> dmk ©   (19.03.15 01:35) [15]

>  а при обращении к контролу выскакивает AV.

Код в студию.

--
Regards, LVT.

---

← →
dmk ©   (2015-03-19 12:32) [17]

Leonid Troyanovsky ©   (19.03.15 09:34) [16]
На почту модуль выслал. Публиковать многовато будет :)

---

← →
dmk ©   (2015-03-19 12:33) [18]

Там беда в том, что после такого назначения Self становится не форма, а контрол, которому назначили новый метод.

---

← →
Leonid Troyanovsky ©   (2015-03-19 15:22) [19]

> dmk ©   (19.03.15 12:32) [17]

> выслал. Публиковать многовато будет :)

А копаться в полусотне кило не многовато ли?

Надо подготовить минимум кода, воспроизводящего проблему.
Опубликовать и ждать желающих потратить свое время на
компиляцию, анализ и т.д.

Иначе получится, что ты нас не уважаешь.

--
Regards, LVT.

---

← →
Leonid Troyanovsky ©   (2015-03-19 15:25) [20]

> dmk ©   (19.03.15 12:33) [18]

> Там беда в том, что после такого назначения Self становится

Self  не нужен.

--
Regards, LVT.

---

← →
dmk ©   (2015-03-20 08:18) [21]

>Иначе получится, что ты нас не уважаешь.
Ни в коем случае. Наоборот, помощь бесценна!

Нашел в чем проблема. Методы назначаются правильно, только нарушается обращение к внутренним переменным класса формы. В коде показано на примере FInt. Видимо надо явное обращение писать, иначе переменная принимает любое значение. Self становится не формы, а Sender"а. Отсюда и AV.

unit test1;

interface

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

type
 TForm1 = class(TForm)
   Edit1: TEdit;
   Button1: TButton;
   Memo1: TMemo;
   Panel1: TPanel;
   procedure FormShow(Sender: TObject);
   procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
   procedure FormCreate(Sender: TObject);
 private
   { Private declarations }
   FInt: integer;
   procedure AssignNewMethod;
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

function HexStr(i: integer): string;
var
 lw, hw: word;
 lws, hws: string;

const
 hexChars: array [0..$F] of char = "0123456789ABCDEF";

begin
 Result := "";
 lws := "";
 hws := "";

 lw := word(i);
 hw := word(i shr 16);

 lws := (hexChars[Hi(lw) shr 4]) + (hexChars[Hi(lw) and $F])+
        (hexChars[Lo(lw) shr 4]) + (hexChars[Lo(lw) and $F]);

 hws := (hexChars[Hi(hw) shr 4]) + (hexChars[Hi(hw) and $F])+
        (hexChars[Lo(hw) shr 4]) + (hexChars[Lo(hw) and $F]);

 result := hws + lws;
end;

function ObjPropInfo(AObject: TObject; const PropName: String): PPropInfo;
begin
 Result := GetPropInfo(AObject.ClassInfo, PropName);
 if Result = nil then raise Exception.Create("Property not exist");
end;

procedure SetMethodProperty(AObject: TObject; const PropName: string; const Value: Pointer);
var
 AMethod: TMethod;

begin
 AMethod.Code := Value;
 AMethod.Data := AObject;
 SetMethodProp(AObject, ObjPropInfo(AObject, PropName), AMethod);
end;

procedure TForm1.AssignNewMethod;
var
 i: integer;
 c: TWinControl;

begin
 for i := 0 to ControlCount - 1 do
 begin
   if Controls[i] is TWinControl then
   begin
     c := TWinControl(Controls[i]);
     if IsPublishedProp(c, "OnMouseUp") then SetMethodProperty(c, "OnMouseUp", @Self.OnMouseUp);
   end;
 end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 FInt := 10;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
 s: string;

begin
 if Sender is TWinControl then s := TWinControl(Sender).Name else s := "";
 ShowMessage("Mouse up from " + s + ": $" + HexStr(uint64(Pointer(@Self.OnMouseUp))) + " (" + IntToStr(FInt) + ")");
end;

procedure TForm1.FormShow(Sender: TObject);
begin
 AssignNewMethod;
end;

end.

---

← →
dmk ©   (2015-03-20 09:29) [22]

Видимо нужно процедуру делать отдельно от класса и обращаться к переменным явно, тогда будет норм.

---

← →
Leonid Troyanovsky ©   (2015-03-20 11:12) [23]

> dmk ©   (20.03.15 09:29) [22]

Self не нужен. Нужен _адрес_кода_ (метода FormMouseUp).

type
 TForm1 = class(TForm)
   Button1: TButton;
   Label1: TLabel;
   Label2: TLabel;
   Label3: TLabel;
   Label4: TLabel;
   procedure FormCreate(Sender: TObject);
   procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
   procedure Button1Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

uses
 TypInfo;

function ObjPropInfo(AObject: TObject; const PropName: String): PPropInfo;
begin
 Result := GetPropInfo(AObject.ClassInfo, PropName);
 if Result = nil then
   raise Exception.Create("Property not exist");
end;

procedure SetMethodProperty( AObject: TObject; const PropName:String;
                            const Value: Pointer);
var
 AMethod: TMethod;
begin
 AMethod.Code := Value;
 AMethod.Data := AObject;
 SetMethodProp(AObject, ObjPropInfo(AObject, PropName), AMethod);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 OnMouseUp := nil;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 if Sender is TLabel then
   ShowMessage(Format("%s: %d %d", [TLabel(Sender).Caption, X, Y]));
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 i : Longint;
begin
 for i := 0 to ControlCount-1 do
   if Controls[i] is TLabel then
     SetMethodProperty(Controls[i], "OnMouseUp", @TForm1.FormMouseUp);
end;

--
Regards, LVT.

---

← →
Leonid Troyanovsky ©   (2015-03-20 11:36) [24]

> Leonid Troyanovsky ©   (20.03.15 11:12) [23]

>Self не нужен.

В смысле, что нужен он совсем для другого:

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
   ShowMessage(Format("%s: %d %d", [Caption, X, Y])); // Self.Caption
end;

--
Regards, LVT.

---

← →
dmk ©   (2015-03-20 13:45) [25]

Метод назначается правильно, но если обратится к полям формы из процедуры, то ссылка идет на неправильные поля. Проверить легко, просто ткнуть по контролу которому метод OnMouseUp от формы назначен. Caption будет содержать не то, что нужно:

unit test1;

interface

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

type
 TForm1 = class(TForm)
   Edit1: TEdit;
   procedure FormShow(Sender: TObject);
   procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
   procedure FormCreate(Sender: TObject);
 private
   { Private declarations }
   FInt: integer;
   FStr: string;
   procedure AssignNewMethod;
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

function ObjPropInfo(AObject: TObject; const PropName: String): PPropInfo;
begin
 Result := GetPropInfo(AObject.ClassInfo, PropName);
 if Result = nil then raise Exception.Create("Property not exist");
end;

procedure SetMethodProperty(AObject: TObject; const PropName: string; const Value: Pointer);
var
 AMethod: TMethod;

begin
 AMethod.Code := Value;
 AMethod.Data := AObject;
 SetMethodProp(AObject, ObjPropInfo(AObject, PropName), AMethod);
end;

procedure TForm1.AssignNewMethod;
var
 i: integer;
 c: TWinControl;

begin
 for i := 0 to ControlCount - 1 do
 begin
   if Controls[i] is TWinControl then
   begin
     c := TWinControl(Controls[i]);
     if IsPublishedProp(c, "OnMouseUp") then SetMethodProperty(c, "OnMouseUp", @Self.OnMouseUp);
   end;
 end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 FInt := 10;
 FStr := "Правильно";
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
 s: string;

begin
 if Sender is TWinControl then
 begin
   Self.Caption := FStr;
   s := TWinControl(Sender).Name;
   ShowMessage("Mouse up from " + s + ": " + " FInt: " + IntToStr(FInt) + " Caption: " + FStr);
 end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
 AssignNewMethod;
end;

end.

---

← →
dmk ©   (2015-03-20 13:46) [26]

В последнем случае возникает AV.

---

← →
Leonid Troyanovsky ©   (2015-03-20 14:54) [27]

> dmk ©   (20.03.15 13:46) [26]

> В последнем случае возникает AV.

Внезапно?

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
 ShowMessage(TWinControl(Sender).Name);
 ShowMessage(Self.Name + ">" +Name); // wow
 ShowMessage(FStr); // surprise
end;

--
Regards, LVT.

---

← →
Leonid Troyanovsky ©   (2015-03-20 14:59) [28]

> @Self.OnMouseUp

Поубивав бы.

---

← →
dmk ©   (2015-03-20 15:26) [29]

Даже если назначить от TForm1, а не от self, то разницы нет. Доступ к полям ошибочный. Поля от TForm1 в случае вызова из TEdit не видны.

---

← →
dmk ©   (2015-03-20 15:30) [30]

я про это и писал выше, что self, что TForm1 разницы нет. Заменять метод небезопасно.

---

← →
Leonid Troyanovsky ©   (2015-03-20 15:40) [31]

> dmk ©   (20.03.15 15:26) [29]

> Даже если назначить от TForm1, а не от self, то разницы нет.

Обоснуй.

> Доступ к полям ошибочный.

Показывай.

> Поля от TForm1 в случае вызова из TEdit не видны.

Предположим, что у Edit есть обработчик OnMouseUp,
скажем, EditMouseUp.
Спросим, что известно в оном форме, на который его положат.
Ну, или, не положат.

Где-то сгодится GetParentForm, а где-то - нет. Всё как в жизни.

--
Regards, LVT.

---

← →
Leonid Troyanovsky ©   (2015-03-20 15:45) [32]

> dmk ©   (20.03.15 15:30) [30]

>  Заменять метод небезопасно.

и загадочно.

--
Regards, LVT.

---

← →
Leonid Troyanovsky ©   (2015-03-20 15:54) [33]

> что известно в оном форме, на который его положат.

что известно в оном о форме, на которую его положат.

Sorry.

--
Regards, LVT.

---

← →
dmk ©   (2015-03-20 16:45) [34]

>> Даже если назначить от TForm1, а не от self, то разницы нет.
>Обоснуй.

без проблем, переменные p1 и p2 ссылаются на один и тот же метод:
http://s15.postimg.org/swpyqo1ob/dump1.jpg

>> Доступ к полям ошибочный.
>Показывай.

когда назначается метод, то self от TForm1, а когда он вызывается, то self становится указателем на Edit1 у которого таких полей как у TForm нет.
http://s21.postimg.org/4yu3q8mkn/dump2.jpg

Видимо надо родителя проверять или не обращаться к self.

---

← →
Leonid Troyanovsky ©   (2015-03-20 17:29) [35]

> dmk ©   (20.03.15 16:45) [34]

> один и тот же метод:http://s15.postimg.org/swpyqo1ob/dump1.jpg

@Self.OnMouseUp - поубивав бы.

> когда назначается метод, то self от TForm1, а когда он вызывается,
> то self становится указателем на Edit1

Он становится Edit1 при AMethod.Data := AObject.

> Видимо надо родителя проверять или не обращаться к self.

Еже ли хочется того самого Self из методов формы, то
procedure SetMethodProperty надо сделать методом формы,
где вместо AMethod.Data := AObject; написать AMethod.Data := Self.

--
Regards, LVT.

---

← →
dmk ©   (2015-03-22 01:18) [36]

>Еже ли хочется того самого Self из методов формы, то
>procedure SetMethodProperty надо сделать методом формы,
>где вместо AMethod.Data := AObject; написать AMethod.Data := Self.

Так не работает. Вызова не происходит.
Сделал пока обращение напрямую к полям формы, но выглядит не очень. Будем разбираться. Спасибо за помощь!

---

← →
Leonid Troyanovsky ©   (2015-03-22 09:04) [37]

> dmk ©   (22.03.15 01:18) [36]

> AMethod.Data := AObject; написать AMethod.Data := Self.Так
> не работает. Вызова не происходит.

Код в студию.
Сдается мне, что не в _методе_ пытаешься.

--
Regards, LVT.

---

← →
Leonid Troyanovsky ©   (2015-03-22 09:20) [38]

> dmk ©   (22.03.15 01:18) [36]

> не работает.

А... Понял.
Ну, тогда  б предпочел GetParentForm.

--
Regards, LVT.

---

← →
Leonid Troyanovsky ©   (2015-03-22 09:29) [39]

> Leonid Troyanovsky ©   (22.03.15 09:20) [38]

Поторопился, sorry.

procedure TForm1.SetMethodProperty( AObject: TObject; const PropName:String; const Value: Pointer);
var
 AMethod: TMethod;
begin
 AMethod.Code := Value;
 AMethod.Data := Self;
 SetMethodProp(AObject, ObjPropInfo(AObject, PropName), AMethod);
end;


Все работает как обычно.

--
Regards, LVT.

---

← →
dmk ©   (2015-03-22 16:21) [40]

>Ну, тогда  б предпочел GetParentForm.

Работает только такой вариант.

---

← →
Leonid Troyanovsky ©   (2015-03-22 19:09) [41]

> dmk ©   (22.03.15 16:21) [40]

> Работает только такой вариант.

Не верю.

--
Regards, LVT.

---

← →
dmk ©   (2015-03-23 16:17) [42]

Вот так заработало:
unit test1;

interface

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

type
 TForm1 = class(TForm)
   Edit1: TEdit;
   procedure FormCreate(Sender: TObject);
   procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
 private
   { Private declarations }
   FInt: integer;
   FStr: string;
   procedure AssignNewMethod;
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

function ObjPropInfo(AObject: TObject; const PropName: String): PPropInfo;
begin
 Result := GetPropInfo(AObject.ClassInfo, PropName);
 if Result = nil then raise Exception.Create("Property not exist");
end;

procedure SetMethodProperty(AObject: TObject; const PropName: string; const Value: Pointer; const ASelf: pointer);
var
 AMethod: TMethod;

begin
 AMethod.Code := Value;
 if ASelf = nil then AMethod.Data := AObject else AMethod.Data := ASelf;
 SetMethodProp(AObject, ObjPropInfo(AObject, PropName), AMethod);
end;

procedure TForm1.AssignNewMethod;
var
 i: integer;
 c: TWinControl;
 p1: pointer;

begin
 for i := 0 to ControlCount - 1 do
 begin
   if Controls[i] is TWinControl then
   begin
     c := TWinControl(Controls[i]);
     p1 := @Self.OnMouseDown;
     if IsPublishedProp(c, "OnMouseDown") then SetMethodProperty(c, "OnMouseDown", p1, Self);
   end;
 end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 FInt := 10;
 FStr := "Правильно";
 AssignNewMethod;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
 s1, s2: string;

begin
 //Только оконные объекты
 if (Sender is TWinControl) then
 begin
   Self.Caption := FStr;
   s1 := TWinControl(Sender).Name;
   s2 := "No parent";
   if TWinControl(Sender).Parent <> nil then s2 := TWinControl(Sender).Parent.Name;
   ShowMessage("Mouse down from (" + s1 + ") FInt: " + IntToStr(FInt) + " Caption: " + FStr + #13 + "Parent form is (" + s2 + ")");
 end;//if sender
end;

end.
Видимо у меня там где 50к кода ошибка где-то. будем разбираться. Спасибо!

---

← →
Leonid Troyanovsky ©   (2015-03-24 09:22) [43]

> dmk ©   (23.03.15 16:17) [42]

> Вот так заработало:

Ну, и как хотелось:

type
 TForm1 = class(TForm)
   Label1: TLabel;
   Label2: TLabel;
   Label3: TLabel;
   Button1: TButton;
   procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
   procedure Button1Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

uses
 TypInfo;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 if Sender is TLabel then
   Caption := Format( "%s.%s: %d %d",
                       [Name, TLabel(Sender).Caption, X, Y]);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 ppi: PPropInfo;
 AMethod: TMethod;
 i : Longint;
begin
 ppi := GetPropInfo(TLabel, "OnMouseUp");
 if ppi = nil then
   raise Exception.Create("Property not exist");
 AMethod.Code := MethodAddress("FormMouseUp");
 AMethod.Data := Self;

 for i := 0 to ControlCount-1 do
   if Controls[i] is TLabel then
     SetMethodProp(Controls[i], ppi, AMethod);
end;

--
Regards, LVT.

---

← →
dmk ©   (2015-03-24 12:09) [44]

У себя тоже нашел ошибку. Она вообще в другом месте была. По крайней мере получил опыт с переназначением методов :)

---

← →
имя   (2015-10-20 19:26) [45]

Удалено модератором

---

← →
имя   (2015-10-20 19:37) [46]

Удалено модератором

---

Страницы: 1 2 вся ветка

Форум: "Начинающим";
Текущий архив: 2017.08.13;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.6 MB
Время: 0.002 c