unit RuTreeView;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, DB, DesignIntf, DesignEditors, Typinfo;
type
  TRules = class(TPersistent)
  private
    Owner : TComponent;

    FItemFieldName : string;
    FParentFieldName : string;
    FLabelFieldName : string;
    FLevelFieldName : string;

    function GetDataSet : TDataSet;

    function GetItemID : TField;
    function GetParentID : TField;
    function GetLabelName : TField;
    function GetLevelID : TField;

    procedure SetItemID ( Value : TField);
    procedure SetParentID ( Value : TField);
    procedure SetLabelName ( Value : TField);
    procedure SetLevelID ( Value : TField);
  public
    property ItemID : TField read GetItemID write SetItemID default nil;
    property ParentID : TField read GetParentID write SetParentID default nil;
    property LabelName : TField read GetLabelName write SetLabelName default nil;
    property LevelID : TField read GetLevelID write SetLevelID default nil;

    property DataSet : TDataSet read GetDataSet;

    Constructor Create(AOwner  : TComponent);
    procedure Assign(Source: TPersistent);
  published
    property ItemFieldName : string read FItemFieldName write FItemFieldName;
    property ParentFieldName : string read FParentFieldName write FParentFieldName;
    property LabelFieldName : string read FLabelFieldName write FLabelFieldName;
    property LevelFieldName : string read FLevelFieldName write FLevelFieldName;
  end;

  TRuTreeView = class(TTreeView)
  private
    FDataSet : TDataSet;
    FRules   : TRules;
    procedure SetRules(Value: TRules);
   { Private declarations }
  protected
    { Protected declarations }
  public
    constructor Create(AOwner: TComponent);override;
    destructor Destroy; override;
    { Public declarations }
  published
    property DataSet : TDataSet read FDataSet write FDataSet;
    property Rules  : TRules read FRules write SetRules;
    { Published declarations }
  end;

  // редактор свойств для выбора полей из списка
  TFieldNameProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValueList(List: TStrings); virtual;
    procedure GetValues(Proc: TGetStrProc); override;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TRuTreeView]);

  RegisterPropertyEditor(TypeInfo(string),TRules,'ItemFieldName',TFieldNameProperty);
  RegisterPropertyEditor(TypeInfo(string),TRules,'ParentFieldName',TFieldNameProperty);
  RegisterPropertyEditor(TypeInfo(string),TRules,'LabelFieldName',TFieldNameProperty);
  RegisterPropertyEditor(TypeInfo(string),TRules,'LevelFieldName',TFieldNameProperty);

end;

// ****** TRuTreeView ********
constructor TRuTreeView.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FRules:=TRules.Create(self);
end;

destructor TRuTreeView.Destroy;
begin
  FRules.Free;
  inherited Destroy;
end;

procedure TRuTreeView.SetRules(Value: TRules);
begin
  if Assigned(Value) then FRules.Assign(Value);
end;
// End TRuTreeView

// ***********  TRules  ********************
constructor TRules.Create(AOwner  : TComponent);
begin
  Owner := AOwner;

  ItemID := nil;
  ParentID := nil;
  LabelName := nil;
  LevelID := nil;

end;

procedure TRules.Assign(Source: TPersistent);
begin
  if Source is TRules then begin
    ItemID:=TRules(Source).ItemID;
    ParentID:=TRules(Source).ParentID;
    LabelName:=TRules(Source).LabelName;
    LevelID:=TRules(Source).LevelID;
    inherited Assign(Source);
  end;
end;

function TRules.GetDataSet : TDataSet;
begin
  if Owner is TRuTreeView then Result := TRuTreeView(Owner).DataSet;
end;

function TRules.GetItemID : TField;
begin
  Result:=nil;
  if DataSet <> nil then
    if FItemFieldName <> '' then Result := DataSet.FieldByName(FItemFieldName);
end;
function TRules.GetParentID : TField;
begin
  Result:=nil;
  if DataSet <> nil then
    if FParentFieldName <> '' then Result := DataSet.FieldByName(FParentFieldName);
end;
function TRules.GetLabelName : TField;
begin
  Result:=nil;
  if DataSet <> nil then
    if FLabelFieldName <> '' then Result := DataSet.FieldByName(FLabelFieldName);
end;
function TRules.GetLevelID : TField;
begin
  Result:=nil;
  if DataSet <> nil then
    if FLevelFieldName <> '' then Result := DataSet.FieldByName(FLevelFieldName);
end;

procedure TRules.SetItemID ( Value : TField);
begin
  if Value<> nil then
    FItemFieldName := Value.FieldName;
end;
procedure TRules.SetParentID ( Value : TField);
begin
  if Value<> nil then
    FParentFieldName := Value.FieldName;
end;
procedure TRules.SetLabelName ( Value : TField);
begin
  if Value<> nil then
    FLabelFieldName := Value.FieldName;
end;
procedure TRules.SetLevelID ( Value : TField);
begin
  if Value<> nil then
    FLevelFieldName := Value.FieldName;
end;

// end TRules

// TFieldNameProperty
function GetPropertyValue(Instance: TPersistent; const PropName: string): TPersistent;
var
  PropInfo: PPropInfo;
begin
  Result := nil;
  PropInfo := TypInfo.GetPropInfo(Instance.ClassInfo, PropName);
  if (PropInfo <> nil) and (PropInfo^.PropType^.Kind = tkClass) then
    Result := TObject(GetOrdProp(Instance, PropInfo)) as TPersistent;
end;

function TFieldNameProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paValueList, paSortList];
end;

procedure TFieldNameProperty.GetValueList(List: TStrings);
var
  DataSet: TDataSet;
  Comp : TPersistent;
  i : integer;
begin
  if GetComponent( 0 ) is TRules then Comp := TRules(GetComponent( 0 )).Owner
                               else Exit;
  DataSet := GetPropertyValue(Comp, 'DataSet') as TDataSet;
  if (DataSet <> nil) and (DataSet.Fields.Count > 0 ) then
    for i:= 0  to DataSet.Fields.Count- 1  do
       List.Add(DataSet.Fields[i].FieldName);
end;

procedure TFieldNameProperty.GetValues(Proc: TGetStrProc);
var
  I: Integer;
  Values: TStringList;
begin
  Values := TStringList.Create;
  try
    GetValueList(Values);
    for I :=  0  to Values.Count -  1  do Proc(Values[I]);
  finally
    Values.Free;
  end;
end;
// End TFieldNameProperty
end.