{ MSEgui Copyright (c) 1999-2014 by Martin Schreiber

    See the file COPYING.MSE, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
}
unit msearrayprops;
{$ifdef FPC}{$mode objfpc}{$h+}{$endif}

interface
{$ifndef mse_allwarnings}
 {$if fpc_fullversion >= 030100}
  {$warn 5089 off}
  {$warn 5090 off}
  {$warn 5093 off}
  {$warn 6058 off}
 {$endif}
{$endif}

uses
  sysutils,classes,mclasses,typinfo,mselist,
  msegraphutils,msetypes,msestrings,mseclasses,mseglob,msestat;

type
 earraystreamerror = class(estreamerror);
 earrayproperror = class(exception);

 tarrayprop = class;
 arrayproparrayty = array of tarrayprop;

 arraychangeeventty = procedure(const sender: tarrayprop; 
                                       const index: integer) of object;
 arraysizechangeeventty = procedure(sender: tarrayprop) of object;

 arraypropstatety = (aps_linking,aps_destroying,aps_needsindexing,aps_moved);
 arraypropsstatesty = set of arraypropstatety;

 arraypropkindty = (apk_none,apk_tpersistent,apk_integer,apk_colorty,apk_real,
                    apk_string,apk_msestring,apk_boolean,apk_pointer,apk_int64);
 
 tarrayprop = class(tpersistent)
  private
   itemsread: boolean;
   linkedarrays: arrayproparrayty;
   fonchange: arraychangeeventty;
   ffixcount: integer;
   procedure internalinsert(const index: integer; const init: boolean);
  protected
   fstate: arraypropsstatesty;
   fupdating: integer;
   fcountbefore: integer;
   procedure setfixcount(const avalue: integer); virtual;
   procedure change(const index: integer); virtual;
   function getcount: integer; virtual; abstract;
   function getdatapo: pointer; virtual; abstract;
   procedure checkcount(var acount: integer); virtual;
   procedure setcount1(acount: integer; doinit: boolean); virtual;
   procedure setcount(const acount: integer);
   procedure dosizechanged; virtual;
   function getsize: integer; virtual; abstract;
   function getitemspo(const index: integer): pointer; virtual; abstract;
   procedure writeitem(const index: integer; writer: twriter); virtual; abstract;
   procedure readitem(const index: integer; reader: treader); virtual; abstract;
   procedure defineproperties(filer: tfiler); override;
   procedure readcount(reader: treader);
   procedure writecount(writer: twriter);
   procedure readitems(reader: treader);
   procedure writeitems(writer: twriter);
   procedure init(startindex,endindex: integer); virtual;
   procedure dochange(const aindex: integer); virtual;
   procedure checkindex(const index: integer);
   function checkstored(ancestor: tpersistent): boolean; virtual;
  public
   function propkind: arraypropkindty; virtual;
   procedure beginupdate;
   procedure endupdate(nochange: boolean = false);
   procedure clear;
   procedure insertempty(const index: integer);
   procedure insertdefault(const index: integer);
   procedure delete(const index: integer);
   procedure move(const curindex,newindex: integer); virtual;
   procedure order(const sourceorder: integerarty); //sourceorder can be nil
   procedure reorder(const destorder: integerarty); //destorder can be nil
   procedure link(alinkedarrays: array of tarrayprop{;
               onsizechanged: arraysizechangeeventty = nil});
   property fixcount: integer read ffixcount write setfixcount default 0;
   property onchange: arraychangeeventty read fonchange write fonchange;
  published
   property count: integer read getcount write setcount default 0;
  end;

 tintegerarrayprop = class(tarrayprop)
  private
  protected
   fitems: integerarty;
   function getitems(const index: integer): integer;
   procedure setitems(const index: integer; const Value: integer);
   function getcount: integer; override;
   procedure setcount1(acount: integer; doinit: boolean); override;
   procedure writeitem(const index: integer; writer: twriter); override;
   procedure readitem(const index: integer; reader: treader); override;
   function getsize: integer; override;
   function getdatapo: pointer; override;
   function getitemspo(const index: integer): pointer; override;
   function checkstored(ancestor: tpersistent): boolean; override;
  public
   function propkind: arraypropkindty; override;
   procedure assign(source: tpersistent); override;
   property items[const index: integer]: integer read getitems write setitems; default;
 end;

 tcolorarrayprop = class(tintegerarrayprop)
  private
   function getitems(const index: integer): colorty;
   procedure setitems(const index: integer; const Value: colorty);
  protected
   fvaluedefault: colorty;
   procedure init(startindex,endindex: integer); override;
  public
   constructor create;
   function propkind: arraypropkindty; override;
   property items[const index: integer]: colorty read getitems 
                                                write setitems; default;
 end;

 tint64arrayprop = class(tarrayprop)
  private
  protected
   fitems: int64arty;
   function getitems(const index: integer): int64;
   procedure setitems(const index: integer; const Value: int64);
   function getcount: integer; override;
   procedure setcount1(acount: integer; doinit: boolean); override;
   procedure writeitem(const index: integer; writer: twriter); override;
   procedure readitem(const index: integer; reader: treader); override;
   function getsize: integer; override;
   function getdatapo: pointer; override;
   function getitemspo(const index: integer): pointer; override;
   function checkstored(ancestor: tpersistent): boolean; override;
  public
   function propkind: arraypropkindty; override;
   procedure assign(source: tpersistent); override;
   property items[const index: integer]: int64 read getitems write setitems; default;
 end;

 trealarrayprop = class(tarrayprop)
  private
   function getitems(const index: integer): real;
   procedure setitems(const index: integer; const Value: real);
  protected
   fitems: realarty;
   function getcount: integer; override;
   procedure setcount1(acount: integer; doinit: boolean); override;
   procedure writeitem(const index: integer; writer: twriter); override;
   procedure readitem(const index: integer; reader: treader); override;
   function getsize: integer; override;
   function getdatapo: pointer; override;
   function getitemspo(const index: integer): pointer; override;
   function checkstored(ancestor: tpersistent): boolean; override;
  public
   function propkind: arraypropkindty; override;
   procedure assign(source: tpersistent); override;
   property items[const index: integer]: real read getitems write setitems; default;
 end;

 tstringarrayprop = class(tarrayprop)
  private
   function getitems(const index: integer): string;
   procedure setitems(const index: integer; const Value: string);
  protected
   fitems: stringarty;
   function getcount: integer; override;
   procedure setcount1(acount: integer; doinit: boolean); override;
   procedure writeitem(const index: integer; writer: twriter); override;
   procedure readitem(const index: integer; reader: treader); override;
   function getsize: integer; override;
   function getdatapo: pointer; override;
   function getitemspo(const index: integer): pointer; override;
   function checkstored(ancestor: tpersistent): boolean; override;
  public
   function propkind: arraypropkindty; override;
   procedure assign(source: tpersistent); override;
   function itemar: stringarty;
   property items[const index: integer]: string read getitems write setitems; default;
 end;

 tmsestringarrayprop = class(tarrayprop)
  private
   function getitems(const index: integer): msestring;
   procedure setitems(const index: integer; const Value: msestring);
  protected
   fitems: msestringarty;
   function getcount: integer; override;
   procedure setcount1(acount: integer; doinit: boolean); override;
   procedure writeitem(const index: integer; writer: twriter); override;
   procedure readitem(const index: integer; reader: treader); override;
   function getsize: integer; override;
   function getdatapo: pointer; override;
   function getitemspo(const index: integer): pointer; override;
   function checkstored(ancestor: tpersistent): boolean; override;
  public
   function propkind: arraypropkindty; override;
   procedure assign(source: tpersistent); override;
   property items[const index: integer]: msestring read getitems write setitems; default;
 end;

 tbooleanarrayprop = class(tintegerarrayprop)
  private
   function getitems(const index: integer): boolean;
   procedure setitems(const index: integer; const Value: boolean);
  public
   function propkind: arraypropkindty; override;
   property items[const index: integer]: boolean read getitems write setitems; default;
 end;

 tenumarrayprop = class(tintegerarrayprop)
  protected
   ftypeinfo: ptypeinfo;
  public
   constructor create(typeinfo: ptypeinfo); reintroduce;
 end;

 tsetarrayprop = class(tintegerarrayprop)
  private
   function getitems(const index: integer): tintegerset;
  protected
   ftypeinfo: ptypeinfo;
   procedure setitems(const index: integer; const Value: tintegerset); virtual;
   procedure writeitem(const index: integer; writer: twriter); override;
   procedure readitem(const index: integer; reader: treader); override;
  public
   constructor create(typeinfo: ptypeinfo); reintroduce;
   property typeinfo: ptypeinfo read ftypeinfo;
   property items[const index: integer]: tintegerset read getitems write setitems; default;
 end;

 tpointerarrayprop = class(tarrayprop)
  private
  protected
   fitems: pointerarty;
   function getitems(const index: integer): pointer;
   procedure setitems(const index: integer; const Value: pointer);
   function getcount: integer; override;
   procedure setcount1(acount: integer; doinit: boolean); override;
   procedure writeitem(const index: integer; writer: twriter); override;
   procedure readitem(const index: integer; reader: treader); override;
   function getsize: integer; override;
   function getdatapo: pointer; override;
   function getitemspo(const index: integer): pointer; override;
   function checkstored(ancestor: tpersistent): boolean; override;
  public
   function propkind: arraypropkindty; override;
   procedure assign(source: tpersistent); override;
   property items[const index: integer]: pointer read getitems write setitems; default;
 end;

 tdynarrayarrayprop = class(tpointerarrayprop)
  protected
   procedure internalsetcount(const acount: int32) virtual abstract;
   procedure setcount1(acount: integer; doinit: boolean); override;
  public
   destructor destroy(); override;
 end;
 
 tpersistentarrayprop = class(tarrayprop,iobjectlink)
  private                     //same layout as tpointerarrayprop!
  protected
   fitems: persistentarty;    //same layout as tintegerarrayprop!
   fdestroyingitem: tpersistent;
   fitemclasstype: virtualpersistentclassty;
   fobjectlinker: tobjectlinker;
   function _addref: integer; stdcall;
   function _release: integer; stdcall;
   function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;

    //iobjectlink
   procedure link(const source,dest: iobjectlink; valuepo: pointer = nil;
                      ainterfacetype: pointer = nil; once: boolean = false);
   procedure unlink(const source,dest: iobjectlink; valuepo: pointer = nil);
   procedure objevent(const sender: iobjectlink; const event: objecteventty);
   function getinstance: tobject;
   
   function getobjectlinker: tobjectlinker;
   procedure objectevent(const sender: tobject; const event: objecteventty); virtual;
   function getitems(const index: integer): tpersistent;{ virtual;}
   procedure init(startindex,endindex: integer); override;
   function getcount: integer; override;
   procedure setcount1(acount: integer; doinit: boolean); override;
   procedure writeitem(const index: integer; writer: twriter); override;
   procedure readitem(const index: integer; reader: treader); override;
   function getsize: integer; override;
   function getdatapo: pointer; override;
   function getitemspo(const index: integer): pointer; override;
   procedure createitem(const index: integer; var item: tpersistent); virtual;
   procedure defineproperties(filer: tfiler); override;
   procedure readcollection(reader: treader);
   procedure writecollection(writer: twriter);
   function getcollectionname(const index: integer): string; virtual;
   function ispropertystored(index: integer): boolean; virtual;
   procedure setlinkedvar(const source: tmsecomponent; var dest: tmsecomponent;
              const linkintf: iobjectlink = nil); overload;
   procedure setlinkedvar(const source: tlinkedobject; var dest: tlinkedobject;
              const linkintf: iobjectlink = nil); overload;
  public
   constructor create(aitemclasstype: virtualpersistentclassty); reintroduce;
   destructor destroy; override;
   procedure itemdestroyed(const aitem: tpersistent);
   procedure assign(source: tpersistent); override;
   function propkind: arraypropkindty; override;
   function displayname(const index: integer): msestring; virtual;
   procedure add(const item: tpersistent);
   function add(): tpersistent; //returns added element
   function indexof(const aitem: tpersistent): integer; //-1 if not found
   class function getitemclasstype: persistentclassty; virtual;
               //used in dumpunitgroups
   property itemclasstype: virtualpersistentclassty read fitemclasstype;
   property items[const index: integer]: tpersistent read getitems; default;
 end;
 persistentarraypropclassty = class of tpersistentarrayprop;

 tmsecomponentlinkarrayprop = class;
 
 tmsecomponentlinkitem = class(tvirtualpersistent)
  private
   fitem: tmsecomponent;
   procedure setitem(const avalue: tmsecomponent);
  protected
   fprop: tmsecomponentlinkarrayprop;
   property item: tmsecomponent read fitem write setitem;
  public
   destructor destroy; override;
  published
 end;

 msecomponentlinkitemclassty = class of tmsecomponentlinkitem; 
 
 tmsecomponentlinkarrayprop = class(tpersistentarrayprop)
  private
