Создать компонент любого класса

unit InfoForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls,
  ExtCtrls, Buttons, Clipbrd, Comctrls, Db, Dbcgrids, Dbctrls, Dbgrids,
  Dblookup, Dbtables, Ddeman, Dialogs, Filectrl, Grids, Mask, Menus,
  Mplayer, Oleconst, Olectnrs, Olectrls, Outline, Tabnotbk, Tabs,
  ExtDlgs, CheckLst, ToolWin;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    ComboBox1: TComboBox;
    Label1: TLabel;
    Label2: TLabel;
    ComboBox2: TComboBox;
    procedure FormCreate(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    function GetNextName(MyClass: TComponentClass): string;
    procedure UpdateList;
    FComponents: TStringList;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

type
  TClassArray = array[1..133] of TPersistentClass;

const
  ClassArray: TClassArray = (
    TApplication,
    TBatchMove,
    TColorDialog,
    TFindDialog,
    TReplaceDialog,
    TFontDialog,
    TOpenDialog,
    TOpenPictureDialog,
    TSavePictureDialog,
    TSaveDialog,
    TPrintDialog,
    TPrinterSetupDialog,
    TBevel,
    TCustomLabel,
    TDBText,
    TLabel,
    TImage,
    TPaintBox,
    TShape,
    TSpeedButton,
    TSplitter,
    TToolButton,
    TAnimate,
    TButton,
    TBitBtn,
    TCheckBox,
    TDBCheckBox,
    TRadioButton,
    TComboBox,
    TDBComboBox,
    TDriveComboBox,
    TFilterComboBox,
    TCustomDBGrid,
    TDBGrid,
    TDBLookupList,
    TPopupGrid,
    TOutline,
    TDrawGrid,
    TStringGrid,
    TDBRadioGroup,
    TRadioGroup,
    TGroupBox,
    TDBNavigator,
    TPanel,
    TDBImage,
    TDBLookupControl,
    TDBLookupComboBox,
    TDBLookupListBox,
    TPopupDataList,
    THeader,
    THintWindow,
    TMediaPlayer,
    TNotebook,
    TOleContainer,
    TPage,
    TScroller,
    TTabSet,
    TDBEdit,
    TInplaceEdit,
    TMaskEdit,
    TCustomRichEdit,
    TDBRichEdit,
    TRichEdit,
    TDBMemo,
    TMemo,
    TDBLookupCombo,
    TEdit,
    THotKey,
    TCheckListBox,
    TDBListBox,
    TDirectoryListBox,
    TFileListBox,
    TListBox,
    TListView,
    TStaticText,
    TPageControl,
    TTabbedNotebook,
    TTabControl,
    TTreeView,
    TUpDown,
    TDateTimePicker,
    TDBCtrlGrid,
    TDBCtrlPanel,
    THeaderControl,
    TOleControl,
    TProgressBar,
    TScrollBar,
    TScrollBox,
    TStatusBar,
    TTabPage,
    TTabSheet,
    TToolWindow,
    TCoolBar,
    TToolBar,
    TTrackBar,
    TImageList,
    TDatabase,
    TDataModule,
    TQuery,
    TStoredProc,
    TTable,
    TUpdateSQL,
    TDataSource,
    TDdeClientConv,
    TDdeClientItem,
    TDdeMgr,
    TDdeServerConv,
    TDdeServerItem,
    TBinaryField,
    TBytesField,
    TVarBytesField,
    TBlobField,
    TGraphicField,
    TMemoField,
    TBooleanField,
    TDateTimeField,
    TDateField,
    TTimeField,
    TNumericField,
    TBCDField,
    TFloatField,
    TCurrencyField,
    TIntegerField,
    TAutoIncField,
    TSmallintField,
    TWordField,
    TStringField,
    TMainMenu,
    TPopupMenu,
    TMenuItem,
    TScreen,
    TSession,
    TTimer
  );

procedure TForm1.FormCreate(Sender: TObject);
var
  I: Integer;
begin
  RegisterClasses(ClassArray);

  FComponents := TStringList.Create;

  for I := Low(ClassArray) to High(ClassArray) do
    ComboBox1.Items.Add(ClassArray[I].ClassName);

  UpdateList;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  MyClass: TComponentClass;
  MyComp: TComponent;
begin
  MyClass := GetClass(ComboBox1.Text);

  if MyClass = nil then
    Beep
  else begin
    MyComp := MyClass.Create(self);

    MyComp.Name := GetNextName(MyClass);

    if MyClass.InheritsFrom(TControl) then
      TControl(MyComp).Parent := self;

    UpdateList;
  end;
end;

function TForm1.GetNextName(MyClass: TComponentClass): string;
var
  I, nTot: Integer;
begin
  nTot := FComponents.Count;

  Result := Copy(MyClass.ClassName, 2, Length(MyClass.ClassName) - 1) + IntToStr(nTot);
end;

procedure TForm1.UpdateList;
begin
  ComboBox2.Items.Clear;

  for I := 0 to ComponentCount - 1 do
    ComboBox2.Items.Add(Components[I].Name);

  FComponents.Clear;
  for I := 0 to ComponentCount - 1 do
    FComponents.Add(Components[I].Name);
end;

end.