سؤال

وأنا أحاول أن إنشاء مكون مخصص مع خاصية جمع. ولكن إذا حاولت فتح محرر جمع أثناء وقت التصميم بالنقر على "..." زر في مفتش الكائن، لا يحدث أي شيء. ما أنا في عداد المفقودين؟

إليك يا سليل TCollection:

  TMyCollection = class(TOwnedCollection)
  private
    function GetItem(Index: Integer): TMyCollectionItem;
    procedure SetItem(Index: Integer; const Value: TMyCollectionItem);
  public
    function Add : TMyCollectionItem;
    property Items[Index: Integer]: TMyCollectionItem read GetItem write SetItem;
  end;

وهذا البند:

 TMyCollectionItem = class(TCollectionItem)
  private
    FValue: integer;
  protected
    function GetDisplayName: string; override;
  public
    procedure Assign(Source: TPersistent); override;
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
  published
    property Value : integer read FValue write FValue;
  end;
هل كانت مفيدة؟

المحلول

والتعاريف صفك تبدو صحيحة حتى مع من يرى التنفيذ الكامل أنا لا أعرف ما هي المشكلة.

وهنا هو وحدة بسيطة لقد كتبت يستخدم TOwnedCollection، TCollectionItem وTComponent.

وأنا أعلم وتعمل هذه الوحدة. استخدامه كأساس لفحص التعليمات البرمجية.

وريان.

unit rmMultiStrings;

interface

uses classes, sysutils;

type
   ErmMultiStringNameException = Exception;
   TrmMultiStringsCollection = class;

   TrmMultiStringCollectionItem = class(TCollectionItem)
   private
     fItemDesc: string;
     fItemName: string;
     fData : TStringList;
     fMultiStrings : TrmMultiStringsCollection;
     function GetStrings: TStringList;
     function GetStringText: String;
     procedure SetItemName(const Value: string);
     procedure SetStrings(const Value: TStringList);
     procedure SetStringText(const Value: String);
   public
     constructor Create(Collection: TCollection); override;
     destructor Destroy; override;

     procedure Assign(Source: TPersistent); override;
   published
     property ItemName : string read fItemName write SetItemName;
     property Description : string read fItemDesc write fItemDesc;
     property Strings : TStringList read GetStrings write SetStrings stored false;
     property Text : String read GetStringText write SetStringText;
   end;

   TrmMultiStringsCollection = class(TOwnedCollection)
   private
     function GetItem(AIndex: integer): TrmMultiStringCollectionItem;
     procedure SetItem(AIndex: integer; const Value: TrmMultiStringCollectionItem);
   public

     function Add: TrmMultiStringCollectionItem;

     function IndexOf(ItemName:string):integer;
     function ValueOf(ItemName:string):String;
     function ValueOfIndex(aIndex:integer):string;

     procedure Assign(Source: TPersistent); override;

     property Items[AIndex: integer] : TrmMultiStringCollectionItem read GetItem write SetItem;
   end;

   TrmMultiStrings = class(TComponent)
   private
     fData : TrmMultiStringsCollection;
     procedure SetData(const Value: TrmMultiStringsCollection);
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;

     function IndexOf(ItemName:string):integer;
     function ValueOf(ItemName:string):String;
     function ValueOfIndex(aIndex:integer):string;
   published
     property Data : TrmMultiStringsCollection read fData write SetData;
   end;

procedure Register;

implementation

procedure Register;
begin
   RegisterClass(TrmMultiStringsCollection);
   RegisterClass(TrmMultiStringCollectionItem);
   RegisterComponents('rmConcordia', [TrmMultiStrings]);
end;


{ TrmMultiStringCollectionItem }

procedure TrmMultiStringCollectionItem.Assign(Source: TPersistent);
var
  wSrc : TrmMultiStringCollectionItem;
begin
  if Source is TrmMultiStringCollectionItem then
  begin
    wSrc := TrmMultiStringCollectionItem(Source);
    ItemName := wSrc.ItemName;
    Description := wSrc.Description;
    Text := wSrc.Text;
  end
  else
    inherited;
