Недавно добавленные исходники

•  3D Designer  830

•  Sik Screen Capture  572

•  Patch Maker  514

•  Айболит (remote control)  628

•  ListBox Drag & Drop  465

•  Доска для игры Реверси  8 589

•  Графические эффекты  561

•  Рисование по маске  442

•  Перетаскивание изображений  487

•  Canvas Drawing  488

•  Рисование Луны  380

•  Поворот изображения  260

•  Рисование стержней  315

•  Paint on Shape  189

•  Генератор кроссвордов  247

•  Головоломка Paletto  225

•  Теорема Монжа об окружностях  270

•  Пазл Numbrix  185

•  Заборы и коммивояжеры  302

•  Игра HIP  204

•  Игра Go (Го)  145

•  Симулятор лифта  180

•  Программа укладки плитки  165

•  Генератор лабиринта  204

•  Проверка числового ввода  193

•  HEX View  231

•  Физический маятник  202

•  Задача коммивояжера  233

•  Автомобильная пробка  156

•  Квадратные сетки из слов  127

 
скрыть


Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



TreeView - компонент для показа dataset в виде дерева с сохранением



Автор: Валентин

{ **** UBPFD *********** by delphibase.endimus.com ****
>> TreeView - компонент для показа dataset в виде дерева с сохранением

Цель создания: необходимость быстрого выбора товара из справочника в виде дерева.
Компонент для визуализации дерева из таблицы. привязка к полям не ведется.
Ключевое поле находится в node.stateindex.

Использует 4 иконки для узлов и позиций, где 0-невыбранный узел,
1- выбранный узел, 2- невыбранный пункт, 3- выбранный пункт.

Необходимо выбрать datasource. вписать id, parentid.
Заполнение методом MRRefresh.
Сохранение в файл методом
MRPSaveToFile(ProgPath+'NameTree.tree').
Загрузка из файла соответственно MRPLoadFromFile(ProgPath+'NameTree.tree').
Кроме того поддерживаются метода последовательно поиска в обоих направлениях.

Зависимости: Windows, Messages, SysUtils, Classes, Controls, ComCtrls,DB,DBCtrls
Автор:       Валентин, visor123@ukr.net, Днепропетровск
Copyright:   Собственная разработка.
Дата:        9 апреля 2003 г.
***************************************************** }

unit GRTreeView;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, ComCtrls, DB, DBCtrls,
  Dialogs;

type
  TMRGroupRec = record
    ID, MasterID, Level: integer;
    MainName: string;
  end;
  TMRGroup = class(TPersistent)
  private
    fCount: integer;
  protected
    procedure SetCount(value: integer);
  public
    items: array of TMRGroupRec;
    property Count: integer read fCount write SetCount;
    constructor Create;
    destructor destroy; override;
    procedure Clear;
    procedure Add(AID, AMasterID: integer; AMainName: string);
    function GetIndexByMasterID(AMasterID: integer): integer;
  end;
  TGRTreeView = class(TTreeView)
  private
    { Private declarations }
    fDataSource: TDataLink;
    fFeyField: TFieldDataLink;
    fMasterFeyField: TFieldDataLink;
    fNameField: TFieldDataLink;
    // fRootName:string;
    fSeparator: Char;
    fLock: Boolean;
    fSearchIndex: integer;
    function GetBufStart(Buffer: PChar; var Level: Integer): PChar;
  protected
    { Protected declarations }
    function GetDataSource: TDataSource;
    procedure SetDataSource(value: TDataSource);
    function GetKeyField: string;
    procedure SetKeyField(value: string);
    function GetMasterKeyField: string;
    procedure SetMasterKeyField(value: string);
    function GetNameField: string;
    procedure SetNameField(value: string);
    procedure SetSeparator(value: char);
    procedure GetImageIndex(Node: TTreeNode); override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor destroy; override;
    function MRRefresh: Boolean;
    procedure MRPLoadFromFile(const FileName: string); overload;
    procedure MRPLoadFromFile(const FileName: string; RootName: string);
      overload;
    procedure MRPLoadFromStream(Stream: TStream);
    procedure MRPSaveToFile(const FileName: string);
    procedure MRPSaveToStream(Stream: TStream);
    function MRGetIndexByText(AText: string): integer;
    function MRGetIndexByMasterID(MasterID: integer): integer;
    function MRGetIndexByMasterIDRecurse(MasterID: integer): integer;
    function MRSearchByText(AText: string; Next: Boolean = True; UseSearchIndex:
      Boolean = false): integer;
  published
    { Published declarations }
    property Separator: char read fSeparator write SetSeparator;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property KeyField: string read GetKeyField write SetKeyField;
    property MasterField: string read GetMasterKeyField write SetMasterKeyField;
    property NameField: string read GetNameField write SetNameField;
  end;

