unit rxsList;

interface

uses
 Classes, Dialogs;

type

 TrxsList = class;
 TrxsItem = class;

 TrxsItem = class(TComponent)
 private
   FList : TrxsList;
   FCaption: String;
   procedure SetList(const Value: TrxsList);
   procedure SetCaption(const Value: String);
   procedure SetIndex(const Value: Integer);
   function GetIndex : Integer;
 protected
   procedure ReadState(Reader: TReader); override;
   procedure SetParentComponent(AParent: TComponent); override;
 public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
   function GetParentComponent: TComponent; override;
   function HasParent: Boolean; override;
   property List : TrxsList read FList write SetList;
   property Index : Integer read GetIndex write SetIndex;
 published
   property Caption : String read FCaption write SetCaption;
 end;

 TrxsList = class(TComponent)
 private
   FItemList : TList;
   function GetCount: Integer;
   function GetItems(index: Integer): TrxsItem;
   procedure SetItems(index: Integer; const Value: TrxsItem);
 protected
   procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
   procedure SetChildOrder(Component: TComponent; Order: Integer); override;
 public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
   procedure AddItem(AItem : TrxsItem);
   function Add : TrxsItem;
   procedure RemoveItem(AItem : TrxsItem);
   property Count : Integer read GetCount;
   property Items[index : Integer] : TrxsItem read GetItems write SetItems;
 end;

implementation

{ TrxsList }

procedure TrxsList.AddItem(AItem: TrxsItem);
begin
 FItemList.Add(AItem);
 AItem.FList := Self;
end;

procedure TrxsList.RemoveItem(AItem: TrxsItem);
begin
 FItemList.Remove(AItem);
 AItem.FList := nil;
end;

constructor TrxsList.Create(AOwner: TComponent);
begin
 inherited;
 FItemList := TList.Create;
end;

destructor TrxsList.Destroy;
var
 LItem : TrxsItem;
begin
 while FItemList.Count > 0 do
 begin
   LItem := TrxsItem(FItemList.Last);
   LItem.Free;
 end;
 FItemList.Free;
 inherited;
end;

procedure TrxsList.GetChildren(Proc: TGetChildProc; Root: TComponent);
var
 i : Integer;
 FItem: TrxsItem;
begin
 for i := 0 to FItemList.Count - 1 do
 begin
   FItem := TrxsItem(FItemList[i]);
   if FItem.Owner = Root then
    Proc(FItem);
 end;
end;

procedure TrxsList.SetChildOrder(Component: TComponent; Order: Integer);
begin
 if FItemList.IndexOf(Component) >= 0 then
   (Component as TrxsItem).Index := Order;
end;

function TrxsList.GetCount: Integer;
begin
 Result := FItemList.Count;
end;

function TrxsList.Add: TrxsItem;
var
 LItem : TrxsItem;
begin
 LItem := TrxsItem.Create(Self.Owner);
 AddItem(LItem);
end;

function TrxsList.GetItems(index: Integer): TrxsItem;
begin
 Result := FItemList[Index];
end;

procedure TrxsList.SetItems(index: Integer; const Value: TrxsItem);
begin
 TrxsItem(FItemList[Index]).Assign(Value);
end;

{ TrxsItem }

constructor TrxsItem.Create(AOwner: TComponent);
begin
 inherited;
end;

destructor TrxsItem.Destroy;
begin
 if Assigned(FList) then FList.RemoveItem(Self);
 inherited;
end;

function TrxsItem.GetParentComponent: TComponent;
begin
 Result := FList;
end;

function TrxsItem.HasParent: Boolean;
begin
 Result := FList <> nil;
end;

procedure TrxsItem.ReadState(Reader: TReader);
begin
 inherited ReadState(Reader);
 if Reader.Parent is TrxsList then
   List := TrxsList(Reader.Parent);
end;

procedure TrxsItem.SetCaption(const Value: String);
begin
 FCaption := Value;
end;

function TrxsItem.GetIndex: Integer;
begin
 if FList <> nil then
   Result := FList.FItemList.IndexOf(Self)
 else
   Result := -1;
end;

procedure TrxsItem.SetIndex(const Value: Integer);
var
 LCurIndex, LNewIndex, LCount: Integer;
begin
 LCurIndex := GetIndex;
 LNewIndex := Value;
 if LCurIndex >= 0 then
 begin
   LCount := FList.FItemList.Count;
   if LNewIndex < 0 then
     LNewIndex := 0;

   if LNewIndex >= LCount then
     LNewIndex := LCount - 1;

   if LNewIndex <> LCurIndex then
   begin
     FList.FItemList.Delete(LCurIndex);
     FList.FItemList.Insert(LNewIndex, Self);
   end;
 end;
end;

procedure TrxsItem.SetList(const Value: TrxsList);
begin
 if Value <> FList then
 begin
   if FList <> nil then FList.RemoveItem(Self);
   if Value <> nil then Value.AddItem(Self);
 end;
end;

procedure TrxsItem.SetParentComponent(AParent: TComponent);
begin
 if not (csLoading in ComponentState) and (AParent is TrxsList) then
   List := TrxsList(AParent);
end;

initialization
 RegisterClass(TrxsItem);

end.

 TrxsListSprig = class(TComponentSprig)
 public
   function SortByIndex: Boolean; override;
 end;

 TrxsItemSprig = class(TComponentSprig)
 public
   function Caption : string; override;
   function ItemIndex: Integer; override;
   function DragOver(AItem: TSprig): Boolean; override;
   function DragDrop(AItem: TSprig): Boolean; override;
 end;

{ TrxstemSprig }

function TrxsItemSprig.Caption: string;
begin
 if TrxsItem(Item).Caption <> '' then
   Result := TrxsItem(Item).Caption
 else
   Result := TrxsItem(Item).Name;
end;

function TrxsItemSprig.DragDrop(AItem: TSprig): Boolean;
begin
 TrxsItem(TrxsItemSprig(AItem).Item).Index := TrxsItem(Item).Index;
 Result := true;
end;

function TrxsItemSprig.DragOver(AItem: TSprig): Boolean;
begin
 Result := true;
end;

function TrxsItemSprig.ItemIndex: Integer;
begin
 Result := TrxsItem(Item).Index;
end;

{ TrxsListSprig }

function TrxsListSprig.SortByIndex: Boolean;
begin
 Result := True;
end;