end;

constructor TrmMultiStringCollectionItem.Create(Collection: TCollection);
begin
  inherited;
  fMultiStrings := TrmMultiStringsCollection(Collection);
  fData := TStringList.create;
end;

destructor TrmMultiStringCollectionItem.Destroy;
begin
  fData.free;
  inherited;
end;

function TrmMultiStringCollectionItem.GetStrings: TStringList;
begin
   result := fData;
end;

function TrmMultiStringCollectionItem.GetStringText: String;
begin
   result := fData.Text;
end;

procedure TrmMultiStringCollectionItem.SetItemName(const Value: string);
begin
  if (fItemName <> Value) then
  begin
     if fMultiStrings.IndexOf(Value) = -1 then
        fItemName := Value
     else
        raise ErmMultiStringNameException.Create('Item name already exists');
  end;
end;

procedure TrmMultiStringCollectionItem.SetStrings(
  const Value: TStringList);
begin
   fData.Assign(Value);
end;

procedure TrmMultiStringCollectionItem.SetStringText(const Value: String);
begin
   fData.Text := Value;
end;

{ TrmMultiStringsCollection }

function TrmMultiStringsCollection.Add: TrmMultiStringCollectionItem;
begin
   result := TrmMultiStringCollectionItem(inherited Add);
   result.ItemName := 'Item_'+inttostr(NextID);
end;

procedure TrmMultiStringsCollection.Assign(Source: TPersistent);
var
   wSrc : TrmMultiStringsCollection;
   loop : integer;
begin
  if (source is TrmMultiStringsCollection)  then
  begin
     wSrc := TrmMultiStringsCollection(Source);
     Clear;
     for loop := 0 to wSrc.Count - 1 do
        Add.Assign(wSrc.Items[loop]);
  end
  else
    inherited;
end;

function TrmMultiStringsCollection.GetItem(
  AIndex: integer): TrmMultiStringCollectionItem;
begin
   result := TrmMultiStringCollectionItem(inherited Items[AIndex]);
end;

function TrmMultiStringsCollection.IndexOf(ItemName: string): integer;
var
   loop : integer;
begin
   result := -1;
   loop := 0;
   while (result = -1) and (loop < Count) do
   begin
      if (CompareText(Items[loop].ItemName, ItemName) = 0) then
         result := loop
      else
         inc(loop);
   end;
end;

procedure TrmMultiStringsCollection.SetItem(AIndex: integer; const Value: TrmMultiStringCollectionItem);
begin
  inherited SetItem(AIndex, Value)
end;

function TrmMultiStringsCollection.ValueOf(ItemName: string): String;
begin
   result := ValueOfIndex(IndexOf(ItemName));
end;

function TrmMultiStringsCollection.ValueOfIndex(aIndex: integer): string;
begin
   if (aIndex >= 0) and (aIndex < Count) then
     result := Items[aIndex].Text
   else
     result := '';
end;

{ TrmMultiStrings }

constructor TrmMultiStrings.Create(AOwner: TComponent);
begin
  inherited;
  fData := TrmMultiStringsCollection.Create(self, TrmMultiStringCollectionItem);
end;

destructor TrmMultiStrings.Destroy;
begin
  fData.Free;
  inherited;
end;

function TrmMultiStrings.IndexOf(ItemName: string): integer;
begin
   result := Data.IndexOf(ItemName);
end;

procedure TrmMultiStrings.SetData(const Value: TrmMultiStringsCollection);
begin
  fData.Assign(Value);
end;

function TrmMultiStrings.ValueOf(ItemName: string): String;
begin
   result := Data.ValueOf(ItemName);
end;

function TrmMultiStrings.ValueOfIndex(aIndex: integer): string;
begin
   result := Data.ValueOfIndex(aIndex);
end;

end.
مرخصة بموجب: CC-BY-SA مع الإسناد
لا تنتمي إلى StackOverflow
scroll top