| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

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

Страницы:   < 1 2 3 >

dmk ©   (2015-03-16 16:53:00) 

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

---

dmk   (2015-03-20 13:46:00) [21]

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

---

dmk   (2015-03-20 13:45:00) [22]

Метод назначается правильно, но если обратится к полям формы из процедуры, то ссылка идет на неправильные поля. Проверить легко, просто ткнуть по контролу которому метод 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.

---

Leonid Troyanovsky   (2015-03-20 11:36:00) [23]

> 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.

---

Leonid Troyanovsky   (2015-03-20 11:12:00) [24]

> 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.

---

dmk   (2015-03-20 09:29:00) [25]

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

---

dmk   (2015-03-20 08:18:00) [26]

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

Нашел в чем проблема. Методы назначаются правильно, только нарушается обращение к внутренним переменным класса формы. В коде показано на примере 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.

---

Leonid Troyanovsky   (2015-03-19 15:25:00) [27]

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

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

Self  не нужен.

--
Regards, LVT.

---

Leonid Troyanovsky   (2015-03-19 15:22:00) [28]

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

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

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

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

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

--
Regards, LVT.

---

dmk   (2015-03-19 12:33:00) [29]

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

---

dmk   (2015-03-19 12:32:00) [30]

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

---

Leonid Troyanovsky   (2015-03-19 09:34:00) [31]

> 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 01:35:00) [32]

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

---

dmk   (2015-03-19 01:34:00) [33]

w: TControl;

---

dmk   (2015-03-19 01:33:00) [34]

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

---

dmk   (2015-03-18 13:20:00) [35]

Версия XE6 Prof

---

MBo   (2015-03-18 13:04:00) [36]

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

---

dmk   (2015-03-18 11:59:00) [37]

Хочется, чтобы если я решил добавить класс, то он вписываля в код без изменений кода. Просто строчкой, например:
 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. Это то, что искалось.

---

dmk   (2015-03-18 11:54:00) [38]

На самом деле я делаю конструктор форм (как в 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

---

DVM   (2015-03-18 10:33:00) [39]

>  dmk ©

А вот это:

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

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

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

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

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

---

DVM   (2015-03-18 10:22:00) [40]

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

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

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

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

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

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

---

Страницы:   < 1 2 3 >

Наверх