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;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
type
TClassArray = array [1..133] of TPersistentClass;
// definition temporary used to check the data types
// TClassArray = array [1..133] of TComponentClass;
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
// register all of the classes
RegisterClasses (ClassArray);
// copy class names to the listbox
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 := TComponentClass (GetClass (ComboBox1.Text));
if MyClass = nil then
Beep
else
begin
MyComp := MyClass.Create (self);
MyComp.Name := GetNextName (MyClass);
if MyClass.InheritsFrom (TControl) then
// if MyComp is TControl then // alternative version
begin
TControl (MyComp).Left := X;
TControl (MyComp).Top := Y;
TControl (MyComp).Parent := self;
end;
end;
UpdateList;
end;
function TForm1.GetNextName (MyClass: TComponentClass): string;
var
I, nTot: Integer;
begin
nTot := 0;
for I := 0 to ComponentCount - 1 do
if Components [I].ClassType = MyClass then
Inc (nTot);
Result := Copy (MyClass.ClassName, 2, Length (MyClass.ClassName) - 1) +
IntToStr (nTot);
end;
procedure TForm1.UpdateList;
var
I: Integer;
begin
Combobox2.Items.Clear;
for I := 0 to ComponentCount - 1 do
ComboBox2.Items.Add (Components [I].Name);
end;
end.
|
Создать компонент любого класса