//   function getitems(const index: integer): tmsecomponent;
//   procedure setitems(const index: integer; const avalue: tmsecomponent);
  protected
   procedure createitem(const index: integer; var item: tpersistent); override;
  public
   constructor create(const aitemclasstype: msecomponentlinkitemclassty);
   class function getitemclasstype: persistentclassty; override;
//   property items[const index: integer]: tmsecomponent read getitems 
//                                                   write setitems; default;
 end;

 ownedpersistentclassty = class of townedpersistent;

 townedpersistentarrayprop = class(tpersistentarrayprop)
  private
  protected
   fowner: tobject;
   procedure createitem(const index: integer; var item: tpersistent); override;
   procedure internalcreate(const aowner: tobject;
                           aclasstype: virtualpersistentclassty);
  public
   constructor create(const aowner: tobject; 
                     aclasstype: ownedpersistentclassty); virtual;
 end;

 tindexpersistentarrayprop = class;
 
 ownedeventpersistentclassty = class of townedeventpersistent;

 townedeventpersistentarrayprop = class(tpersistentarrayprop)
  private
  protected
   fowner: tobject;
   procedure createitem(const index: integer; var item: tpersistent); override;
  public
   constructor create(const aowner: tobject;
                  aclasstype: ownedeventpersistentclassty);
 end;

 tpersistonchangearrayprop = class(tpersistentarrayprop)
  protected
   onchange1: notifyeventty;
  public
   constructor create(aclasstype: virtualpersistentclassty; aonchange: notifyeventty);
 end;

 tstringlistarrayprop = class(tpersistentarrayprop)
  private
   function getitems(index: integer): tstringlist; reintroduce;
   procedure setitems(index: integer; const Value: tstringlist); reintroduce;
  protected
   procedure createitem(const index: integer; var item: tpersistent); override;
  public
   property items[index: integer]: tstringlist read getitems write setitems;
 end;

 tindexpersistent = class(townedeventpersistent)
  private
   fident: integer;
   fprop: tindexpersistentarrayprop;
  protected
   findex: integer;
   procedure dostatwrite(const writer: tstatwriter); virtual;
   procedure dostatread(const reader: tstatreader); virtual;
  public
   constructor create(const aowner: tobject;
         const aprop: tindexpersistentarrayprop); reintroduce; virtual;
   property index: integer read findex;
   property ident: integer read fident;
   property prop: tindexpersistentarrayprop read fprop;
 end;

 indexpersistentclassty = class of tindexpersistent;

 tindexpersistentarrayprop = class(townedpersistentarrayprop)
  private
   fident: integer;
   function getidents: integerarty;
   function getidentmap: integerarty;
  protected
   procedure createitem(const index: integer; var item: tpersistent); override;
   procedure change(const index: integer); override;
   function getidentnum(const index: integer): integer;
   procedure dosizechanged; override;
   function originalorder: integerarty; //restores original order, returns sort vector
  public
   constructor create(const aowner: tobject; aclasstype: indexpersistentclassty);
                   reintroduce; virtual;
   procedure add(const item: tindexpersistent);
   procedure dostatwrite(const writer: tstatwriter; const aorder: boolean);
   procedure writeorder(const writer: tstatwriter);
   function readorder(const reader: tstatreader): integerarty;
   procedure dostatread(const reader: tstatreader; const aorder: boolean);
   procedure clearorder; //ident order = index order
   function newident: integer;
   property idents: integerarty read getidents;
   property identmap: integerarty read getidentmap;
 end;
{ 
 tsubcomponentitem = class(tindexpersistent)
  protected
   fitem: tcomponent;
   function createitem: tcomponent; virtual; abstract;
   function getnamebase: string; virtual;
  public
   constructor create(const aowner: tobject;
                           const aprop: tindexpersistentarrayprop); override;
   destructor destroy; override;
 end; 
 subcomponentitemclassty = class of tsubcomponentitem;
 
 tsubcomponentarrayprop = class(tindexpersistentarrayprop)
  protected
//   procedure createitem(const index: integer; var item: tpersistent); override;
  public
   constructor create(const aowner: tcomponent; 
                const aitemclasstype: subcomponentitemclassty); reintroduce;
 end;
}
implementation
uses
 rtlconsts,msedatalist,msearrayutils;
{$ifndef mse_allwarnings}
 {$if fpc_fullversion >= 030100}
  {$warn 5089 off}
  {$warn 5090 off}
  {$warn 5093 off}
  {$warn 6058 off}
 {$endif}
{$endif}

