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

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

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

WEB-сайт: http://delphibase.endimus.com

{ **** 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.

{/codecitation}

Добавить комментарий