Inprise также рассказывала об этом в выпусках TechInfo. Поищите ti2938.asc Creating Dynamic Components at Runtime на публичном WWW или FTP сайте компании Inprise.

---

Код

Var
MyButton : TButton;

MyButton := TButton.Create(MyForm); // MyForm теперь "обладает" MyButton
with MyButton do

BEGIN
Parent := MyForm; // Выбираем родителей. MyForm "усыновляет" MyButton
height := 32;
width := 128;
caption := 'Я здесь!';
left := (MyForm.ClientWidth - width) div 2;
top := (MyForm.ClientHeight - height) div 2;
END;

Я несколько раз видел в конференциях вопросы типа "как мне добавить элементы управления в TTabbedNotebook или TNotebook во время выполнения программы?". Теперь, когда у меня выдалось несколько свободных минут, я попытаюсь осветить этот вопрос как можно подробнее.

---

TTabbedNotebook

Добавление элементов управления в TTabbedNotebook во время проектирования - красивая и простая задача. Все, что Вам нужно - это установить свойство PageIndex или ActivePage на необходимую страницу и начать заполнять ее элементами управления.

Добавление элементов управление во время выполнения приложения также очень просто. Тем не менее, в прилагаемой документации по Delphi вы не найдете рецептов типа Что-и-Как. Видимо для того, чтобы окончательно запутать начинающих программистов, фирма-изготовитель даже не удосужилась включить исходный код TTabbedNotebook в VCL-библиотеку. Таким образом, TTabbedNotebook остается для некоторых тайной за семью печатями. К счастью, я имею некоторый опыт, коим и хочу поделиться.

Первым шагом к раскрытию тайны послужит просмотр файла DELPHIDOCTABNOTBK.INT, интерфейсной секции модуля TABNOTBK.PAS, в котором определен класс TTabbedNotebook. Беглый просмотр позволяет обнаружить класс TTabPage, описанный как хранилище элементов управления отдельной страницы TTabbedNotebook.

Вторым шагом в исследовании TTabbedNotebook может стать факт наличия свойством Pages типа TStrings. В связи с этим отметим, что Delphi-классы TStrings и TStringList соорганизуются с двумя свойствами: Strings и Objects. Другими словами, для каждой строки в TStrings есть указатель на соответствующий Objects. Во многих случаях этот дополнительный указатель игнорируется, нам же он очень пригодится.

После небольшого эксперимента выясняем, что свойство Objects указывает на нашу копию TTabPage и ссылается на имя страницы в свойстве Strings. Блестяще! Всегда полезно знать что ищешь. Теперь посмотрим что мы можем сделать:

Код

{ Данная процедура добавляет кнопку в случайной позиции на }
{ текущей странице данного TTabbedNotebook. }

procedure AddButton(tabNotebook : TTabbedNotebook);
var

tabpage : TTabPage;
button : TButton;
begin

with tabNotebook do
tabpage := TTabPage(Pages.Objects[PageIndex]);
button := TButton.Create(tabpage);
try
with button do begin
Parent := tabpage;
Left := Random(tabpage.ClientWidth - Width);
Top := Random(tabpage.ClientHeight - Height);
end;
except
button.Free;
end;
end;

TNotebook

Операция по заполнению элементами управления компонента TNotebook почти такая же, как и в TTabbedNotebook - разница лишь в типе класса - TPage вместо TTabPage. Тем не менее, если вы заглянете в DELPHIDOCEXTCTRLS.INT, декларацию класса TPage вы там не найдете. По неизвестной причине Borland не включил определение TPage и в DOC-файлы, поставляемые с Delphi. Декларация TPage в EXTCTRLS.PAS (можно найти в библиотеке VCL-исходников), правда, расположена в интерфейсной части модуля. Мы восполним пропущенную информацию о классе TPage:

Код

TPage = class(TCustomControl)
private
procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
protected
procedure ReadState(Reader: TReader); override;
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
published
property Caption;
property Height stored False;
property TabOrder stored False;
property Visible stored False;
property Width stored False;
end;

Теперь, по аналогии с вышеприведенной процедурой, попробуем добавить кнопку на TNotebook. Все, что мы должны сделать - заменить "TTabbedNotebook" на "TNotebook" и "TTabPage" на "TPage". Вот что должно получиться:

Код

{ Данная процедура добавляет кнопку в случайной позиции на }
{ текущей странице данного TNotebook. }

procedure AddButton(Notebook1 : TNotebook);
var

page : TPage;
button : TButton;
begin

with Notebook1 do
page := TPage(Pages.Objects[PageIndex]);
button := TButton.Create(page);
try
with button do begin
Parent := page;
Left := Random(page.ClientWidth - Width);
Top := Random(page.ClientHeight - Height);
end;
except
button.Free;
end;
end;

Один из примеров создания текстового компонента с трехмерной декоративной контурной рамкой (для создания компонента потребовалось около получаса. Он демонстрирует только принцип получения рамки. Я не стал колдовать над свойствами типа ParentFont..., т.к. это заняло бы еще немало времени и места).

---

Код

unit IDSLabel;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,

ExtCtrls;

type
TIDSLabel = class(TBevel)
private
{ Private declarations }
FAlignment : TAlignment;
FCaption : String;
FFont : TFont;
FOffset : Byte;

FOn : TNotifyEvent;

procedure SetAlignment( taIn : TAlignment );
procedure SetCaption( const strIn : String);
procedure SetFont( fntNew : TFont );
procedure SetOffset( bOffNew : Byte );
protected
{ Protected declarations }
constructor Create( compOwn : TComponent ); override;
destructor Destroy; override;
procedure Paint; override;
public
{ Public declarations }
published
{ Published declarations }
property Alignment : TAlignment read FAlignment write SetAlignment default taLeftJustify;
property Caption : String read FCaption write SetCaption;
property Font : TFont read FFont write SetFont;
property Offset : Byte read FOffset write SetOffset;

