TmpSort:= SortType;
SortType:= stNone;
try
for Cnt := 0 to AList.Count-1 do begin
S:= AList[Cnt];
if (length(s) = 1) and (s[1] = chr($1a)) then break;
ANewStr:= GetBufStart(PChar(S), ALevel);
if (ALevel > AOldLevel) or (AParentNode = nil) then begin
if ALevel - AOldLevel > 1 then raise Exception.Create('Неверный уровень TreeNode');
end else begin
for i:= AOldLevel downto ALevel do begin
AParentNode:= AParentNode.Parent;
if (AParentNode = nil) and (i - ALevel > 0) then raise Exception.Create('Неверный уровень TreeNode');
end;
end;
AParentNode:= Items.AddChild(AParentNode, ANewStr);
AOldLevel:= ALevel;
end;
finally
//Возвращаем исходный флаг сортировки…
SortType:= TmpSort;
end;
end;
procedure THETreeView.GetItemList(AList: TStrings); var i, Cnt: integer; ANode: TTreeNode; begin AList.Clear; Cnt:= Items.Count -1; ANode:= Items.GetFirstNode; for i:= 0 to Cnt do begin AList.Add(GetItemText(ANode)); ANode:= ANode.GetNext; end; end;
function THETreeView.GetItemText(ANode: TTreeNode): string; begin Result:= StringOfChar(' ', ANode.Level) + ANode.Text; end;
function THETreeView.AlphaSort: Boolean; var I: Integer; begin if HandleAllocated then begin Result:= CustomSort(nil, 0); end else Result:= False; end;
function eView.CustomSort(SortProc: TTVCompare; Data: Longint): Boolean; var SortCB: TTVSortCB; I: Integer; Node: TTreeNode; begin Result:= False; if HandleAllocated then begin with SortCB do begin if not Assigned(SortProc) then lpfnCompare:= @DefaultTreeViewSort else lpfnCompare:= SortProc; hParent:= TVI_ROOT; lParam:= Data; Result:= TreeView_SortChildrenCB(Handle, SortCB, 0); end; if Items.Count > 0 then begin Node:= Items.GetFirstNode; while Node <> nil do begin if Node.HasChildren then Node.CustomSort(SortProc, Data); Node:= Node.GetNext; end; end; end; end;
//Регистрация компонента procedure Register; begin RegisterComponents('Win95', [THETreeView]); end;
end.
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; Inprise также рассказывала об этом в выпусках TechInfo. Поищите ti2938.asc Creating Dynamic Components at Runtime на публичном WWW или FTP сайте компании Inprise.
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( // Задаем уникальное имя считываемому компоненту, например, "Panel2", если "Panel1" уже существует 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
procedure THETreeView.GetItemList(AList: TStrings); var i, Cnt: integer; ANode: TTreeNode; begin AList.Clear; Cnt:= Items.Count -1; ANode:= Items.GetFirstNode; for i:= 0 to Cnt do begin AList.Add(GetItemText(ANode)); ANode:= ANode.GetNext; end; end;
function THETreeView.GetItemText(ANode: TTreeNode): string; begin Result:= StringOfChar(' ', ANode.Level) + ANode.Text; end;
function THETreeView.AlphaSort: Boolean; var I: Integer; begin if HandleAllocated then begin Result:= CustomSort(nil, 0); end else Result:= False; end;
function eView.CustomSort(SortProc: TTVCompare; Data: Longint): Boolean; var SortCB: TTVSortCB; I: Integer; Node: TTreeNode; begin Result:= False; if HandleAllocated then begin with SortCB do begin if not Assigned(SortProc) then lpfnCompare:= @DefaultTreeViewSort else lpfnCompare:= SortProc; hParent:= TVI_ROOT; lParam:= Data; Result:= TreeView_SortChildrenCB(Handle, SortCB, 0); end; if Items.Count > 0 then begin Node:= Items.GetFirstNode; while Node <> nil do begin if Node.HasChildren then Node.CustomSort(SortProc, Data); Node:= Node.GetNext; end; end; end; end;
//Регистрация компонента procedure Register; begin RegisterComponents('Win95', [THETreeView]); end;
end.
Разное
Создание компонента во время работы приложения
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; Inprise также рассказывала об этом в выпусках TechInfo. Поищите ti2938.asc Creating Dynamic Components at Runtime на публичном WWW или FTP сайте компании Inprise.
Получение индекса компонента в списке родителя
Мне необходимо найти индекс компонента в родительском списке дочерних элементов управления. Я попытался модифицировать prjexp.dll, но без успеха. У кого-нибудь есть идеи? Есть такая функция. Ищет родителя заданного компонента, перебирает список и возвращает индекс искомого компонента. Функция прошла многочисленные тесты и вполне работоспособна. { функция, возвращающая индекс искомого компонента в списке родителя; возвращает –1 при отсутствии компонента } function IndexInParent(vControl: TControl): integer; var ParentControl: TWinControl; begin {делаем "слепок" родителя через базовый класс на предмет доступности } ParentControl:= TForm(vControl.Parent); if (ParentControl <> nil) then begin for Result:= 0 to ParentControl.ControlCount - 1 do begin if (ParentControl.Controls[Result] = vControl) then exit; end; end; { если мы уж попали в это место, то либо не найден компонент, либо компонент не имел родителя } Result:= –1; end;Массив компонентов…
Возможно ли создание массива компонентов? Для показа статуса я использую набор LED-компонентов и хотел бы иметь к ним доступ, используя массив. Прежде всего необходимо объявить массив: LED: array[1..10] of TLed; (10 элементов компонентного типа TLed) При необходимости динамического создания LED-компонентов организуйте цикл, пример которого мы приводим ниже: for counter:= 1 to 10 do begin LED[counter]:= TLED.Create; LED[counter].top:= … LED[counter].Left:= … LED[counter].Parent:= Mainform; {что-то типа этого} end; Если компоненты уже присутствуют на форме (в режиме проектирования), сделайте их элементами массива, например так: leds:= 0; for counter:= 0 to Form.Componentcount do begin if (components[counter] is TLED) then begin inc(leds); LED[leds]:= TLED(components[counter]); end end; Тем не менее у нас получился массив со случайным расположением LED-компонентов. Я предлагаю назначить свойству Tag каждого LED-компонента порядковый номер его расположения в массиве, а затем заполнить массив, используя это свойство: for counter := 0 to Form.Componentcount do begin if (components[counter] is TLED) then begin LED[Component[counter].tag]:= TLED(components[counter]); end end; Если вам нужен двухмерный массив, то для формирования индекса понадобится другая хитрость, например, хранение в свойстве Hint информации о времени создания компонентов.Дублирование компонентов и их потомков во время выполнения приложения
Приведенный ниже код содержит функцию 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( // Задаем уникальное имя считываемому компоненту, например, "Panel2", если "Panel1" уже существует 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