procedure Register;

implementation
//var
// MGRGroup:array of TMRGroup;

procedure Register;
begin
  RegisterComponents('Visor', [TGRTreeView]);
end;

{ TGRTreeView }

constructor TGRTreeView.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fDataSource := TDataLink.Create;
  fFeyField := TFieldDataLink.Create;
  fFeyField.Control := self;
  fMasterFeyField := TFieldDataLink.Create;
  fMasterFeyField.Control := self;
  fNameField := TFieldDataLink.Create;
  fNameField.Control := self;
  fSeparator := '^';
  fLock := false;
  HideSelection := false;
  fSearchIndex := -1;
end;

destructor TGRTreeView.destroy;
begin
  fNameField.Free;
  fNameField := nil;
  fFeyField.Free;
  fFeyField := nil;
  fDataSource.Free;
  fDataSource := nil;
  inherited;
end;

function TGRTreeView.GetBufStart(Buffer: PChar; var Level: Integer): PChar;
begin
  Level := 0;
  while Buffer^ in [' ', #9] do
  begin
    Inc(Buffer);
    Inc(Level);
  end;
  Result := Buffer;
end;

function TGRTreeView.GetDataSource: TDataSource;
begin
  Result := fDataSource.DataSource;
end;

procedure TGRTreeView.MRPLoadFromFile(const FileName: string);
var
  Stream: TStream;
  FNT, FNR, Ex: string;
begin
  if not FileExists(FileName) then
    Exit;
  Ex := ExtractFileExt(FileName);
  if Ex = '' then
  begin
    FNT := ExtractFileName(FileName) + '.tree';
    FNR := ExtractFileName(FileName) + '.ini';
  end
  else
  begin
    FNT := ExtractFileName(FileName);
    FNT := Copy(FNT, 0, pos('.', FNT) - 1);
    FNR := FNT + '.ini';
    FNT := FNT + '.tree';
  end;
  FNT := ExtractFilePath(FileName) + FNT;
  FNR := ExtractFilePath(FileName) + FNR;
  Stream := TFileStream.Create(FNT, fmOpenRead);
  try
    MRPLoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

function TGRTreeView.MRGetIndexByText(AText: string): integer;
var
  i: integer;
begin
  if Items.Count = 0 then
  begin
    Result := -1;
    Exit;
  end;
  for i := 0 to Items.Count - 1 do
  begin
    if Items.Item[i].Text = AText then
    begin
      Result := i;
      Exit;
    end;
  end;
  Result := -1;
end;

procedure TGRTreeView.MRPLoadFromFile(const FileName: string;
  RootName: string);
var
  FNT, FNR, Ex: string;
  ANode: TTreeNode;
begin
  if not FileExists(FileName) then
    Exit;
  Ex := ExtractFileExt(FileName);
  if Ex = '' then
  begin
    FNT := ExtractFileName(FileName) + '.tree';
    FNR := ExtractFileName(FileName) + '.ini';
  end
  else
  begin
    FNT := ExtractFileName(FileName);
    FNT := Copy(FNT, 0, pos('.', FNT) - 1);
    FNR := FNT + '.ini';
    FNT := FNT + '.tree';
  end;
  FNT := ExtractFilePath(FileName) + FNT;
  FNR := ExtractFilePath(FileName) + FNR;
  if (not FileExists(FNT)) or (not FileExists(FNR)) then
  begin
    ANode := Items.Add(nil, RootName);
    ANode.StateIndex := 0;
    Self.MRPSaveToFile(FileName);
  end
  else
  begin
    MRPLoadFromFile(FileName);
  end;
end;

procedure TGRTreeView.MRPLoadFromStream(Stream: TStream);
var
  List: TStringList;
  ANode, NextNode: TTreeNode;
  ALevel, i, AStateIndex: Integer;
  CurrStr, Buff: string;
begin
  Items.Clear;
  List := TStringList.Create;
  Items.BeginUpdate;
  try
    try
      List.Clear;
      List.LoadFromStream(Stream);
      ANode := nil;
      for i := 0 to List.Count - 1 do
      begin
        CurrStr := GetBufStart(PChar(List[i]), ALevel);
        AStateIndex := -1;
        if pos(fSeparator, CurrStr) > 0 then
        begin
          Buff := Copy(CurrStr, pos(fSeparator, CurrStr) + 1, length(CurrStr) -
            pos(fSeparator, CurrStr));
          if Buff <> '' then
            AStateIndex := StrToInt(Buff);
          // Delete(CurrStr,pos(CurrStr,fSeparator),length(CurrStr)-pos(CurrStr,fSeparator)-1);
          buff := Copy(CurrStr, 0, pos(fSeparator, CurrStr) - 1);
          CurrStr := Buff;
        end;
        if ANode = nil then
        begin
          ANode := Items.AddChild(nil, CurrStr);
          if AStateIndex <> -1 then
            ANode.StateIndex := AStateIndex;
        end
        else if ANode.Level = ALevel then
        begin
          ANode := Items.AddChild(ANode.Parent, CurrStr);
          if AStateIndex <> -1 then
            ANode.StateIndex := AStateIndex;
        end
        else if ANode.Level = (ALevel - 1) then
        begin
          ANode := Items.AddChild(ANode, CurrStr);
          if AStateIndex <> -1 then
            ANode.StateIndex := AStateIndex;
        end
        else if ANode.Level > ALevel then
        begin
          NextNode := ANode.Parent;
          while NextNode.Level > ALevel do
            NextNode := NextNode.Parent;
          ANode := Items.AddChild(NextNode.Parent, CurrStr);
          if AStateIndex <> -1 then
            ANode.StateIndex := AStateIndex;
        end;
        // else TreeViewErrorFmt(sInvalidLevelEx, [ALevel, CurrStr]);
      end;
    finally
      Items.EndUpdate;
      List.Free;
    end;
  except
    Items.Owner.Invalidate; // force repaint on exception see VCL
    raise;
  end;
  if Items.Count > 0 then
    Items.Item[0].Expand(false);
end;

procedure TGRTreeView.MRPSaveToFile(const FileName: string);
var
  Stream: TStream;
  FNT, FNR, Ex: string;
begin
  Ex := ExtractFileExt(FileName);
  if Ex = '' then
  begin
    FNT := ExtractFileName(FileName) + '.tree';
    FNR := ExtractFileName(FileName) + '.ini';
  end
  else
  begin
    FNT := ExtractFileName(FileName);
    FNT := Copy(FNT, 0, pos('.', FNT) - 1);
    FNR := FNT + '.ini';
    FNT := FNT + '.tree';
  end;
  FNT := ExtractFilePath(FileName) + FNT;
  FNR := ExtractFilePath(FileName) + FNR;
  Stream := TFileStream.Create(FNT, fmCreate);
  try
    flock := True;
    MRPSaveToStream(Stream);
  finally
    Stream.Free;
    flock := false;
  end;
end;

procedure TGRTreeView.MRPSaveToStream(Stream: TStream);
const
  TabChar = #9;
  EndOfLine = #13#10;
var
i: Integer;
  ANode: TTreeNode;
  NodeStr: string;
begin
  if Items.Count > 0 then
  begin
    ANode := Items.Item[0];
    while ANode <> nil do
    begin
      NodeStr := '';
      for i := 0 to ANode.Level - 1 do
        NodeStr := NodeStr + TabChar;
      NodeStr := NodeStr + ANode.Text + fSeparator + IntToStr(ANode.StateIndex)
        + EndOfLine;
      Stream.Write(Pointer(NodeStr)^, Length(NodeStr));
      ANode := ANode.GetNext;
    end;
  end;
end;

function TGRTreeView.MRRefresh: boolean;
var
  i: integer;
  ANode, NextNode: TTreeNode;
  MGroup: TMRGroup;
begin
  if (fDataSource.DataSet = nil) or (KeyField = '') or (MasterField = '') or
    (NameField = '') then
  begin
    Result := false;
    Exit;
  end;
  if not fDataSource.DataSet.Active then
    fDataSource.DataSet.Open
  else
  begin
    fDataSource.DataSet.Close;
    fDataSource.DataSet.Open;
  end;

  fDataSource.DataSet.DisableControls;
  MGroup := TMRGroup.Create;
  MGroup.Clear;
  try
    while not fDataSource.DataSet.Eof do
    begin
      MGroup.Add(DataSource.DataSet.FieldByName(KeyField).AsInteger,
        DataSource.DataSet.FieldByName(MasterField).AsInteger,
        DataSource.DataSet.FieldByName(NameField).AsString);
      fDataSource.DataSet.Next;
    end;
    items.Clear;
    Items.BeginUpdate;
    fLock := True;
    ANode := nil;
    for i := 0 to MGroup.Count - 1 do
    begin
      if ANode = nil then
      begin
        ANode := Items.AddChild(nil, MGroup.Items[i].MainName);
        ANode.StateIndex := MGroup.items[i].ID;
      end
      else if ANode.Level = (MGroup.items[i].Level) then
      begin
        ANode := items.AddChild(ANode.Parent, MGroup.items[i].MainName);
        ANode.StateIndex := MGroup.items[i].ID;
      end
      else if ANode.Level = (MGroup.items[i].Level - 1) then
      begin
        ANode := Items.AddChild(ANode, MGroup.items[i].MainName);
        ANode.StateIndex := MGroup.items[i].ID;
      end
      else if ANode.Level > MGroup.items[i].Level then
      begin
        NextNode := ANode.Parent;
        while NextNode.Level > MGroup.items[i].Level do
          NextNode := NextNode.Parent;
        ANode := Items.AddChild(NextNode.Parent, MGroup.items[i].MainName);
        ANode.StateIndex := MGroup.items[i].ID;
      end;
      { else if ANode.Level > MGroup.items[i].Level then
              begin
                NextNode := ANode.Parent;
                while NextNode.Level > MGroup.items[i].Level do
                  NextNode := NextNode.Parent;
                ANode := Items.AddChild(NextNode.Parent, MGroup.items[i].MainName);
                ANode.StateIndex:=MGroup.items[i].ID;
              end;}
    end;
  finally
    fDataSource.DataSet.First;
    fDataSource.DataSet.EnableControls;
    //ShowMessage('Tree count='+IntToStr(Items.Count)+' MGroup count='+IntToStr(MGroup.Count));
    MGroup.Free;
    fLock := false;
  end;
  Items.EndUpdate;
  if Items.Count > 0 then
    Items.Item[0].Expand(false);
  Result := True;
end;

procedure TGRTreeView.SetDataSource(value: TDataSource);
begin
  fDataSource.DataSource := value;
end;

function TGRTreeView.MRGetIndexByMasterID(MasterID: integer): integer;
var
  i: integer;
begin
  if Items.Count = 0 then
  begin
    Result := -1;
    exit;
  end;
  for i := 0 to Items.Count - 1 do
  begin
    if Items.Item[i].StateIndex = MasterID then
    begin
      Result := i;
      Exit;
    end;
  end;
  Result := -1;
end;

function TGRTreeView.GetKeyField: string;
begin
  Result := fFeyField.FieldName;
end;

function TGRTreeView.GetMasterKeyField: string;
begin
  Result := fMasterFeyField.FieldName;
end;

function TGRTreeView.GetNameField: string;
begin
  Result := fNameField.FieldName;
end;

procedure TGRTreeView.SetKeyField(value: string);
begin
  fFeyField.FieldName := value;
end;

procedure TGRTreeView.SetMasterKeyField(value: string);
begin
  fMasterFeyField.FieldName := value;
end;

procedure TGRTreeView.SetNameField(value: string);
begin
  fNameField.FieldName := value;
end;

procedure TGRTreeView.SetSeparator(value: char);
begin
  fSeparator := value;
end;

procedure TGRTreeView.GetImageIndex(Node: TTreeNode);
begin
  if fLock then
    Exit;
  inherited;
  if Node.getFirstChild <> nil then
  begin
    Node.ImageIndex := 0;
    Node.SelectedIndex := 1;
  end
  else
  begin
    Node.ImageIndex := 2;
    Node.SelectedIndex := 3;
  end;
end;

function TGRTreeView.MRGetIndexByMasterIDRecurse(
  MasterID: integer): integer;
var
  i: integer;
begin
  if Items.Count = 0 then
  begin
    Result := -1;
    exit;
  end;
  for i := Items.Count - 1 downto 0 do
  begin
    if Items.Item[i].StateIndex = MasterID then
    begin
      Result := i;
      Exit;
    end;
  end;
  Result := -1;
end;

function TGRTreeView.MRSearchByText(AText: string; Next: Boolean = True;
  UseSearchIndex: Boolean = false): integer;
var
  i, iStart, iEnd: integer;
  sel: TList;
  f: boolean;
begin
  if Items.Count = 0 then
  begin
    Result := -1;
    fSearchIndex := -1;
    Exit;
  end;
  if Next then
  begin
    if (UseSearchIndex) and (fSearchIndex <> -1) then
      iStart := fSearchIndex + 1
    else
      iStart := 0;
    iEnd := Items.Count - 1;
  end
  else
  begin
    if (UseSearchIndex) and (fSearchIndex <> -1) then
      iStart := fSearchIndex - 1
    else
      iStart := Items.Count - 1;
    iEnd := 0;
  end;
  i := iStart;
  f := true;
  repeat
    if pos(AnsiUpperCase(AText), AnsiUpperCase(Items.Item[i].Text)) > 0 then
    begin
      Result := i;
      fSearchIndex := i;
      sel := TList.Create;
      sel.Add(Items.Item[i]);
      Select(Sel);
      sel.Free;
      Exit;
    end;
    if Next then
    begin
      inc(i);
      if i > iEnd then
        f := false;
    end
    else
    begin
      dec(i);
      if i < iEnd then
        f := false;
    end;
  until f <> true;
  Result := -1;
  fSearchIndex := -1;
end;

{ TMRGroup }

procedure TMRGroup.Add(AID, AMasterID: integer; AMainName: string);
var
  idx: integer;
begin
  inc(fCount);
  SetLength(items, fCount);
  items[fCount - 1].ID := AID;
  items[fCount - 1].MasterID := AMasterID;
  items[fCount - 1].MainName := AMainName;
  idx := GetIndexByMasterID(AMasterID);
  if idx = -1 then
  begin
    items[idx].Level := 0;
  end
  else
  begin
    items[fCount - 1].Level := items[idx].Level + 1;
  end;
end;

procedure TMRGroup.Clear;
begin
  items := nil;
  fCount := 0;
end;

constructor TMRGroup.Create;
begin
  inherited;
  fCount := 0;
end;

destructor TMRGroup.destroy;
begin
  items := nil;
  inherited;
end;

function TMRGroup.GetIndexByMasterID(AMasterID: integer): integer;
var
  i: integer;
begin
  if (fCount = 0) then
  begin
    Result := -1;
    Exit;
  end;
  for i := 0 to fCount - 1 do
  begin
    if items[i].ID = AMasterID then
    begin
      Result := i;
      Exit;
    end;
  end;
  Result := -1;
end;

procedure TMRGroup.SetCount(value: integer);
begin
  fCount := value;
end;

end.




Похожие по теме исходники

Расширение компонента TEdit

Компонент TDBF

Нейросеть для распознавания образов

Механизм станка качалки для нефти

 

Весы для взвешивания

Кувшины для воды

Доска для игры Реверси

База данных Видеофильмов

 

Видеозахват с камеры XCam

Передача видео по сети




Copyright © 2004-2021 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте   Facebook   Ссылка на Twitter   Ссылка на Telegram