type
 tbinaryobjectreader1 = class(tbinaryobjectreader);
 twriter1 = class(twriter);
 treader1 = class(treader);

{ tarrayprop }

procedure tarrayprop.checkindex(const index: integer);
begin
 if (index < 0) or (index >= count) then begin
  tlist.Error({$ifndef FPC}@{$endif}SListIndexError, Index);
 end;
end;

function tarrayprop.checkstored(ancestor: tpersistent): boolean;
begin
 if ancestor is tarrayprop then begin
  with tarrayprop(ancestor) do begin
   result:= (self.count <> 0) or (count <> 0);
  end;
 end
 else begin
  result:= false;
 end;
end;

procedure tarrayprop.change(const index: integer);
begin
 if (fupdating = 0) and not (aps_destroying in fstate) then begin
  dochange(index);
 end;
end;

procedure tarrayprop.beginupdate;
begin
 inc(fupdating);
end;

procedure tarrayprop.endupdate(nochange: boolean = false);
begin
 dec(fupdating);
 if not nochange then begin
  change(-1);
 end;
end;

procedure tarrayprop.clear;
begin
 count:= 0;
end;

procedure tarrayprop.dosizechanged;
begin
 //dummy
{
 if assigned(fonsizechanged) then begin
  fonsizechanged(self);
 end;
 }
end;

procedure tarrayprop.checkcount(var acount: integer);
begin
 if ffixcount <> 0 then begin
  acount:= ffixcount;
 end;
end;

procedure tarrayprop.setcount1(acount: integer; doinit: boolean);
var
 int1: integer;
 obj: tarrayprop;
 count2: integer;

begin
 if acount <> fcountbefore then begin
  if acount = 0 then begin
   fstate:= fstate - [aps_needsindexing,aps_moved];
  end;
  count2:= fcountbefore;
  if acount > fcountbefore then begin
//   fillchar(getitemspo(fcountbefore)^,(acount-fcountbefore)*getsize,#0);
   if doinit then begin
    init(fcountbefore,acount-1);
   end;
  end
  else begin
   if aps_moved in fstate then begin
    include(fstate,aps_needsindexing);
   end;
  end;
  fcountbefore:= acount;
  if not (aps_linking in fstate) then begin
   for int1:= 0 to length(linkedarrays) - 1 do begin
    obj:= linkedarrays[int1];
    if obj <> self then begin
     include(obj.fstate,aps_linking);
     try
      obj.count:= acount;
     finally
      exclude(obj.fstate,aps_linking);
     end;
    end;
   end;
  end;
  change(-1);
  if (count2 <> acount) and not (aps_destroying in fstate) then begin
   dosizechanged;
  end;
 end;
end;

procedure tarrayprop.setcount(const acount: integer);
begin
 setcount1(acount,true);
end;

procedure tarrayprop.setfixcount(const avalue: integer);
begin
 if ffixcount <> avalue then begin
  ffixcount:= avalue;
  setcount(avalue);
 end;
end;

procedure tarrayprop.readcount(reader: treader);
begin
 beginupdate;
 try
  count:= reader.ReadInteger;
 finally
  endupdate;
 end;
end;

procedure tarrayprop.writecount(writer: twriter);
begin
 writer.writeinteger(count);
end;

procedure tarrayprop.readitems(reader: treader);
var
 int1: integer;
begin
 int1:= 0;
 reader.ReadListBegin;
 while not reader.EndOfList do begin
  if int1 >= count then begin
   raise earraystreamerror.create('Arrayproperty length mismatch: '+
         inttostr(count) + '.');
  end;
  readitem(int1,reader);
  inc(int1);
 end;
 reader.readlistend;
 itemsread:= true;
end;

procedure tarrayprop.writeitems(writer: twriter);
var
 int1: integer;
begin
 writer.writeListBegin;
 for int1:= 0 to count-1 do begin
  writeitem(int1,writer);
 end;
 writer.writelistend;
end;

procedure tarrayprop.defineproperties(filer: tfiler);

  function DoWrite: Boolean;
  begin
   if Filer.Ancestor <> nil then begin
    Result := checkstored(filer.Ancestor);
   end
   else begin
    Result := Count > 0;
   end;
  end;

begin
// filer.DefineProperty('count',readcount,writecount,true);
 filer.DefineProperty('items',{$ifdef FPC}@{$endif}readitems,
           {$ifdef FPC}@{$endif}writeitems,dowrite);
 if itemsread then begin
  itemsread:= false;
  change(-1);
 end;
end;

procedure tarrayprop.link(alinkedarrays: array of tarrayprop{;
                  onsizechanged: arraysizechangeeventty = nil});
var
 int1: integer;
begin
// fonsizechanged:= onsizechanged;
 setlength(linkedarrays,high(alinkedarrays)+1);
 for int1:= 0 to high(alinkedarrays) do begin
  linkedarrays[int1]:= alinkedarrays[int1];
 end;
 for int1:= 0 to length(linkedarrays)-1 do begin
  if linkedarrays[int1] <> self then begin
   linkedarrays[int1].linkedarrays:= linkedarrays;
  end;
 end;
 setcount(count);
end;

procedure tarrayprop.init(startindex, endindex: integer);
begin
 //dummy
end;

procedure tarrayprop.dochange(const aindex: integer);
begin
 if assigned(fonchange) then begin
  fonchange(self,aindex);
 end;
end;

procedure tarrayprop.move(const curindex, newindex: integer);
var
 postart,pocur,ponew,poend,backup: pchar;
 size,count1: integer;