property On : TNotifyEvent read FOn write FOn;
end;

implementation

constructor TIDSLabel.Create;
begin

inherited Create(compOwn);

FFont := TFont.Create;
with compOwn as TForm do
FFont.Assign(Font);

Offset := 4;
Height := 15;
end;

destructor TIDSLabel.Destroy;
begin

FFont.Free;

inherited Destroy;
end;

procedure TIDSLabel.Paint;
var

wXPos, wYPos : Word;
begin

{Рисуем рамку}
inherited Paint;

{Назначаем шрифт}
Canvas.Font.Assign(Font);

{Вычисляем вертикальную позицию}
wYPos := (Height - Canvas.TextHeight(Caption)) div 2;

{Вычисляем горизонтальную позицию}
wXPos := Offset;
case Alignment of
taRightJustify: wXPos := Width - Canvas.TextWidth(Caption) - Offset;
taCenter: wXPos := (Width - Canvas.TextWidth(Caption)) div 2;
end;
Canvas.Brush := Parent.Brush;
Canvas.TextOut(wXPos,wYPos,Caption);

end;

procedure TIDSLabel.SetAlignment;
begin

FAlignment := taIn;
Invalidate;
end;

procedure TIDSLabel.SetCaption;
begin
FCaption := strIn;


if Assigned(FOn) then
FOn(Self);


Invalidate;
end;

procedure TIDSLabel.SetFont;
begin

FFont.Assign(fntNew);
Invalidate;
end;

procedure TIDSLabel.SetOffset;
begin

FOffset := bOffNew;
Invalidate;
end;

end.

Приведенный ниже код содержит функцию DuplicateComponents, позволяющую проводить клонирование любых компонентов и их потомков во время выполнения приложения. Действия ее напоминают операцию копирования/вставки (copy/paste) во время разработки приложения.

---

Новые компоненты при создании получают тех же родителей, владельцев (в случае применения контейнеров) и имена (естественно, несколько отличающихся), что и оригиналы. В данной функции есть вероятность багов, но я пока их не обнаружил. Ошибки и недочеты могут возникнуть из-за редко применяемых специфических методов, которые, вместе с тем, могут помочь программистам, столкнувшимися с аналогичными проблемами.

Данная функция может оказаться весьма полезной в случае наличия нескольких одинаковых областей на форме с необходимостью синхронизации изменений в течение некоторого промежутка времени. Процедура создания дубликата проста до безобразия: разместите на TPanel или на другом родительском компоненте необходимые элементы управления и сделайте: "newpanel := DuplicateComponents(designedpanel)".

Код

uses

SysUtils, Windows, Messages, Classes, Graphics, Controls,
Forms, Dialogs, ExtCtrls, StdCtrls, IniFiles, TypInfo, Debug;

type

TUniqueReader = Class(TReader)
LastRead: TComponent;
procedure ComponentRead(Component: TComponent);
procedure SetNameUnique(
Reader: TReader;
Component: TComponent;
var Name: string
);
end;

implementation

procedure TUniqueReader.ComponentRead(

Component: TComponent
);
begin

LastRead := Component;
end;

procedure TUniqueReader.SetNameUnique( // Задаем уникальное имя считываемому компоненту

Reader: TReader;
Component: TComponent; // Считываемый компонент
var Name: string // Имя компонента для дальнейшей модификации
);
var

i: Integer;
tempname: string;
begin

i := 0;
tempname := Name;
while Component.Owner.FindComponent(Name) <> nil do begin
Inc(i);
Name := Format('%s%d', [tempname, i]);
end;
end;


function DuplicateComponents(

AComponent: TComponent // исходный компонент
): TComponent; // возвращаемся к созданию нового компонента

procedure RegisterComponentClasses(
AComponent: TComponent
);
var
i : integer;
begin
RegisterClass(TPersistentClass(AComponent.ClassType));
if AComponent is TWinControl then
if TWinControl(AComponent).ControlCount > 0 then
for i := 0 to
(TWinControl(AComponent).ControlCount-1) do

RegisterComponentClasses(TWinControl(AComponent).Controls[i]);

end;

var

Stream: TMemoryStream;
UniqueReader: TUniqueReader;
Writer: TWriter;
begin

result := nil;
UniqueReader := nil;
Writer := nil;


try
Stream := TMemoryStream.Create;
RegisterComponentClasses(AComponent);


try
Writer := TWriter.Create(Stream, 4096);
Writer.Root := AComponent.Owner;
Writer.WriteSignature;
Writer.WriteComponent(AComponent);
Writer.WriteListEnd;
finally
Writer.Free;
end;


Stream.Position := 0;
try
UniqueReader := TUniqueReader.Create(Stream, 4096); // создаем поток, перемещающий данные о компоненте в конструктор
UniqueReader.OnSetName := UniqueReader.SetNameUnique;
UniqueReader.LastRead := nil;


if AComponent is TWinControl then

UniqueReader.ReadComponents(
// считываем компоненты и суб-компоненты

TWinControl(AComponent).Owner,
TWinControl(AComponent).Parent,
UniqueReader.ComponentRead
)
else

UniqueReader.ReadComponents(
// читаем компоненты

AComponent.Owner,
nil,
UniqueReader.ComponentRead
);
result := UniqueReader.LastRead;
finally
UniqueReader.Free;
end;
finally
Stream.Free;
end;
end;