如何使用包含某些框架类型的类引用进行转换Delphi

编程问答 2022-07-26

问题描述

我有一个应用程序可以在许多表上实现CRUD。

主窗体的每个表都有一个选项卡，而单个工具栏具有对所有选项卡均有效的“插入”，“更新”，“删除”按钮。

每次更改标签时，都会有一个变量 frameClass: TFrameClass;（其中TFrameClass = class of TFrame）获得在选项卡下创建的框架的类型，其他变量frame: TFrame;获得在选项卡下创建的框架。

例如，当单击INSERT按钮时，我想直接转到与活动选项卡相对应的Insert()过程，例如：

frameClass(frame).insert    // trying to cast

但是编译器说insert是无效的方法。但是，如果我使用frameClass的内容进行转换，它将起作用：

TFrame1(frame).insert;    // does not work in general case.

我在做什么错了？

这是示例代码：

Unit1.pas 

unit unit1;

interface

uses
  System.SysUtils,System.Types,System.UITypes,System.Classes,System.Variants,FMX.Types,FMX.Controls,FMX.Forms,FMX.Graphics,FMX.Dialogs,FMX.Menus,FMX.TabControl,unit2,unit3;

type
  TFrameClass = class of TFrame;

  TFormMain = class(TForm)
    TabControl1: TTabControl;
    TabItem1: TTabItem;
    TabItem2: TTabItem;
    PopupMenu1: TPopupMenu;
    MenuItemInsert: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure TabControl1Change(Sender: TObject);
    procedure MenuItemInsertClick(Sender: TObject);
  public
    frame: TFrame;
    frameClass: TFrameClass;
    frames: array[0..1] of TFrameClass;
  end;

var
  FormMain: TFormMain;

implementation

{$R *.fmx}

procedure TFormMain.FormCreate(Sender: TObject);
begin
  frames[0]:= TFrame1;
  frames[1]:= TFrame2;
end;

procedure TFormMain.MenuItemInsertClick(Sender: TObject);
begin
  // want the insert click to work whatever the activeTab is
  // (frame as FrameClass).insert;   // insert is not a method
  // THIS IS THE GIST OF MY QUESTION:
  // TFrame1(frame).insert;          // it works but want it general
  // FrameClass(frame).insert;       // this is how I'd like it to work
end;

procedure TFormMain.TabControl1Change(Sender: TObject);
begin
  frameClass:= frames[tabControl1.tabIndex];
  frame:= frameClass.Create(tabControl1.activeTab);
  frame.Parent:= tabControl1.activeTab;end;    
end.

Unit2.pas 

unit Unit2;

interface

uses
  System.SysUtils,FMX.StdCtrls,FMX.Controls.Presentation;

type
// if try to descend from other than TFrame,some properties like align,size,etc,are lost
  TFrame1 = class(TFrame)
    Label1: TLabel;
  private
    { Private declarations }
  public
    { Public declarations }
    procedure insert;
  end;

implementation

{$R *.fmx}

procedure TFrame1.insert;
begin
  //
end;

end.

unit3.pas 

unit Unit3;

interface

uses
  System.SysUtils,FMX.Controls.Presentation,FMX.Edit;

type
  // if try to descend from other than TFrame,are lost
  TFrame2 = class(TFrame)
    Edit1: TEdit;
  private
    { Private declarations }
  public
    { Public declarations }
    procedure insert;
  end;

implementation

{$R *.fmx}

procedure TFrame2.insert;
begin
  //
end;

end.

解决方法

它不能按照您想要的方式工作，因为基类TFrame没有您要查找的方法，只有派生的框架类才有。通过TFrame类引用（或基TFrameClass对象指针）访问TFrame对象时，只能访问TFrame本身中的方法。要访问派生类方法，您将需要执行以下操作：

if frame is TFrame1 then
  TFrame1(frame).insert  
else if frame is TFrame2 then
  TFrame2(frame).insert;

打败您要完成的目标。为此，您需要使框架类派生自声明了所需方法的公共祖先，然后可以在需要时通过该祖先访问这些方法。

有两种方法可以做到这一点：

  1. 创建一个从TFrame派生的新基类，并具有所需的方法，然后更改框架类以从该基类派生。

Unit1.pas 

unit Unit1;

interface

uses
  System.SysUtils,System.Types,System.UITypes,System.Classes,System.Variants,FMX.Types,FMX.Controls,FMX.Forms,FMX.Graphics,FMX.Dialogs,FMX.Menus,FMX.TabControl,MyFrameBase;

type
  TMyFrameBaseClass = class of TMyFrameBase;

  TFormMain = class(TForm)
    TabControl1: TTabControl;
    TabItem1: TTabItem;
    TabItem2: TTabItem;
    PopupMenu1: TPopupMenu;
    MenuItemInsert: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure TabControl1Change(Sender: TObject);
    procedure MenuItemInsertClick(Sender: TObject);
  public
    frame: TMyFrameBase;
    frames: array[0..1] of TMyFrameBaseClass;
  end;

var
  FormMain: TFormMain;

implementation

{$R *.fmx}

uses
  Unit2,Unit3;

procedure TFormMain.FormCreate(Sender: TObject);
begin
  frames[0] := TFrame1;
  frames[1] := TFrame2;
end;

