运行时刻类型转换

Question

我在做一个类型管理工具，但是遇上一个难题。我自己申明了几个类，不是从
TObject派生来的（由于种种原因），而且各个类也不是从一个基类派生的。我
想在程序运行时，动态添加删除类的实例。开始运行时，管理器并不知道有哪
些类。我把各个类实例插入一个链表，这时，管理器只知道是一个Pointer。
而我需要知道这个类的具体类型，便于运行这个类的一个接口函数。例如：Ta = class
public
    procedure Run( );virtual;  // ShowMessage('calss "a"');
    ...
end;Tb = class
public
    procedure Run( ); virtual; // ShowMessage('calss "b"');
    ...
end;...
...
...man = class
private
    f_pList:TList;public
    procedure Run( ); // 如：Tb(f_pList.Items[0]).Run( );
    ...
    ...
end;其中，man 的 Run 运行 f_pList 指向的类的 Run( );
请问，该如何实现？很急，请哪位大侠援手！！！

Answer 1

这样好不好：
man中在定义一个列表，类型为枚举，枚举的内容为你定义的几种类
即你的枚举是个类类型man=class
 f_plist:tlist;
 f_type:tlist;
.........(f_type.item[0])(f_plist.item[0]).run();

Answer 2

Ta = class
其实也是从TObject继承来的。
不信你试试。
var
 q:Ta;
begin
 q:=tq.Create;
 showmessage(q.ClassParent.ClassName);
 q.free;
end;

Answer 3

在Delphi中，你定义的类没有不是从TObject继承来的就算是这样Ta = class，也是默认从TObject继承来的

Answer 4

你说的是 
(f_pList.Items[0] as Tb).Run( );

Answer 5

to del_c_sharp(头大中......) and pazee(耙子):
    我在运行时刻才能知道具体类。在源代码级是不知道将会遇上什么
类。因此“(f_type.item[0])(f_plist.item[0]).run();”和
“(f_pList.Items[0] as Tb).Run( );”都是行不通的。to wr960204(武稀松) and 40Star(陪你去看--☆流星雨★) :
    哦，受教了*_*。但是问题同上，编译的时候，编译器根本
通不过，认为没有 Run 这个函数。    其实这个问题的实质是：如何在运行时刻，绕过编译器，通过某
种标准方法自己(!)构造一个类。
例如：
f_pList[0] 是 Ta 类型
procedure man.Run( );
var p:pointer;
    s:String;
    c:TClass;
begin
    c := TClass(f_pList[0]).ClassType( );
    s := c.ClassName( );
    ShowMessage(s);
end;这时，s 显示的是 "Ta".
我想有什么方法得到类似于如下的结果：
f_pList[0] 是 Ta 类型
procedure man.Run( );
var p:pointer;
    c:TClass;
begin
    c := TClass(f_pList[0]).ClassType( );
    p := f_pList[0];    *** c(p).Run( ); ***
end;  打星号的句子表示 把 p 造型为Ta 类型，并且运行。
当然，用这种方式写的源代码肯定编译出错。哪位能想
个好方法在运行时刻，根据 RTTL 的信息，构造出实际
的类。
  我想通过用得到虚函数表来运行，但是这种方法必须
得知道 Delphi 的 VTBL 布局方式，对于不同的 Delphi 
版本很可能根本无法重用，更何况操作起来... 嘿嘿，
我可不想和编译器搏斗。

Answer 6

我的理解你可以做成多态的形式，定义一个基类并声明run的虚拟方法，在所有的基类中覆盖此方法即可。其实delphi的架构中，destroy析构函数就是用的多态的形式。
给你一个摘自d4技术内幕的例程：
类声明单元：
unit Shapes1;interfaceuses
  Windows;type
  TShape = class
  private
    FDC: HDC;
    FXPos,
    FYPos: Integer;
  protected
    destructor Destroy; override;
  public
    constructor Create(ADC: HDC; X, Y: Integer);
    procedure Draw; virtual;
    procedure SetXY(X, Y: Integer);
  end;  TRectangle = class(TShape)
    procedure Draw; override;
  end;  TEllipse = class(TShape)
    procedure Draw; override;
  end;  TFlower = class(TShape)
  private
    FFileName: String;
  public
    constructor CreateMe(ADC: HDC; X, Y: Integer; FileName: String);
    procedure Draw; override;
  end;  TRupert = class(TFlower)
    procedure Draw; override;
  end;  implementationuses
  SysUtils, Dialogs, Graphics, MMSystem;
{ TShape }constructor TShape.Create(ADC: HDC; X, Y: Integer);
begin
  inherited Create;
  FXPos := X;
  FYPos := Y;
  FDC   := ADC;
end;destructor TShape.Destroy;
const
  FileName = 'Destroy.txt';
var
  AText: TextFile;
begin
  AssignFile(AText, FileName);
  if FileExists(FileName) then
    Append(AText)
  else Rewrite(AText);
  try
    Writeln(AText, ClassName);
  finally
    CloseFile(AText);
  end;  
  inherited Destroy;
end;procedure TShape.Draw;
begin
  SetPixel(FDC, FXPos, FYPos, clRed);
end;procedure TShape.SetXY(X, Y: Integer);
begin
  FXPos := X;
  FYPos := Y;
end;{ TRectangle }procedure TRectangle.Draw;
var
  Brush,
  OldBrush: HBrush;