begin
 if curindex <> newindex then begin
  checkindex(curindex);
  checkindex(newindex);
  include(fstate,aps_moved);
  size:= getsize;
  count1:= getcount;
  postart:= getitemspo(0);
  pocur:= postart + curindex*size;
  ponew:= postart + newindex*size;
  poend:= postart + count1*size;
  getmem(backup,size);
  try
   system.move(pocur^,backup^,size);
   system.move((pocur+size)^,pocur^,poend-pocur-size);
   system.move(ponew^,(ponew+size)^,poend-ponew-size);
   system.move(backup^,ponew^,size);
  finally
   freemem(backup);
  end;
  change(-1);
//  change(curindex);
//  change(newindex);
 end;
end;

procedure tarrayprop.order(const sourceorder: integerarty);
var
 int1: integer;
begin
 if sourceorder <> nil then begin
  int1:= getcount;
  if int1 <> length(sourceorder) then begin
   raise exception.create('tarrayprop: Wrong length of neworder');
  end;
  if int1 > 0 then begin
   include(fstate,aps_moved);
   orderarray(sourceorder,getdatapo^,getsize);
  end;
  change(-1);
 end;
end;

procedure tarrayprop.reorder(const destorder: integerarty);
var
 int1: integer;
begin
 int1:= getcount;
 if int1 <> length(destorder) then begin
  raise exception.create('tarrayprop: Wrong length of neworder');
 end;
 if int1 > 0 then begin
  include(fstate,aps_moved);
  reorderarray(destorder,getdatapo^,getsize);
 end;
 change(-1);
end;

procedure tarrayprop.delete(const index: integer);
begin
 beginupdate;
 try
  move(index,count - 1);
  count:= count - 1;
 finally
  endupdate;
 end;
end;

procedure tarrayprop.internalinsert(const index: integer; const init: boolean);
begin
 include(fstate,aps_moved);
 beginupdate;
 try
  setcount1(count + 1,init);
  move(count-1,index);
 finally
  endupdate;
 end;
end;

procedure tarrayprop.insertempty(const index: integer);
begin
 internalinsert(index,false);
end;

procedure tarrayprop.insertdefault(const index: integer);
begin
 internalinsert(index,true);
end;

function tarrayprop.propkind: arraypropkindty;
begin
 result:= apk_none;
end;

{ tintegerarrayprop }

function tintegerarrayprop.checkstored(ancestor: tpersistent): boolean;
begin
 result:= not (ancestor is tintegerarrayprop);
 if not result then begin
  with tintegerarrayprop(ancestor) do begin
   result:= self.count <> count;
   if not result then begin
    result:= not comparemem(@self.fitems[0],@fitems[0],
        length(fitems)*sizeof(integer));
   end;
  end;
 end;
end;

function tintegerarrayprop.getcount: integer;
begin
 result:= length(fitems);
end;

procedure tintegerarrayprop.readitem(const index: integer; reader: treader);
begin
 fitems[index]:= reader.ReadInteger;
end;

procedure tintegerarrayprop.writeitem(const index: integer; writer: twriter);
begin
 writer.writeinteger(fitems[index]);
end;

procedure tintegerarrayprop.setcount1(acount: integer; doinit: boolean);
begin
 checkcount(acount);
 setlength(fitems,acount);    //immer zuerst!
 inherited;
end;

function tintegerarrayprop.getitemspo(const index: integer): pointer;
begin
 result:= @fitems[index];
end;

function tintegerarrayprop.getsize: integer;
begin
 result:= sizeof(integer);
end;

function tintegerarrayprop.getdatapo: pointer;
begin
 result:= @fitems;
end;

function tintegerarrayprop.getitems(const index: integer): integer;
begin
 checkindex(index);
 result:= fitems[index];
end;

procedure tintegerarrayprop.setitems(const index: integer; const Value: integer);
begin
 checkindex(index);
 fitems[index]:= value;
 change(index);
end;

procedure tintegerarrayprop.assign(source: tpersistent);
begin
 if source is tintegerarrayprop then begin
  fitems:= copy(tintegerarrayprop(source).fitems);
  beginupdate;
  setcount1(length(fitems),false);
  endupdate;
 end
 else begin
  inherited;
 end;
end;

function tintegerarrayprop.propkind: arraypropkindty;
begin
 result:= apk_integer;
end;

{ tcolorarrayprop }

constructor tcolorarrayprop.create;
begin
 fvaluedefault:= cl_none;
 inherited;
end;

function tcolorarrayprop.getitems(const index: integer): colorty;
begin
 checkindex(index);
 result:= fitems[index];
end;

procedure tcolorarrayprop.setitems(const index: integer; const Value: colorty);
begin
 inherited setitems(index,value);
end;

procedure tcolorarrayprop.init(startindex, endindex: integer);
var
 int1: integer;
begin
 for int1:= startindex to endindex do begin
  items[int1]:= fvaluedefault;
 end;
end;

function tcolorarrayprop.propkind: arraypropkindty;
begin
 result:= apk_colorty;
end;

{ tint64arrayprop }

function tint64arrayprop.checkstored(ancestor: tpersistent): boolean;
begin
 result:= not (ancestor is tint64arrayprop);
 if not result then begin
  with tint64arrayprop(ancestor) do begin
   result:= self.count <> count;
   if not result then begin
    result:= not comparemem(@self.fitems[0],@fitems[0],
        length(fitems)*sizeof(int64));
   end;
  end;
 end;
end;

function tint64arrayprop.getcount: integer;
begin
 result:= length(fitems);
end;

procedure tint64arrayprop.readitem(const index: integer; reader: treader);
begin
 fitems[index]:= reader.ReadInt64;
end;

procedure tint64arrayprop.writeitem(const index: integer; writer: twriter);
begin
 writer.writeinteger(fitems[index]);
end;

procedure tint64arrayprop.setcount1(acount: integer; doinit: boolean);
begin
 checkcount(acount);
 setlength(fitems,acount);    //immer zuerst!
 inherited;
end;

function tint64arrayprop.getitemspo(const index: integer): pointer;
begin
 result:= @fitems[index];
end;

function tint64arrayprop.getsize: integer;
begin
 result:= sizeof(int64);
end;

function tint64arrayprop.getdatapo: pointer;
begin
 result:= @fitems;
end;

function tint64arrayprop.getitems(const index: integer): int64;
begin
 checkindex(index);
 result:= fitems[index];
end;

procedure tint64arrayprop.setitems(const index: integer; const Value: int64);
begin
 checkindex(index);
 fitems[index]:= value;
 change(index);
end;

procedure tint64arrayprop.assign(source: tpersistent);
begin
 if source is tint64arrayprop then begin
  fitems:= copy(tint64arrayprop(source).fitems);
  beginupdate;
  setcount1(length(fitems),false);
  endupdate;
 end
 else begin
  inherited;
 end;
end;

function tint64arrayprop.propkind: arraypropkindty;
begin
 result:= apk_int64;
end;

{ trealarrayprop }

function trealarrayprop.getcount: integer;
begin
 result:= length(fitems);
end;

function trealarrayprop.getitemspo(const index: integer): pointer;
begin
 result:= @fitems[index];
end;

function trealarrayprop.getsize: integer;
begin
 result:= sizeof(real);
end;

function trealarrayprop.getdatapo: pointer;
begin
 result:= @fitems;
end;

procedure trealarrayprop.setcount1(acount: integer; doinit: boolean);
begin
 checkcount(acount);
 setlength(fitems,acount);    //immer zuerst!
 inherited;
end;

procedure trealarrayprop.readitem(const index: integer; reader: treader);
begin
 fitems[index]:= reader.ReadFloat;
end;

procedure trealarrayprop.writeitem(const index: integer; writer: twriter);
begin
 writer.writefloat(fitems[index]);
end;

function trealarrayprop.getitems(const index: integer): real;
begin
 checkindex(index);
 result:= fitems[index];
end;

procedure trealarrayprop.setitems(const index: integer; const Value: real);
begin
 checkindex(index);
 fitems[index]:= value;
 change(index);
