RAD Studio Создание собственного Компонента на основе TPanel с размещением на нем дочерних Компонентов без использования SetSubComponent

ser4270

Местный
Регистрация
5 Май 2022
Сообщения
25
Реакции
1
Credits
86
Могу сразу сказать, что я потратил на изобретение этого "велосипеда" около 10 дней. Перепробовал многое. Те коды, что предлагаются в инете по динамическому созданию компонентов в Run-Time - это совсем не одно и тоже, чем размещение Своего Компонента на TForm с адекватным поведением при нажатии Alt+F12, переоткрытием формы. В тоже время это дало возможность прямого изменения СубКомпонентов в радакторе объектов, т.к. использование SetSubComponent хоть упрощает жизнь с кодом компонента, но и усложняет его разработку в визуальной среде.

Постараюсь не только привести конечный кода, но и упоминуть "грабли", на которые не следует наступать, а заодно и поделюсь с русскоязычным клубом необходимыми знаниями по теории поведения компонентов при сохранении в DFM и создании на форме.
 

ser4270

Местный
Регистрация
5 Май 2022
Сообщения
25
Реакции
1
Credits
86
Прежде всего: А какая цель?

Да, если вам нужен один СубКомпонент, то нет проблем. Но если у вас на панели 6 субкомпонентов и еще будет вспомогательная форма, и такой элемент у вас будет в программе раз 40 использоваться, то проще помучаться один раз, тем более потом вносить изменения будет проще.



А теперь в путь.

Как было испробовано вначале:



Вариант 1.



TrteCustomPeriodPanel = class(TdxPanel)

private

// fbtPeriodEdit: TcxButton;

btPeriodEdit: TcxButton;

procedure Notification(AComponent: TComponent; Operation: TOperation); override;

procedure Loaded; override;

public

constructor Create(AOwner: TComponent); override;

procedure AfterConstruction; override;

procedure btPeriodEditClick;//(Sender: TObject);



published

// property btPeriodEdit: TcxButton read fbtPeriodEdit write fbtPeriodEdit;

end;



constructor TrteCustomPeriodPanel.Create(AOwner: TComponent);

var

Comp: TComponent;

begin

inherited Create(AOwner);



if (csDesigning in ComponentState) then

begin

btPeriodEdit := TcxButton.Create(Self);

btPeriodEdit.OnClick := self.btPeriodEditClick;

btPeriodEdit.Parent := self;

btPeriodEdit.Caption := ' ... ';

btPeriodEdit.Left := 200;

btPeriodEdit.Top := 9;

btPeriodEdit.Width := 72;

btPeriodEdit.Height := 25;

end;

end;



ИТОГ:

Полностью рабочий вариант. Кнопка формируется программно.

НО, ее нельзя передвинуть в IDE.

Данные не сохраняются в DFM.

Доступа через Property нет.

btPeriodEdit.OnClick := btPeriodEditClick; - устанавливается !!!



Теперь поясню, что тут не так. Экскурс для новичков и тех, кто подзабыл теорию )))

Я не стал приводить весь код, акцент на мелочах, но важных. btPeriodEdit := TcxButton.Create(Self); - привязывает элемент к Панели, но владельцем должна быть Форма (!). Не подумайте, что я сразу написал это по ошибке, но это был перебор вариантов, и он частично оказался рабочим, но не так как все хотелось бы!
 

ser4270

Местный
Регистрация
5 Май 2022
Сообщения
25
Реакции
1
Credits
86
Немного Теории.



Во-первых, когда мы кидаем Компонент на Форму, среда запускает Create данного компонента, чтобы это не происходило в RunTime, необходимо использовать проверку if (csDesigning in ComponentState) then

Что примечательно, но при открытии модуля с формой, на котором установлен компонент и при переключении формы в текст DFM файла и обратно – csDesigning в ComponentState тоже устанавливается. При этом вы не можете использовать никакие другие флаги ComponentState – т.к. никакие другие при этом не используются (увы!)