begin
  Brush := CreateSolidBrush(clGreen);
  OldBrush := SelectObject(FDC, Brush);
  Rectangle(FDC, FXPos, FYPos, FXPos + 25, FYPos + 20);
  SelectObject(FDC, OldBrush);
  DeleteObject(Brush);
end;{ TEllipse }procedure TEllipse.Draw;
var
  Brush,
  OldBrush: HBrush;
begin
  Brush := CreateSolidBrush(clBlue);
  OldBrush := SelectObject(FDC, Brush);
  Ellipse(FDC, FXPos, FYPos, FXPos + 25, FYPos + 25);
  SelectObject(FDC, OldBrush);
  DeleteObject(Brush);
end;{ TFlower }constructor TFlower.CreateMe(ADC: HDC; X, Y: Integer; FileName: String);
begin
  inherited Create(ADC, X, Y);
  FFileName := FileName;
end;procedure TFlower.Draw;
var
  Bitmap: TBitmap;
  MemDC,
  OldBitmap: HDC;
begin
  Bitmap := TBitmap.Create;
  Bitmap.LoadFromResourceName(HInstance, FFileName);;  MemDC := CreateCompatibleDC(FDC);
  OldBitmap := SelectObject(MemDC, Bitmap.Handle);
  BitBlt(FDC, FXPos, FYPos, Bitmap.Width,
         Bitmap.Height, MemDC, 0, 0, SRCCOPY);
  SelectObject(MemDC, OldBitmap);
  DeleteObject(MemDC);  Bitmap.Free;       
end;{ TRupert }procedure TRupert.Draw;
begin
  inherited Draw;
  PlaySound('Meow', HInstance, SND_RESOURCE or SND_ASYNC);
end;end.主窗口单元：
unit Main;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, TFlatButtonUnit, ImgList, ComCtrls, ToolWin;type
  TForm1 = class(TForm)
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ImageList1: TImageList;
    FlatButton1: TFlatButton;
    procedure FlatButton1Click(Sender: TObject);
  private
    FXSpot: Integer;
    function GetFXSpot: Integer;
  end;var
  Form1: TForm1;implementationuses Shapes1;{$R *.dfm}{ TForm1 }function TForm1.GetFXSpot: Integer;
begin
  Inc(FXSpot, 105);
  Result := FXSpot;
end;procedure TForm1.FlatButton1Click(Sender: TObject);
{ // 不具有多态性的代码
const
  YPos = 100;
var
  DC: HDC;
  i: Integer;
  Shape: TShape;
  Rectangle: TRectangle;
  Ellipse: TEllipse;
  Flower: TFlower;
  Rupert: TRupert;
begin
  FXSpot := 5;
  DC := GetDC(Handle);  Shape := TShape.Create(DC, FXSpot, YSpot);
  Rectangle := TRectangle.Create(DC, FXSpot, YSpot);
  Ellipse := TEllipse.Create(DC, FXSpot, YSpot);
  Flower := TFlower.Create(DC, FXSpot, YSpot, 'Flower');
  Rupert := TRupert.Create(DC, FXSpot, YSpot, 'Rupert');  Shape.Draw;
  Rectangle.Draw;
  Ellipse.Draw;
  Flower.Draw;
  Rupert.Draw;  Shape.Free;
  Rectangle.Free;
  Ellipse.Free;
  Flower.Free;
  Rupert.Free;  ReleaseDC(Handle, DC);
end;
}
const
  YPos = 100;
var
  DC: HDC;
  i: Integer;
  Shapes: Array[0..4] of TShape;
begin
  FXSpot := 5;
  DC := GetDC(Handle);
  Shapes[0] := TShape.Create(DC, FXSpot, YPos);
  Shapes[1] := TRectangle.Create(DC, GetFXSpot, YPos);
  Shapes[2] := TEllipse.Create(DC, GetFXSpot, YPos);
  Shapes[3] := TFlower.CreateMe(DC, GetFXSpot, YPos, 'Flowers');
  Shapes[4] := TRupert.CreateMe(DC, GetFXSpot, YPos, 'Rupert');  for i := 0 to 4 do
  begin
    Shapes[i].Draw;
    Shapes[i].Free;
  end;  ReleaseDC(Handle, DC);
end;end.

Answer 7

不行吗？
man中在定义一个列表，类型为枚举，枚举的内容为你定义的几种类
即你的枚举是个类类型man=class
 f_plist:tlist;
 f_type:tlist;//=== array of Tclass      just as yours
.........(f_type.item[0])(f_plist.item[0]).run();

Answer 8

to King_Dragon(我是谁) and
    del_c_sharp(头大中......) :  我知道这些方法。但是大家没有仔细看我的问题。如果采用
虚函数的方式，只能是在源代码级指定所有的类型。但是现在
是:我并不知道到底在运行中有哪些类在运行，但是我知道这些
类都有几个相同的方法。我需要 2 进制的类型识别。其实就是
和 COM 类似。如果采用 COM，肯定能解决。只是 COM 使用的
是IID来区分类，而我想用 RTTI 来区别类。而且我不想做成 COM。   对了，del_c_sharp，你提供的方法我实现不了，你能给个
比较完整的例子么？
   我认为你的方法和我提出的方法是一样的，就是上面的带有星
号的那句：
"
   f_pList[0] 是 Ta 类型
   procedure man.Run( );
   var p:pointer;
       c:TClass;
   begin
       c := TClass(f_pList[0]).ClassType( );
       p := f_pList[0];      *** c(p).Run( ); ***
   end
"