end;

function trealarrayprop.checkstored(ancestor: tpersistent): boolean;
begin
 result:= not (ancestor is trealarrayprop);
 if not result then begin
  with trealarrayprop(ancestor) do begin
   result:= self.count <> count;
   if not result then begin
    result:= not comparemem(@self.fitems[0],@fitems[0],
        length(fitems)*sizeof(real));
   end;
  end;
 end;
end;

procedure trealarrayprop.assign(source: tpersistent);
begin
 if source is trealarrayprop then begin
  fitems:= copy(trealarrayprop(source).fitems);
  beginupdate;
  setcount1(length(fitems),false);
  endupdate;
 end
 else begin
  inherited;
 end;
end;

function trealarrayprop.propkind: arraypropkindty;
begin
 result:= apk_real;
end;

{ tstringarrayprop }

function tstringarrayprop.checkstored(ancestor: tpersistent): boolean;
var
 int1: integer;
begin
 result:= not (ancestor is tstringarrayprop);
 if not result then begin
  with tstringarrayprop(ancestor) do begin
   result:= self.count <> count;
   if not result then begin
    for int1:= 0 to count - 1 do begin
     if self.fitems[int1] <> fitems[int1] then begin
      result:= true;
      break;
     end;
    end;
   end;
  end;
 end;
end;

function tstringarrayprop.getcount: integer;
begin
 result:= length(fitems);
end;

function tstringarrayprop.getitems(const index: integer): string;
begin
 checkindex(index);
 result:= fitems[index];
end;

function tstringarrayprop.getitemspo(const index: integer): pointer;
begin
 result:= @fitems[index];
end;

function tstringarrayprop.getsize: integer;
begin
 result:= sizeof(string);
end;

function tstringarrayprop.getdatapo: pointer;
begin
 result:= @fitems;
end;

procedure tstringarrayprop.readitem(const index: integer; reader: treader);
begin
 fitems[index]:= reader.Readstring;
end;

procedure tstringarrayprop.setcount1(acount: integer; doinit: boolean);
begin
 checkcount(acount);
 setlength(fitems,acount);    //immer zuerst!
 inherited;
end;

procedure tstringarrayprop.setitems(const index: integer; const Value: string);
begin
 checkindex(index);
 fitems[index]:= value;
 change(index);
end;

procedure tstringarrayprop.writeitem(const index: integer; writer: twriter);
begin
 writer.writestring(fitems[index]);
end;

procedure tstringarrayprop.assign(source: tpersistent);
begin
 if source is tstringarrayprop then begin
  fitems:= copy(tstringarrayprop(source).fitems);
  beginupdate;
  setcount1(length(fitems),false);
  endupdate;
 end
 else begin
  inherited;
 end;
end;

function tstringarrayprop.propkind: arraypropkindty;
begin
 result:= apk_string;
end;

function tstringarrayprop.itemar: stringarty;
begin
 result:= copy(fitems);
end;

{ tmsestringarrayprop }

function tmsestringarrayprop.checkstored(ancestor: tpersistent): boolean;
var
 int1: integer;
begin
 result:= not (ancestor is tmsestringarrayprop);
 if not result then begin
  with tmsestringarrayprop(ancestor) do begin
   result:= self.count <> count;
   if not result then begin
    for int1:= 0 to count - 1 do begin
     if self.fitems[int1] <> fitems[int1] then begin
      result:= true;
      break;
     end;
    end;
   end;
  end;
 end;
end;

function tmsestringarrayprop.getcount: integer;
begin
 result:= length(fitems);
end;

function tmsestringarrayprop.getitems(const index: integer): msestring;
begin
 checkindex(index);
 result:= fitems[index];
end;

function tmsestringarrayprop.getitemspo(const index: integer): pointer;
begin
 result:= @fitems[index];
end;

function tmsestringarrayprop.getsize: integer;
begin
 result:= sizeof(msestring);
end;

function tmsestringarrayprop.getdatapo: pointer;
begin
 result:= @fitems;
end;

procedure tmsestringarrayprop.readitem(const index: integer; reader: treader);
begin
 fitems[index]:= treader_readmsestring(reader); //msestringimplementation
// {$ifdef mse_unicodestring}
// fitems[index]:= reader.Readunicodestring; //msestringimplementation
// {$else}
// fitems[index]:= reader.Readwidestring; //msestringimplementation
// {$endif}
end;

procedure tmsestringarrayprop.setcount1(acount: integer; doinit: boolean);
begin
 checkcount(acount);
 setlength(fitems,acount);    //immer zuerst!
 inherited;
end;

procedure tmsestringarrayprop.setitems(const index: integer; const Value: msestring);
begin
 checkindex(index);
 fitems[index]:= value;
 change(index);
end;

procedure tmsestringarrayprop.writeitem(const index: integer; writer: twriter);
begin
 twriter_writemsestring(writer,fitems[index]);
// {$ifdef mse_unicodestring}
// writer.writeunicodestring(fitems[index]);
// {$else}
// writer.writewidestring(fitems[index]); //msestringimplementation
// {$endif}
end;

procedure tmsestringarrayprop.assign(source: tpersistent);
begin
 if source is tmsestringarrayprop then begin
  fitems:= copy(tmsestringarrayprop(source).fitems);
  beginupdate;
  setcount1(length(fitems),false);
  endupdate;
 end
 else begin
  inherited;
 end;
end;

function tmsestringarrayprop.propkind: arraypropkindty;
begin
 result:= apk_msestring;
end;

{ tbooleanarrayprop }

function tbooleanarrayprop.getitems(const index: integer): boolean;
begin
 checkindex(index);
 result:= boolean(fitems[index]);
end;

procedure tbooleanarrayprop.setitems(const index: integer;
  const Value: boolean);
begin
 inherited setitems(index,integer(value));
end;

function tbooleanarrayprop.propkind: arraypropkindty;
begin
 result:= apk_boolean;
end;

{ tenumarrayprop }

constructor tenumarrayprop.create(typeinfo: ptypeinfo);
begin
 if typeinfo^.Kind <> tkenumeration then begin
  raise earrayproperror.Create('typ muss enum sein!');
 end;
 ftypeinfo:= typeinfo;
 inherited create;
end;

{ tsetarraypropmse }

constructor tsetarrayprop.create(typeinfo: ptypeinfo);
var
 typedatapo: ptypedata;

begin
 if typeinfo^.Kind <> tkset then begin
  raise earrayproperror.Create('typ muss set sein!');
 end;
 ftypeinfo:= typeinfo;
 typedatapo:= gettypedata(ftypeinfo);
 typedatapo:= gettypedata(typedatapo^.comptype{$ifndef FPC}^{$endif});
// fsize:= (typedatapo^.maxvalue - typedatapo^.minvalue) div 8 + 1;
 if (typedatapo^.maxvalue - typedatapo^.minvalue) div 8 + 1 > 
                   sizeof(tintegerset) then begin
  raise earrayproperror.Create('set muss <= 32 sein!');
 end;
// {$ifdef FPC}
// fsize:= sizeof(longword);
// {$endif}
 inherited create;
end;
{
function tsetarrayprop.getcount: integer;
begin
 result:= length(fitems);
end;
}
function tsetarrayprop.getitems(const index: integer): tintegerset;
begin
 checkindex(index);
 result:= tintegerset(fitems[index]);
end;
{
function tsetarrayprop.getitemspo(const index: integer): pointer;
begin
 result:= @fitems[index];
end;

function tsetarrayprop.getsize: integer;
begin
 result:= sizeof(tintegerset);
end;

function tsetarrayprop.getdatapo: pointer;
begin
 result:= @fitems;
end;

procedure tsetarrayprop.setcount1(acount: integer; doinit: boolean);
begin
 checkcount(acount);
 setlength(fitems,acount);    //immer zuerst!
 inherited;
end;
}
procedure tsetarrayprop.setitems(const index: integer; const Value: tintegerset);
begin
 checkindex(index);
 fitems[index]:= integer(value);
 change(index);
