private
FSortType: TSortType;
procedure SetSortType(Value: TSortType);
protected
function GetItemText(ANode: TTreeNode): string;
public
constructor Create(AOwner: TComponent); override;
function AlphaSort: Boolean;
function CustomSort(SortProc: TTVCompare; Data: Longint): Boolean;
procedure LoadFromFile(const AFileName: string);
procedure SaveToFile(const AFileName: string);
procedure GetItemList(AList: TStrings);
procedure SetItemList(AList: TStrings);
//Жирное начертание шрифта 'Bold' должно быть свойством TTreeNode, но...
function IsItemBold(ANode: TTreeNode): Boolean;
procedure SetItemBold(ANode: TTreeNode; Value: Boolean);
published
property SortType: TSortType read FSortType write SetSortType default stNone;
end;
procedure Register;
implementation
function DefaultTreeViewSort(Node1, Node2: TTreeNode; lParam: Integer): Integer; stdcall;
begin
{with Node1 do
if Assigned(TreeView.OnCompare) then
TreeView.OnCompare(Node1.TreeView, Node1, Node2, lParam, Result)
else}
Result:= lstrcmp(PChar(Node1.Text), PChar(Node2.Text));
end;
constructor THETreeView.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FSortType:= stNone;
end;
procedure THETreeView.SetItemBold(ANode: TTreeNode; Value: Boolean);
var
Item: TTVItem; Template: Integer;
begin
if ANode = nil then Exit;
if Value then Template:= -1 else Template:= 0;
with Item do begin
mask:= TVIF_STATE;
hItem:= ANode.ItemId;
stateMask:= TVIS_BOLD;
state:= stateMask and template;
end;
TreeView_SetItem(Handle, Item);
end;
function THETreeView.IsItemBold(ANode: TTreeNode): Boolean;
var
Item: TTVItem;
begin
Result:= False;
if ANode = nil then Exit;
with Item do begin
mask:= TVIF_STATE;
hItem:= ANode.ItemId;
if TreeView_GetItem(Handle, Item) then Result:= (state and TVIS_BOLD) <> 0;
end;
end;
procedure THETreeView.SetSortType(Value: TSortType);
begin
if SortType <> Value then begin
FSortType:= Value;
if ((SortType in [stData, stBoth]) and Assigned(OnCompare)) or (SortType in [stText, stBoth]) then AlphaSort;
end;
end;
procedure THETreeView.LoadFromFile(const AFileName: string);
var
AList: TStringList;
begin
AList:= TStringList.Create;
Items.BeginUpdate;
try
AList.LoadFromFile(AFileName);
SetItemList(AList);
finally
Items.EndUpdate;
AList.Free;
end;
end;
procedure THETreeView.SaveToFile(const AFileName: string);
var
AList: TStringList;
begin
AList:= TStringList.Create;
try
GetItemList(AList);
AList.SaveToFile(AFileName);
finally
AList.Free;
end;
end;
procedure THETreeView.SetItemList(AList: TStrings);
var
ALevel, AOldLevel, i, Cnt: Integer;
S: string;
ANewStr: string;
AParentNode: TTreeNode;
TmpSort: TSortType;
function GetBufStart(Buffer: PChar; var ALevel: Integer): PChar;
begin
ALevel:= 0;
while Buffer^ in [' ', #9] do begin
Inc(Buffer);
Inc(ALevel);
end;
Result:= Buffer;
end;
begin
//Удаление всех элементов – в обычной ситуации подошло бы Items.Clear, но уж очень медленно
SendMessage(handle, TVM_DELETEITEM, 0, Longint(TVI_ROOT));
AOldLevel:= 0;
AParentNode:= nil;
//Снятие флага сортировки
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.
Создание компонента во время работы приложения
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-компонента порядковый номер его расположения в массиве, а затем заполнить массив, используя это свойство:
