动态加载和动态注册类技术的深入探索(3)

{ *********************************************************************** }
unit Unit1;

interface

uses
UnitPackageInfo,
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
GroupBox1: TGroupBox;
Panel1: TPanel;
ListBox1: TListBox;
Button1: TButton;
Button2: TButton;
OpenDialog1: TOpenDialog;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
FPack: TPackage;
procedure FreePack;
public
{ Public declarations }
end;

var
Form1 : TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
I : Integer;
begin
if OpenDialog1.Execute then
begin
FreePack;
FPack := TPackage.Create(OpenDialog1.FileName);
FPack.RegClassInPackage;
end;
ListBox1.Items.Clear;
for i := 0 to FPack.IDEInfoCount - 1 do
begin
ListBox1.Items.Add(FPack.IDEInfo[I].iClass.ClassName);
end;
Memo1.Lines.Clear;
Memo1.Lines.Add(''''------ContainsUnitList:-------'''');
for i := 0 to FPack.ContainsUnit.Count - 1 do
begin
Memo1.Lines.Add(FPack.ContainsUnit[I]);
end;
Memo1.Lines.Add(''''------DcpBpiNameList:-------'''');
for i := 0 to FPack.DcpBpiName.Count - 1 do
begin
Memo1.Lines.Add(FPack.DcpBpiName[I]);
end;
Memo1.Lines.Add(''''--------RequiresPackageList:---------'''');
for i := 0 to FPack.RequiresPackage.Count - 1 do
begin
Memo1.Lines.Add(FPack.RequiresPackage[I]);
end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FreePack;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
Ctrl : TControl;
begin
if (ListBox1.ItemIndex <> -1) and (FPack <> nil) then
begin //判断如果不是TControl的子类创建了也看不见，就不创建了
if (FPack.IDEInfo[ListBox1.ItemIndex].iClass.InheritsFrom(TControl)) then
begin
Ctrl := nil;
try
Ctrl := TControl(FPack.IDEInfo[ListBox1.ItemIndex].iClass.Create(Self));
Ctrl.Parent := Panel1;
Ctrl.SetBounds(0, 0, 100, 100);
Ctrl.Visible := True;
except

end;
end;
end;
end;

procedure TForm1.FreePack;
var
I : Integer;
begin
for i := Panel1.ControlCount - 1 downto 0 do
Panel1.Controls[i].Free;
FreeAndNil(FPack);
end;

end.
窗体文件如下：
object Form1: TForm1
Left = 87
Top = 120
Width = 518
Height = 375
Caption = ''''Form1''''
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = ''''MS Sans Serif''''
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
PixelsPerInch = 96
TextHeight = 13
object GroupBox1: TGroupBox
Left = 270
Top = 0
Width = 240
Height = 224
Align = alRight
Caption = ''''类''''
TabOrder = 0
object ListBox1: TListBox
Left = 2
Top = 15
Width = 236
Height = 207
Align = alClient
ItemHeight = 13
TabOrder = 0
end
end
object Panel1: TPanel
Left = 0
Top = 224
Width = 510
Height = 124
Align = alBottom
Color = clCream
TabOrder = 1
end
object Button1: TButton
Left = 8
Top = 8
Width = 249
Height = 25
Caption = ''''载入包''''
TabOrder = 2
OnClick = Button1Click
end
object Button2: TButton
Left = 8
Top = 40
Width = 249
Height = 25
Caption = ''''创建所选中的类的实例在Panel上''''
TabOrder = 3
OnClick = Button2Click
end
object Memo1: TMemo
Left = 8
Top = 72
Width = 257
Height = 145
ReadOnly = True
ScrollBars = ssBoth
TabOrder = 4
end
object OpenDialog1: TOpenDialog
Filter = ''''*.BPL|*.BPL''''
Left = 200
Top = 16
end
end
在这些基础上我们完全可以建立一个自己的Delphi的IDE，对象的属性的获得和设置用TYPInfo单元的RTTI类函数完全可以轻松搞定，我就不在这里多费口舌了。
记住了，编译时一定要用携带VCL.BPL 包的方式.

标签：

版权申明：本站文章部分自网络，如有侵权，请联系：west999com@outlook.com
特别注意：本站所有转载文章言论不代表本站观点，本站所提供的摄影照片，插画，设计作品，如需使用，请与原作者联系，版权归原作者所有