end;

procedure tsetarrayprop.writeitem(const index: integer; writer: twriter);
begin
 writeset(writer,tintegerset(fitems[index]),ftypeinfo);
end;

procedure tsetarrayprop.readitem(const index: integer; reader: treader);
begin
 fitems[index]:= integer(readset(reader,ftypeinfo));
end;
{
procedure tsetarrayprop.getset(const index: integer; out value);
begin
 checkindex(index);
 system.move(fitems[index],value,fsize);
end;

procedure tsetarrayprop.setset(const index: integer; const value);
begin
 checkindex(index);
 fillchar(fitems[index],sizeof(tintegerset),0);
 system.move(value,fitems[index],fsize);
end;
}

{ tpointerarrayprop }

function tpointerarrayprop.checkstored(ancestor: tpersistent): boolean;
begin
 result:= not (ancestor is tpointerarrayprop);
 if not result then begin
  with tpointerarrayprop(ancestor) do begin
   result:= self.count <> count;
   if not result then begin
    result:= not comparemem(@self.fitems[0],@fitems[0],
        length(fitems)*sizeof(pointer));
   end;
  end;
 end;
end;

function tpointerarrayprop.getcount: integer;
begin
 result:= length(fitems);
end;

procedure tpointerarrayprop.readitem(const index: integer; reader: treader);
begin
{$ifdef CPU64}
 fitems[index]:= pointer(reader.ReadInt64);
{$else}
 fitems[index]:= pointer(reader.ReadInteger);
{$endif}
end;

procedure tpointerarrayprop.writeitem(const index: integer; writer: twriter);
begin
{$ifdef CPU64}
 writer.writeinteger(int64(fitems[index]));
{$else}
 writer.writeinteger(integer(fitems[index]));
{$endif}
end;

procedure tpointerarrayprop.setcount1(acount: integer; doinit: boolean);
begin
 checkcount(acount);
 setlength(fitems,acount);    //immer zuerst!
 inherited;
end;

function tpointerarrayprop.getitemspo(const index: integer): pointer;
begin
 result:= @fitems[index];
end;

function tpointerarrayprop.getsize: integer;
begin
 result:= sizeof(pointer);
end;

function tpointerarrayprop.getdatapo: pointer;
begin
 result:= @fitems;
end;

function tpointerarrayprop.getitems(const index: integer): pointer;
begin
 checkindex(index);
 result:= fitems[index];
end;

procedure tpointerarrayprop.setitems(const index: integer; const Value: pointer);
begin
 checkindex(index);
 fitems[index]:= value;
 change(index);
end;

procedure tpointerarrayprop.assign(source: tpersistent);
begin
 if source is tpointerarrayprop then begin
  fitems:= copy(tpointerarrayprop(source).fitems);
  beginupdate;
  setcount1(length(fitems),false);
  endupdate;
 end
 else begin
  inherited;
 end;
end;

function tpointerarrayprop.propkind: arraypropkindty;
begin
 result:= apk_pointer;
end;

{ tdynarrayarrayprop }

destructor tdynarrayarrayprop.destroy();
begin
 inherited;
 internalsetcount(0);
end;

procedure tdynarrayarrayprop.setcount1(acount: integer; doinit: boolean);
begin
 checkcount(acount);
 internalsetcount(acount);
 inherited;
end;

{ tpersistentarrayprop }

constructor tpersistentarrayprop.create(aitemclasstype: virtualpersistentclassty);
begin
 fitemclasstype:= aitemclasstype;
 inherited create;
end;

destructor tpersistentarrayprop.destroy;
begin
 include(fstate,aps_destroying);
 setlength(linkedarrays,0);
 clear;
 inherited;
 fobjectlinker.free;
end;

function tpersistentarrayprop.getcount: integer;
begin
 result:= length(fitems);
end;

procedure tpersistentarrayprop.init(startindex, endindex: integer);
var
 int1: integer;
begin
 inherited;
 for int1:= startindex to endindex do begin
  createitem(int1,fitems[int1]);
 end;
end;

procedure tpersistentarrayprop.setcount1(acount: integer; doinit: boolean);
var
 {lengthvorher,}int1: integer;
 ar1: persistentarty;
 pers1: tpersistent;
begin
 if not (aps_destroying in fstate) then begin
  checkcount(acount);
 end;
 int1:= length(fitems) - acount;
 if int1 > 0 then begin
  pers1:= fdestroyingitem;
  ar1:= copy(fitems,acount,int1);
  setlength(fitems,acount); //return new count
  for int1:= high(ar1) downto 0 do begin
   fdestroyingitem:= ar1[int1];
   ar1[int1].free;
  end;
  fdestroyingitem:= pers1;
 end
 else begin
  setlength(fitems,acount);
 end;
 inherited;
end;

procedure tpersistentarrayprop.readitem(const index: integer; reader: treader);
begin
 //dummy
end;

procedure tpersistentarrayprop.writeitem(const index: integer; writer: twriter);
begin
 //dummy
end;

function tpersistentarrayprop.getitemspo(const index: integer): pointer;
begin
 result:= @fitems[index];
end;

function tpersistentarrayprop.getsize: integer;
begin
 result:= sizeof(tpersistent);
end;

function tpersistentarrayprop.getdatapo: pointer;
begin
 result:= @fitems;
end;

procedure tpersistentarrayprop.createitem(const index: integer;
                  var item: tpersistent);
begin
 if fitemclasstype <> nil then begin
  item:= fitemclasstype.create;
 end
 else begin
  item:= nil;
 end;
end;

function tpersistentarrayprop.ispropertystored(index: integer): boolean;
begin
 result:= fitems[index] <> nil;
end;

procedure tpersistentarrayprop.readcollection(reader: treader);
var
 int1,int2,int3: integer;
 str1: string;
begin
 with treader1(reader) do begin
  readvalue;
  int1:= 0;
  while not EndOfList do begin
   if NextValue in [vaInt8, vaInt16, vaInt32] then ReadInteger;
   int2:= int1;
   if nextvalue = vaident then begin
    str1:= readident;
    if str1 <> '' then begin
     for int3:= 0 to count-1 do begin 
      if getcollectionname(int3) = str1 then begin
       int2:= int3;
       break;
      end;
     end;
    end;
   end;
   ReadListBegin;
   while not EndOfList do  begin
    if int2 <= high(fitems) then begin
     treader1(reader).ReadProperty(getitems(int2));
    end
    else begin
     tbinaryobjectreader1(reader.driver).skipproperty;
    end;
   end;
   ReadListEnd;
   inc(int1);
  end;
  readlistend;
 end;
 itemsread:= true;
end;

procedure tpersistentarrayprop.writecollection(writer: twriter);
var
 int1,int2,int3: integer;
 proppathvorher: string;
 ancestorbefore: tpersistentarrayprop;
 str1: string;

begin
 proppathvorher:= getfproppath(writer);
 setfproppath(writer,'');
 ancestorbefore:= tpersistentarrayprop(writer.ancestor);
 try
  with twriter1(writer) do begin
   driver.begincollection;
   for int1 := 0 to Count - 1 do begin
    str1:= getcollectionname(int1);
    if str1 <> '' then begin
     writeident(str1);
    end;
    WriteListBegin;
    ancestor:= nil;
    if ancestorbefore <> nil then begin 
     int2:= int1;
     if (str1 <> '') then begin
      int2:= bigint; //needs ancestor name
      for int3:= 0 to ancestorbefore.count-1 do begin
       if ancestorbefore.getcollectionname(int3) = str1 then begin
        int2:= int3;
        break;
       end;
      end;
     end;
     if (int2 < ancestorbefore.count) then begin
      ancestor:= ancestorbefore.fitems[int2];
     end;
    end;
    if ispropertystored(int1) then begin
     twriter1(writer).WriteProperties(getitems(int1));
    end;
    WriteListEnd;
   end;
   WriteListEnd;
  end;
 finally
  setfproppath(writer,proppathvorher);
  writer.Ancestor:= ancestorbefore;
 end;
