Валентин Озеров - Советы по Delphi. Версия 1.0.6 Страница 19

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-компонента порядковый номер его расположения в массиве, а затем заполнить массив, используя это свойство: