unit Problem;

interface

Uses
 Classes;

Type

 TAntiqueItem = class(TCollectionItem)
 private
   FDescription: string;
   FdisplayName: string;
   procedure SetDescription(const Value: string);
 protected
   function GetDisplayName: string;override;
   procedure SetDisplayName(const Value: string); override;
 published
   property DisplayName;
   property Description:string read FDescription write SetDescription;
 end;

 TAntiqueItemClass = class(TAntiqueItem);

 TAntiqueCollection = class(TCollection)
 private
   function GetItem(index:integer): TAntiqueItem;
   procedure SetItem(index:integer; const Value: TAntiqueItem);

 public
   function Add:TAntiqueItem;
   property Items[index:integer]:TAntiqueItem read GetItem write SetItem;default;
 end;

 TMarket=class(TComponent)
 private
   FAntique: TAntiqueCollection;
   procedure SetAntique(const Value: TAntiqueCollection);
 public
   constructor Create(AOwner: TComponent);override;
   destructor Destroy;override;
 published
   property Antique : TAntiqueCollection read FAntique write SetAntique;
 end;

 TCollector=class(TComponent)
 private
   FDesired: TAntiqueItem;
   FMarket: TMarket;
   procedure SetDesired(const Value: TAntiqueItem);
   procedure SetMarket(const Value: TMarket);
 published
   property Market:TMarket read FMarket write SetMarket;
   property Desired:TAntiqueItem read FDesired write SetDesired;
 end;

 procedure Register;

implementation

procedure Register;
begin
 RegisterComponents('Problem',[ TMarket, TCollector ]);
end;

{ TAntiqueItem }

function TAntiqueItem.GetDisplayName: string;
begin
 result := FDisplayName;
end;

procedure TAntiqueItem.SetDescription(const Value: string);
begin
 FDescription := Value;
end;

procedure TAntiqueItem.SetDisplayName(const Value: string);
begin
 inherited;
 if Value <> ''
 then FDisplayName := Value
 else FDisplayName := 'Unnamed';
end;

{ TAntiqueCollection }

function TAntiqueCollection.Add: TAntiqueItem;
begin
 result := TAntiqueItem(inherited Add);
 result.SetDisplayName('');
end;

function TAntiqueCollection.GetItem(index:integer): TAntiqueItem;
begin
 result := TAntiqueItem(inherited GetItem(index));
end;

procedure TAntiqueCollection.SetItem(index:integer; const Value: TAntiqueItem);
begin
 inherited SetItem(Index, TAntiqueItem( Value ));
end;

{ TMarket }

constructor TMarket.Create(AOwner: TComponent);
begin
 inherited;
 FAntique := TAntiqueCollection.Create( TAntiqueItemClass );
end;

destructor TMarket.Destroy;
begin
 FAntique.Free;
 inherited;
end;

procedure TMarket.SetAntique(const Value: TAntiqueCollection);
begin
 FAntique := Value;
end;

{ TCollector }

procedure TCollector.SetDesired(const Value: TAntiqueItem);
begin
 FDesired := Value;
end;

procedure TCollector.SetMarket(const Value: TMarket);
begin
 FMarket := Value;
end;

end.

TCollector=class(TComponent)
private
  FDesiredIndex: integer;
  FMarket: TMarket;
  procedure SetDesired(const Value: TAntiqueItem);
 function GetDesired : TAntiqueItem;
  procedure SetMarket(const Value: TMarket);
published
  property Market:TMarket read FMarket write SetMarket;
  property Desired:TAntiqueItem read GetDesired write SetDesired stored false;
end;

constructor TCollector.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 FDesiredIndex := -1;
end;

function TCollector.GetDesired: TAntiqueItem
begin
 if Assigned(Market) and (FDesiredIndex>=0)
  then Result := Market.Antique[FDesiredIndex]
  else Result := nil;
end;

procedure TCollector.SetDesired(const Value: TAntiqueItem);
begin
 if Assigned(Value) and Assigned(Market)
   then FDesiredIndex := Market.IndexOf(Value)
   else FDesiredIndex := -1;
end;

procedure ReadIndex(Reader: TReader);
procedure WriteIndex(Writer: TWriter);
procedure DefineProperties(Filer: TFiler); override;

procedure TCollector.DefineProperties(Filer: TFiler);
begin
 Filer.DefineProperty('DesiredIndex', ReadIndex, WriteIndex, FDesiredIndex<>-1);
end;

procedure TCollectorReadIndex(Reader: TReader);
begin
 FDesiredIndex := Reader.ReadInteger;
end;

procedure TCollectorWriteIndex(Writer: TWriter)
begin
 Writer.WriteInteger(FDesiredIndex)
end;

procedure TCollector.SetMarket(const Value: TMarket);
begin
 if Assigned(FMarket) then FMarket.RemoveFreeNotification(self);
 FMarket := Value;
 if Assigned(FMarket) then FMarket.FreeNotification(self);
end;

procedure TCollector.Notification(AComponent: TComponent;Operation: TOperation);
begin
 inherited Notification(AComponent, Operation);
 if Operation = opRemove then
   if AComponent = Market then Market := nil;
end;

 TDesiredPropEditor = class(TClassProperty)
 public
   function GetAttributes: TPropertyAttributes; override;
   procedure GetValues(Proc:TGetStrProc); override;
   procedure SetValue(const Value: string); override;
 end;

TDesiredProperty = class(TPropertyEditor)
 protected
   function GetAttributes: TPropertyAttributes; override;
   procedure GetProperties(Proc: TGetPropProc); override;
   function GetValue: string; override;
   procedure GetValues(Proc: TGetStrProc); override;
   procedure SetValue(const Value: string); override;
   function Collector: TCollector;
   function FilterFunc(const ATestEditor: IProperty): Boolean;
 end;

function TDesiredProperty.Collector: TCollector;
begin
 Result := GetComponent(0) as TCollector;
end;

function TDesiredProperty.GetAttributes: TPropertyAttributes;
begin
 Result := [paMultiSelect,paValueList, paSortList, paRevertable];
 if  Assigned(Collector.Desired) then
   Result := Result + [paSubProperties, paVolatileSubProperties];
end;

procedure TDesiredProperty.GetProperties(Proc: TGetPropProc);
var LComponents: IDesignerSelections;
   LDesigner: IDesigner;
begin
 LComponents := GetSelections;
 if LComponents <> nil then
 begin
   if not Supports(FindRootDesigner(LComponents[0]), IDesigner, LDesigner) then
     LDesigner := Designer;
   GetComponentProperties(LComponents, tkAny, LDesigner, Proc, FilterFunc);
 end;
end;

function TDesiredProperty.GetValue: string;
begin
 if  Assigned(Collector.Desired)
   then Result := Collector.Desired.Description
   else Result := '';
end;

procedure TDesiredProperty.GetValues(Proc: TGetStrProc);
begin
 if  Assigned(Collector.Market) then
   for i := 0 to Collector.Market.Antique.Count-1 do
    Proc(Collector.Market.Antiqu[i].Description);
end;

procedure TDesiredProperty.SetValue(const Value: string);
var Item: TAntiqueItem;
    i: integer;
begin
 Item := nil;
 if (Value <> '') and Assigned(Collector.Market) then
   for i := 0 to Collector.Market.Antique.Count-1 do
      if SameText(Collector.Market.Antiqu[i].Description,Value) then begin
        Item := Collector.Market.Antiqu[i];
        Break;
      end;
Collector.Desired := Item;
end;

function TDesiredProperty.FilterFunc(const ATestEditor: IProperty): Boolean;
begin
 Result := not (paNotNestable in ATestEditor.GetAttributes);
end;

procedure Register;
begin
 RegisterPropertyEditor(TypeInfo(TAntiqueItem), TCollector, 'Desired', TDesiredProperty);
end;

unit DesiredEditor;

interface

Uses
 SysUtils,Classes, DesignEditors, DesignIntf, Dialogs;

Type

 TDesiredPropEditor = class(TClassProperty)
 public
   function GetAttributes: TPropertyAttributes; override;
   function GetValue: string; override;
   procedure GetValues(Proc:TGetStrProc); override;
   procedure SetValue(const Value: string); override;
 end;

 procedure Register;

implementation

Uses
 Problem;

procedure Register;
begin
 RegisterPropertyEditor( TypeInfo( TAntiqueItem ), TCollector, 'Desired', TDesiredPropEditor );
end;

{ DesiredPropEditor }

function TDesiredPropEditor.GetAttributes: TPropertyAttributes;
begin
 result := [ paValueList, paSubProperties, paAutoUpdate, paVolatileSubProperties ];
end;

function TDesiredPropEditor.GetValue: string;
begin
 if  Assigned( TCollector( GetComponent(0) ).Desired )
 then Result := '[' +
                inttostr( TCollector( GetComponent(0) ).Desired.Index )+
                '] '+TCollector( GetComponent(0) ).Desired.DisplayName
  else Result := '';