end;

procedure tpersistentarrayprop.defineproperties(filer: tfiler);
begin
 filer.DefineProperty('items',{$ifdef FPC}@{$endif}readcollection,
                              {$ifdef FPC}@{$endif}writecollection,count>0);
// inherited;
 if itemsread and (filer is treader) then begin
  itemsread:= false;
  change(-1);
 end;
end;

procedure tpersistentarrayprop.link(const source,dest: iobjectlink; valuepo: pointer = nil;
                            ainterfacetype: pointer = nil; once: boolean = false);
begin
 getobjectlinker.link(source,dest,valuepo,ainterfacetype,once);
end;

procedure tpersistentarrayprop.unlink(const source,dest: iobjectlink; valuepo: pointer = nil);
begin
 getobjectlinker.unlink(source,dest,valuepo);
end;

procedure tpersistentarrayprop.objevent(const sender: iobjectlink; const event: objecteventty);
begin
 getobjectlinker.objevent(sender,event);
end;

function tpersistentarrayprop.getinstance: tobject;
begin
 result:= self;
end;

function tpersistentarrayprop._addref: integer; stdcall;
begin
 result:= -1;
end;

function tpersistentarrayprop._release: integer; stdcall;
begin
 result:= -1;
end;

function tpersistentarrayprop.QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
begin
 if GetInterface(IID, Obj) then begin
   Result:=0
 end
 else begin
  result:= integer(e_nointerface);
 end;
end;

function tpersistentarrayprop.getobjectlinker: tobjectlinker;
begin
 if fobjectlinker = nil then begin
  createobjectlinker(iobjectlink(self),{$ifdef FPC}@{$endif}objectevent,fobjectlinker);
 end;
 result:= fobjectlinker;
end;

procedure tpersistentarrayprop.objectevent(const sender: tobject;
                  const event: objecteventty);
begin
 //dummy
end;

procedure tpersistentarrayprop.setlinkedvar(const source: tmsecomponent;
                   var dest: tmsecomponent; const linkintf: iobjectlink = nil);
begin
 if linkintf = nil then begin
  getobjectlinker.setlinkedvar(iobjectlink(self),source,dest);
 end
 else begin
  getobjectlinker.setlinkedvar(linkintf,source,dest);
 end;
end;

procedure tpersistentarrayprop.setlinkedvar(const source: tlinkedobject;
                   var dest: tlinkedobject; const linkintf: iobjectlink = nil);
begin
 if linkintf = nil then begin
  getobjectlinker.setlinkedvar(iobjectlink(self),source,dest);
 end
 else begin
  getobjectlinker.setlinkedvar(linkintf,source,dest);
 end;
end;

function tpersistentarrayprop.getitems(const index: integer): tpersistent;
begin
 checkindex(index);
 result:= fitems[index];
end;

function tpersistentarrayprop.displayname(const index: integer): msestring;
begin
 if fitemclasstype <> nil then begin
  result:= msestring(PTypeInfo(fitemclasstype.ClassInfo)^.name);
 end
 else begin
  result:= '';
 end;
end;

procedure tpersistentarrayprop.add(const item: tpersistent);
begin
 beginupdate;
 setlength(fitems,high(fitems)+2);
// insertempty(length(fitems));
 fitems[high(fitems)]:= item;
 setcount1(length(fitems),false);
 endupdate;
end;

function tpersistentarrayprop.add(): tpersistent; //returns added element
begin
 count:= count+1;
 result:= fitems[high(fitems)];
end;

function tpersistentarrayprop.indexof(const aitem: tpersistent): integer; //-1 if not found
var
 int1: integer;
begin
 result:= -1;
 for int1:= 0 to high(fitems) do begin
  if fitems[int1] = aitem then begin
   result:= int1;
  end;
 end;
end;

function tpersistentarrayprop.propkind: arraypropkindty;
begin
 result:= apk_tpersistent;
end;

procedure tpersistentarrayprop.assign(source: tpersistent);
var
 int1: integer;
begin
 if source is tpersistentarrayprop then begin
  clear;
  with tpersistentarrayprop(source) do begin
   self.count:= count;
   for int1:= 0 to count - 1 do begin
    self.fitems[int1].assign(fitems[int1]);
   end;
  end;
 end
 else begin
  inherited;
 end;
end;

class function tpersistentarrayprop.getitemclasstype: persistentclassty;
begin
 result:= nil; //dummy
end;

function tpersistentarrayprop.getcollectionname(const index: integer): string;
begin
 result:= '';
end;

procedure tpersistentarrayprop.itemdestroyed(const aitem: tpersistent);
begin
 if not (aps_destroying in fstate) and (aitem <> fdestroyingitem) then begin
  if removeitem(pointerarty(fitems),aitem) >= 0 then begin
   change(-1);
   dosizechanged;
  end;
 end;
end;

{ townedpersistentarrayprop }

constructor townedpersistentarrayprop.create(const aowner: tobject;
                            aclasstype: ownedpersistentclassty);
begin
 internalcreate(aowner,aclasstype);
end;

procedure townedpersistentarrayprop.internalcreate(const aowner: tobject;
                     aclasstype: virtualpersistentclassty);
begin
 fowner:= aowner;
 inherited create(aclasstype);
end;

procedure townedpersistentarrayprop.createitem(const index: integer;
                  var item: tpersistent);
begin
 if fitemclasstype <> nil then begin
  item:= tpersistent(fitemclasstype.newinstance);
  townedpersistent(item).create(fowner);
 end
 else begin
  item:= nil;
 end;
end;

{ townedeventpersistentarrayprop }

constructor townedeventpersistentarrayprop.create(const aowner: tobject;
  aclasstype: ownedeventpersistentclassty);
begin
 fowner:= aowner;
 inherited create(aclasstype);
end;

procedure townedeventpersistentarrayprop.createitem(const index: integer;
                                 var item: tpersistent);
begin
 if fitemclasstype <> nil then begin
  item:= ownedeventpersistentclassty(fitemclasstype).create(fowner);
 end
 else begin
  item:= nil;
 end;
end;

{ tpersistonchangearrayprop }

constructor tpersistonchangearrayprop.create(aclasstype: virtualpersistentclassty;
      aonchange: notifyeventty);
begin
 onchange1:= aonchange;
 inherited create(aclasstype);
end;

{ tstringlistarrayprop }

procedure tstringlistarrayprop.createitem(const index: integer;
                                                   var item: tpersistent);
begin
 item:= tstringlist.create;
end;

function tstringlistarrayprop.getitems(index: integer): tstringlist;
begin
 checkindex(index);
 result:= tstringlist(fitems[index]);
end;

procedure tstringlistarrayprop.setitems(index: integer;
  const Value: tstringlist);
begin
 checkindex(index);
 tstringlist(fitems[index]).assign(value);
end;

{ tindexpersistentarrayprop }

constructor tindexpersistentarrayprop.create(const aowner: tobject;
                             aclasstype: indexpersistentclassty);
begin
 internalcreate(aowner,aclasstype);
end;

procedure tindexpersistentarrayprop.createitem(const index: integer;
                                   var item: tpersistent);
begin
 if fitemclasstype <> nil then begin
  item:= indexpersistentclassty(fitemclasstype).create(fowner,self);
  tindexpersistent(item).findex:= index;
 end
 else begin
  item:= nil;
 end;
