Текущий архив: 2017.08.13;
Скачать: CL | DM;

Вниз

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

← →
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;
Скачать: CL | DM;

Наверх

Память: 0.55 MB
Время: 0.008 c