procedure TFormMain.MenuItemInsertClick(Sender: TObject);
begin
  frame.Insert;
end;

procedure TFormMain.TabControl1Change(Sender: TObject);
var
  frameClass: TMyFrameBaseClass;
begin
  frameClass := frames[TabControl1.TabIndex];
  frame := frameClass.Create(TabControl1.ActiveTab);
  frame.Parent := TabControl1.ActiveTab;
end;    

end.

MyFrameBase.pas 

unit MyFrameBase;

interface

uses
  FMX.Forms;

type
  TMyFrameBase = class(TFrame)
  public
    procedure Insert; virtual; abstract;
  end;

implementation

end.

Unit2.pas 

unit Unit2;

interface

uses
  System.SysUtils,FMX.StdCtrls,FMX.Controls.Presentation,MyFrameBase;

type
  TFrame1 = class(TMyFrameBase)
    Label1: TLabel;
  private
    { Private declarations }
  public
    { Public declarations }
    procedure Insert; override;
  end;

implementation

{$R *.fmx}

procedure TFrame1.Insert;
begin
  //
end;

end.

Unit3.pas 

unit Unit3;

interface

uses
  System.SysUtils,FMX.Edit,MyFrameBase;

type
  TFrame2 = class(TMyFrameBase)
    Edit1: TEdit;
  private
    { Private declarations }
  public
    { Public declarations }
    procedure Insert; override;
  end;

implementation

{$R *.fmx}

procedure TFrame2.Insert;
begin
  //
end;

end.
  1. 声明具有所需方法的interface，然后让框架类实现该接口。您可以在需要时查询该接口的框架对象。

Unit1.pas 

unit Unit1;

interface

uses
  System.SysUtils,FMX.TabControl;

type
  TFrameClass = class of TFrame;

  TFormMain = class(TForm)
    TabControl1: TTabControl;
    TabItem1: TTabItem;
    TabItem2: TTabItem;
    PopupMenu1: TPopupMenu;
    MenuItemInsert: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure TabControl1Change(Sender: TObject);
    procedure MenuItemInsertClick(Sender: TObject);
  public
    frame: TFrame;
    frames: array[0..1] of TFrameClass;
  end;

var
  FormMain: TFormMain;

implementation

{$R *.fmx}

uses
  MyFrameIntf,Unit2,Unit3;

procedure TFormMain.FormCreate(Sender: TObject);
begin
  frames[0] := TFrame1;
  frames[1] := TFrame2;
end;

procedure TFormMain.MenuItemInsertClick(Sender: TObject);
var
  intf: IMyFrameIntf;
begin
  if Supports(frame,IMyFrameIntf,intf) then
    intf.Insert;
end;

procedure TFormMain.TabControl1Change(Sender: TObject);
var
  frameClass: TFrameClass;
begin
  frameClass := frames[TabControl1.TabIndex];
  frame := frameClass.Create(TabControl1.ActiveTab);
  frame.Parent := TabControl1.ActiveTab;
end;    

end.

MyFrameIntf.pas 

unit MyFrameIntf;

interface

type
  IMyFrameIntf = interface
    ['{83A4D2BF-C72F-4075-9450-4A1480A674A4}']
    procedure Insert;
  end;

implementation

end.

Unit2.pas 

unit Unit2;

interface

uses
  System.SysUtils,MyFrameIntf;

type
  TFrame1 = class(TFrame,IMyFrameIntf)
    Label1: TLabel;
  private
    { Private declarations }
  public
    { Public declarations }
    procedure Insert;
  end;

implementation

{$R *.fmx}

procedure TFrame1.Insert;
begin
  //
end;

end.

Unit3.pas 

unit Unit3;

interface

uses
  System.SysUtils,MyFrameBase;

type
  TFrame2 = class(TFrame,IMyFrameIntf)
    Edit1: TEdit;
  private
    { Private declarations }
  public
    { Public declarations }
    procedure Insert;
  end;

implementation

{$R *.fmx}

procedure TFrame2.Insert;
begin
  //
end;

end.
,

像现在一样，从“新建项目”对话框的“ Delphi项目” |“ Delphi文件” |“ VCL框架”中创建基类（具有所需的其他功能）。 Base Frame 但是，然后从“新建项目”对话框的Delphi Project | 可继承项目 |您的基本对话框（已添加到此页面）中进行选择，以您创建的那个基础框架开发所有其他框架。 enter image description here 请注意，这与Remy的第一个解决方案并没有什么不同，但是它说明了在实践中您可以如何做。显然，您在尝试按照雷米的指示做错事。

delphidelphi-10.2-tokyo

相关问答

matplotlib报错：AttributeError: module 'backend_interagg' has no attribute 'FigureCanvas'. Did you mean: 'FigureCanvasAgg'?
使用本地python环境可以成功执行 import pandas as pd impor...
gitlab登录失败，报错：This challenge page was accidentally cached by an intermediary and is no longer available.
设置时间 控制面板
后端开发常见错误
错误1：Request method ‘DELETE‘ not supported 错误还原：...
docker常见错误
错误1：启动docker镜像时报错：Error response from daemon:...
idea常见错误
错误1：private field ‘xxx‘ is never assigned 按Alt...
pip安装依赖失败
报错如下，通过源不能下载，最后警告pip需升级版本 Requirem...