Оригинал Поиск Дополнительно Вход
ДомойОсновная Компоненты FreePascal Начинающим KOL Игры Corba Media Журнал WinAPI Сети Прочее Базы .Net
Конференция "Компоненты" » Компонент содержащий коллекцию не сохраняем ее [D7, WinXP]
 
  • baghin © (31.10.13 14:21) [0]
    Доброго времени стуок
    Сделал компонент с коллекцией для хранения настроек колонок в гриде

    type
     TFieldControlItem = class(TCollectionItem)
     private
       FFieldName: string;       // имя поля в DataSet
       FComponentName: string;   // Имя компоненты отвечающей за поле
       FCaption: string;     // Название поля в Гриде можно где-нидь ещё
       FWidth: integer;          // Ширина поля в гриде
       FMayBeVisible: Boolean;   // можно поле делать не видимым
       FWithoutFilter: Boolean;  // нужен ли фильтр для столбца
     protected
       function GetDisplayName: string; override;
     published
       property FieldName: string read FFieldName write FFieldName;
       property ComponentName: string read FComponentName write FComponentName;
       property Caption: string read FCaption write FCaption;
       property Width: integer read FWidth write FWidth default 50;
       property MayBeVisible: boolean read FMayBeVisible write FMayBeVisible default true;
       property WithoutFilter: boolean read FWithoutFilter write FWithoutFilter default false;
     end;

     TFieldControlItemCalss = class of TFieldControlItem;

     TFieldControlList = class;

     TFieldControls = class(TOwnedCollection)
     private
       FFieldControlList: TFieldControlList;
       function GetItem(Index: Integer): TFieldControlItem;
       procedure SetItem(Index: Integer; const Value: TFieldControlItem);
     protected
       procedure Update(Item: TCollectionItem); override;
     public
       function Add: TFieldControlItem;
       property Items[Index: Integer]: TFieldControlItem read GetItem write SetItem; default;
     published
     end;

     TFieldControlList = class(TComponent)
     private
       FFieldControls: TFieldControls;
       procedure SetFieldControl(const Value: TFieldControls);
     protected
     public
       constructor Create(AOwner: TComponent); override;
       destructor Destroy; override;
       function IndexByFieldName(AFieldName: string): integer;
       function VisibleByFieldName(AFieldName: string): boolean;
     published
       property FieldControls: TFieldControls read FFieldControls write SetFieldControl;
     end;

    procedure Register;

    implementation

    procedure Register;
    begin
     RegisterComponents('MyComp', [TFieldControlList]);
    end;

    { TFieldControlItem }

    function TFieldControlItem.GetDisplayName: string;
    begin
     Result := FFieldName;
     if Result = '' then Result := inherited GetDisplayName;
    end;

    { TFieldControlCollection }

    function TFieldControls.Add: TFieldControlItem;
    begin
     Result := TFieldControlItem(inherited Add);
    end;

    function TFieldControls.GetItem(Index: Integer): TFieldControlItem;
    begin
     Result := TFieldControlItem(inherited GetItem(Index))
    end;

    procedure TFieldControls.SetItem(Index: Integer; const Value: TFieldControlItem);
    begin
     inherited SetItem(Index, Value);
    end;

    procedure TFieldControls.Update(Item: TCollectionItem);
    begin
     inherited Update(Item);
    end;

    { TFieldControlList }

    constructor TFieldControlList.Create(AOwner: TComponent);
    begin
     inherited Create(AOwner);
     FFieldControls:= TFieldControls.Create(Self, TFieldControlItem);
    end;

    destructor TFieldControlList.Destroy;
    begin
     FFieldControls.Free;
     inherited;
    end;

    function TFieldControlList.IndexByFieldName(AFieldName: string): integer;
    begin
     for Result:= 0 to FFieldControls.Count-1 do
       if FFieldControls.GetItem(Result).FieldName = AFieldName then Exit;
     Result:= -1;
    end;

    function TFieldControlList.VisibleByFieldName(AFieldName: string): boolean;
    var i: integer;
    begin
     for i:= 0 to FFieldControls.Count-1 do
       if FFieldControls.GetItem(i).FieldName = AFieldName then
         begin
           Result:= FFieldControls.GetItem(i).MayBeVisible;
           Exit;
         end;
     Result:= false;
    end;

    procedure TFieldControlList.SetFieldControl(const Value: TFieldControls);
    begin
     FFieldControls.Assign(Value)
    end;



    Выкладываю его на форму, заполняю. Все отрабатывает нормально. Затем создаю потомка этой формы. Захожу в компонент на форме-потомке, данные в нем есть. Пытаюсь сохранить форму, вываливается ошибка и содержимое коллекции исчезает.
    Что сделал не так?
  • DimaBr © (01.11.13 16:20) [1]
    А текст ошибки секретный ?
  • baghin © (01.11.13 17:55) [2]
    текст ошибки
    Cannot assign a TFieldControlItem to a TFieldControlItem

    [5009E719]{rtl150.bpl  } Classes.TPersistent.AssignError (Line 4420, "Classes.pas" + 4) + $36
    [5009E761]{rtl150.bpl  } Classes.TPersistent.AssignTo (Line 4425, "Classes.pas" + 0) + $1
    [5009E697]{rtl150.bpl  } Classes.TPersistent.Assign (Line 4410, "Classes.pas" + 0) + $7
    [5009EE26]{rtl150.bpl  } Classes.TCollection.Assign (Line 4699, "Classes.pas" + 10) + $16
    [21063606]{designide150.bpl} Update.TUpdateObject.Update (Line 1126, "Update.pas" + 54) + $E
    [500375B3]{rtl150.bpl  } System.@ReallocMem (Line 3935, "System.pas" + 85) + $0
    [5009D49C]{rtl150.bpl  } Classes.TList.SetCapacity (Line 3777, "Classes.pas" + 5) + $9
    [5009D227]{rtl150.bpl  } Classes.TList.Grow (Line 3615, "Classes.pas" + 7) + $4
    [5009CFDF]{rtl150.bpl  } Classes.TList.Add (Line 3514, "Classes.pas" + 3) + $4
    [21063596]{designide150.bpl} Update.TUpdateObject.Update (Line 1112, "Update.pas" + 40) + $3
    [50037560]{rtl150.bpl  } System.@FreeMem (Line 3768, "System.pas" + 20) + $0
    [5003A0D0]{rtl150.bpl  } System.TObject.FreeInstance (Line 11050, "System.pas" + 2) + $2
    [21061BB5]{designide150.bpl} Update.TChildUpdateObjects.Destroy (Line 364, "Update.pas" + 3) + $6
    [5003A118]{rtl150.bpl  } System.TObject.Free (Line 11069, "System.pas" + 1) + $4
    [210631D2]{designide150.bpl} Update.UpdateOrder (Line 1028, "Update.pas" + 29) + $3
    [2106363B]{designide150.bpl} Update.TUpdateObject.Update (Line 1131, "Update.pas" + 59) + $9
    [50037560]{rtl150.bpl  } System.@FreeMem (Line 3768, "System.pas" + 20) + $0
    [5003A924]{rtl150.bpl  } System.TMonitor.Destroy (Line 12347, "System.pas" + 0) + $0
    [5003A193]{rtl150.bpl  } System.TObject.CleanupInstance (Line 11189, "System.pas" + 20) + $0
    [21064079]{designide150.bpl} Update.TUpdateManager.Update (Line 1462, "Update.pas" + 22) + $9
    [2107AF5C]{designide150.bpl} ComponentDesigner.TComponentRoot.GetRootStream (Line 2760, "ComponentDesigner.pas" + 11) + $8
    [2107FE0A]{designide150.bpl} ComponentDesigner.TComponentRoot.Save (Line 4734, "ComponentDesigner.pas" + 1) + $2
    [21B8FB53]{delphicoreide150.bpl} DelphiModule.TPascalCodeMgrModHandler.SaveFile (Line 1474, "DelphiModule.pas" + 2) + $8
    [208AF488]{coreide150.bpl} SourceModule.TCodeISourceModule.SaveFile (Line 1508, "SourceModule.pas" + 2) + $26
    [208ACB30]{coreide150.bpl} SourceModule.TSourceModule.SaveFile (Line 653, "SourceModule.pas" + 3) + $23
    [20A7475A]{coreide150.bpl} DocModul.TDocModule.TheMalteseFalcon (Line 1422, "DocModul.pas" + 60) + $6
    [5013A3F5]{rtl150.bpl  } Rtti.RawInvoke (Line 5538, "Rtti.pas" + 46) + $0
    [5013A75A]{rtl150.bpl  } Rtti.Invoke (Line 5729, "Rtti.pas" + 38) + $6
    [501335D9]{rtl150.bpl  } Rtti.TRttiInstanceMethodClassic.GetCallingConvention (Line 4103, "Rtti.pas" + 1) + $2
    [50133F7F]{rtl150.bpl  } Rtti.TRttiInstanceMethodEx.DispatchInvoke (Line 4408, "Rtti.pas" + 130) + $17
    [5013ABC0]{rtl150.bpl  } Rtti.TRttiMethod.Invoke (Line 5859, "Rtti.pas" + 1) + $11
    [20A743C6]{coreide150.bpl} DocModul.TDocModule.Save (Line 1346, "DocModul.pas" + 3) + $23
    [208ADC4F]{coreide150.bpl} SourceModule.TSourceModule.Save (Line 1002, "SourceModule.pas" + 13) + $B
    [2231511B]{delphide150.bpl} DelphiProject.TDelphiCodeIWin32Project._AddRef (Line 367, "DelphiProject.pas" + 1) + $1
    [50040A1D]{rtl150.bpl  } System.TInterfacedObject._AddRef (Line 28238, "System.pas" + 1) + $3
    [20A79398]{coreide150.bpl} DocModul.SaveModifiedModules (Line 3554, "DocModul.pas" + 57) + $7
    [0041D711]{bds.exe     } Sanctuary.MD5.Transform (Line 282, "Sanctuary.MD5.pas" + 11) + $F
    [500AED6F]{rtl150.bpl  } Classes.TBasicAction.Execute (Line 12988, "Classes.pas" + 3) + $7
    [5026AA15]{vcl150.bpl  } ActnList.TContainedAction.Execute (Line 448, "ActnList.pas" + 8) + $2C
    [5026B7F0]{vcl150.bpl  } ActnList.TCustomAction.Execute (Line 1094, "ActnList.pas" + 7) + $8
    [500AEC33]{rtl150.bpl  } Classes.TBasicActionLink.Execute (Line 12917, "Classes.pas" + 2) + $7
    [5029E788]{vcl150.bpl  } Menus.TMenuItem.Click (Line 2525, "Menus.pas" + 17) + $7
    [502A0113]{vcl150.bpl  } Menus.DoClick (Line 3609, "Menus.pas" + 41) + $4
    [502A01FF]{vcl150.bpl  } Menus.TMenu.IsShortCut (Line 3662, "Menus.pas" + 38) + $6
    [004238ED]{bds.exe     } Sanctuary.Util.LaunchProcess (Line 1821, "Sanctuary.Util.pas" + 20) + $43
    [50354A74]{vcl150.bpl  } Forms.TCustomForm.IsShortCut (Line 6885, "Forms.pas" + 2) + $16
    [50284CC0]{vcl150.bpl  } Controls.TWinControl.IsMenuKey (Line 11464, "Controls.pas" + 13) + $C
    [50284D0D]{vcl150.bpl  } Controls.TWinControl.CNKeyDown (Line 11479, "Controls.pas" + 5) + $4
    [5027DF6C]{vcl150.bpl  } Controls.TControl.WndProc (Line 7074, "Controls.pas" + 91) + $6
    [50282830]{vcl150.bpl  } Controls.TWinControl.WndProc (Line 9831, "Controls.pas" + 144) + $6
    [211973B3]{vclide150.bpl} IDEInspListBox.TPropInspEdit.WndProc (Line 360, "IDEInspListBox.pas" + 7) + $4
    [50281ED0]{vcl150.bpl  } Controls.TWinControl.MainWndProc (Line 9552, "Controls.pas" + 3) + $6
    [500AFA64]{rtl150.bpl  } Classes.StdWndProc (Line 13491, "Classes.pas" + 8) + $0
    [5035882C]{vcl150.bpl  } Forms.TApplication.IsKeyMsg (Line 9668, "Forms.pas" + 25) + $12
    [503588BA]{vcl150.bpl  } Forms.TApplication.IsHintMsg (Line 9688, "Forms.pas" + 2) + $10
    [50358AD3]{vcl150.bpl  } Forms.TApplication.ProcessMessage (Line 9754, "Forms.pas" + 17) + $31
    [50358B3A]{vcl150.bpl  } Forms.TApplication.HandleMessage (Line 9790, "Forms.pas" + 1) + $4
    [50358E65]{vcl150.bpl  } Forms.TApplication.Run (Line 9927, "Forms.pas" + 26) + $3
  • baghin © (01.11.13 17:56) [3]
    Ах да, забыл, делаю на Delphi XE
    Но и в D7 такая же картинка
  • DimaBr © (02.11.13 00:35) [4]

    > Cannot assign a TFieldControlItem to a TFieldControlItem

    Ну так напишите метод Assign
    procedure TFieldControlItem.Assign(Source: TPersistent);
    begin
     if Source is TFieldControlItem then begin
       FieldName := TFieldControlItem(Source).FieldName;
       ...
     end
     else inherited Assign(Source);
    end;

  • Юрий Зотов © (02.11.13 22:25) [5]
    Я все же склонен перекрывать не Assign, а AssignTo. Потому что, если перекрыт только Assign, то вызов AssignTo всегда даст ошибку - а этого быть не должно.
  • DimaBr © (03.11.13 20:46) [6]
    Так до inherited Assign(Source); дело не дойдёт и соответственно AssignTo не вызовется. Для надёжности можно вообще убрать
    procedure TFieldControlItem.Assign(Source: TPersistent);
    begin
     if Source is TFieldControlItem then begin
       FieldName := TFieldControlItem(Source).FieldName;
       ...
     end
    end;

  • baghin © (05.11.13 09:16) [7]
    Огромное спасибо. Все заработало.
  • baghin © (05.11.13 09:17) [8]
    Сразу еще вопрос. Как сделать так, чтобы редактирование коллекции открывалось при двойному клику по компоненту на форме, а не только через инспектор?
  • DimaBr © (05.11.13 14:48) [9]
    http://pda.delphimaster.net/?id=1174055007&n=12
  • Юрий Зотов © (06.11.13 13:11) [10]
    > DimaBr ©   (03.11.13 20:46) [6]
    Так ведь никто не мешает юзеру (т.е. прикладнику) вызвать AssignTo самому, из любого места кода. И если AssignTo не перекрыт, то будет исключение, даже если вызов был вполне корректен. А если AssignTo перекрыть (даже не перекрывая Assign), то и Assign, и AssignTo всегда будут работать правильно.

    >baghin ©   (05.11.13 09:17) [8]
    Написать редактор компонента.
  • DimaBr © (06.11.13 14:58) [11]

    > Юрий Зотов

    Юзеру вообще ничего не мешает грохнуть компонент, а потом к нему обращаться
  • Юрий Зотов © (06.11.13 17:57) [12]
    > DimaBr ©   (06.11.13 14:58) [11]

    За некорректную работу с компонентом сам юзер и отвечает.

    Но вызов юзером AssignTo вполне корректен, а при корректной работе с компонентом он глючить не должен, и отвечает за это разработчик компонента.
  • DimaBr © (06.11.13 23:52) [13]
    Не согласен !
    Assign - присвоить себе подобному
    AssignTo - присвоить чужеродному

    В данном случае нужно себе подобному, а на чужеродном пусть валится ошибкой. А вообще , мне кажется, ТС это вообще не интересно, он не проявляет с своему вопросу никакого внимания
  • Юрий Зотов © (07.11.13 16:07) [14]

    > DimaBr ©   (06.11.13 23:52) [13]
    > Assign - присвоить себе подобному
    > AssignTo - присвоить чужеродному

    С какой радости? И то, и другое - просто присвоить одно другому. А разобраться кто свой, кто чужой и что с ним делать - это должен сам код.

    Вариант 1.
    Есть TMyClass. В нем замещен только Assign:

    procedure TMyClass.Assign(Source: TPersistent);
    begin
     if Source is TMyClass then
     begin
     ...
     end
     else inherited
    end;



    Теперь Assign работает правильно, а вот AssignTo работает неправильно. Потому что при вызове AssignTo(экземпляр_TMyClass) получим ошибку, хотя при таком вызове никакой ошибки быть не должно.

    Вариант 2.
    Есть TMyClass. В нем замещен только AssignTo:

    procedure TMyClass.AssignTo(Dest: TPersistent);
    begin
     if Dest is TMyClass then
     begin
     ...
     end
     else inherited
    end;



    Теперь можем вызывать хоть Assign, хоть AssignTo - все и всегда работает правильно. Для родного класса выполняет присвоение, для чужого выдает ошибку.

    Что и требовалось.
  • DimaBr © (08.11.13 00:53) [15]
    Метод AssignTo - protected и его "пользователь" вызвать не может (только в наследнике)

    А вообще в справке написано
    For example, given the following code in which A and B are instance variables:

    A.Assign(B); {Delphi}

    if A knows how to handle B, then it does so and returns. If A doesn’t know how to handle B’s type, execution will trickle to the TPersistent version of Assign, which calls:

    B.AssignTo(A); {Delphi}

    If B knows how to copy to A, the assignment succeeds. Otherwise, TPersistent raises an exception.



    Если А знает, как присвоить B , то всё ОК, так и делаем. Если не знает, то спускаемся к TPersisten, где спросим у самого В как присвоиться А.
    Метод AssignTo нужен для того чтобы научить незыблемые (например стандартные) компоненты получать значения из моих совершенно левых компонентов.
    Например, я хочу научить TEdit получать текст от заголовка моей формы. Класс TEdit я изменить не могу, но зато я могу изменить класс моей формы

    TForm1 = class(TForm)
       Edit1: TEdit;
       procedure FormClick(Sender: TObject);
     private
       { Private declarations }
     protected
       procedure AssignTo(Dest: TPersistent);override;
     end;

    procedure TForm1.AssignTo(Dest: TPersistent);
    begin
     if Dest is TEdit then TEdit(Dest).Text := Caption else inherited;
    end;

    procedure TForm1.FormClick(Sender: TObject);
    begin
     Edit1.Assign(Form1);
    end;

  • Юрий Зотов © (09.11.13 17:45) [16]
    > DimaBr ©   (08.11.13 00:53) [15]

    Одно другому не мешает. Но спорить действительно смысла нет - у нас разные исходные позиции. Ты считаешь, что ошибка при совершенно корректном вызове AssignTo - это нормально, я считаю - что ненормально.
  • baghin © (12.11.13 11:38) [17]
    Всем доброго времени суток

    Пришлось переключится но другой проект

    В результате экспериментов пришел к следующим результатам:
    1. При использовании AssignTo коллекция наследовалась но при сохранении и открытии проекта снова не сохранялись данные в записях коллекции. их число соответствовало введенному, но без измененных параметров.
    2. При использовании только Assign происходило следующее. Заполняем коллекцию на родителе. Создаем наследника. Сохраняем все. В предке добавляем еще одну запись. В наследнике она не появляется.
    3. Если перекрывать обе процедуры то описанное выше отрабатывает нормально.
  • baghin © (12.11.13 11:50) [18]
    Дальнейшие эксперименты привели к еще одной проблеме

    Исходные данные:
    Предок с компонентом и заполненной коллекцией
    Потомок. В нем коллекция не менялась

    Если попытаться удалить одну из записей в коллекции предка, выдает ошибку
    Selection conttains a component introduced in an ancestor form which cannot be deleted

    Куда дальше копать

    Исходный код сейчас выглядит так
    type
     TFormulaKind = (fkNone, fkCount, fkMaximum, fkMinimum, fkSum);

     TFieldControlItem = class(TCollectionItem)
     private
       FFieldName: string;         // имя поля в DataSet
       FComponentName: string;     // Имя компоненты отвечающей за поле
       FCaption: string;           // Название поля в Гриде можно где-нидь ещё
       FWidth: integer;            // Ширина поля в гриде
       FMayBeVisible: Boolean;     // можно поле делать не видимым
       FWithFilter: Boolean;    // нужен ли фильтр для столбца
       FFormulaKind: TFormulaKind; // как вычислять "групповую" запись
     protected
       function GetDisplayName: string; override;
       procedure AssignTo(Dest: TPersistent); override;
     public
       constructor Create(Collection: TCollection); override;
       procedure Assign(Source: TPersistent); override;
     published
       property FieldName: string read FFieldName write FFieldName;
       property ComponentName: string read FComponentName write FComponentName;
       property Caption: string read FCaption write FCaption;
       property Width: integer read FWidth write FWidth;
       property MayBeVisible: boolean read FMayBeVisible write FMayBeVisible;
       property WithFilter: boolean read FWithFilter write FWithFilter;
       property FormulaGroup: TFormulaKind read FFormulaKind write FFormulaKind;
     end;

     TFieldControlItemCalss = class of TFieldControlItem;

     TFieldControlList = class;

     TFieldControls = class(TOwnedCollection)
     private
       FFieldControlList: TFieldControlList;
       function GetItem(Index: Integer): TFieldControlItem;
       procedure SetItem(Index: Integer; const Value: TFieldControlItem);
     protected
       procedure Update(Item: TCollectionItem); override;
     public
       function Add: TFieldControlItem;
       property Items[Index: Integer]: TFieldControlItem read GetItem write SetItem; default;
     published
     end;

     TFieldControlList = class(TComponent)
     private
       FFieldControls: TFieldControls;
       procedure SetFieldControl(const Value: TFieldControls);
     protected
     public
       constructor Create(AOwner: TComponent); override;
       destructor Destroy; override;
       function IndexByFieldName(AFieldName: string): integer;
       function VisibleByFieldName(AFieldName: string): boolean;
     published
       property FieldControls: TFieldControls read FFieldControls write SetFieldControl;
     end;

    procedure Register;

    implementation

    procedure Register;
    begin
     RegisterComponents('Terminal', [TFieldControlList, TImageGIF]);
    end;

    { TFieldControlItem }

    procedure TFieldControlItem.AssignTo(Dest: TPersistent);
    begin
     if Dest is TFieldControlItem then
       begin
         FieldName:= TFieldControlItem(Dest).FieldName;
         ComponentName:= TFieldControlItem(Dest).ComponentName;
         Caption:= TFieldControlItem(Dest).Caption;
         Width:= TFieldControlItem(Dest).Width;
         MayBeVisible:= TFieldControlItem(Dest).MayBeVisible;
         WithFilter:= TFieldControlItem(Dest).WithFilter;
         FormulaGroup:= TFieldControlItem(Dest).FormulaGroup;
       end
       else inherited AssignTo(Dest);
    end;

    procedure TFieldControlItem.Assign(Source: TPersistent);
    begin
     if Source is TFieldControlItem then
       begin
         FieldName:= TFieldControlItem(Source).FieldName;
         ComponentName:= TFieldControlItem(Source).ComponentName;
         Caption:= TFieldControlItem(Source).Caption;
         Width:= TFieldControlItem(Source).Width;
         MayBeVisible:= TFieldControlItem(Source).MayBeVisible;
         WithFilter:= TFieldControlItem(Source).WithFilter;
         FormulaGroup:= TFieldControlItem(Source).FormulaGroup;
       end
       else inherited Assign(Source);
    end;

    constructor TFieldControlItem.Create(Collection: TCollection);
    begin
     inherited;
     FFieldName:= '';
     FComponentName:= '';
     FCaption:= '';
     FWidth:= 50;
     FMayBeVisible:= true;
     FWithFilter:= false;
     FFormulaKind:= fkNone;
    end;

    function TFieldControlItem.GetDisplayName: string;
    begin
     Result := FFieldName;
     if Result = '' then Result := inherited GetDisplayName;
    end;

    { TFieldControlCollection }

    function TFieldControls.Add: TFieldControlItem;
    begin
     Result := TFieldControlItem(inherited Add);
    end;

    function TFieldControls.GetItem(Index: Integer): TFieldControlItem;
    begin
     Result := TFieldControlItem(inherited GetItem(Index))
    end;

    procedure TFieldControls.SetItem(Index: Integer; const Value: TFieldControlItem);
    begin
     inherited SetItem(Index, Value);
    end;

    procedure TFieldControls.Update(Item: TCollectionItem);
    begin
     inherited Update(Item);
    end;

    { TFieldControlList }

    constructor TFieldControlList.Create(AOwner: TComponent);
    begin
     inherited Create(AOwner);
     FFieldControls:= TFieldControls.Create(Self, TFieldControlItem);
    end;

    destructor TFieldControlList.Destroy;
    begin
     FFieldControls.Free;
     inherited;
    end;

    function TFieldControlList.IndexByFieldName(AFieldName: string): integer;
    begin
     for Result:= 0 to FFieldControls.Count-1 do
       if FFieldControls.GetItem(Result).FieldName = AFieldName then Exit;
     Result:= -1;
    end;

    function TFieldControlList.VisibleByFieldName(AFieldName: string): boolean;
    var i: integer;
    begin
     for i:= 0 to FFieldControls.Count-1 do
       if FFieldControls.GetItem(i).FieldName = AFieldName then
         begin
           Result:= FFieldControls.GetItem(i).MayBeVisible;
           Exit;
         end;
     Result:= false;
    end;

    procedure TFieldControlList.SetFieldControl(const Value: TFieldControls);
    begin
     FFieldControls.Assign(Value)
    end;

  • baghin © (12.11.13 11:59) [19]
    Дополнение

    В случае зачистки записи в dfm файле она исчезает в потомке
  • Юрий Зотов © (12.11.13 15:19) [20]
    Код в TFieldControlItem.AssignTo неверен, наоборот надо. Начнем с этого. И поясните, о каких таких предках-потомках идет речь?
  • baghin © (12.11.13 15:31) [21]
    Не понял. как наоборот
  • baghin © (12.11.13 15:37) [22]
    Поясню для чего все это надо
    Создается форма (назовем ее frmList) на которой DBGrid, DataSet, этот компонент(назовем его FieldControl) и т.д.
    В компоненте будут хранится настройки столбцов грида. В этом модуле процедурой создаются колонки в гриде согласно настройкам из FieldControl
    В FieldControl хранятся описания колонок которые присутствуют в гриде на всех потомках данной формы.

    От этой формы наследуются "потомки" со своей спецификой. Соответственно в FieldControl на формах потомках добавляются свои записи о столбцах
  • baghin © (12.11.13 15:39) [23]

    > Не понял. как наоборот


    Извините не разобрался. Сейчас все понял. Выкладывать исправленное пока не буду.
  • Юрий Зотов © (12.11.13 16:08) [24]
    > baghin ©   (12.11.13 15:31) [21]

    В Assign:
    поле := Source.поле; // Source - источник

    В AssignTo:
    Dest.поле := поле; // Dest - приемник
  • baghin © (12.11.13 16:14) [25]
    Это я уже поправил. Еще раз спасибо
  • DimaBr © (13.11.13 17:55) [26]
    Без AssignTo работает прекрасно. Проверено на D6, D7, XE2.
    И добавляются в наследнике и удаляются, для надёжности напишите в AssignTo какой нибудь ShowMessage, что бы убедиться что он никогда не показывется
  • Юрий Зотов © (13.11.13 22:16) [27]
    > DimaBr ©   (13.11.13 17:55) [26]
    > Без AssignTo работает прекрасно.

    Естественно - ведь в этом случае AssignTo в коде компонента нигде не вызывается (о чем Вы сами и написали).

    Но как только будет вызван из любого другого места...
    Error: Can not assign TMyClass to TMyClass.

    И сидит изумленный программист, чешет репу - как же это так?
  • Юрий Зотов © (13.11.13 22:38) [28]
    > DimaBr ©   (13.11.13 17:55) [26]

    А если вместо Assign перекрыть AssignTo, то тоже будет прекрасно работать. Причем без всяких "Can not...".
  • имя (20.10.15 19:54) [29]
    Удалено модератором
  • имя (20.10.15 20:54) [30]
    Удалено модератором
 
Конференция "Компоненты" » Компонент содержащий коллекцию не сохраняем ее [D7, WinXP]
ДомойОсновная Компоненты FreePascal Начинающим KOL Игры Corba Media Журнал WinAPI Сети Прочее Базы .Net
Есть новые Нет новых   [134427   +34][b:0.001][p:0.006]