end;

procedure TDesiredPropEditor.GetValues(Proc: TGetStrProc);
Var
 Collector:TCollector;
 Market:TMarket;
 AntiqueCollection:TAntiqueCollection;
 I:integer;
begin
 Collector := TCollector( GetComponent(0) );

 Market := Collector.Market;

 if Market = nil then exit;

 AntiqueCollection := Market.Antique;

 // Нет никакой надежды, что AntiqueCollection[i].DisplayName не будет пусто !!!
 // Потому формирую "суррогатные" имена.

 for I := 0 to AntiqueCollection.Count - 1 do
   Proc( '['  +inttostr( i )+ '] ' + AntiqueCollection[i].DisplayName );
end;

procedure TDesiredPropEditor.SetValue(const Value: string);
Var
 Collector:TCollector;
 Market:TMarket;
 AntiqueCollection:TAntiqueCollection;
 I:integer;

 Index:integer;
 _Index:string;

 Ai:TAntiqueItem;
begin
 Collector := TCollector( GetComponent(0) );

 if Value = ''
 then
   begin
     SetOrdValue(0);
     Modified;
     exit;
   end;

 Market := Collector.Market;

 if Market = nil then exit;

 AntiqueCollection := Market.Antique;

 Index := -1;
 _Index:= '';

 for I := 2 to length( Value ) do
   if Value[ I ] in ['0'..'9']
   then _Index := _Index + Value[i]
   else Break;

 Index := StrToInt( _Index );

 Ai := TAntiqueItem( AntiqueCollection[ Index ] );

 SetOrdValue( Longint( Ai ) );

 Modified;
end;

end.

procedure TAntiqueCollection.Notify(Item: TCollectionItem;
 Action: TCollectionNotification);
begin
 inherited;

                       // Тут думать надо, индекс может "поехать"
 case Action of
 cnAdded      :begin

               end;
 cnExtracting :begin

               end;
 cnDeleting   :begin
               end;
 End;
//  ShowMessage('Notify');
end;

TCollector=class(TComponent)
private
  FDesiredIndex: integer;
  FDesiredItem: TAntiqueItem;

function TCollector.GetDesired: TAntiqueItem;
begin
 Result := nil;
 if Assigned(Market) and Assigned(FDesiredItem) then begin
   FDesiredIndex := FDesiredItem.Index;
   Result := FDesiredItem;
 end;
end;

procedure TCollector.SetDesired(const Value: TAntiqueItem);
begin
if Assigned(Value) and Assigned(Market) then begin
  FDesiredIndex := Value.Index;
  FDesiredItem := Value;
end
else begin
  FDesiredIndex := -1;
  FDesiredItem := nil;
end;
end;

function TCollector.GetDesired: TAntiqueItem;
begin
Result := nil;
if Assigned(Market) and Assigned(FDesiredItem) and (FDesiredIndex>=0)
then
  begin
    FDesiredIndex := FDesiredItem.Index;
    Result := FDesiredItem;
  end;
end;

procedure TCollector.SetDesired(const Value: TAntiqueItem);
begin
 if Assigned(Value) and Assigned(Market)
 then
   begin
     FDesiredIndex := Value.Index;
     FDesiredItem := Value;
   end
 else
  begin
   FDesiredIndex := -1;
   FDesiredItem := nil;
 end;
end;

procedure TCollector.Notification(AComponent: TComponent;
 Operation: TOperation);
begin
 inherited Notification(AComponent, Operation);
 if Operation = opRemove
 then if AComponent = Market
      then
        begin
          Market := nil;
          FDesiredIndex := -1;
          FDesiredItem := nil;
        end;
end;

procedure TCollector.SetMarket(const Value: TMarket);
begin
 if Assigned(FMarket)
 then FMarket.RemoveFreeNotification(Self);
 FMarket := Value;
 if Assigned(FMarket)
 then FMarket.FreeNotification(self)
 else
   begin
     FDesiredIndex := -1;
     FDesiredItem  := nil;
   end;
end;

function TCollector.GetDesired: TAntiqueItem;
var i: integer;
begin
Result := nil;
if Assigned(Market) and Assigned(FDesiredItem) and (FDesiredIndex>=0) then
 for i := 0 to Market.Antique.Count-1 do
   if Market.Antique[i] = FDesiredItem then begin
     FDesiredIndex := FDesiredItem.Index;
     Result := FDesiredItem;
     Break;
 end;
end;

if Assigned(Market) and Assigned(FDesiredItem) and (FDesiredIndex>=0)