end;

procedure tindexpersistentarrayprop.change(const index: integer);
var
 int1: integer;
 item1: tindexpersistent;
begin
 if (index < 0) and (fupdating = 0) then begin
  for int1:= 0 to high(fitems) do begin
   item1:= tindexpersistent(fitems[int1]);
   if item1 <> nil then begin
    item1.findex:= int1;
   end;
  end;
 end;
 inherited;
end;

function tindexpersistentarrayprop.getidentnum(const index: integer): integer;
var
 item1: tindexpersistent;
begin
 item1:= tindexpersistent(fitems[index]);
 if item1 <> nil then begin
  result:= item1.fident;
 end
 else begin
  result:= bigint;
 end;
end;

function tindexpersistentarrayprop.newident: integer;
begin
 if aps_needsindexing in fstate then begin
  result:= newidentnum(count,{$ifdef FPC}@{$endif}getidentnum);
 end
 else begin
  result:= fident;
  inc(fident);
 end;
end;

procedure tindexpersistentarrayprop.dosizechanged;
begin
 if count = 0 then begin
  exclude(fstate,aps_needsindexing);
  fident:= 0;
 end
 else begin
  if not (aps_needsindexing in fstate) then begin
   fident:= count;
  end;
 end;
 inherited;
end;

procedure tindexpersistentarrayprop.writeorder(const writer: tstatwriter);
var
 int1,int2,int3: integer;
 ar1: integerarty;
 bo1: boolean;
begin
 if count > 0 then begin
  setlength(ar1,count);
  int2:= tindexpersistent(fitems[0]).fident;
  bo1:= false;
  for int1:= 0 to count -1 do begin
   int3:= tindexpersistent(fitems[int1]).fident;
   if int3 < int2 then begin
    bo1:= true;
   end;
   ar1[int1]:= int3;
   int2:= int3;
  end;
  if bo1 then begin
   writer.writearray('order',ar1);
  end;
 end;
end;
 
function tindexpersistentarrayprop.readorder(
                                      const reader: tstatreader): integerarty;
var
 ar1,ar2: integerarty;
 int1: integer;
begin
 result:= nil;
 beginupdate;
 try
  ar1:= nil;
  ar1:= reader.readarray('order',ar1);
  if (ar1 <> nil) and (high(ar1) = high(fitems)) then begin
   sortarray(ar1,ar2);
   for int1:= 0 to high(ar1) do begin
    if ar1[int1] <> int1 then begin
     exit; //invalid
    end;
   end;
   reorderarray(ar2,pointerarty(fitems));
   for int1:= 0 to count -1 do begin
    tindexpersistent(fitems[int1]).findex:= int1;
   end;
   result:= ar2;
  end;
 finally
  endupdate;
 end;
end;

procedure tindexpersistentarrayprop.dostatread(const reader: tstatreader;
                                                       const aorder: boolean);
var
 int1: integer;
begin
 if reader.canstate then begin
  beginupdate;
  try
   if aorder then begin
    readorder(reader);
   end;
   for int1:= 0 to count -1 do begin
    tindexpersistent(fitems[int1]).dostatread(reader);
   end;
  finally
   endupdate;
  end;
 end;
end;

procedure tindexpersistentarrayprop.dostatwrite(const writer: tstatwriter;
                                                        const aorder: boolean);
var
 int1: integer;
begin
 if writer.canstate then begin
  for int1:= 0 to count -1 do begin
   tindexpersistent(fitems[int1]).dostatwrite(writer);
  end;
  if aorder then begin
   writeorder(writer);
  end;
 end;
end;

procedure tindexpersistentarrayprop.add(const item: tindexpersistent);
begin
 item.findex:= count;
 inherited add(item);
end;

function tindexpersistentarrayprop.getidents: integerarty;
var
 int1: integer;
begin
 setlength(result,count);
 for int1:= 0 to high(fitems) do begin
  result[int1]:= tindexpersistent(fitems[int1]).fident;
 end;
end;

function tindexpersistentarrayprop.originalorder: integerarty;
var
 int1: integer;
 ar1: integerarty;
begin
 ar1:= getidents;
 sortarray(ar1,result);
 orderarray(result,pointerarty(fitems));
 for int1:= 0 to count -1 do begin
  tindexpersistent(fitems[int1]).findex:= int1;
 end;
end;

function tindexpersistentarrayprop.getidentmap: integerarty;
 var
  int1,int2: integer;
begin
 int2:= -1;
 for int1:= 0 to high(fitems) do begin
  with tindexpersistent(fitems[int1]) do begin
   if fident > int2 then begin
    int2:= fident;
   end;
  end;
 end;
 setlength(result,int2+1);
 for int2:= 0 to high(result) do begin
  result[int2]:= -1;
  for int1:= 0 to high(fitems) do begin
   with tindexpersistent(fitems[int1]) do begin
    if fident = int2 then begin
     result[int2]:= int1;
     break;
    end;
   end;
  end;
 end;
end;

procedure tindexpersistentarrayprop.clearorder;
var
 int1: integer;
begin
 fident:= count;
 exclude(fstate,aps_needsindexing);
 for int1:= 0 to fident - 1 do begin
  with tindexpersistent(fitems[int1]) do begin
   fident:= int1;
  end;  
 end;
end;

{ tindexpersistent }

constructor tindexpersistent.create(const aowner: tobject;
               const aprop: tindexpersistentarrayprop);
begin
 findex:= -1;
 fprop:= aprop;
 inherited create(aowner);
 fident:= fprop.newident;
end;

procedure tindexpersistent.dostatread(const reader: tstatreader);
begin
 //dummy
end;

procedure tindexpersistent.dostatwrite(const writer: tstatwriter);
begin
 //dummy
end;

{ tmsecomponenlinktitem }

destructor tmsecomponentlinkitem.destroy;
begin
 item:= nil;
 inherited;
end;

procedure tmsecomponentlinkitem.setitem(const avalue: tmsecomponent);
begin
 fprop.setlinkedvar(avalue,fitem);
end;

{ tmsecomponentlinkarrayprop }

constructor tmsecomponentlinkarrayprop.create(
                        const aitemclasstype: msecomponentlinkitemclassty);
begin
 inherited create(aitemclasstype);
end;
{
function tmsecomponentarrayprop.getitems(const index: integer): tmsecomponent;
begin
 result:= tmsecomponent(inherited getitems(index));
end;

procedure tmsecomponentarrayprop.setitems(const index: integer;
               const avalue: tmsecomponent);
begin
 inherited;
end;
}
procedure tmsecomponentlinkarrayprop.createitem(const index: integer;
               var item: tpersistent);
begin
 inherited;
 tmsecomponentlinkitem(item).fprop:= self; 
end;

class function tmsecomponentlinkarrayprop.getitemclasstype: persistentclassty;
begin
 result:= tmsecomponentlinkitem;
// result:= tmsecomponent;
end;
(*
{ tsubcomponentarrayprop }

constructor tsubcomponentarrayprop.create(const aowner: tcomponent;
               const aitemclasstype: subcomponentitemclassty);
begin
 inherited create(aowner,aitemclasstype);
end;

{ tsubcomponentitem }

constructor tsubcomponentitem.create(const aowner: tobject;
                  const aprop: tindexpersistentarrayprop);
begin
 inherited;
 fitem:= createitem;
 if not (csloading in tcomponent(aowner).componentstate) then begin
  fitem.name:= getnumberedname(tcomponent(aowner),getnamebase);
 end;
end;

destructor tsubcomponentitem.destroy;
begin
 inherited;
 fitem.free;
end;

function tsubcomponentitem.getnamebase: string;
begin
 result:= 'item';
end;
*)

end.