Далее после Create вызывается AfterConstruction (это заложено еще в TObject), а после этого вызывается Notification (уведомление о вставке или удалении компонента), затем происходит загрузка данных из DFM, после чего вызывается метод Loaded (сигнал об окончании загрузки). Что печально – так это то, что режим компонента (его поля ComponentState) и видимого старшего брата (ControlState) – никак не меняются в зависимости от того, как создается компонент – путем вашего перетаскивания на форму, или при открытии модуля формы. Одинаково только csDesigning in ComponentState.



Попутно замечу, что имя компонента присваивается в недрах TObject уже после окончания Create. Внутри конструктора имя компонента еще не существует. Вы только можете его там писать. Скажу больше. Имени не существует даже когда уже вызван AfterConstruction.
 

ser4270

Местный
Регистрация
5 Май 2022
Сообщения
25
Реакции
1
Credits
86
Вариант 2. И снова мимо.



TrteCustomPeriodPanel = class(TdxPanel)

private

fbtPeriodEdit: TcxButton;

// btPeriodEdit: TcxButton;

...

public

...

property btPeriodEdit: TcxButton read fbtPeriodEdit write fbtPeriodEdit;



end;



TrtePeriodPanel = class(TrteCustomPeriodPanel)

published

property btPeriodEdit;

end;



// изменения в Create



if (csDesigning in ComponentState) and (not Assigned(fbtPeriodEdit)) then

begin

btPeriodEdit := TcxButton.Create(AOwner); // Владелец Форма

btPeriodEdit.OnClick := btPeriodEditClick; // Важана ли последовательность ???



btPeriodEdit.Parent := self; // Родитель - Панель

btPeriodEdit.Name := 'btPeriodEdit'; // Self.Name - не создано на данный момент времени + '_button';

btPeriodEdit.Caption := ' ... ';



ИТОГ:

Кнопка формируется в момент установки элемента на форму.

Ее МОЖНО передвинуть в IDE.

Данные сохраняются в DFM.

Доступ через Property ЕСТЬ.



НО, btPeriodEdit.Name - задан статический. При добавлении на форму второго элемента - ругается на Имя

Если имя не задавать (что можно), то в Properties не отображается.



КРОМЕ ТОГО при просмотре DFM как текста и обратно - кнопка формируется ЗАНОВО.

Но с ошибкой. И размеры с положением восстанавливаются.



btPeriodEdit.OnClick := btPeriodEditClick; - НЕ устанавливается !!!



Каждое открытие формы приводит к желанию создания нового компонента btPeriodEdit

При удалении ТОЛЬКО btPeriodEdit - ошибка IDE



Как видим, проблем стало только больше!!

Почему так?

Все логично. Срабатывает Create, затем загрузка из DFM, и элемент с таким же именем загружается из потока. Кроме того, удаление (remove) из Панели не работает, если вы в IDE нажимаете Delete (!)
 

ser4270

Местный
Регистрация
5 Май 2022
Сообщения
25
Реакции
1
Credits
86
Вариант 3. Динамические имена новых компонентов.

Для создания отличающихся имен новых компонентов на Панели была сделана несложная функция, которая используется в Create. Работает аналогично среде, которая размещает новый компонент на форме – «Имя + Число»

function TrtePeriodPanel.NewCompName(AName: String): String;
var
I: Integer;
S: String;
begin
I := 1;
while I < 100 do
begin
S := AName + IntToStr(I);
if Owner.FindComponent(S) = nil then
begin
Result := S;
exit;
end;
Inc(I);
end;

Raise Exception.CreateFmt('Уже создано 100 элементов ' + AName + '. Продолжение невозможно. ', []);
end;

Разумеется, в Create была добавлена и строка:
btPeriodEdit.Name := NewCompName('PeriodEdit');

