VPF::построить TreeView по данным из БД

ilya198293

Дата 26.9.2007, 08:40 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 170
Регистрация: 17.3.2007
Где: Сириус, созвездие Большого Пса

Репутация: нет
Всего: нет

Нужно построить TreeView по результатам запроса из БД.
Пробовал двумя способами это сделать, сначалдо занести все данные в StringList? потом сохранить его в файл и потом TreeView считать из этого файла. Сработало достаточно быстро, но работа с лишним файлом не устраивает(хотя в крайнем случае и покатит).

Код


      while not EOF do
        begin
          if i=1
            then begin
              StructureBase.Add(Trim(IBQuery1['NAZVMEST']));
              StructureBase.Add(#09+Trim(IntToStr(IBQuery1['KUST']))+Trim(IBQuery1['LKUST']));
              StructureBase.Add(#09+#09+Trim(IBQuery1['NSKV']));
              TekZnach[1]:=IBQuery1['NAZVMEST'];
              TekZnach[2]:=IntToStr(IBQuery1['KUST']);
              TekZnach[3]:=IBQuery1['LKUST'];
              TekZnach[4]:=FloatToStr(IBQuery1['IDSKV']);
              TekZnach[5]:=IBQuery1['NSKV'];
              inc(i);
            end
            else begin
              if TekZnach[1]<>IBQuery1['NAZVMEST']
                then begin
                  StructureBase.Add(Trim(IBQuery1['NAZVMEST']));
                  StructureBase.Add(#09+Trim(IntToStr(IBQuery1['KUST']))+Trim(IBQuery1['LKUST']));
                  StructureBase.Add(#09+#09+Trim(IBQuery1['NSKV']));
                end
                else begin
                  if (TekZnach[2]<>IntToStr(IBQuery1['KUST'])) OR (TekZnach[3]<>IBQuery1['LKUST'])
                    then begin
                      StructureBase.Add(#09+Trim(IntToStr(IBQuery1['KUST']))+Trim(IBQuery1['LKUST']));
                      StructureBase.Add(#09+#09+Trim(IBQuery1['NSKV']));
                    end
                    else begin
                      StructureBase.Add(#09+#09+Trim(IBQuery1['NSKV']));
                    end;
                end;
              TekZnach[1]:=IBQuery1['NAZVMEST'];
              TekZnach[2]:=IntToStr(IBQuery1['KUST']);
              TekZnach[3]:=IBQuery1['LKUST'];
              TekZnach[4]:=FloatToStr(IBQuery1['IDSKV']);
              TekZnach[5]:=IBQuery1['NSKV'];
              inc(i);
            end;
          IBQuery1.Next;
        end;

Ещё один вариант:

Код


      while not EOF do
        begin
          if i=1
            then begin
              TreeView1.Items.Add(nil, Trim(IBQuery1['NAZVMEST']));             //месторождение
              TreeAdd[1]:=TreeView1.Items.Count-1;
              TreeView1.Items.AddChild(TreeView1.Items.Item[TreeAdd[1]], Trim(IntToStr(IBQuery1['KUST']))+Trim(IBQuery1['LKUST']));   //куст
              TreeAdd[2]:=TreeView1.Items.Count-1;
              TreeView1.Items.AddChild(TreeView1.Items.Item[TreeAdd[2]], Trim(IBQuery1['NSKV']));   //скважина
              TreeAdd[3]:=TreeView1.Items.Count-1;
              TekZnach[1]:=IBQuery1['NAZVMEST'];
              TekZnach[2]:=IntToStr(IBQuery1['KUST']);
              TekZnach[3]:=IBQuery1['LKUST'];
              TekZnach[4]:=FloatToStr(IBQuery1['IDSKV']);
              TekZnach[5]:=IBQuery1['NSKV'];
              inc(i);
            end
            else begin
              if TekZnach[1]<>IBQuery1['NAZVMEST']
                then begin
                  TreeView1.Items.Add(nil,Trim(IBQuery1['NAZVMEST']));          //месторождение
                  TreeAdd[1]:=TreeView1.Items.Count-1;
                  TreeView1.Items.AddChild(TreeView1.Items.Item[TreeAdd[1]], Trim(IntToStr(IBQuery1['KUST']))+Trim(IBQuery1['LKUST']));   //куст
                  TreeAdd[2]:=TreeView1.Items.Count-1;
                  TreeView1.Items.AddChild(TreeView1.Items.Item[TreeAdd[2]], Trim(IBQuery1['NSKV']));   //скважина
                  TreeAdd[3]:=TreeView1.Items.Count-1;
                end
                else begin
                  if (TekZnach[2]<>IntToStr(IBQuery1['KUST'])) OR (TekZnach[3]<>IBQuery1['LKUST'])
                    then begin
                      TreeView1.Items.AddChild(TreeView1.Items.Item[TreeAdd[1]], Trim(IntToStr(IBQuery1['KUST']))+Trim(IBQuery1['LKUST']));   //куст
                      TreeAdd[2]:=TreeView1.Items.Count-1;
                      TreeView1.Items.AddChild(TreeView1.Items.Item[TreeAdd[2]], Trim(IBQuery1['NSKV']));   //скважина
                      TreeAdd[3]:=TreeView1.Items.Count-1;
                    end
                    else begin
                      TreeView1.Items.AddChild(TreeView1.Items.Item[TreeAdd[2]], Trim(IBQuery1['NSKV']));   //скважина
                      TreeAdd[3]:=TreeView1.Items.Count-1;
                    end;
                end;
              TekZnach[1]:=IBQuery1['NAZVMEST'];
              TekZnach[2]:=IntToStr(IBQuery1['KUST']);
              TekZnach[3]:=IBQuery1['LKUST'];
              TekZnach[4]:=FloatToStr(IBQuery1['IDSKV']);
              TekZnach[5]:=IBQuery1['NSKV'];
              inc(i);
            end;
          IBQuery1.Next;
        end;

запоминаю Item вышерасположеной ветки и добавляю как ребёнка. Причём на каждый уровень своя переменная.
Работает очень долго. 3000 Item-ов создаются уже десятки секунд.
А работа с глубиной дерева ещё не закончена. Сейчас глубина 3. А будет 5. Причём сумарное кол-во элементов 5-го уровня предполагается около 325000.

В первом случае - это будет сохранение и загрузка промежуточного файла размером 2,5-3 МБ.
Может кто-нибудь посоветует как ускорить второй метод.
В SQL сортировка задаётся как нужно. Просто нужно Считать строку и в колонке где идёт отличие с предыдущей строкой ввести соответственно Item.

Это сообщение отредактировал(а) ilya198293 - 26.9.2007, 08:43

--------------------

Недавно пытался объяснить сыну, кто такой модератор. Сошлись на Мойдодыре.

Savek

Дата 26.9.2007, 11:01 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 355
Регистрация: 10.4.2006
Где: Воронеж

Репутация: 7
Всего: 7

Сам не пробовал но говорят работает гораздо быстрее:

Код


Представляем вашему вниманию немного переработанный компонент TreeView, работающий быстрее своего собрата из стандартной поставки Delphi. Кроме того, была добавлена возможность вывода текста узлов и пунктов в жирном начертании (были использованы методы TreeView, хотя, по идее, необходимы были свойства TreeNode. Мне показалось, что это будет удобнее). 

Для сравнения: 

TreeView:

128 сек. для загрузки 1000 элементов (без сортировки)*
270 сек. для сохранения 1000 элементов (4.5 минуты!!!)
HETreeView:

1.5 сек. для загрузки 1000 элементов - ускорение около 850%!!! (2.3 секунды без сортировки = stText)*
0.7 сек. для сохранения 1000 элементов - ускорение около 3850%!!!
Примечание: 


Все операции выполнялись на медленной машине 486SX 33 Mгц, 20 Mб RAM. 
Если TreeView пуст, загрузка происходит за 1.5 секунды, плюс 1.5 секунды на стирание 1000 элементов (общее время загрузки составило 3 секунды). В этих условиях стандартный компонент TTreeView показал общее время 129.5 секунд. Очистка компонента осуществлялась вызовом функции SendMessage(hwnd, TVM_DELETEITEM, 0, Longint(TVI_ROOT)). 
Проведите несколько приятных минут, развлекаясь с компонентом. 



unit HETreeView;
{$R-}

// Описание: Реактивный TreeView
(*

TREEVIEW:
128 сек. для загрузки 1000 элементов (без сортировки)*
270 сек. для сохранения 1000 элементов (4.5 минуты!!!)

HETREEVIEW:
1.5 сек. для загрузки 1000 элементов - ускорение около 850%!!!
  (2.3 секунды без сортировки = stText)*
0.7 сек. для сохранения 1000 элементов - ускорение около 3850%!!!

NOTES:
- Все операции выполнялись на медленной машине 486SX 33 Mгц, 20 Mб RAM.

- * Если TTreeView пуст, загрузка происходит за 1.5 секунды,
плюс 1.5 секунды на стирание 1000 элементов
  (общее время загрузки составило 3 секунды).
В этих условиях стандартный компонент TreeView показал общее время 129.5 секунд.
Очистка компонента осуществлялась вызовом функции
SendMessage(hwnd, TVM_DELETEITEM, 0, Longint(TVI_ROOT)).
*)

interface

uses

  SysUtils, Windows, Messages, Classes, Graphics,
  Controls, Forms, Dialogs, ComCtrls, CommCtrl;

type

  THETreeView = class(TTreeView)
  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 THETreeView.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.

Anry

Дата 26.9.2007, 12:03 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 15
Регистрация: 20.4.2006

Репутация: нет
Всего: нет

Цитата

Причём сумарное кол-во элементов 5-го уровня предполагается около 325000.

Вообще не стоит загонять столько данных в дерево, слишком накладно.
Лучше заполнять данные когда они тебе действительно нужны, например при событии разворота ветки. так будет быстрее работать

ilya198293

Дата 26.9.2007, 13:15 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Savek, а что делать с кодом? Куда сохранить? Компилировать как компонент или просто подключать в uses-ах?

Цитата

Я думал об этом, но сначало попробую вариант с загрузкой всего дерева (просто для практики).

Это сообщение отредактировал(а) ilya198293 - 26.9.2007, 13:44

--------------------

Недавно пытался объяснить сыну, кто такой модератор. Сошлись на Мойдодыре.

Savek

Дата 26.9.2007, 13:42 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 355
Регистрация: 10.4.2006
Где: Воронеж

Репутация: 7
Всего: 7

Дело хозяйское, но если просто подключишь в uses не забудь при создании указать родителя, а то не появится

Код


var tv:THETreeView;
begin
tv:=THETreeView.Create(self);
tv.Parent:=form1;
end

Savek

Дата 27.9.2007, 07:41 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 355
Регистрация: 10.4.2006
Где: Воронеж

Репутация: 7
Всего: 7

ilya198293, как испытаешь, расскажи, действительно ли этот компонент так хорош

Akella

Дата 27.9.2007, 07:59 (ссылка)

(нет голосов)

Загрузка ...

Творец

Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

Репутация: 29
Всего: 329

ilya198293, судя по этой строчке
RegisterComponents('Win95', [THETreeView]);

это компонент

Добавлено через 2 минуты и 21 секунду
ilya198293, простой вопрос: поиском по форуму пользовался?
http://forum.vingrad.ru/act-Search/CODE/sh...25BE/index.html

а вниз этой странички заглядывал?

Добавлено через 14 минут и 2 секунды
вот так я когда-то строил дерево

здесь 4 уровня - классы, типы, спецификация, серия

это не совсем классическое дерево, где есть ID, ParentID, Value

Код


procedure TTree.FillTree2;
Var
 NodeRoot,
 nodeClass,
 nodeType ,
 nodeSpec  :TTreeNode;
begin
try
  Screen.Cursor := crHourGlass;
  fTree.Items.BeginUpdate;
  fTree.Items.Clear;
  NodeRoot := nil;
  new(DataRec);
  DataRec^.IdClass := null;
  DataRec^.IdType  := null;
  DataRec^.IdSpec  := null;
  DataRec^.IdSer   := null;

  nodeRoot := fTree.Items.AddObjectFirst(nil,'F10 - Всесь каталог',DataRec);

  //загружаем классы fClassDS - ADODataset
  fClassDS.Open;
//  nodeRoot.Text := GetRecordCount(nodeRoot,fClassDS);
  fClassDS.First;
  while Not fClassDS.Eof
  do begin
    New(DataRec);
    DataRec^.IdClass := fClassDS.FieldByName('Class_id').AsInteger;
    DataRec^.IdType  := null;
    DataRec^.IdSpec  := null;
    DataRec^.IdSer   := null;

    nodeClass := fTree.Items.AddChildObject(NodeRoot,
                                            fClassDS.FieldValues['class_name'],
                                            DataRec);

    //загружаем типы fTypeDS - ADODataset
    fTypeDS.Parameters.ParamByName('@class_id').Value :=
       fClassDS.FieldByName('Class_id').AsInteger;
    fTypeDS.Open;
//    nodeClass.Text := GetRecordCount(nodeClass,fTypeDS);
    fTypeDS.First;
    while Not fTypeDS.Eof
    do begin
      //загружаем типы
      New(DataRec);
      DataRec^.IdClass := fClassDS.FieldByName('Class_id').AsInteger;
      DataRec^.IdType  := fTypeDS.FieldByName('goods_type_id').AsInteger;
      DataRec^.IdSpec  := null;
      DataRec^.IdSer   := null;

      nodeType := fTree.Items.AddChildObject(nodeClass,
                                             fTypeDS.FieldValues['goods_type_name'],
                                             DataRec);

      //загрузка спецификаций fSpecDS - ADODataset
      fSpecDS.Parameters.ParamByName('@goods_type_id').Value :=
        fTypeDS.FieldByName('goods_type_id').AsInteger;
      fSpecDS.Open;
//      nodeType.Text := GetRecordCount(nodeType,fSpecDS);
      fSpecDS.First;
      while not fSpecDS.eof
      do begin
        New(DataRec);
        DataRec^.IdClass := fClassDS.FieldByName('Class_id').AsInteger;
        DataRec^.IdType  := fTypeDS.FieldByName('goods_type_id').AsInteger;
        DataRec^.IdSpec  := fSpecDS.FieldByName('Specified_id').AsInteger;
        DataRec^.IdSer   := null;

        nodeSpec :=  fTree.Items.AddChildObject(nodeType,
                                               fSpecDS.FieldValues['Specified_Name'],
                                                DataRec);
        //загрузка серий fSerDS - ADODataset
        fSerDS.Parameters.ParamByName('@Specified_id').Value :=
        fSpecDS.FieldByName('Specified_id').AsInteger;
        fSerDS.Open;
//        nodeSpec.Text := GetRecordCount(nodeSpec,fSerDS);
        fSerDS.First;
        while not fSerDS.eof
        do begin
          New(DataRec);
          DataRec^.IdClass := fClassDS.FieldByName('Class_id').AsInteger;
          DataRec^.IdType  := fTypeDS.FieldByName('goods_type_id').AsInteger;
          DataRec^.IdSpec  := fSpecDS.FieldByName('Specified_id').AsInteger;
          DataRec^.IdSer   := fSerDS.FieldByName('Series_ID').AsInteger;
//          if fSerDS.FieldValues['Serie_Name'] <> 'Не задана' then
          fTree.Items.AddChildObject(nodeSpec,
                                     fSerDS.FieldValues['Serie_Name'],
                                     DataRec);
          fSerDS.Next;
        end;
        fSerDS.Close;
        fSpecDS.next;
      end;
      fSpecDS.Close;
      fTypeDS.next;
    end;
    fTypeDS.Close;
    fClassDS.Next;
  end;
finally
  if Assigned(fTree.selected)
  then fTree.selected.Expand(False);
  fTree.Items.EndUpdate;
  Screen.Cursor := crDefault;
end;//try-finally
end;

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Базы данных и репортинг \| Следующая тема »