Для удаления компонентов изначально было решено попробовать такой алгоритм:
  • Create – создание нового с именем из NewCompName
  • Переименование его в Notification
  • Удаление лишнего в Loaded
Все было хорошо до того момента, пока ты на форму не кидаешь 2-3 созданных компонента и затем удаляешь первый из них. После этого ошибка при Alt+F12 и обратно – неизбежна, т.к. новый Create снова создает компонент по номером 1.

Все что в Notification, вызывается после создания Кнопки btPeriodEdit = 'PeriodEdit##'
(По смыслу ее надо переименовать, т.к. при нажатии Alt+F12 происходит Create компонента + загрузка данных из DFM)


Как происходит загрузка из DFM:
Сначала TReader читает имя класса и создает путем Create Компонент, в момент Create вызывается Notification всем объектам
csReading - только в момент считывания свойств.
Как только считывание окончено csReading – выключается.
После создания всех (!) компонентов на форме - производится рассылка Loaded.
И перед Loaded csLoading выключается.

procedure TrtePeriodPanel.Notification(AComponent: TComponent; Operation: TOperation);
var
AComp: TComponent;
s: string;
begin
// inherited;

// для корректного удаления вручную Кнопки с Панели в IDE
if csDestroying in AComponent.ComponentState then
if (csDesigning in ComponentState) and (AComponent.ClassType = TcxButton) then
if Operation = opRemove then
begin
if Assigned(btPeriodEdit) then // Параноидальная проверка
if btPeriodEdit = AComponent then
begin
btPeriodEdit := nil; // только так !!! без всяких Free или FreeAndNil !!
exit;
end;
end;

if not (csReading in ComponentState) then exit;
// if not (csLoading in ComponentState) then exit; этого не достаточно !!
// if csInline in ComponentState then mes('csInline'); это не работает !!

if Operation = opInsert then
if (csDesigning in ComponentState) and (AComponent.ClassType = TcxButton) then
begin
// if TcxButton(AComponent).Parent = self then // на этом этапе у него нет Parent
if AComponent.Name = '' then // ТОЛЬКО при вставке нового компонента
begin
// ищем такой же созданный ранее
AComp := Owner.FindComponent(ButtonName{'PeriodEdit'});
if AComp <> nil then AComp.Name := 'A' + ButtonName; //PeriodEdit';
end;
end;

end;

procedure TrtePeriodPanel.Loaded;
var
AComp, LoadComp: TComponent;
begin

inherited Loaded; // ???

if btPeriodEdit = nil then exit;
// после загрузки компонента нужно удалить переименованный до этого экземпляр
if (csDesigning in ComponentState) then
begin
try
AComp := Owner.FindComponent('A' + ButtonName{PeriodEdit'}); // ранее переименованный экземпляр из Create
LoadComp := Owner.FindComponent(ButtonName{'PeriodEdit'});
if Assigned(AComp) and Assigned(LoadComp) then
begin
// удаляем дубликат из Create
RemoveControl(TcxButton(AComp));
AComp.Free;
end else
// переименовываем загруженный из DFM
if Assigned(AComp) then AComp.Name := {Name + '_' +} ButtonName;
except
mes('ERROR TrtePeriodPanel.Loaded');
end;
end else
begin
Caption := '';
btPeriodEdit.OnClick := Self.btPeriodEditClick;
end;

end;
 

ser4270

Местный
Регистрация
5 Май 2022
Сообщения
25
Реакции
1
Credits
86
Вариант 4. И крайний. Работает TReader.



Когда почитал код Delphi поглубже, то заметил, что при чтении из потока вызывается метод компонента procedure ReadState(Reader: TReader); override;



Его и надо переопределить.



procedure TrtePeriodPanel.ReadState(Reader: TReader);

begin

// удаление созданных в Create компонентов до создания из потока DFM

if fButton <> nil then

begin

RemoveControl(fButton);

FreeAndNil(fButton);

end;



inherited ReadState(Reader);

end;





Вот только теперь вы можете:

  • Корректно разместить и удалить множество компонентов и субкомпонентов
  • Открытие модуля и переключение формы в текст DFM и обратно не вызывает ошибок
  • Вы можете выбрать любой субкомпонент мышкой
  • Вы можете выбрать этот субкомпонент как property вашего компонента
  • Обратите внимание, что xButton.OnClick := Self.ButtonClick; происходит в Loaded
  • Удаление субкомпонентов должно быть в ReadState до inherited
  • Назначение отдельным полям property в Create нужно производить с учетом их особенностей (до конца еще не изучено, но некоторые требуют определенный порядок)


Жду комментарии и рацпредложения.
 

jonik

Местный
Регистрация
26 Мар 2005
Сообщения
111
Реакции
36
Credits
448
очень тяжело воспринимается, потому что код не выделен. Форум ведь позволяет сделать так:

Код:
procedure TrtePeriodPanel.ReadState(Reader: TReader);
begin
  // удаление созданных в Create компонентов до создания из потока DFM
  if fButton <> nil then
  begin
    RemoveControl(fButton);
    FreeAndNil(fButton);
  end;
  inherited ReadState(Reader);
end;
 

jonik

Местный
Регистрация
26 Мар 2005
Сообщения
111
Реакции
36
Credits
448
ну и полного кода компонента нет, поэтому какие могут быть критика и рацпредложения?
 

ser4270

Местный
Регистрация
5 Май 2022
Сообщения
25
Реакции
1
Credits
86
Полный код Компонента.



Код:
TrtePeriodPanel = class(TdxPanel)
private
  fButton: TcxButton;
  function NewCompName(AName: String): String;
  procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  procedure Loaded; override;
  procedure ReadState(Reader: TReader); override;
public

constructor Create(AOwner: TComponent); override;

procedure ButtonClick(Sender: TObject);

published

property xButton: TcxButton read fButton write fButton;

end;





Код:
procedure TrtePeriodPanel.ReadState(Reader: TReader);

begin

// удаление созданных в Create компонентов до создания из потока DFM

if fButton <> nil then

begin

RemoveControl(fButton);

FreeAndNil(fButton);

end;



inherited ReadState(Reader);

end;



function TrtePeriodPanel.NewCompName(AName: String): String;

var

I: Integer;

S: String;

begin

I := 1;

while I < 100 do

begin

S := AName + IntToStr(I);

if Owner.FindComponent(S) = nil then

begin

Result := S;

exit;

end;

Inc(I);

end;



Raise Exception.CreateFmt('Уже создано 100 элементов ' + AName + '. Продолжение невозможно. ', []);

end;



procedure TrtePeriodPanel.Loaded;

var

StringStream: TStringStream;

MemStream: TMemoryStream;

B: TBytes;

S: String;

const

WinTemp = 'C:\Windows\Temp\rtetemp.png';



begin

inherited Loaded; // ???



Caption := '';

Frame.Visible := false;

if xButton <> nil then xButton.OnClick := Self.ButtonClick;





// перенесено в Loaded иначе будет хранится в каждом элементе в программе

xButton.Caption := '';

xButton.OptionsImage.Glyph.SourceDPI := 96;

S := '89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF' +

'610000001974455874536F6674776172650041646F626520496D616765526561' +

'647971C9653C00000026744558745469746C650043616C656E6461723B536368' +

'6564756C65723B5765656B3B5765656B656E643B66FC76510000006449444154' +

'785EDDD0C10D80200C85E12EC81A0EE00886A11CC0795CE19726A00906DFA11E' +

'8C872F2D24AF341820E59C295261B5D23232D8E9EFE4CB2EB48164695951F66D' +

'BEF130700EF03AEC6B686AEAF9E501C0A8FFCC804B78833F0E501E3F11083900' +

'0FEB89CF1A29ACE60000000049454E44AE426082';

StringStream := TStringStream.Create(S);

MemStream := TMemoryStream.Create;

try

SetLength(B, Length(S) div SizeOf(Char));

HexToBin(PWideChar(S), B, Length(S) div SizeOf(Char));

MemStream.WriteBuffer(B[0], Length(B));

MemStream.SaveToFile(WinTemp);

xButton.OptionsImage.Glyph.LoadFromFile(WinTemp);

finally

StringStream.Free;

MemStream.Free;

end;

end;



procedure TrtePeriodPanel.Notification(AComponent: TComponent; Operation: TOperation);

begin

inherited; // ????



// для корректного удаления вручную элементов с Панели в IDE

if (csDestroying in AComponent.ComponentState) and (csDesigning in ComponentState)

and (Operation = opRemove) then

begin

// Кнопка

if (AComponent.ClassType = TcxButton) then

begin

if Assigned(xButton) then // Параноидальная проверка

if xButton = AComponent then

begin

xButton := nil; // только так !!! без всяких Free или FreeAndNil !!

exit;

end;

end;

end;



constructor TrtePeriodPanel.Create(AOwner: TComponent);

begin

inherited Create(AOwner);



if (csDesigning in ComponentState) then

begin

// параметры Панели

Width := 600;

Height := 56;



// TcxButton

ButtonName := NewCompName('PeriodEdit');

xButton := TcxButton.Create(AOwner); // Владелец Форма

xButton.Caption := ' ... ';

xButton.Name := ButtonName;

Self.InsertControl(xButton);

xButton.Left := 480;

xButton.Top := 8;

xButton.Width := 96;

xButton.Height := 35;

end;



end;



procedure TrtePeriodPanel.ButtonClick(Sender: TObject);

begin

// ваша задача

end;
 

ser4270

Местный
Регистрация
5 Май 2022
Сообщения
25
Реакции
1
Credits
86
Полный код Компонента.

Код:
TrtePeriodPanel = class(TdxPanel)
private
    fButton: TcxButton;
    function NewCompName(AName: String): String;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Loaded; override;
    procedure ReadState(Reader: TReader); override;
public
    constructor Create(AOwner: TComponent); override;
    procedure ButtonClick(Sender: TObject);
  published
    property xButton: TcxButton read fButton write fButton;
  end;
 
 
procedure TrtePeriodPanel.ReadState(Reader: TReader);
begin
  // удаление созданных в Create компонентов до создания из потока DFM
  if fButton <> nil then
  begin
    RemoveControl(fButton);
    FreeAndNil(fButton);
  end;
 
  inherited ReadState(Reader);
end;
 
function TrtePeriodPanel.NewCompName(AName: String): String;
var
  I: Integer;
  S: String;
begin
  I := 1;
  while I < 100 do
  begin
    S := AName + IntToStr(I);
    if Owner.FindComponent(S) = nil then
    begin
      Result := S;
      exit;
    end;
    Inc(I);
  end;
 
  Raise Exception.CreateFmt('Уже создано 100 элементов ' + AName + '. Продолжение невозможно. ', []);
end;
 
procedure TrtePeriodPanel.Loaded;
var
  StringStream: TStringStream;
  MemStream: TMemoryStream;
  B: TBytes;
  S: String;
const
  WinTemp = 'C:\Windows\Temp\rtetemp.png';
 
begin
  inherited Loaded;   // ???
 
  Caption := '';
  Frame.Visible := false;
  if xButton <> nil then xButton.OnClick := Self.ButtonClick;
 
 
  //  перенесено в Loaded иначе будет хранится в каждом элементе в программе
  xButton.Caption := '';
  xButton.OptionsImage.Glyph.SourceDPI := 96;
  S :=  '89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF' +
        '610000001974455874536F6674776172650041646F626520496D616765526561' +
        '647971C9653C00000026744558745469746C650043616C656E6461723B536368' +
        '6564756C65723B5765656B3B5765656B656E643B66FC76510000006449444154' +
        '785EDDD0C10D80200C85E12EC81A0EE00886A11CC0795CE19726A00906DFA11E' +
        '8C872F2D24AF341820E59C295261B5D23232D8E9EFE4CB2EB48164695951F66D' +
        'BEF130700EF03AEC6B686AEAF9E501C0A8FFCC804B78833F0E501E3F11083900' +
        '0FEB89CF1A29ACE60000000049454E44AE426082';
  StringStream := TStringStream.Create(S);
  MemStream := TMemoryStream.Create;
  try
    SetLength(B, Length(S) div SizeOf(Char));
    HexToBin(PWideChar(S), B, Length(S) div SizeOf(Char));
    MemStream.WriteBuffer(B[0], Length(B));
    MemStream.SaveToFile(WinTemp);
    xButton.OptionsImage.Glyph.LoadFromFile(WinTemp);
  finally
    StringStream.Free;
    MemStream.Free;
  end;
end;
 
procedure TrtePeriodPanel.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited; // ????
 
  // для корректного удаления вручную элементов с Панели в IDE
  if (csDestroying in AComponent.ComponentState) and (csDesigning in ComponentState)
    and (Operation = opRemove) then
  begin
    // Кнопка
    if  (AComponent.ClassType = TcxButton) then
    begin
      if Assigned(xButton) then     // Параноидальная проверка
      if xButton = AComponent  then
      begin
        xButton := nil;    // только так !!! без всяких Free или FreeAndNil !!
        exit;
      end;
    end;
  end;
 
constructor TrtePeriodPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
 
  if (csDesigning in ComponentState) then
  begin
    // параметры Панели
    Width := 600;
    Height := 56;
 
    // TcxButton
    ButtonName := NewCompName('PeriodEdit');
    xButton := TcxButton.Create(AOwner); // Владелец Форма
    xButton.Caption := ' ... ';
    xButton.Name := ButtonName;
    Self.InsertControl(xButton);
    xButton.Left := 480;
    xButton.Top := 8;
    xButton.Width := 96;
    xButton.Height := 35;
  end;
 
end;
 
procedure TrtePeriodPanel.ButtonClick(Sender: TObject);
begin
    // ваша задача
end;
 

ser4270

Местный
Регистрация
5 Май 2022
Сообщения
25
Реакции
1
Credits
86
очень тяжело воспринимается, потому что код не выделен. Форум ведь позволяет сделать так:

Код:
procedure TrtePeriodPanel.ReadState(Reader: TReader);
begin
  // удаление созданных в Create компонентов до создания из потока DFM
  if fButton <> nil then
  begin
    RemoveControl(fButton);
    FreeAndNil(fButton);
  end;
  inherited ReadState(Reader);
end;
это мой косяк - не знал как делать.

исправить не могу. проще перезалить заново
 

ser4270

Местный
Регистрация
5 Май 2022
Сообщения
25
Реакции
1
Credits
86
тот случай, когда не знал, но еще важно что выделено жирным, чтобы обращать внимание. А код не получается выделить жирным, а после Ответить - на изменение 10 минут ((
и все пробелы в начале строки улетают автоматом ((( хоть и руками правил
но имеем что имеем
 

jonik

Местный
Регистрация
26 Мар 2005
Сообщения
111
Реакции
36
Credits
448
А это вот зачем?
Код:
    SetLength(B, Length(S) div SizeOf(Char));
    HexToBin(PWideChar(S), B, Length(S) div SizeOf(Char));
    MemStream.WriteBuffer(B[0], Length(B));
    MemStream.SaveToFile(WinTemp);
    xButton.OptionsImage.Glyph.LoadFromFile(WinTemp);

Храним в строке, потом загружаем в стрим, затем сохраняем в файл и из файла грузим в глиф.
 

jonik

Местный
Регистрация
26 Мар 2005
Сообщения
111
Реакции
36
Credits
448
что будет в runtime, если в дизайне мы удалим кнопку?