diff --git a/components/codetools/codetoolmanager.pas b/components/codetools/codetoolmanager.pas
index 55a7233979..fe1bb97aef 100644
--- a/components/codetools/codetoolmanager.pas
+++ b/components/codetools/codetoolmanager.pas
@@ -754,6 +754,8 @@ type
                        const ClassContext, AncestorClassContext: TFindContext;
                        {%H-}LFMNode: TLFMTreeNode;
                        const IdentName: string; var IsDefined: boolean);
+    function UpdateComponentInit(Code: TCodeBuffer; const aClassName,
+          AccessClass, StartSignature, EndSignature, InitSrc: string): boolean;
 
     // register proc
     function HasInterfaceRegisterProc(Code: TCodeBuffer;
@@ -5383,6 +5385,23 @@ begin
   end;
 end;
 
+function TCodeToolManager.UpdateComponentInit(Code: TCodeBuffer;
+  const aClassName, AccessClass, StartSignature, EndSignature, InitSrc: string
+  ): boolean;
+begin
+  Result:=false;
+  {$IFDEF CTDEBUG}
+  DebugLn(['TCodeToolManager.UpdateComponentInit A ',Code.Filename,' Class="'+aClassName+'" AccessClass="'+AccessClass+'" StartSignature="'+StartSignature+'" EndSignature="'+EndSignature+'" InitSrc={'+InitSrc+'}']);
+  {$ENDIF}
+  if not InitCurCodeTool(Code) then exit;
+  try
+    Result:=FCurCodeTool.UpdateComponentInit(aClassName,AccessClass,
+      StartSignature,EndSignature,InitSrc,SourceChangeCache);
+  except
+    on e: Exception do Result:=HandleException(e);
+  end;
+end;
+
 function TCodeToolManager.FindCreateFormStatement(Code: TCodeBuffer;
   StartPos: integer;
   const AClassName, AVarName: string;
diff --git a/components/codetools/extractproctool.pas b/components/codetools/extractproctool.pas
index 9f0d048498..b27ccdf126 100644
--- a/components/codetools/extractproctool.pas
+++ b/components/codetools/extractproctool.pas
@@ -124,6 +124,10 @@ type
       const WithExpr: string; // if empty: collect Candidates
       Candidates: TStrings; SourceChangeCache: TSourceChangeCache): boolean;
 
+    function UpdateComponentInit(const aClassName, AccessClass,
+         StartSignature, EndSignature, InitSrc: string;
+         SourceChangeCache: TSourceChangeCache): boolean;
+
     procedure CalcMemSize(Stats: TCTMemStats); override;
   end;
   
@@ -1696,6 +1700,35 @@ begin
   Result:=true;
 end;
 
+function TExtractProcTool.UpdateComponentInit(const aClassName, AccessClass,
+  StartSignature, EndSignature, InitSrc: string;
+  SourceChangeCache: TSourceChangeCache): boolean;
+
+  procedure E(TheID: int64; Msg: string);
+  begin
+    raise ECodeToolError.Create(Self,TheID,'TExtractProcTool.UpdateComponentInit: '+Msg);
+  end;
+
+begin
+  Result:=false;
+  {$IFDEF VerbosePasStream}
+  debugln(['TExtractProcTool.UpdateComponentInit START ',MainFilename,' aClassName="'+aClassName+'" AccessClass="'+AccessClass+'" StartSignature={'+DbgStr(StartSignature)+'} EndSignature={'+dbgstr(EndSignature)+'} InitSrc={'+InitSrc+'}']);
+  {$ENDIF}
+  if aClassName='' then
+    E(20171025224428,'missing aClassName');
+  if not IsValidIdent(aClassName) then
+    E(20171025224540,'invalid aClassName "'+aClassName+'"');
+  if (AccessClass<>'') and not IsValidIdent(AccessClass) then
+    E(20171025224607,'invalid AccessClass "'+AccessClass+'"');
+  if StartSignature='' then
+    E(20171025224636,'missing StartSignature');
+  if EndSignature='' then
+    E(20171025224647,'missing EndSignature');
+
+  // find class
+  // ToDo
+end;
+
 procedure TExtractProcTool.CalcMemSize(Stats: TCTMemStats);
 begin
   inherited CalcMemSize(Stats);
diff --git a/components/codetools/tests/testcompreaderwriterpas.pas b/components/codetools/tests/testcompreaderwriterpas.pas
index 3018237989..3dbfd8b89c 100644
--- a/components/codetools/tests/testcompreaderwriterpas.pas
+++ b/components/codetools/tests/testcompreaderwriterpas.pas
@@ -47,139 +47,15 @@ unit TestCompReaderWriterPas;
 
 {$mode objfpc}{$H+}
 
-{$DEFINE VerboseCompWriterPas}
+{off $DEFINE VerboseCompWriterPas}
 
 interface
 
 uses
-  Classes, SysUtils, typinfo, RtlConsts, LazLoggerBase, LazUTF8, LazLogger,
-  fpcunit, testregistry, CodeToolManager, LinkScanner, CodeToolsStructs,
-  CodeCache, BasicCodeTools, TestStdCodetools, TestGlobals, variants;
-
-const
-  // Component Stream as Pascal
-  CSPDefaultSignature = '// Component Stream as Pascal';
-  CSPDefaultSignatureBegin = CSPDefaultSignature+' - Begin';
-  CSPDefaultSignatureEnd = CSPDefaultSignature+' - End';
-  CSPDefaultAccessClass = 'TPasStreamAccess';
-  CSPDefaultExecCustomLFM = 'ExecCustomLFM';
-  CSPDefaultMaxColumn = 80;
-  CWPSkipParentName = '-';
-type
-  TCWPFindAncestorEvent = procedure(Sender: TObject; Component: TComponent;
-    const Name: string; var Ancestor, RootAncestor: TComponent) of object;
-  TCWPGetMethodName = procedure(Sender: TObject; Instance: TPersistent;
-    PropInfo: PPropInfo; out Name: String) of object;
-  TCWPGetParentProperty = procedure(Sender: TObject; Component: TComponent;
-    var PropName: string) of object;
-
-  TCWPOption = (
-    cwpoNoSignature,
-    cwpoSetParentFirst,  // add "Parent:=" before properties
-    cwpoSrcCodepageUTF8
-    );
-  TCWPOptions = set of TCWPOption;
-
-  TCWPChildrenStep = (
-    cwpcsCreate,
-    cwpcsProperties
-  );
-
-  { TCompWriterPas }
-
-  TCompWriterPas = class
-  private
-    FAccessClass: string;
-    FAncestor: TPersistent;
-    FAncestorPos: Integer;
-    FAncestors: TStringList;
-    FAssignOp: String;
-    FCurIndent: integer;
-    FCurrentPos: Integer;
-    FDefaultDefineProperties: CodePointer;
-    FExecCustomData: string;
-    FIgnoreChildren: Boolean;
-    FIndentStep: integer;
-    FLineEnding: string;
-    FLookupRoot: TComponent;
-    FMaxColumn: integer;
-    FNeedAccessClass: boolean;
-    FOnFindAncestor: TCWPFindAncestorEvent;
-    FOnGetMethodName: TCWPGetMethodName;
-    FOnGetParentProperty: TCWPGetParentProperty;
-    FOnWriteMethodProperty: TWriteMethodPropertyEvent;
-    FOnWriteStringProperty: TReadWriteStringPropertyEvent;
-    FOptions: TCWPOptions;
-    FParent: TComponent;
-    FPropPath: string;
-    FRoot: TComponent;
-    FRootAncestor: TComponent;
-    FSignature: String;
-    FStream: TStream;
-    procedure AddToAncestorList(Component: TComponent);
-    procedure DetermineAncestor(Component: TComponent);
-    procedure SetRoot(const AValue: TComponent);
-    procedure WriteComponentData(Instance: TComponent);
-    procedure WriteChildren(Component: TComponent; Step: TCWPChildrenStep);
-    procedure WriteProperty(Instance: TPersistent; PropInfo: PPropInfo);
-    procedure WriteProperties(Instance: TPersistent);
-    procedure WriteDefineProperties(Instance: TPersistent);
-    procedure WriteCollection(PropName: string; Collection: TCollection);
-    function ShortenFloat(s: string): string;
-  public
-    constructor Create(AStream: TStream);
-    destructor Destroy; override;
-    procedure WriteComponentCreate(Component: TComponent);
-    procedure WriteComponent(Component: TComponent);
-    procedure WriteDescendant(ARoot: TComponent; AAncestor: TComponent = nil);
-    procedure WriteSignature;
-    procedure WriteIndent;
-    procedure Write(const s: string);
-    procedure WriteLn;
-    procedure WriteStatement(const s: string);
-    procedure WriteAssign(const LHS, RHS: string);
-    function GetComponentPath(Component: TComponent): string;
-    function GetBoolLiteral(b: boolean): string;
-    function GetCharLiteral(c: integer): string;
-    function GetWideCharLiteral(c: integer): string;
-    function GetStringLiteral(const s: string): string;
-    function GetWStringLiteral(p: PWideChar; Count: integer): string;
-    function GetFloatLiteral(const e: Extended): string;
-    function GetCurrencyLiteral(const c: currency): string;
-    function GetEnumExpr(TypeInfo: PTypeInfo; Value: integer;
-      AllowOutOfRange: boolean): string;
-    function CreatedByAncestor(Component: TComponent): boolean;
-    procedure Indent;
-    procedure Unindent;
-    property Stream: TStream read FStream;
-    property Root: TComponent read FRoot write SetRoot;
-    property LookupRoot: TComponent read FLookupRoot;
-    property Ancestor: TPersistent read FAncestor write FAncestor;
-    property RootAncestor: TComponent read FRootAncestor write FRootAncestor;
-    property Parent: TComponent read FParent;
-    property OnFindAncestor: TCWPFindAncestorEvent read FOnFindAncestor write FOnFindAncestor;
-    property OnGetMethodName: TCWPGetMethodName read FOnGetMethodName write FOnGetMethodName;
-    property PropertyPath: string read FPropPath;
-    property CurIndent: integer read FCurIndent write FCurIndent;
-    property IndentStep: integer read FIndentStep write FIndentStep;
-    property Options: TCWPOptions read FOptions write FOptions;
-    property IgnoreChildren: Boolean read FIgnoreChildren write FIgnoreChildren;
-    property OnGetParentProperty: TCWPGetParentProperty read FOnGetParentProperty write FOnGetParentProperty;
-  public
-    // for custom DefineProperties
-    property OnWriteMethodProperty: TWriteMethodPropertyEvent read FOnWriteMethodProperty write FOnWriteMethodProperty;
-    property OnWriteStringProperty: TReadWriteStringPropertyEvent read FOnWriteStringProperty write FOnWriteStringProperty;
-  public
-    // code snippets
-    property LineEnding: string read FLineEnding write FLineEnding;
-    property AssignOp: String read FAssignOp write FAssignOp;
-    property Signature: String read FSignature write FSignature;
-    property AccessClass: string read FAccessClass
-      write FAccessClass; // classname used to access protected TComponent members like SetChildOrder
-    property NeedAccessClass: boolean read FNeedAccessClass write FNeedAccessClass; // some property needed AccessClass
-    property ExecCustomData: string read FExecCustomData write FExecCustomData;
-    property MaxColumn: integer read FMaxColumn write FMaxColumn default CSPDefaultMaxColumn;
-  end;
+  Classes, SysUtils, typinfo, LazLoggerBase, LazUTF8, LazLogger,
+  CompWriterPas, fpcunit, testregistry, CodeToolManager, LinkScanner,
+  CodeToolsStructs, CodeCache, BasicCodeTools, TestStdCodetools, TestGlobals,
+  variants;
 
 // Tests =======================================================================
 const
@@ -635,6 +511,9 @@ type
 
 implementation
 
+type
+  TAccessComp = class(TComponent);
+
 function CreateRootName(aComponent: TComponent): string;
 begin
   Result:=aComponent.ClassName;
@@ -642,82 +521,6 @@ begin
   Result:=Result+'1';
 end;
 
-function IsValidUTF8(p: PChar): integer;
-var
-  c: Char;
-begin
-  c:=p^;
-  if ord(c)<%10000000 then begin
-    // regular single byte ASCII character (#0 is a character, this is Pascal ;)
-    Result:=1;
-  end else if ord(c)<=%11000001 then begin
-    // single byte character, between valid UTF-8 encodings
-    // %11000000 and %11000001 map 2 byte to #0..#128, which is invalid and used for XSS attacks
-    Result:=0;
-  end else if ord(c)<=%11011111 then begin
-    // could be 2 byte character (%110xxxxx %10xxxxxx)
-    if ((ord(p[1]) and %11000000) = %10000000) then
-      Result:=2
-    else
-      Result:=0; // missing following bytes
-  end
-  else if ord(c)<=%11101111 then begin
-    // could be 3 byte character (%1110xxxx %10xxxxxx %10xxxxxx)
-    if ((ord(p[1]) and %11000000) = %10000000)
-    and ((ord(p[2]) and %11000000) = %10000000) then begin
-      if (ord(c)=%11100000) and (ord(p[1])<=%10011111) then
-        Result:=0; // XSS attack: 3 bytes are mapped to the 1 or 2 byte codes
-      Result:=3;
-    end else
-      Result:=0; // missing following bytes
-  end
-  else if ord(c)<=%11110111 then begin
-    // could be 4 byte character (%11110xxx %10xxxxxx %10xxxxxx %10xxxxxx)
-    if ((ord(p[1]) and %11000000) = %10000000)
-    and ((ord(p[2]) and %11000000) = %10000000)
-    and ((ord(p[3]) and %11000000) = %10000000) then begin
-      if (ord(c)=%11110000) and (ord(p[1])<=%10001111) then
-        Result:=0; // XSS attack: 4 bytes are mapped to the 1-3 byte codes
-      Result:=4;
-    end else
-      Result:=0; // missing following bytes
-  end
-  else begin
-    Result:=0;
-  end;
-end;
-
-function IsValidUTF16(p: PWideChar): integer;
-var
-  c: WideChar;
-begin
-  c:=p^;
-  if c<=#$DC7F then
-    exit(1)
-  else if c<=#$DBFF then begin
-    c:=p[1];
-    if (c>=#$DC00) and (c<=#$DFFF) then
-      exit(2)
-    else
-      exit(0);
-  end else if c<=#$Dfff then begin
-    exit(0);
-  end else
-    exit(1);
-end;
-
-
-Type
-  TAccessComp = class(TComponent); // to access TComponent protected members
-
-  { TPosComponent }
-
-  TPosComponent = class(TObject)
-    FPos: Integer;
-    FComponent: TComponent;
-    constructor Create(APos: Integer; AComponent: TComponent);
-  end;
-
 { TSimpleControlWithInterface }
 
 function TSimpleControlWithInterface.GetComponent: TComponent;
@@ -847,14 +650,6 @@ begin
   if Sender=nil then ;
 end;
 
-{ TPosComponent }
-
-constructor TPosComponent.Create(APos: Integer; AComponent: TComponent);
-begin
-  FPos:=APos;
-  FComponent:=AComponent;
-end;
-
 { TCompBaseTypesCustomStored }
 
 procedure TCompBaseTypesCustomStored.OnClick(Sender: TObject);
@@ -1027,1132 +822,6 @@ begin
   inherited Create(AOwner);
 end;
 
-{ TCompWriterPas }
-
-procedure TCompWriterPas.AddToAncestorList(Component: TComponent);
-begin
-  FAncestors.AddObject(Component.Name,TPosComponent.Create(FAncestors.Count,Component));
-end;
-
-procedure TCompWriterPas.DetermineAncestor(Component: TComponent);
-var
-  i : Integer;
-  C: TComponent;
-begin
-  if Assigned(FAncestors) then
-  begin
-    i:=FAncestors.IndexOf(Component.Name);
-    if i<0 then
-    begin
-      FAncestor:=nil;
-      FAncestorPos:=-1;
-    end
-    else
-      With TPosComponent(FAncestors.Objects[i]) do
-      begin
-        FAncestor:=FComponent;
-        FAncestorPos:=FPos;
-      end;
-  end;
-  if Assigned(FOnFindAncestor) then
-    if (Ancestor=Nil) or (Ancestor is TComponent) then
-    begin
-      C:=TComponent(Ancestor);
-      FOnFindAncestor(Self,Component,Component.Name,C,FRootAncestor);
-      Ancestor:=C;
-    end;
-end;
-
-procedure TCompWriterPas.SetRoot(const AValue: TComponent);
-begin
-  FRoot:=AValue;
-  FLookupRoot:=FRoot;
-end;
-
-procedure TCompWriterPas.WriteComponentData(Instance: TComponent);
-var
-  HasAncestor: Boolean;
-
-  procedure WriteSetParent;
-  var
-    PropName: String;
-  begin
-    if Parent=nil then exit;
-    if Instance.GetParentComponent=nil then exit;
-    if CreatedByAncestor(Instance) then begin
-      // ancestor creates the component
-      // and descendants cannot change parent
-      exit;
-    end;
-    PropName:='';
-    if Assigned(OnGetParentProperty) then
-      OnGetParentProperty(Self,Instance,PropName);
-    if PropName=CWPSkipParentName then
-    else if PropName<>'' then
-      WriteAssign(PropName,GetComponentPath(Parent))
-    else begin
-      NeedAccessClass:=true;
-      WriteStatement(AccessClass+'(TComponent('+Instance.Name+')).SetParentComponent('+GetComponentPath(Parent)+');');
-    end;
-  end;
-
-begin
-  HasAncestor := Assigned(Ancestor) and ((Instance = Root) or
-    (Instance.ClassType = Ancestor.ClassType));
-  if Instance=LookupRoot then begin
-    WriteAssign('Name',''''+Instance.Name+'''');
-    WriteChildren(Instance,cwpcsCreate);
-  end
-  else begin
-    WriteStatement('with '+Instance.Name+' do begin');
-    Indent;
-    if not CreatedByAncestor(Instance) then
-      WriteAssign('Name',''''+Instance.Name+'''');
-    if cwpoSetParentFirst in Options then
-      WriteSetParent;
-  end;
-  WriteProperties(Instance);
-  if not (cwpoSetParentFirst in Options) then
-    WriteSetParent;
-  if not IgnoreChildren then
-    WriteChildren(Instance,cwpcsProperties);
-  if Instance<>LookupRoot then
-  begin
-    Unindent;
-    WriteStatement('end;');
-  end;
-  if HasAncestor and (Ancestor<>FRootAncestor)
-      and (FCurrentPos<>FAncestorPos) then
-  begin
-    if Parent=LookupRoot then
-      WriteStatement('SetChildOrder('+GetComponentPath(Instance)+','+IntToStr(FCurrentPos)+');')
-    else begin
-      NeedAccessClass:=true;
-      WriteStatement(AccessClass+'(TComponent('+GetComponentPath(Parent)+')).SetChildOrder('+GetComponentPath(Instance)+','+IntToStr(FCurrentPos)+');');
-    end;
-  end;
-  Inc(FCurrentPos);
-end;
-
-procedure TCompWriterPas.WriteChildren(Component: TComponent;
-  Step: TCWPChildrenStep);
-var
-  SRoot, SRootA, SParent: TComponent;
-  SList: TStringList;
-  SPos, i, SAncestorPos: Integer;
-begin
-  // Write children list.
-  // While writing children, the ancestor environment must be saved
-  // This is recursive...
-  SRoot:=FRoot;
-  SRootA:=FRootAncestor;
-  SList:=FAncestors;
-  SPos:=FCurrentPos;
-  SAncestorPos:=FAncestorPos;
-  SParent:=Parent;
-  try
-    FAncestors:=Nil;
-    FCurrentPos:=0;
-    FAncestorPos:=-1;
-    FParent:=Component;
-    if csInline in Component.ComponentState then
-      FRoot:=Component;
-    if (FAncestor is TComponent) then
-    begin
-      FAncestors:=TStringList.Create;
-      if csInline in TComponent(FAncestor).ComponentState then
-        FRootAncestor := TComponent(FAncestor);
-      TAccessComp(FAncestor).GetChildren(@AddToAncestorList,FRootAncestor);
-      FAncestors.Sorted:=True;
-    end;
-    try
-      case Step of
-      cwpcsCreate:
-        TAccessComp(Component).GetChildren(@WriteComponentCreate, FRoot);
-      cwpcsProperties:
-        TAccessComp(Component).GetChildren(@WriteComponent, FRoot);
-      end;
-    finally
-      if Assigned(FAncestor) then
-        for i:=0 to FAncestors.Count-1 do
-          FAncestors.Objects[i].Free;
-      FreeAndNil(FAncestors);
-    end;
-  finally
-    FParent:=SParent;
-    FAncestors:=SList;
-    FRoot:=SRoot;
-    FRootAncestor:=SRootA;
-    FCurrentPos:=SPos;
-    FAncestorPos:=SAncestorPos;
-  end;
-end;
-
-procedure TCompWriterPas.WriteProperty(Instance: TPersistent;
-  PropInfo: PPropInfo);
-type
-  TSet = set of 0..31;
-var
-  PropType, CompType: PTypeInfo;
-  ObjValue, AncestorObj: TObject;
-  HasAncestor, BoolValue, DefBoolValue: Boolean;
-  Int32Value, DefValue: longint;
-  PropName, Ident, s, StrValue, DefStrValue, Name, SavedPropPath: String;
-  IntToIdentFn: TIntToIdent;
-  i, j: Integer;
-  Int64Value, DefInt64Value: Int64;
-  FloatValue, DefFloatValue: Extended;
-  MethodValue, DefMethodValue: TMethod;
-  WStrValue, WDefStrValue: WideString;
-  UStrValue, UDefStrValue: UnicodeString;
-  VarValue, DefVarValue: tvardata;
-  aTypeData: PTypeData;
-  Component, AncestorComponent: TComponent;
-  SavedAncestor: TPersistent;
-  IntfValue, AncestorIntf: IInterface;
-  CompRef: IInterfaceComponentReference;
-begin
-  // do not stream properties without getter
-  if not Assigned(PropInfo^.GetProc) then
-    exit;
-
-  // properties without setter are only allowed, if they are csSubComponent
-  PropType := PropInfo^.PropType;
-  if not Assigned(PropInfo^.SetProc) then begin
-    if PropType^.Kind<>tkClass then
-      exit;
-    ObjValue := TObject(GetObjectProp(Instance, PropInfo));
-    if not (ObjValue is TComponent) or
-       not (csSubComponent in TComponent(ObjValue).ComponentStyle) then
-      exit;
-  end;
-
-  { Check if the ancestor can be used }
-  HasAncestor := Assigned(Ancestor) and ((Instance = Root) or
-    (Instance.ClassType = Ancestor.ClassType));
-  PropName:=FPropPath + PropInfo^.Name;
-  {$IFDEF VerboseCompWriterPas}
-  debugln(['TWriter.WriteProperty PropName="',PropName,'" TypeName=',PropType^.Name,' Kind=',GetEnumName(TypeInfo(TTypeKind),ord(PropType^.Kind)),' HasAncestor=',HasAncestor]);
-  {$ENDIF}
-
-  case PropType^.Kind of
-    tkInteger, tkChar, tkEnumeration, tkSet, tkWChar:
-      begin
-        Int32Value := GetOrdProp(Instance, PropInfo);
-        if HasAncestor then
-          DefValue := GetOrdProp(Ancestor, PropInfo)
-        else
-          DefValue := PPropInfo(PropInfo)^.Default;
-        //debugln([PropInfo^.Name,', HasAncestor=',HasAncestor,', Value=',Int32Value,', Default=',DefValue]);
-        if (Int32Value <> DefValue) or (DefValue=longint($80000000)) then
-        begin
-          case PropType^.Kind of
-            tkInteger:
-              begin
-                // Check if this integer has a string identifier
-                IntToIdentFn := FindIntToIdent(PropInfo^.PropType);
-                Ident:='';
-                if Assigned(IntToIdentFn) and IntToIdentFn(Int32Value, Ident) then
-                  // Integer with a custom identifier
-                  // ToDo: check if this is an actual Pascal constant and remember the unit
-                  WriteAssign(PropName,Ident)
-                else begin
-                  // Integer has to be written just as number
-                  aTypeData:=GetTypeData(PropInfo^.PropType);
-                  if aTypeData^.MinValue>=0 then
-                    WriteAssign(PropName,IntToStr(longword(Int32Value)))
-                  else
-                    WriteAssign(PropName,IntToStr(Int32Value));
-                end;
-              end;
-            tkChar:
-              WriteAssign(PropName,GetCharLiteral(Int32Value));
-            tkWChar:
-              WriteAssign(PropName,GetWideCharLiteral(Int32Value));
-            tkSet:
-              begin
-              s:='';
-              CompType:=GetTypeData(PropType)^.CompType;
-              i:=0;
-              while i<32 do
-              begin
-                if i in TSet(Int32Value) then
-                begin
-                  if s<>'' then s:=s+',';
-                  // ToDo: store needed unit
-                  s:=s+GetEnumExpr(CompType, i,false);
-                  j:=i;
-                  while (i<31) and (byte(i+1) in TSet(Int32Value)) do
-                    inc(i);
-                  if i>j then
-                    s:=s+'..'+GetEnumExpr(CompType, i,false);
-                end;
-                inc(i);
-              end;
-              WriteAssign(PropName,'['+s+']');
-              end;
-            tkEnumeration:
-              // ToDo: store needed unit
-              WriteAssign(PropName,GetEnumExpr(PropType, Int32Value,true));
-          end;
-        end;
-      end;
-    tkFloat:
-      begin
-        FloatValue := GetFloatProp(Instance, PropInfo);
-        if HasAncestor then
-          DefFloatValue := GetFloatProp(Ancestor, PropInfo)
-        else
-          begin
-          DefValue :=PropInfo^.Default;
-          DefFloatValue:=PSingle(@PropInfo^.Default)^;
-          end;
-        if (FloatValue<>DefFloatValue) or (DefValue=longint($80000000)) then
-          WriteAssign(PropName,GetFloatLiteral(FloatValue));
-      end;
-    tkMethod:
-      begin
-        MethodValue := GetMethodProp(Instance, PropInfo);
-        if HasAncestor then
-          DefMethodValue := GetMethodProp(Ancestor, PropInfo)
-        else begin
-          DefMethodValue.Data := nil;
-          DefMethodValue.Code := nil;
-        end;
-
-        //debugln(['TCompWriterPas.WriteProperty ',dbgs(MethodValue.Data),' ',dbgs(MethodValue.Code),' ',dbgs(DefMethodValue.Data),' ',dbgs(DefMethodValue.Code)]);
-        if Assigned(OnGetMethodName) then
-        begin
-          if (MethodValue.Code <> DefMethodValue.Code) or
-            (MethodValue.Data <> DefMethodValue.Data) then
-          begin
-            OnGetMethodName(Self,Instance,PropInfo,Ident);
-            OnGetMethodName(Self,Ancestor,PropInfo,s);
-            if Ident<>s then
-            begin
-              if Ident='' then
-                WriteAssign(PropName,'nil')
-              else
-                // ToDo: check nameclash of Ident with current with-do block
-                WriteAssign(PropName,'@'+Ident);
-            end;
-          end;
-        end else begin
-          if (MethodValue.Code <> DefMethodValue.Code) then
-          begin
-            if not Assigned(MethodValue.Code) then
-              Ident:=''
-            else
-              Ident:=FLookupRoot.MethodName(MethodValue.Code);
-            if Ident='' then
-              WriteAssign(PropName,'nil')
-            else
-              // ToDo: check nameclash of Ident with current with-do block
-              WriteAssign(PropName,'@'+Ident);
-          end;
-        end;
-      end;
-    tkSString, tkLString, tkAString:
-      begin
-        StrValue := GetStrProp(Instance, PropInfo);
-        if HasAncestor then
-          DefStrValue := GetStrProp(Ancestor, PropInfo)
-        else
-          SetLength(DefStrValue, 0);
-
-        if StrValue <> DefStrValue then
-          WriteAssign(PropName,GetStringLiteral(StrValue));
-      end;
-    tkWString:
-      begin
-        WStrValue := GetWideStrProp(Instance, PropInfo);
-        if HasAncestor then
-          WDefStrValue := GetWideStrProp(Ancestor, PropInfo)
-        else
-          WDefStrValue := '';
-
-        if WStrValue <> WDefStrValue then
-          WriteAssign(PropName,GetWStringLiteral(PWideChar(WStrValue),length(WStrValue)));
-      end;
-    tkUString:
-      begin
-        UStrValue := GetUnicodeStrProp(Instance, PropInfo);
-        if HasAncestor then
-          UDefStrValue := GetUnicodeStrProp(Ancestor, PropInfo)
-        else
-          SetLength(UDefStrValue, 0);
-
-        if UStrValue <> UDefStrValue then
-          WriteAssign(PropName,GetWStringLiteral(PWideChar(UStrValue),length(UStrValue)));
-      end;
-    tkVariant:
-      begin
-        // Ensure that a Variant manager is installed
-        if not Assigned(VarClearProc) then
-          raise EWriteError.Create(SErrNoVariantSupport);
-
-        VarValue := tvardata(GetVariantProp(Instance, PropInfo));
-        if HasAncestor then
-          DefVarValue := tvardata(GetVariantProp(Ancestor, PropInfo))
-        else
-          FillChar(DefVarValue,sizeof(DefVarValue),0);
-
-        if (CompareByte(VarValue,DefVarValue,sizeof(VarValue)) <> 0) then
-          begin
-            // can't use variant() typecast, pulls in variants unit
-            case VarValue.vtype of
-            varsmallint : WriteAssign(PropName,'SmallInt('+IntToStr(VarValue.vsmallint)+')');
-            varinteger : WriteAssign(PropName,'LongInt('+IntToStr(VarValue.vinteger)+')');
-            varsingle : WriteAssign(PropName,'Single('+GetFloatLiteral(VarValue.vsingle)+')');
-            vardouble : WriteAssign(PropName,'Double('+GetFloatLiteral(VarValue.vdouble)+')');
-            vardate : WriteAssign(PropName,'TDateTime('+GetFloatLiteral(VarValue.vdate)+')');
-            varcurrency : WriteAssign(PropName,'Currency('+GetCurrencyLiteral(VarValue.vcurrency)+')');
-            //varolestr : (volestr : pwidechar);
-            //vardispatch : (vdispatch : pointer);
-            //varerror : (verror : hresult);
-            varboolean : WriteAssign(PropName,GetBoolLiteral(VarValue.vboolean));
-            //varunknown : (vunknown : pointer);
-            // vardecimal : ( : );
-            varshortint : WriteAssign(PropName,'ShortInt('+IntToStr(VarValue.vshortint)+')');
-            varbyte : WriteAssign(PropName,'Byte('+IntToStr(VarValue.vbyte)+')');
-            varword : WriteAssign(PropName,'Word('+IntToStr(VarValue.vword)+')');
-            varlongword : WriteAssign(PropName,'LongWord('+IntToStr(VarValue.vlongword)+')');
-            varint64 : WriteAssign(PropName,'Int64('+IntToStr(VarValue.vint64)+')');
-            varqword : WriteAssign(PropName,'QWord('+IntToStr(VarValue.vqword)+')');
-            // duplicate: varword64
-            varstring : WriteAssign(PropName,GetStringLiteral(AnsiString(VarValue.vstring)));
-            //varany :  (vany : pointer);
-            //vararray : (varray : pvararray);
-            //varbyref : (vpointer : pointer);
-            //varrecord : (vrecord : pointer;precinfo : pointer);
-            else
-              {$IFDEF VerboseCompWriterPas}
-              debugln(['TCompWriterPas.WriteProperty Property="',PropName,'" Kind=',PropType^.Kind,' vtype=',VarValue.vtype]);
-              raise EWriteError.Create('proptype not supported: '+GetEnumName(TypeInfo(PropType^.Kind),ord(PropType^.Kind))+' vtype='+dbgs(VarValue.vtype));
-              {$ENDIF}
-            end;
-            //ToDo WriteVariant(pvariant(@VarValue)^);
-          end;
-      end;
-    tkClass:
-      begin
-        ObjValue := TObject(GetObjectProp(Instance, PropInfo));
-        if HasAncestor then
-        begin
-          AncestorObj := TObject(GetObjectProp(Ancestor, PropInfo));
-          if (AncestorObj is TComponent) and
-             (ObjValue is TComponent) then
-          begin
-            //debugln(['TWriter.WriteProperty AncestorObj=',TComponent(AncestorObj).Name,' OwnerFit=',TComponent(AncestorObj).Owner = FRootAncestor,' ',TComponent(ObjValue).Name,' OwnerFit=',TComponent(ObjValue).Owner = Root]);
-            if (AncestorObj<>ObjValue) and
-               (TComponent(AncestorObj).Owner = FRootAncestor) and
-               (TComponent(ObjValue).Owner = Root) and
-               SameText(TComponent(AncestorObj).Name,TComponent(ObjValue).Name) then
-            begin
-              // value is a component, and it is the same as in the ancestor
-              // Note: a descendant has new instances with same names
-              AncestorObj := ObjValue;
-            end;
-          end;
-        end else
-          AncestorObj := nil;
-
-        if not Assigned(ObjValue) then
-        begin
-          if ObjValue <> AncestorObj then
-            WriteAssign(PropName,'Nil');
-        end
-        else if ObjValue.InheritsFrom(TPersistent) then
-        begin
-          // Subcomponents are streamed the same way as persistents
-          if ObjValue.InheritsFrom(TComponent)
-            and ((not (csSubComponent in TComponent(ObjValue).ComponentStyle))
-                 or ((TComponent(ObjValue).Owner<>Instance) and (TComponent(ObjValue).Owner<>Nil))) then
-          begin
-            Component := TComponent(ObjValue);
-            if (ObjValue <> AncestorObj)
-                and not (csTransient in Component.ComponentStyle) then
-            begin
-              // set property value
-              Name:=GetComponentPath(Component);
-              if Name='' then
-                raise EWriteError.Create('cannot write property "'+DbgSName(Instance)+'.'+PropName+'"');
-              WriteAssign(PropName,Name);
-            end; //(ObjValue <> AncestorObj)
-          end // ObjValue.InheritsFrom(TComponent)
-          else
-          begin
-            // keep property value, set sub properties recursively with full path
-            // e.g. Font.Size:=5;
-            SavedAncestor := Ancestor;
-            SavedPropPath := FPropPath;
-            try
-              FPropPath := FPropPath + PPropInfo(PropInfo)^.Name + '.';
-              if HasAncestor then
-                Ancestor := TPersistent(GetObjectProp(Ancestor, PropInfo));
-              WriteProperties(TPersistent(ObjValue));
-            finally
-              Ancestor := SavedAncestor;
-              FPropPath := SavedPropPath;
-            end;
-            if ObjValue.InheritsFrom(TCollection) then
-            begin
-              if (not HasAncestor) or (not CollectionsEqual(TCollection(ObjValue),
-                TCollection(GetObjectProp(Ancestor, PropInfo)),Root,RootAncestor)) then
-              begin
-                // create collection items
-                SavedPropPath := FPropPath;
-                try
-                  SetLength(FPropPath, 0);
-                  WriteCollection(PropName,TCollection(ObjValue));
-                finally
-                  FPropPath := SavedPropPath;
-                end;
-              end;
-            end // TCollection
-          end;
-        end; // Inheritsfrom(TPersistent)
-      end;
-    tkInt64, tkQWord:
-      begin
-        Int64Value := GetInt64Prop(Instance, PropInfo);
-        if HasAncestor then
-          DefInt64Value := GetInt64Prop(Ancestor, PropInfo)
-        else
-          DefInt64Value := 0;
-        if Int64Value <> DefInt64Value then
-          if PropType^.Kind=tkInt64 then
-            WriteAssign(PropName,IntToStr(Int64Value))
-          else
-            WriteAssign(PropName,IntToStr(QWord(Int64Value)));
-      end;
-    tkBool:
-      begin
-        BoolValue := GetOrdProp(Instance, PropInfo)<>0;
-        if HasAncestor then
-          DefBoolValue := GetOrdProp(Ancestor, PropInfo)<>0
-        else
-          DefBoolValue := PropInfo^.Default<>0;
-        DefValue:=PropInfo^.Default;
-        //debugln([PropInfo^.Name,', HasAncestor=',HasAncestor,', BoolValue=',BoolValue,', DefBoolValue=',DefBoolValue,' Default=',DefValue]);
-        if (BoolValue<>DefBoolValue) or (DefValue=longint($80000000)) then
-          WriteAssign(PropName,GetBoolLiteral(BoolValue));
-      end;
-    tkInterface:
-      begin
-        IntfValue := GetInterfaceProp(Instance, PropInfo);
-        if not Assigned(IntfValue) then
-          WriteAssign(PropName,'Nil')
-        else if Supports(IntfValue, IInterfaceComponentReference, CompRef) then
-        begin
-          Component := CompRef.GetComponent;
-          AncestorComponent := nil;
-          if HasAncestor then
-          begin
-            AncestorIntf := GetInterfaceProp(Instance, PropInfo);
-            if Supports(AncestorIntf, IInterfaceComponentReference, CompRef) then
-            begin
-              AncestorComponent := CompRef.GetComponent;
-              if (AncestorComponent<>Component) and
-                 (AncestorComponent.Owner = FRootAncestor) and
-                 (Component.Owner = Root) and
-                 SameText(AncestorComponent.Name,Component.Name) then
-              begin
-                // value is a component, and it is the same as in the ancestor
-                // Note: a descendant has new instances with same names
-                AncestorComponent := Component;
-              end;
-            end;
-          end;
-
-          if Component<>AncestorComponent then
-          begin
-            Name:=GetComponentPath(Component);
-            if Name='' then
-              raise EWriteError.Create('cannot write property "'+DbgSName(Instance)+'.'+PropName+'"');
-            WriteAssign(PropName,Name);
-          end;
-        end else
-          raise EWriteError.Create('interface property "'+PropName+'" does not support IInterfaceComponentReference');
-      end;
-  else
-    {$IFDEF VerboseCompWriterPas}
-    debugln(['TCompWriterPas.WriteProperty Property="',PropName,'" Kind=',PropType^.Kind]);
-    raise EWriteError.Create('proptype not supported: '+GetEnumName(TypeInfo(PropType^.Kind),ord(PropType^.Kind)));
-    {$ENDIF}
-  end;
-end;
-
-procedure TCompWriterPas.WriteProperties(Instance: TPersistent);
-var
-  PropCount, i: integer;
-  PropList: PPropList;
-begin
-  PropCount:=GetPropList(Instance,PropList);
-  if PropCount>0 then
-    try
-      for i := 0 to PropCount-1 do
-        if IsStoredProp(Instance,PropList^[i]) then
-          WriteProperty(Instance,PropList^[i]);
-    finally
-      Freemem(PropList);
-    end;
-  WriteDefineProperties(Instance);
-end;
-
-procedure TCompWriterPas.WriteDefineProperties(Instance: TPersistent);
-var
-  Col: Integer;
-  InLit, NeedComma: boolean;
-
-  function CheckCol(aCol: integer): boolean;
-  begin
-    if (Col<=CurIndent+1) or (aCol<=MaxColumn) then exit(true);
-    Result:=false;
-    if NeedComma then
-      Write(',');
-    WriteLn;
-    WriteIndent;
-    Col:=CurIndent+1;
-    NeedComma:=false;
-  end;
-
-var
-  HasAncestor: Boolean;
-  DefValue, Value: LongInt;
-  aStream: TMemoryStream;
-  BinWriter: TWriter;
-  s: String;
-  p: PChar;
-  c: Char;
-  i: Integer;
-begin
-  if Instance is TComponent then begin
-    HasAncestor := Assigned(Ancestor) and ((Instance = Root) or
-      (Instance.ClassType = Ancestor.ClassType));
-    if HasAncestor then
-      DefValue := TComponent(Ancestor).DesignInfo
-    else
-      DefValue := 0;
-    Value:=TComponent(Instance).DesignInfo;
-    if Value<>DefValue then
-      // Note: DesignInfo contains Left/Top. On BigEndian systems the order
-      // is reversed, which is already handled in TComponent.DefineProperties
-      // -> it is the same longint value on Little and BigEndian system
-      WriteAssign(FPropPath + 'DesignInfo',IntToStr(Value));
-  end;
-
-  if TMethod(@TAccessComp(Instance).DefineProperties).Code<>FDefaultDefineProperties
-  then begin
-    // this class has overriden DefineProperties
-    aStream:=TMemoryStream.Create;
-    BinWriter:=TWriter.Create(aStream,1024);
-    try
-      BinWriter.Root:=Root;
-      BinWriter.RootAncestor:=RootAncestor;
-      BinWriter.Ancestor:=Ancestor;
-      BinWriter.IgnoreChildren:=IgnoreChildren;
-      BinWriter.OnWriteMethodProperty:=OnWriteMethodProperty;
-      BinWriter.OnWriteStringProperty:=OnWriteStringProperty;
-      TAccessComp(Instance).DefineProperties(BinWriter);
-      BinWriter.WriteListEnd;
-      FreeAndNil(BinWriter); // flush buffer to stream
-      if aStream.Size>1 then
-      begin
-        WriteIndent;
-        if PropertyPath<>'' then
-        begin
-          s:=PropertyPath;
-          Delete(s,length(s),1); // chomp '.'
-        end
-        else if Instance is TComponent then
-          s:=GetComponentPath(TComponent(Instance))
-        else
-          s:='';
-        if s='' then
-          raise EWriteError.Create('cannot write DefineProperties of "'+DbgSName(Instance)+'"');
-
-        s:=ExecCustomData+'('+s+',[';
-        Write(s);
-        Col:=CurIndent+length(s)+1;
-        Indent;
-        NeedComma:=false;
-        CheckCol(Col);
-        InLit:=false;
-        p:=PChar(aStream.Memory);
-        for i:=0 to aStream.Size-1 do
-        begin
-          c:=p^;
-          if c in [#32..#126] then
-          begin
-            if (not InLit) or (Col+2>MaxColumn) then
-            begin
-              if InLit then
-                Write('''');
-              CheckCol(Col+3);
-              InLit:=true;
-              Write('''');
-              inc(Col);
-            end;
-            Write(c);
-            inc(Col);
-            NeedComma:=true;
-          end else begin
-            if InLit then
-            begin
-              Write('''');
-              inc(Col);
-              InLit:=false;
-            end;
-            s:='#'+IntToStr(ord(c));
-            CheckCol(Col+length(s));
-            Write(s);
-            inc(Col,length(s));
-            NeedComma:=true;
-          end;
-          inc(p);
-        end;
-        if InLit then
-          Write('''');
-        Write(']);');
-        WriteLn;
-        Unindent;
-      end;
-    finally
-      BinWriter.Free;
-      aStream.Free;
-    end;
-  end;
-end;
-
-procedure TCompWriterPas.WriteCollection(PropName: string;
-  Collection: TCollection);
-var
-  i: Integer;
-  Item: TCollectionItem;
-begin
-  WriteStatement(PropName+'.Clear;');
-  for i:=0 to Collection.Count-1 do
-  begin
-    Item:=Collection.Items[i];
-    WriteStatement('with '+Item.ClassName+'('+PropName+'.Add) do begin');
-    Indent;
-    WriteProperties(Item);
-    Unindent;
-    WriteStatement('end;');
-  end;
-end;
-
-function TCompWriterPas.GetComponentPath(Component: TComponent): string;
-var
-  Name: String;
-  C: TComponent;
-begin
-  if Component=nil then
-    Result:='Nil'
-  else if Component=LookupRoot then
-    Result:='Self'
-  else begin
-    Name:= '';
-    C:=Component;
-    While (C<>Nil) do
-    begin
-      if (Name<>'') Then
-        Name:='.'+Name;
-      if C.Owner = LookupRoot then
-      begin
-        Name := C.Name+Name;
-        break;
-      end
-      else if C = LookupRoot then
-      begin
-        Name := 'Self'+Name;
-        break;
-      end else if C.Name='' then
-        exit('');
-      Name:=C.Name+Name;
-      // ToDo: store used unit
-      C:=C.Owner;
-    end;
-    Result:=Name;
-  end;
-end;
-
-function TCompWriterPas.GetBoolLiteral(b: boolean): string;
-begin
-  if b then
-    Result:='True'
-  else
-    Result:='False';
-end;
-
-function TCompWriterPas.GetCharLiteral(c: integer): string;
-begin
-  case c of
-  32..126: Result:=''''+chr(c)+'''';
-  else     Result:='#'+IntToStr(c);
-  end;
-end;
-
-function TCompWriterPas.GetWideCharLiteral(c: integer): string;
-begin
-  case c of
-  32..126:
-    Result:=''''+Chr(c)+'''';
-  0..31,127..255,$D800..$DFFF:
-    Result:='#'+IntToStr(c);
-  else
-    if cwpoSrcCodepageUTF8 in Options then
-      Result:=''''+UTF16ToUTF8(WideChar(c))+''''
-    else
-      Result:='#'+IntToStr(c);
-  end;
-end;
-
-function TCompWriterPas.GetStringLiteral(const s: string): string;
-
-  function IsSpecialChar(p: PChar): boolean;
-  const
-    SpecialChars = [#0..#31,#127,#255];
-  begin
-    Result:=(p^ in SpecialChars) or (IsValidUTF8(p)=0);
-  end;
-
-var
-  InLit: Boolean;
-  p, StartP: PChar;
-  c: Char;
-begin
-  Result:='';
-  if s='' then exit;
-  InLit:=false;
-  p:=PChar(s);
-  repeat
-    c:=p^;
-    if (c=#0) and (p-PChar(s)=length(s)) then
-      break
-    else if IsSpecialChar(p) then
-    begin
-      if InLit then begin
-        InLit:=false;
-        Result:=Result+'''';
-      end;
-      Result:=Result+'#'+IntToStr(ord(c));
-      inc(p);
-    end else begin
-      if not InLit then begin
-        InLit:=true;
-        Result:=Result+'''';
-      end;
-      if c='''' then begin
-        Result:=Result+'''''';
-        inc(p);
-      end else begin
-        StartP:=p;
-        repeat
-          inc(p,IsValidUTF8(p));
-          c:=p^;
-        until ((c=#0) and (p-PChar(s)=length(s))) or IsSpecialChar(p) or (c='''');
-        Result:=Result+copy(s,StartP-PChar(s)+1,p-StartP);
-      end;
-    end;
-  until false;
-  if InLit then
-    Result:=Result+'''';
-end;
-
-function TCompWriterPas.GetWStringLiteral(p: PWideChar; Count: integer): string;
-
-  function IsSpecialChar(w: PWideChar): boolean;
-  const
-    SpecialChars = [#0..#31,#127];
-  begin
-    if w^ in SpecialChars then exit(true);
-    if cwpoSrcCodepageUTF8 in FOptions then begin
-      Result:=IsValidUTF16(w)=0;
-    end else begin
-      Result:=w^>=#$7f;
-    end;
-  end;
-
-var
-  InLit: Boolean;
-  c: WideChar;
-  FirstP, StartP: PWideChar;
-  AddLen: SizeUInt;
-  s: string;
-  OldLen: Integer;
-begin
-  Result:='';
-  if Count=0 then exit;
-  FirstP:=p;
-  InLit:=false;
-  s:='';
-  repeat
-    c:=p^;
-    if (c=#0) and (p-FirstP=Count) then
-      break
-    else if IsSpecialChar(p) then
-    begin
-      if InLit then begin
-        InLit:=false;
-        Result:=Result+'''';
-      end;
-      Result:=Result+'#'+Format('%.4d',[ord(c)]);
-      inc(p);
-    end else begin
-      if not InLit then begin
-        InLit:=true;
-        Result:=Result+'''';
-      end;
-      if c='''' then begin
-        Result:=Result+'''''';
-        inc(p);
-      end else begin
-        StartP:=p;
-        repeat
-          inc(p,IsValidUTF16(p));
-          c:=p^;
-        until ((c=#0) and (p-FirstP=Count)) or IsSpecialChar(p) or (c='''');
-        AddLen:=p-StartP;
-        if length(s)<AddLen*3 then SetLength(s,AddLen*3);
-        if ConvertUTF16ToUTF8(@s[1],length(s),StartP,AddLen,
-            [toInvalidCharError,toUnfinishedCharError],AddLen)=trNoError then
-          dec(AddLen); // omit #0
-        OldLen:=length(Result);
-        SetLength(Result,OldLen+AddLen);
-        System.Move(s[1],Result[OldLen+1],AddLen);
-      end;
-    end;
-  until false;
-  if InLit then
-    Result:=Result+'''';
-end;
-
-function TCompWriterPas.GetFloatLiteral(const e: Extended): string;
-var
-  s: String;
-begin
-  s:='';
-  str(e,s);
-  Result:=ShortenFloat(s);
-end;
-
-function TCompWriterPas.GetCurrencyLiteral(const c: currency): string;
-var
-  i: int64 absolute c;
-var
-  s: String;
-begin
-  if i mod 10000=0 then
-    s:=IntToStr(i div 10000)
-  else begin
-    s:=IntToStr(i);
-    while length(s)<4 do
-      s:='0'+s;
-    if length(s)=4 then
-      s:='0.'+s
-    else
-      system.insert('.',s,length(s)-3);
-  end;
-  Result:=s;
-end;
-
-function TCompWriterPas.ShortenFloat(s: string): string;
-var
-  p, i: SizeInt;
-begin
-  // remove unneeded leading 0 of exponent
-  p:=Pos('E',s);
-  if p<1 then exit;
-  i:=p;
-  if s[i+1]='+' then inc(i);
-  while (i<length(s)) and (s[i+1]='0') do
-    inc(i);
-  if i>p then
-    if i=length(s) then
-      Delete(s,p,i-p+1) // delete whole exponent
-    else
-      Delete(s,p+1,i-p);
-  // remove trailing 0 of base
-  i:=p;
-  while (i>2) and (s[i-1]='0') do
-    dec(i);
-  if not (s[i-1] in ['0'..'9']) then inc(i);
-  if i<p then
-    Delete(s,i,p-i);
-  // remove leading space
-  if s[1]=' ' then
-    Delete(s,1,1);
-  Result:=s;
-end;
-
-function TCompWriterPas.GetEnumExpr(TypeInfo: PTypeInfo; Value: integer;
-  AllowOutOfRange: boolean): string;
-var
-  PT: PTypeData;
-begin
-  PT:=GetTypeData(TypeInfo);
-  if (Value>=PT^.MinValue) and (Value<=PT^.MaxValue) then
-    case TypeInfo^.Kind of
-    tkBool: Result:=GetBoolLiteral(Value=ord(true));
-    tkChar: Result:=GetCharLiteral(Value);
-    tkEnumeration: Result:=GetEnumName(TypeInfo,Value);
-    else Result:=IntToStr(Value);
-    end
-  else if AllowOutOfRange then
-    Result:=TypeInfo^.Name+'('+IntToStr(Value)+')'
-  else
-    raise EWriteError.Create('enum '+IntToStr(Value)+' is out of range of type "'+TypeInfo^.Name+'"');
-end;
-
-constructor TCompWriterPas.Create(AStream: TStream);
-var
-  C: TAccessComp;
-begin
-  FIndentStep:=2;
-  FStream:=AStream;
-  FLineEnding:=system.LineEnding;
-  FAssignOp:=':=';
-  FSignature:=CSPDefaultSignature;
-  FMaxColumn:=CSPDefaultMaxColumn;
-  FExecCustomData:=CSPDefaultExecCustomLFM;
-  FAccessClass:=CSPDefaultAccessClass;
-  C:=TAccessComp.Create(nil);
-  FDefaultDefineProperties:=TMethod(@C.DefineProperties).Code;
-  C.Free;
-end;
-
-destructor TCompWriterPas.Destroy;
-begin
-  inherited Destroy;
-end;
-
-procedure TCompWriterPas.WriteComponentCreate(Component: TComponent);
-var
-  OldAncestor: TPersistent;
-  OldRoot, OldRootAncestor: TComponent;
-  HasAncestor: boolean;
-begin
-  if (Component=LookupRoot) then exit;
-  OldRoot:=FRoot;
-  OldAncestor:=FAncestor;
-  OldRootAncestor:=FRootAncestor;
-  Try
-    DetermineAncestor(Component);
-    HasAncestor:=FAncestor is TComponent;
-    if not CreatedByAncestor(Component) then
-      WriteAssign(Component.Name,Component.ClassName+'.Create(Self)');
-    if HasAncestor then begin
-      if (csInline in Component.ComponentState)
-      and not (csInline in TComponent(Ancestor).ComponentState) then
-      begin
-        NeedAccessClass:=true;
-        WriteStatement(AccessClass+'(TComponent('+Component.Name+')).SetInline('+GetBoolLiteral(true)+');');
-      end;
-      if (csAncestor in Component.ComponentState)
-      and not (csAncestor in TComponent(Ancestor).ComponentState) then
-      begin
-        NeedAccessClass:=true;
-        WriteStatement(AccessClass+'(TComponent('+Component.Name+')).SetAncestor('+GetBoolLiteral(true)+');');
-      end;
-    end;
-    if not IgnoreChildren then
-      WriteChildren(Component,cwpcsCreate);
-  finally
-    FAncestor:=OldAncestor;
-    FRoot:=OldRoot;
-    FRootAncestor:=OldRootAncestor;
-  end;
-end;
-
-procedure TCompWriterPas.WriteComponent(Component: TComponent);
-var
-  OldAncestor : TPersistent;
-  OldRoot, OldRootAncestor : TComponent;
-begin
-  OldRoot:=FRoot;
-  OldAncestor:=FAncestor;
-  OldRootAncestor:=FRootAncestor;
-  Try
-    // Component.ComponentState:=Component.FComponentState+[csWriting];
-    DetermineAncestor(Component);
-    WriteComponentData(Component);
-  finally
-    FAncestor:=OldAncestor;
-    FRoot:=OldRoot;
-    FRootAncestor:=OldRootAncestor;
-  end;
-end;
-
-procedure TCompWriterPas.WriteDescendant(ARoot: TComponent; AAncestor: TComponent);
-begin
-  FRoot := ARoot;
-  FAncestor := AAncestor;
-  FRootAncestor := AAncestor;
-  FLookupRoot := ARoot;
-  FNeedAccessClass := false;
-  if not (cwpoNoSignature in Options) then
-    WriteSignature;
-  WriteComponent(ARoot);
-end;
-
-procedure TCompWriterPas.WriteSignature;
-begin
-  WriteStatement(Signature);
-end;
-
-procedure TCompWriterPas.WriteIndent;
-begin
-  Write(StringOfChar(' ',CurIndent));
-end;
-
-procedure TCompWriterPas.Write(const s: string);
-begin
-  if s='' then exit;
-  FStream.Write(s[1],length(s));
-end;
-
-procedure TCompWriterPas.WriteLn;
-begin
-  Write(LineEnding);
-end;
-
-procedure TCompWriterPas.WriteStatement(const s: string);
-begin
-  WriteIndent;
-  Write(s);
-  WriteLn;
-end;
-
-procedure TCompWriterPas.WriteAssign(const LHS, RHS: string);
-begin
-  WriteIndent;
-  Write(LHS);
-  Write(AssignOp);
-  Write(RHS);
-  Write(';');
-  WriteLn;
-end;
-
-function TCompWriterPas.CreatedByAncestor(Component: TComponent): boolean;
-begin
-  Result:=(FAncestor is TComponent)
-    and (TComponent(FAncestor).Owner = FRootAncestor)
-    and (Component.Owner = Root)
-    and SameText(Component.Name,TComponent(FAncestor).Name)
-end;
-
-procedure TCompWriterPas.Indent;
-begin
-  CurIndent:=CurIndent+IndentStep;
-end;
-
-procedure TCompWriterPas.Unindent;
-begin
-  CurIndent:=CurIndent-IndentStep;
-end;
-
 { TCompBaseTypes }
 
 function TCompBaseTypes.isACurrencyStored: Boolean;
diff --git a/components/lazutils/compwriterpas.pas b/components/lazutils/compwriterpas.pas
index 9d3ba8a22f..054a8d5b55 100644
--- a/components/lazutils/compwriterpas.pas
+++ b/components/lazutils/compwriterpas.pas
@@ -34,86 +34,137 @@ unit CompWriterPas;
 
 {$mode objfpc}{$H+}
 
+{off $DEFINE VerboseCompWriterPas}
+
 interface
 
 uses
-  Classes, SysUtils, typinfo, LazLoggerBase;
+  Classes, SysUtils, typinfo, RtlConsts, LazLoggerBase, LazUTF8;
 
+const
+  // Component serialized as Pascal
+  CSPDefaultSignature = '// Component serialized as Pascal';
+  CSPDefaultSignatureBegin = CSPDefaultSignature+' - Begin';
+  CSPDefaultSignatureEnd = CSPDefaultSignature+' - End';
+  CSPDefaultAccessClass = 'TPasStreamAccess';
+  CSPDefaultExecCustomLFM = 'ExecCustomLFM';
+  CSPDefaultMaxColumn = 80;
+  CWPSkipParentName = '-';
 type
+  TCWPFindAncestorEvent = procedure(Sender: TObject; Component: TComponent;
+    const Name: string; var Ancestor, RootAncestor: TComponent) of object;
+  TCWPGetMethodName = procedure(Sender: TObject; Instance: TPersistent;
+    PropInfo: PPropInfo; out Name: String) of object;
+  TCWPGetParentProperty = procedure(Sender: TObject; Component: TComponent;
+    var PropName: string) of object;
 
-  TPASObjectWriterStackElType = (
-    elUnknown,
-    elComponent,
-    elPropertyList,
-    elProperty,
-    elChildrenList,
-    elCollection,
-    elCollectionItem
+  TCWPOption = (
+    cwpoNoSignature,
+    cwpoSetParentFirst,  // add "Parent:=" before properties
+    cwpoSrcCodepageUTF8
     );
+  TCWPOptions = set of TCWPOption;
 
-  TPASObjectWriterStackEl = class
-  public
-    ElementName, ElementClass: string;
-    ElemType: TPASObjectWriterStackElType;
-  end;
+  TCWPChildrenStep = (
+    cwpcsCreate,
+    cwpcsProperties
+  );
 
-  { TPASObjectWriter }
+  { TCompWriterPas }
 
-  TPASObjectWriter = class(TAbstractObjectWriter)
+  TCompWriterPas = class
   private
+    FAccessClass: string;
+    FAncestor: TPersistent;
+    FAncestorPos: Integer;
+    FAncestors: TStringList;
+    FAssignOp: String;
+    FCurIndent: integer;
+    FCurrentPos: Integer;
+    FDefaultDefineProperties: CodePointer;
+    FExecCustomData: string;
+    FIgnoreChildren: Boolean;
+    FIndentStep: integer;
+    FLineEnding: string;
+    FLookupRoot: TComponent;
+    FMaxColumn: integer;
+    FNeedAccessClass: boolean;
+    FOnFindAncestor: TCWPFindAncestorEvent;
+    FOnGetMethodName: TCWPGetMethodName;
+    FOnGetParentProperty: TCWPGetParentProperty;
+    FOnWriteMethodProperty: TWriteMethodPropertyEvent;
+    FOnWriteStringProperty: TReadWriteStringPropertyEvent;
+    FOptions: TCWPOptions;
+    FParent: TComponent;
+    FPropPath: string;
+    FRoot: TComponent;
+    FRootAncestor: TComponent;
+    FSignature: String;
     FStream: TStream;
-    FStack: TFPList; // stack of TPASObjectWriterStackEl
-    StackEl: TPASObjectWriterStackEl;
-    procedure StackPush(const ElementName: string;
-                        ElementType: TPASObjectWriterStackElType);
-    procedure StackPop;
-    procedure WriteIndent;
-    procedure WriteAssignment(PropertyName, Value: string);
-    procedure WritePropertyAssignment(Value: string);
-    procedure WriteCreateComponent(CompName, CompClass, CompOwner: string);
-    procedure WriteWithDoBegin(Expr: string);
-    procedure WriteEnd;
-
-    function StringToConstant(s: string): string;
+    procedure AddToAncestorList(Component: TComponent);
+    procedure DetermineAncestor(Component: TComponent);
+    procedure SetRoot(const AValue: TComponent);
+    procedure WriteComponentData(Instance: TComponent);
+    procedure WriteChildren(Component: TComponent; Step: TCWPChildrenStep);
+    procedure WriteProperty(Instance: TPersistent; PropInfo: PPropInfo);
+    procedure WriteProperties(Instance: TPersistent);
+    procedure WriteDefineProperties(Instance: TPersistent);
+    procedure WriteCollection(PropName: string; Collection: TCollection);
+    function ShortenFloat(s: string): string;
   public
     constructor Create(AStream: TStream);
-
-    { Begin/End markers. Those ones who don't have an end indicator, use
-      "EndList", after the occurrence named in the comment. Note that this
-      only counts for "EndList" calls on the same level; each BeginXXX call
-      increases the current level. }
-    procedure BeginCollection; override;{ Ends with the next "EndList" }
-    procedure BeginComponent(Component: TComponent; Flags: TFilerFlags;
-      ChildPos: Integer); override;{ Ends after the second "EndList" }
-    procedure BeginList; override;
-    procedure EndList; override;
-    procedure BeginProperty(const PropName: String); override;
-    procedure EndProperty; override;
-
-    procedure WriteBinary(const Buffer; Count: Longint); override;
-    procedure WriteBoolean(Value: Boolean); override;
-    // procedure WriteChar(Value: Char);
-    procedure WriteFloat(const Value: Extended); override;
-    {$IF FPC_FULLVERSION >= 30000}
-    procedure WriteSignature; override;
-    {$ENDIF}
-    procedure WriteSingle(const Value: Single); override;
-    procedure WriteCurrency(const Value: Currency); override;
-    procedure WriteDate(const Value: TDateTime); override;
-    procedure WriteIdent(const Ident: string); override;
-    procedure WriteInteger(Value: Int64); override;
-    procedure WriteMethodName(const Name: String); override;
-    procedure WriteSet(Value: LongInt; SetType: Pointer); override;
-    procedure WriteString(const Value: String); override;
-    procedure WriteWideString(const Value: WideString); override;
-    procedure WriteUInt64(Value: QWord); override;
-    procedure WriteUnicodeString(const Value: UnicodeString); override;
-    procedure WriteVariant(const VarValue: Variant); override;
-    procedure Write(const {%H-}Buffer; {%H-}Count: Longint); override;
-  public
+    destructor Destroy; override;
+    procedure WriteComponentCreate(Component: TComponent);
+    procedure WriteComponent(Component: TComponent);
+    procedure WriteDescendant(ARoot: TComponent; AAncestor: TComponent = nil);
+    procedure WriteSignature;
+    procedure WriteIndent;
+    procedure Write(const s: string);
+    procedure WriteLn;
+    procedure WriteStatement(const s: string);
+    procedure WriteAssign(const LHS, RHS: string);
+    function GetComponentPath(Component: TComponent): string;
+    function GetBoolLiteral(b: boolean): string;
+    function GetCharLiteral(c: integer): string;
+    function GetWideCharLiteral(c: integer): string;
+    function GetStringLiteral(const s: string): string;
+    function GetWStringLiteral(p: PWideChar; Count: integer): string;
+    function GetFloatLiteral(const e: Extended): string;
+    function GetCurrencyLiteral(const c: currency): string;
+    function GetEnumExpr(TypeInfo: PTypeInfo; Value: integer;
+      AllowOutOfRange: boolean): string;
+    function CreatedByAncestor(Component: TComponent): boolean;
+    procedure Indent;
+    procedure Unindent;
     property Stream: TStream read FStream;
+    property Root: TComponent read FRoot write SetRoot;
+    property LookupRoot: TComponent read FLookupRoot;
+    property Ancestor: TPersistent read FAncestor write FAncestor;
+    property RootAncestor: TComponent read FRootAncestor write FRootAncestor;
+    property Parent: TComponent read FParent;
+    property OnFindAncestor: TCWPFindAncestorEvent read FOnFindAncestor write FOnFindAncestor;
+    property OnGetMethodName: TCWPGetMethodName read FOnGetMethodName write FOnGetMethodName;
+    property PropertyPath: string read FPropPath;
+    property CurIndent: integer read FCurIndent write FCurIndent;
+    property IndentStep: integer read FIndentStep write FIndentStep;
+    property Options: TCWPOptions read FOptions write FOptions;
+    property IgnoreChildren: Boolean read FIgnoreChildren write FIgnoreChildren;
+    property OnGetParentProperty: TCWPGetParentProperty read FOnGetParentProperty write FOnGetParentProperty;
+  public
+    // for custom DefineProperties
+    property OnWriteMethodProperty: TWriteMethodPropertyEvent read FOnWriteMethodProperty write FOnWriteMethodProperty;
+    property OnWriteStringProperty: TReadWriteStringPropertyEvent read FOnWriteStringProperty write FOnWriteStringProperty;
+  public
+    // code snippets
+    property LineEnding: string read FLineEnding write FLineEnding;
+    property AssignOp: String read FAssignOp write FAssignOp;
+    property Signature: String read FSignature write FSignature;
+    property AccessClass: string read FAccessClass
+      write FAccessClass; // classname used to access protected TComponent members like SetChildOrder
+    property NeedAccessClass: boolean read FNeedAccessClass write FNeedAccessClass; // some property needed AccessClass
+    property ExecCustomData: string read FExecCustomData write FExecCustomData;
+    property MaxColumn: integer read FMaxColumn write FMaxColumn default CSPDefaultMaxColumn;
   end;
-  TPASObjectWriterClass = class of TPASObjectWriter;
 
 procedure WriteComponentToPasStream(AComponent: TComponent; AStream: TStream);
 
@@ -121,392 +172,1224 @@ implementation
 
 procedure WriteComponentToPasStream(AComponent: TComponent; AStream: TStream);
 var
-  Driver: TPASObjectWriter;
-  Writer: TWriter;
+  Writer: TCompWriterPas;
 begin
-  Driver:=nil;
-  Writer:=nil;
+  Writer:=TCompWriterPas.Create(AStream);
   try
-    Driver:=TPASObjectWriter.Create(AStream);
-    Writer:=TWriter.Create(Driver);
-    Writer.WriteDescendent(AComponent,nil);
+    Writer.WriteDescendant(AComponent);
   finally
     Writer.Free;
-    Driver.Free;
   end;
 end;
 
-procedure TPASObjectWriter.StackPush(const ElementName: string;
-  ElementType: TPASObjectWriterStackElType);
-begin
-  if Assigned(FStack) then
-  begin
-    // append to stack
-    FStack.Add(StackEl);
-  end else
-  begin
-    // start stack
-    FStack := TFPList.Create;
-  end;
-  // create element
-  StackEl := TPASObjectWriterStackEl.Create;
-  StackEl.ElementName:=ElementName;
-  StackEl.ElemType:=ElementType;
-  DebugLn('TPASObjectWriter.StackPush Element="',ElementName,'" FStack.Count=',dbgs(FStack.Count));
-end;
-
-procedure TPASObjectWriter.StackPop;
-begin
-  DebugLn('TPASObjectWriter.StackPop ',dbgs(FStack.Count),' ',StackEl.ElementName);
-  if FStack=nil then
-    raise Exception.Create('TPASObjectWriter.StackPop stack empty');
-  StackEl.Free;
-  if FStack.Count > 0 then
-  begin
-    StackEl := TPASObjectWriterStackEl(FStack[FStack.Count - 1]);
-    FStack.Delete(FStack.Count - 1);
-  end else
-  begin
-    FStack.Free;
-    FStack := nil;
-    StackEl := nil;
-  end;
-end;
-
-procedure TPASObjectWriter.WriteIndent;
-const
-  Indent: PChar = '  ';
+function IsValidUTF8(p: PChar): integer;
 var
-  i: Integer;
-  Item: TPASObjectWriterStackEl;
+  c: Char;
 begin
-  if StackEl<>nil then begin
-    if StackEl.ElemType in [elComponent,elCollection,elCollectionItem] then
-      Stream.Write(Indent^,2);
+  c:=p^;
+  if ord(c)<%10000000 then begin
+    // regular single byte ASCII character (#0 is a character, this is Pascal ;)
+    Result:=1;
+  end else if ord(c)<=%11000001 then begin
+    // single byte character, between valid UTF-8 encodings
+    // %11000000 and %11000001 map 2 byte to #0..#128, which is invalid and used for XSS attacks
+    Result:=0;
+  end else if ord(c)<=%11011111 then begin
+    // could be 2 byte character (%110xxxxx %10xxxxxx)
+    if ((ord(p[1]) and %11000000) = %10000000) then
+      Result:=2
+    else
+      Result:=0; // missing following bytes
+  end
+  else if ord(c)<=%11101111 then begin
+    // could be 3 byte character (%1110xxxx %10xxxxxx %10xxxxxx)
+    if ((ord(p[1]) and %11000000) = %10000000)
+    and ((ord(p[2]) and %11000000) = %10000000) then begin
+      if (ord(c)=%11100000) and (ord(p[1])<=%10011111) then
+        Result:=0; // XSS attack: 3 bytes are mapped to the 1 or 2 byte codes
+      Result:=3;
+    end else
+      Result:=0; // missing following bytes
+  end
+  else if ord(c)<=%11110111 then begin
+    // could be 4 byte character (%11110xxx %10xxxxxx %10xxxxxx %10xxxxxx)
+    if ((ord(p[1]) and %11000000) = %10000000)
+    and ((ord(p[2]) and %11000000) = %10000000)
+    and ((ord(p[3]) and %11000000) = %10000000) then begin
+      if (ord(c)=%11110000) and (ord(p[1])<=%10001111) then
+        Result:=0; // XSS attack: 4 bytes are mapped to the 1-3 byte codes
+      Result:=4;
+    end else
+      Result:=0; // missing following bytes
+  end
+  else begin
+    Result:=0;
   end;
-  if FStack<>nil then begin
-    for i:=0 to FStack.Count-1 do begin
-      Item:=TPASObjectWriterStackEl(FStack[i]);
-      if Item.ElemType in [elComponent,elCollection,elCollectionItem] then
-        Stream.Write(Indent^,2);
+end;
+
+function IsValidUTF16(p: PWideChar): integer;
+var
+  c: WideChar;
+begin
+  c:=p^;
+  if c<=#$DC7F then
+    exit(1)
+  else if c<=#$DBFF then begin
+    c:=p[1];
+    if (c>=#$DC00) and (c<=#$DFFF) then
+      exit(2)
+    else
+      exit(0);
+  end else if c<=#$Dfff then begin
+    exit(0);
+  end else
+    exit(1);
+end;
+
+
+type
+  TAccessComp = class(TComponent); // to access TComponent protected members
+
+  { TPosComponent }
+
+  TPosComponent = class(TObject)
+    FPos: Integer;
+    FComponent: TComponent;
+    constructor Create(APos: Integer; AComponent: TComponent);
+  end;
+
+{ TPosComponent }
+
+constructor TPosComponent.Create(APos: Integer; AComponent: TComponent);
+begin
+  FPos:=APos;
+  FComponent:=AComponent;
+end;
+
+{ TCompWriterPas }
+
+procedure TCompWriterPas.AddToAncestorList(Component: TComponent);
+begin
+  FAncestors.AddObject(Component.Name,TPosComponent.Create(FAncestors.Count,Component));
+end;
+
+procedure TCompWriterPas.DetermineAncestor(Component: TComponent);
+var
+  i : Integer;
+  C: TComponent;
+begin
+  if Assigned(FAncestors) then
+  begin
+    i:=FAncestors.IndexOf(Component.Name);
+    if i<0 then
+    begin
+      FAncestor:=nil;
+      FAncestorPos:=-1;
+    end
+    else
+      With TPosComponent(FAncestors.Objects[i]) do
+      begin
+        FAncestor:=FComponent;
+        FAncestorPos:=FPos;
+      end;
+  end;
+  if Assigned(FOnFindAncestor) then
+    if (Ancestor=Nil) or (Ancestor is TComponent) then
+    begin
+      C:=TComponent(Ancestor);
+      FOnFindAncestor(Self,Component,Component.Name,C,FRootAncestor);
+      Ancestor:=C;
+    end;
+end;
+
+procedure TCompWriterPas.SetRoot(const AValue: TComponent);
+begin
+  FRoot:=AValue;
+  FLookupRoot:=FRoot;
+end;
+
+procedure TCompWriterPas.WriteComponentData(Instance: TComponent);
+var
+  HasAncestor: Boolean;
+
+  procedure WriteSetParent;
+  var
+    PropName: String;
+  begin
+    if Parent=nil then exit;
+    if Instance.GetParentComponent=nil then exit;
+    if CreatedByAncestor(Instance) then begin
+      // ancestor creates the component
+      // and descendants cannot change parent
+      exit;
+    end;
+    PropName:='';
+    if Assigned(OnGetParentProperty) then
+      OnGetParentProperty(Self,Instance,PropName);
+    if PropName=CWPSkipParentName then
+    else if PropName<>'' then
+      WriteAssign(PropName,GetComponentPath(Parent))
+    else begin
+      NeedAccessClass:=true;
+      WriteStatement(AccessClass+'(TComponent('+Instance.Name+')).SetParentComponent('+GetComponentPath(Parent)+');');
+    end;
+  end;
+
+begin
+  HasAncestor := Assigned(Ancestor) and ((Instance = Root) or
+    (Instance.ClassType = Ancestor.ClassType));
+  if Instance=LookupRoot then begin
+    WriteAssign('Name',''''+Instance.Name+'''');
+    WriteChildren(Instance,cwpcsCreate);
+  end
+  else begin
+    WriteStatement('with '+Instance.Name+' do begin');
+    Indent;
+    if not CreatedByAncestor(Instance) then
+      WriteAssign('Name',''''+Instance.Name+'''');
+    if cwpoSetParentFirst in Options then
+      WriteSetParent;
+  end;
+  WriteProperties(Instance);
+  if not (cwpoSetParentFirst in Options) then
+    WriteSetParent;
+  if not IgnoreChildren then
+    WriteChildren(Instance,cwpcsProperties);
+  if Instance<>LookupRoot then
+  begin
+    Unindent;
+    WriteStatement('end;');
+  end;
+  if HasAncestor and (Ancestor<>FRootAncestor)
+      and (FCurrentPos<>FAncestorPos) then
+  begin
+    if Parent=LookupRoot then
+      WriteStatement('SetChildOrder('+GetComponentPath(Instance)+','+IntToStr(FCurrentPos)+');')
+    else begin
+      NeedAccessClass:=true;
+      WriteStatement(AccessClass+'(TComponent('+GetComponentPath(Parent)+')).SetChildOrder('+GetComponentPath(Instance)+','+IntToStr(FCurrentPos)+');');
+    end;
+  end;
+  Inc(FCurrentPos);
+end;
+
+procedure TCompWriterPas.WriteChildren(Component: TComponent;
+  Step: TCWPChildrenStep);
+var
+  SRoot, SRootA, SParent: TComponent;
+  SList: TStringList;
+  SPos, i, SAncestorPos: Integer;
+begin
+  // Write children list.
+  // While writing children, the ancestor environment must be saved
+  // This is recursive...
+  SRoot:=FRoot;
+  SRootA:=FRootAncestor;
+  SList:=FAncestors;
+  SPos:=FCurrentPos;
+  SAncestorPos:=FAncestorPos;
+  SParent:=Parent;
+  try
+    FAncestors:=Nil;
+    FCurrentPos:=0;
+    FAncestorPos:=-1;
+    FParent:=Component;
+    if csInline in Component.ComponentState then
+      FRoot:=Component;
+    if (FAncestor is TComponent) then
+    begin
+      FAncestors:=TStringList.Create;
+      if csInline in TComponent(FAncestor).ComponentState then
+        FRootAncestor := TComponent(FAncestor);
+      TAccessComp(FAncestor).GetChildren(@AddToAncestorList,FRootAncestor);
+      FAncestors.Sorted:=True;
+    end;
+    try
+      case Step of
+      cwpcsCreate:
+        TAccessComp(Component).GetChildren(@WriteComponentCreate, FRoot);
+      cwpcsProperties:
+        TAccessComp(Component).GetChildren(@WriteComponent, FRoot);
+      end;
+    finally
+      if Assigned(FAncestor) then
+        for i:=0 to FAncestors.Count-1 do
+          FAncestors.Objects[i].Free;
+      FreeAndNil(FAncestors);
+    end;
+  finally
+    FParent:=SParent;
+    FAncestors:=SList;
+    FRoot:=SRoot;
+    FRootAncestor:=SRootA;
+    FCurrentPos:=SPos;
+    FAncestorPos:=SAncestorPos;
+  end;
+end;
+
+procedure TCompWriterPas.WriteProperty(Instance: TPersistent;
+  PropInfo: PPropInfo);
+type
+  TSet = set of 0..31;
+var
+  PropType, CompType: PTypeInfo;
+  ObjValue, AncestorObj: TObject;
+  HasAncestor, BoolValue, DefBoolValue: Boolean;
+  Int32Value, DefValue: longint;
+  PropName, Ident, s, StrValue, DefStrValue, Name, SavedPropPath: String;
+  IntToIdentFn: TIntToIdent;
+  i, j: Integer;
+  Int64Value, DefInt64Value: Int64;
+  FloatValue, DefFloatValue: Extended;
+  MethodValue, DefMethodValue: TMethod;
+  WStrValue, WDefStrValue: WideString;
+  UStrValue, UDefStrValue: UnicodeString;
+  VarValue, DefVarValue: tvardata;
+  aTypeData: PTypeData;
+  Component, AncestorComponent: TComponent;
+  SavedAncestor: TPersistent;
+  IntfValue, AncestorIntf: IInterface;
+  CompRef: IInterfaceComponentReference;
+begin
+  // do not stream properties without getter
+  if not Assigned(PropInfo^.GetProc) then
+    exit;
+
+  // properties without setter are only allowed, if they are csSubComponent
+  PropType := PropInfo^.PropType;
+  if not Assigned(PropInfo^.SetProc) then begin
+    if PropType^.Kind<>tkClass then
+      exit;
+    ObjValue := TObject(GetObjectProp(Instance, PropInfo));
+    if not (ObjValue is TComponent) or
+       not (csSubComponent in TComponent(ObjValue).ComponentStyle) then
+      exit;
+  end;
+
+  { Check if the ancestor can be used }
+  HasAncestor := Assigned(Ancestor) and ((Instance = Root) or
+    (Instance.ClassType = Ancestor.ClassType));
+  PropName:=FPropPath + PropInfo^.Name;
+  {$IFDEF VerboseCompWriterPas}
+  debugln(['TWriter.WriteProperty PropName="',PropName,'" TypeName=',PropType^.Name,' Kind=',GetEnumName(TypeInfo(TTypeKind),ord(PropType^.Kind)),' HasAncestor=',HasAncestor]);
+  {$ENDIF}
+
+  case PropType^.Kind of
+    tkInteger, tkChar, tkEnumeration, tkSet, tkWChar:
+      begin
+        Int32Value := GetOrdProp(Instance, PropInfo);
+        if HasAncestor then
+          DefValue := GetOrdProp(Ancestor, PropInfo)
+        else
+          DefValue := PPropInfo(PropInfo)^.Default;
+        //debugln([PropInfo^.Name,', HasAncestor=',HasAncestor,', Value=',Int32Value,', Default=',DefValue]);
+        if (Int32Value <> DefValue) or (DefValue=longint($80000000)) then
+        begin
+          case PropType^.Kind of
+            tkInteger:
+              begin
+                // Check if this integer has a string identifier
+                IntToIdentFn := FindIntToIdent(PropInfo^.PropType);
+                Ident:='';
+                if Assigned(IntToIdentFn) and IntToIdentFn(Int32Value, Ident) then
+                  // Integer with a custom identifier
+                  // ToDo: check if this is an actual Pascal constant and remember the unit
+                  WriteAssign(PropName,Ident)
+                else begin
+                  // Integer has to be written just as number
+                  aTypeData:=GetTypeData(PropInfo^.PropType);
+                  if aTypeData^.MinValue>=0 then
+                    WriteAssign(PropName,IntToStr(longword(Int32Value)))
+                  else
+                    WriteAssign(PropName,IntToStr(Int32Value));
+                end;
+              end;
+            tkChar:
+              WriteAssign(PropName,GetCharLiteral(Int32Value));
+            tkWChar:
+              WriteAssign(PropName,GetWideCharLiteral(Int32Value));
+            tkSet:
+              begin
+              s:='';
+              CompType:=GetTypeData(PropType)^.CompType;
+              i:=0;
+              while i<32 do
+              begin
+                if i in TSet(Int32Value) then
+                begin
+                  if s<>'' then s:=s+',';
+                  // ToDo: store needed unit
+                  s:=s+GetEnumExpr(CompType, i,false);
+                  j:=i;
+                  while (i<31) and (byte(i+1) in TSet(Int32Value)) do
+                    inc(i);
+                  if i>j then
+                    s:=s+'..'+GetEnumExpr(CompType, i,false);
+                end;
+                inc(i);
+              end;
+              WriteAssign(PropName,'['+s+']');
+              end;
+            tkEnumeration:
+              // ToDo: store needed unit
+              WriteAssign(PropName,GetEnumExpr(PropType, Int32Value,true));
+          end;
+        end;
+      end;
+    tkFloat:
+      begin
+        FloatValue := GetFloatProp(Instance, PropInfo);
+        if HasAncestor then
+          DefFloatValue := GetFloatProp(Ancestor, PropInfo)
+        else
+          begin
+          DefValue :=PropInfo^.Default;
+          DefFloatValue:=PSingle(@PropInfo^.Default)^;
+          end;
+        if (FloatValue<>DefFloatValue) or (DefValue=longint($80000000)) then
+          WriteAssign(PropName,GetFloatLiteral(FloatValue));
+      end;
+    tkMethod:
+      begin
+        MethodValue := GetMethodProp(Instance, PropInfo);
+        if HasAncestor then
+          DefMethodValue := GetMethodProp(Ancestor, PropInfo)
+        else begin
+          DefMethodValue.Data := nil;
+          DefMethodValue.Code := nil;
+        end;
+
+        //debugln(['TCompWriterPas.WriteProperty ',dbgs(MethodValue.Data),' ',dbgs(MethodValue.Code),' ',dbgs(DefMethodValue.Data),' ',dbgs(DefMethodValue.Code)]);
+        if Assigned(OnGetMethodName) then
+        begin
+          if (MethodValue.Code <> DefMethodValue.Code) or
+            (MethodValue.Data <> DefMethodValue.Data) then
+          begin
+            OnGetMethodName(Self,Instance,PropInfo,Ident);
+            OnGetMethodName(Self,Ancestor,PropInfo,s);
+            if Ident<>s then
+            begin
+              if Ident='' then
+                WriteAssign(PropName,'nil')
+              else
+                // ToDo: check nameclash of Ident with current with-do block
+                WriteAssign(PropName,'@'+Ident);
+            end;
+          end;
+        end else begin
+          if (MethodValue.Code <> DefMethodValue.Code) then
+          begin
+            if not Assigned(MethodValue.Code) then
+              Ident:=''
+            else
+              Ident:=FLookupRoot.MethodName(MethodValue.Code);
+            if Ident='' then
+              WriteAssign(PropName,'nil')
+            else
+              // ToDo: check nameclash of Ident with current with-do block
+              WriteAssign(PropName,'@'+Ident);
+          end;
+        end;
+      end;
+    tkSString, tkLString, tkAString:
+      begin
+        StrValue := GetStrProp(Instance, PropInfo);
+        if HasAncestor then
+          DefStrValue := GetStrProp(Ancestor, PropInfo)
+        else
+          SetLength(DefStrValue, 0);
+
+        if StrValue <> DefStrValue then
+          WriteAssign(PropName,GetStringLiteral(StrValue));
+      end;
+    tkWString:
+      begin
+        WStrValue := GetWideStrProp(Instance, PropInfo);
+        if HasAncestor then
+          WDefStrValue := GetWideStrProp(Ancestor, PropInfo)
+        else
+          WDefStrValue := '';
+
+        if WStrValue <> WDefStrValue then
+          WriteAssign(PropName,GetWStringLiteral(PWideChar(WStrValue),length(WStrValue)));
+      end;
+    tkUString:
+      begin
+        UStrValue := GetUnicodeStrProp(Instance, PropInfo);
+        if HasAncestor then
+          UDefStrValue := GetUnicodeStrProp(Ancestor, PropInfo)
+        else
+          SetLength(UDefStrValue, 0);
+
+        if UStrValue <> UDefStrValue then
+          WriteAssign(PropName,GetWStringLiteral(PWideChar(UStrValue),length(UStrValue)));
+      end;
+    tkVariant:
+      begin
+        // Ensure that a Variant manager is installed
+        if not Assigned(VarClearProc) then
+          raise EWriteError.Create(SErrNoVariantSupport);
+
+        VarValue := tvardata(GetVariantProp(Instance, PropInfo));
+        if HasAncestor then
+          DefVarValue := tvardata(GetVariantProp(Ancestor, PropInfo))
+        else
+          FillChar(DefVarValue,sizeof(DefVarValue),0);
+
+        if (CompareByte(VarValue,DefVarValue,sizeof(VarValue)) <> 0) then
+          begin
+            // can't use variant() typecast, pulls in variants unit
+            case VarValue.vtype of
+            varsmallint : WriteAssign(PropName,'SmallInt('+IntToStr(VarValue.vsmallint)+')');
+            varinteger : WriteAssign(PropName,'LongInt('+IntToStr(VarValue.vinteger)+')');
+            varsingle : WriteAssign(PropName,'Single('+GetFloatLiteral(VarValue.vsingle)+')');
+            vardouble : WriteAssign(PropName,'Double('+GetFloatLiteral(VarValue.vdouble)+')');
+            vardate : WriteAssign(PropName,'TDateTime('+GetFloatLiteral(VarValue.vdate)+')');
+            varcurrency : WriteAssign(PropName,'Currency('+GetCurrencyLiteral(VarValue.vcurrency)+')');
+            //varolestr : (volestr : pwidechar);
+            //vardispatch : (vdispatch : pointer);
+            //varerror : (verror : hresult);
+            varboolean : WriteAssign(PropName,GetBoolLiteral(VarValue.vboolean));
+            //varunknown : (vunknown : pointer);
+            // vardecimal : ( : );
+            varshortint : WriteAssign(PropName,'ShortInt('+IntToStr(VarValue.vshortint)+')');
+            varbyte : WriteAssign(PropName,'Byte('+IntToStr(VarValue.vbyte)+')');
+            varword : WriteAssign(PropName,'Word('+IntToStr(VarValue.vword)+')');
+            varlongword : WriteAssign(PropName,'LongWord('+IntToStr(VarValue.vlongword)+')');
+            varint64 : WriteAssign(PropName,'Int64('+IntToStr(VarValue.vint64)+')');
+            varqword : WriteAssign(PropName,'QWord('+IntToStr(VarValue.vqword)+')');
+            // duplicate: varword64
+            varstring : WriteAssign(PropName,GetStringLiteral(AnsiString(VarValue.vstring)));
+            //varany :  (vany : pointer);
+            //vararray : (varray : pvararray);
+            //varbyref : (vpointer : pointer);
+            //varrecord : (vrecord : pointer;precinfo : pointer);
+            else
+              {$IFDEF VerboseCompWriterPas}
+              debugln(['TCompWriterPas.WriteProperty Property="',PropName,'" Kind=',PropType^.Kind,' vtype=',VarValue.vtype]);
+              raise EWriteError.Create('proptype not supported: '+GetEnumName(TypeInfo(PropType^.Kind),ord(PropType^.Kind))+' vtype='+dbgs(VarValue.vtype));
+              {$ENDIF}
+            end;
+            //ToDo WriteVariant(pvariant(@VarValue)^);
+          end;
+      end;
+    tkClass:
+      begin
+        ObjValue := TObject(GetObjectProp(Instance, PropInfo));
+        if HasAncestor then
+        begin
+          AncestorObj := TObject(GetObjectProp(Ancestor, PropInfo));
+          if (AncestorObj is TComponent) and
+             (ObjValue is TComponent) then
+          begin
+            //debugln(['TWriter.WriteProperty AncestorObj=',TComponent(AncestorObj).Name,' OwnerFit=',TComponent(AncestorObj).Owner = FRootAncestor,' ',TComponent(ObjValue).Name,' OwnerFit=',TComponent(ObjValue).Owner = Root]);
+            if (AncestorObj<>ObjValue) and
+               (TComponent(AncestorObj).Owner = FRootAncestor) and
+               (TComponent(ObjValue).Owner = Root) and
+               SameText(TComponent(AncestorObj).Name,TComponent(ObjValue).Name) then
+            begin
+              // value is a component, and it is the same as in the ancestor
+              // Note: a descendant has new instances with same names
+              AncestorObj := ObjValue;
+            end;
+          end;
+        end else
+          AncestorObj := nil;
+
+        if not Assigned(ObjValue) then
+        begin
+          if ObjValue <> AncestorObj then
+            WriteAssign(PropName,'Nil');
+        end
+        else if ObjValue.InheritsFrom(TPersistent) then
+        begin
+          // Subcomponents are streamed the same way as persistents
+          if ObjValue.InheritsFrom(TComponent)
+            and ((not (csSubComponent in TComponent(ObjValue).ComponentStyle))
+                 or ((TComponent(ObjValue).Owner<>Instance) and (TComponent(ObjValue).Owner<>Nil))) then
+          begin
+            Component := TComponent(ObjValue);
+            if (ObjValue <> AncestorObj)
+                and not (csTransient in Component.ComponentStyle) then
+            begin
+              // set property value
+              Name:=GetComponentPath(Component);
+              if Name='' then
+                raise EWriteError.Create('cannot write property "'+DbgSName(Instance)+'.'+PropName+'"');
+              WriteAssign(PropName,Name);
+            end; //(ObjValue <> AncestorObj)
+          end // ObjValue.InheritsFrom(TComponent)
+          else
+          begin
+            // keep property value, set sub properties recursively with full path
+            // e.g. Font.Size:=5;
+            SavedAncestor := Ancestor;
+            SavedPropPath := FPropPath;
+            try
+              FPropPath := FPropPath + PPropInfo(PropInfo)^.Name + '.';
+              if HasAncestor then
+                Ancestor := TPersistent(GetObjectProp(Ancestor, PropInfo));
+              WriteProperties(TPersistent(ObjValue));
+            finally
+              Ancestor := SavedAncestor;
+              FPropPath := SavedPropPath;
+            end;
+            if ObjValue.InheritsFrom(TCollection) then
+            begin
+              if (not HasAncestor) or (not CollectionsEqual(TCollection(ObjValue),
+                TCollection(GetObjectProp(Ancestor, PropInfo)),Root,RootAncestor)) then
+              begin
+                // create collection items
+                SavedPropPath := FPropPath;
+                try
+                  SetLength(FPropPath, 0);
+                  WriteCollection(PropName,TCollection(ObjValue));
+                finally
+                  FPropPath := SavedPropPath;
+                end;
+              end;
+            end // TCollection
+          end;
+        end; // Inheritsfrom(TPersistent)
+      end;
+    tkInt64, tkQWord:
+      begin
+        Int64Value := GetInt64Prop(Instance, PropInfo);
+        if HasAncestor then
+          DefInt64Value := GetInt64Prop(Ancestor, PropInfo)
+        else
+          DefInt64Value := 0;
+        if Int64Value <> DefInt64Value then
+          if PropType^.Kind=tkInt64 then
+            WriteAssign(PropName,IntToStr(Int64Value))
+          else
+            WriteAssign(PropName,IntToStr(QWord(Int64Value)));
+      end;
+    tkBool:
+      begin
+        BoolValue := GetOrdProp(Instance, PropInfo)<>0;
+        if HasAncestor then
+          DefBoolValue := GetOrdProp(Ancestor, PropInfo)<>0
+        else
+          DefBoolValue := PropInfo^.Default<>0;
+        DefValue:=PropInfo^.Default;
+        //debugln([PropInfo^.Name,', HasAncestor=',HasAncestor,', BoolValue=',BoolValue,', DefBoolValue=',DefBoolValue,' Default=',DefValue]);
+        if (BoolValue<>DefBoolValue) or (DefValue=longint($80000000)) then
+          WriteAssign(PropName,GetBoolLiteral(BoolValue));
+      end;
+    tkInterface:
+      begin
+        IntfValue := GetInterfaceProp(Instance, PropInfo);
+        if not Assigned(IntfValue) then
+          WriteAssign(PropName,'Nil')
+        else if Supports(IntfValue, IInterfaceComponentReference, CompRef) then
+        begin
+          Component := CompRef.GetComponent;
+          AncestorComponent := nil;
+          if HasAncestor then
+          begin
+            AncestorIntf := GetInterfaceProp(Instance, PropInfo);
+            if Supports(AncestorIntf, IInterfaceComponentReference, CompRef) then
+            begin
+              AncestorComponent := CompRef.GetComponent;
+              if (AncestorComponent<>Component) and
+                 (AncestorComponent.Owner = FRootAncestor) and
+                 (Component.Owner = Root) and
+                 SameText(AncestorComponent.Name,Component.Name) then
+              begin
+                // value is a component, and it is the same as in the ancestor
+                // Note: a descendant has new instances with same names
+                AncestorComponent := Component;
+              end;
+            end;
+          end;
+
+          if Component<>AncestorComponent then
+          begin
+            Name:=GetComponentPath(Component);
+            if Name='' then
+              raise EWriteError.Create('cannot write property "'+DbgSName(Instance)+'.'+PropName+'"');
+            WriteAssign(PropName,Name);
+          end;
+        end else
+          raise EWriteError.Create('interface property "'+PropName+'" does not support IInterfaceComponentReference');
+      end;
+  else
+    {$IFDEF VerboseCompWriterPas}
+    debugln(['TCompWriterPas.WriteProperty Property="',PropName,'" Kind=',PropType^.Kind]);
+    raise EWriteError.Create('proptype not supported: '+GetEnumName(TypeInfo(PropType^.Kind),ord(PropType^.Kind)));
+    {$ENDIF}
+  end;
+end;
+
+procedure TCompWriterPas.WriteProperties(Instance: TPersistent);
+var
+  PropCount, i: integer;
+  PropList: PPropList;
+begin
+  PropCount:=GetPropList(Instance,PropList);
+  if PropCount>0 then
+    try
+      for i := 0 to PropCount-1 do
+        if IsStoredProp(Instance,PropList^[i]) then
+          WriteProperty(Instance,PropList^[i]);
+    finally
+      Freemem(PropList);
+    end;
+  WriteDefineProperties(Instance);
+end;
+
+procedure TCompWriterPas.WriteDefineProperties(Instance: TPersistent);
+var
+  Col: Integer;
+  InLit, NeedComma: boolean;
+
+  function CheckCol(aCol: integer): boolean;
+  begin
+    if (Col<=CurIndent+1) or (aCol<=MaxColumn) then exit(true);
+    Result:=false;
+    if NeedComma then
+      Write(',');
+    WriteLn;
+    WriteIndent;
+    Col:=CurIndent+1;
+    NeedComma:=false;
+  end;
+
+var
+  HasAncestor: Boolean;
+  DefValue, Value: LongInt;
+  aStream: TMemoryStream;
+  BinWriter: TWriter;
+  s: String;
+  p: PChar;
+  c: Char;
+  i: Integer;
+begin
+  if Instance is TComponent then begin
+    HasAncestor := Assigned(Ancestor) and ((Instance = Root) or
+      (Instance.ClassType = Ancestor.ClassType));
+    if HasAncestor then
+      DefValue := TComponent(Ancestor).DesignInfo
+    else
+      DefValue := 0;
+    Value:=TComponent(Instance).DesignInfo;
+    if Value<>DefValue then
+      // Note: DesignInfo contains Left/Top. On BigEndian systems the order
+      // is reversed, which is already handled in TComponent.DefineProperties
+      // -> it is the same longint value on Little and BigEndian system
+      WriteAssign(FPropPath + 'DesignInfo',IntToStr(Value));
+  end;
+
+  if TMethod(@TAccessComp(Instance).DefineProperties).Code<>FDefaultDefineProperties
+  then begin
+    // this class has overriden DefineProperties
+    aStream:=TMemoryStream.Create;
+    BinWriter:=TWriter.Create(aStream,1024);
+    try
+      BinWriter.Root:=Root;
+      BinWriter.RootAncestor:=RootAncestor;
+      BinWriter.Ancestor:=Ancestor;
+      BinWriter.IgnoreChildren:=IgnoreChildren;
+      BinWriter.OnWriteMethodProperty:=OnWriteMethodProperty;
+      BinWriter.OnWriteStringProperty:=OnWriteStringProperty;
+      TAccessComp(Instance).DefineProperties(BinWriter);
+      BinWriter.WriteListEnd;
+      FreeAndNil(BinWriter); // flush buffer to stream
+      if aStream.Size>1 then
+      begin
+        WriteIndent;
+        if PropertyPath<>'' then
+        begin
+          s:=PropertyPath;
+          Delete(s,length(s),1); // chomp '.'
+        end
+        else if Instance is TComponent then
+          s:=GetComponentPath(TComponent(Instance))
+        else
+          s:='';
+        if s='' then
+          raise EWriteError.Create('cannot write DefineProperties of "'+DbgSName(Instance)+'"');
+
+        s:=ExecCustomData+'('+s+',[';
+        Write(s);
+        Col:=CurIndent+length(s)+1;
+        Indent;
+        NeedComma:=false;
+        CheckCol(Col);
+        InLit:=false;
+        p:=PChar(aStream.Memory);
+        for i:=0 to aStream.Size-1 do
+        begin
+          c:=p^;
+          if c in [#32..#126] then
+          begin
+            if (not InLit) or (Col+2>MaxColumn) then
+            begin
+              if InLit then
+                Write('''');
+              CheckCol(Col+3);
+              InLit:=true;
+              Write('''');
+              inc(Col);
+            end;
+            Write(c);
+            inc(Col);
+            NeedComma:=true;
+          end else begin
+            if InLit then
+            begin
+              Write('''');
+              inc(Col);
+              InLit:=false;
+            end;
+            s:='#'+IntToStr(ord(c));
+            CheckCol(Col+length(s));
+            Write(s);
+            inc(Col,length(s));
+            NeedComma:=true;
+          end;
+          inc(p);
+        end;
+        if InLit then
+          Write('''');
+        Write(']);');
+        WriteLn;
+        Unindent;
+      end;
+    finally
+      BinWriter.Free;
+      aStream.Free;
     end;
   end;
 end;
 
-procedure TPASObjectWriter.WriteAssignment(PropertyName, Value: string);
-var
-  s: String;
-begin
-  WriteIndent;
-  s:=PropertyName+' := '+Value+';'+LineEnding;
-  Stream.Write(s[1],length(s));
-end;
-
-procedure TPASObjectWriter.WritePropertyAssignment(Value: string);
-begin
-  if (StackEl=nil) or (StackEl.ElemType<>elProperty) then
-    raise Exception.Create('TPASObjectWriter.WritePropertyAssignment not in property');
-  WriteAssignment(StackEl.ElementName,Value);
-end;
-
-procedure TPASObjectWriter.WriteCreateComponent(CompName, CompClass,
-  CompOwner: string);
-var
-  s: String;
-begin
-  WriteIndent;
-  s:='if '+CompName+'=nil then '+CompName+' := '+CompClass+'.Create('+CompOwner+');'+LineEnding;
-  Stream.Write(s[1],length(s));
-end;
-
-procedure TPASObjectWriter.WriteWithDoBegin(Expr: string);
-var
-  s: String;
-begin
-  WriteIndent;
-  s:='with '+Expr+' do begin'+LineEnding;
-  Stream.Write(s[1],length(s));
-end;
-
-procedure TPASObjectWriter.WriteEnd;
-const
-  EndTxt: String = 'end;'+LineEnding;
-begin
-  WriteIndent;
-  Stream.Write(EndTxt[1],length(EndTxt));
-end;
-
-function TPASObjectWriter.StringToConstant(s: string): string;
+procedure TCompWriterPas.WriteCollection(PropName: string;
+  Collection: TCollection);
 var
   i: Integer;
-  InString: Boolean;
+  Item: TCollectionItem;
+begin
+  WriteStatement(PropName+'.Clear;');
+  for i:=0 to Collection.Count-1 do
+  begin
+    Item:=Collection.Items[i];
+    WriteStatement('with '+Item.ClassName+'('+PropName+'.Add) do begin');
+    Indent;
+    WriteProperties(Item);
+    Unindent;
+    WriteStatement('end;');
+  end;
+end;
+
+function TCompWriterPas.GetComponentPath(Component: TComponent): string;
+var
+  Name: String;
+  C: TComponent;
+begin
+  if Component=nil then
+    Result:='Nil'
+  else if Component=LookupRoot then
+    Result:='Self'
+  else begin
+    Name:= '';
+    C:=Component;
+    While (C<>Nil) do
+    begin
+      if (Name<>'') Then
+        Name:='.'+Name;
+      if C.Owner = LookupRoot then
+      begin
+        Name := C.Name+Name;
+        break;
+      end
+      else if C = LookupRoot then
+      begin
+        Name := 'Self'+Name;
+        break;
+      end else if C.Name='' then
+        exit('');
+      Name:=C.Name+Name;
+      // ToDo: store used unit
+      C:=C.Owner;
+    end;
+    Result:=Name;
+  end;
+end;
+
+function TCompWriterPas.GetBoolLiteral(b: boolean): string;
+begin
+  if b then
+    Result:='True'
+  else
+    Result:='False';
+end;
+
+function TCompWriterPas.GetCharLiteral(c: integer): string;
+begin
+  case c of
+  32..126: Result:=''''+chr(c)+'''';
+  else     Result:='#'+IntToStr(c);
+  end;
+end;
+
+function TCompWriterPas.GetWideCharLiteral(c: integer): string;
+begin
+  case c of
+  32..126:
+    Result:=''''+Chr(c)+'''';
+  0..31,127..255,$D800..$DFFF:
+    Result:='#'+IntToStr(c);
+  else
+    if cwpoSrcCodepageUTF8 in Options then
+      Result:=''''+UTF16ToUTF8(WideChar(c))+''''
+    else
+      Result:='#'+IntToStr(c);
+  end;
+end;
+
+function TCompWriterPas.GetStringLiteral(const s: string): string;
+
+  function IsSpecialChar(p: PChar): boolean;
+  const
+    SpecialChars = [#0..#31,#127,#255];
+  begin
+    Result:=(p^ in SpecialChars) or (IsValidUTF8(p)=0);
+  end;
+
+var
+  InLit: Boolean;
+  p, StartP: PChar;
+  c: Char;
 begin
   Result:='';
-  InString:=false;
-  for i:=1 to length(s) do begin
-    case s[i] of
-    #0..#31,#127..#255:
-      begin
-        if InString then
-          Result:=Result+'''';
-        InString:=false;
-        Result:=Result+'#'+IntToStr(ord(s[i]));
-      end;
-    else
-      if not InString then
+  if s='' then exit;
+  InLit:=false;
+  p:=PChar(s);
+  repeat
+    c:=p^;
+    if (c=#0) and (p-PChar(s)=length(s)) then
+      break
+    else if IsSpecialChar(p) then
+    begin
+      if InLit then begin
+        InLit:=false;
         Result:=Result+'''';
-      InString:=true;
-      Result:=Result+s[i];
-    end;
-  end;
-  if InString then Result:=Result+'''';
-end;
-
-constructor TPASObjectWriter.Create(AStream: TStream);
-begin
-  inherited Create;
-  FStream:=AStream;
-end;
-
-procedure TPASObjectWriter.BeginCollection;
-begin
-  debugln(['TPASObjectWriter.BeginCollection']);
-  if StackEl.ElemType<>elProperty then
-    raise Exception.Create('TPASObjectWriter.BeginCollection not supported');
-  WriteWithDoBegin(StackEl.ElementName);
-  StackPush('collection',elCollection);
-end;
-
-procedure TPASObjectWriter.BeginComponent(Component: TComponent; Flags: TFilerFlags;
-  ChildPos: Integer);
-// TWriter expects to push two elements on the stack, which are popped by
-// two EndList calls.
-var
-  i: Integer;
-  Item: TPASObjectWriterStackEl;
-begin
-  if Flags<>[] then ; // ToDo
-  if ChildPos>0 then ; //
-
-  if not IsValidIdent(Component.Name) then
-    raise Exception.Create('TPASObjectWriter.BeginComponent not pascal identifier');
-  if (FStack<>nil) and (FStack.Count>0) then begin
-    // auto create child components
-    for i:=0 to FStack.Count-1 do begin
-      Item:=TPASObjectWriterStackEl(FStack[i]);
-      if Item.ElemType=elComponent then begin
-        if Item.ElementName<>'' then
-          WriteCreateComponent(Component.Name,Component.ClassName,Item.ElementName);
-        break;
+      end;
+      Result:=Result+'#'+IntToStr(ord(c));
+      inc(p);
+    end else begin
+      if not InLit then begin
+        InLit:=true;
+        Result:=Result+'''';
+      end;
+      if c='''' then begin
+        Result:=Result+'''''';
+        inc(p);
+      end else begin
+        StartP:=p;
+        repeat
+          inc(p,IsValidUTF8(p));
+          c:=p^;
+        until ((c=#0) and (p-PChar(s)=length(s))) or IsSpecialChar(p) or (c='''');
+        Result:=Result+copy(s,StartP-PChar(s)+1,p-StartP);
       end;
     end;
+  until false;
+  if InLit then
+    Result:=Result+'''';
+end;
+
+function TCompWriterPas.GetWStringLiteral(p: PWideChar; Count: integer): string;
+
+  function IsSpecialChar(w: PWideChar): boolean;
+  const
+    SpecialChars = [#0..#31,#127];
+  begin
+    if w^ in SpecialChars then exit(true);
+    if cwpoSrcCodepageUTF8 in FOptions then begin
+      Result:=IsValidUTF16(w)=0;
+    end else begin
+      Result:=w^>=#$7f;
+    end;
   end;
-  // enclose in "with" to create nicer code
-  WriteWithDoBegin(Component.Name);
 
-  StackPush(Component.Name,elComponent);
-  StackEl.ElementClass := Component.ClassName;
-  StackPush('properties',elPropertyList);
-end;
-
-procedure TPASObjectWriter.BeginList;
-begin
-  debugln(['TPASObjectWriter.BeginList ']);
-  if (StackEl<>nil) and (StackEl.ElemType=elCollection) then begin
-    // create collection item
-    WriteWithDoBegin('Add');
-    StackPush('collectionlist',elCollectionItem);
-  end else
-    raise Exception.Create('TPASObjectWriter.BeginList not supported');
-end;
-
-procedure TPASObjectWriter.EndList;
-begin
-  if StackEl.ElemType = elPropertyList then begin
-    // end the property list and start the children list
-    StackPop;
-    StackPush('children',elChildrenList);
-  end else if StackEl.ElemType = elChildrenList then begin
-    // end the children list and the component
-    StackPop; // end children
-    StackPop; // end component
-    WriteEnd;
-  end else if StackEl.ElemType in [elCollection,elCollectionItem] then begin
-    StackPop;
-    WriteEnd;
-  end else
-    StackPop;
-end;
-
-procedure TPASObjectWriter.BeginProperty(const PropName: String);
-begin
-  DebugLn('TPASObjectWriter.BeginProperty "',PropName,'"');
-  StackPush(PropName,elProperty);
-end;
-
-procedure TPASObjectWriter.EndProperty;
-begin
-  StackPop;
-end;
-
-procedure TPASObjectWriter.WriteBinary(const Buffer; Count: Longint);
 var
+  InLit: Boolean;
+  c: WideChar;
+  FirstP, StartP: PWideChar;
+  AddLen: SizeUInt;
   s: string;
+  OldLen: Integer;
 begin
-  SetLength(s,Count);
-  if s<>'' then
-    System.Move(Buffer,s[1],length(s));
-  raise Exception.Create('TPASObjectWriter.WriteBinary not supported');
+  Result:='';
+  if Count=0 then exit;
+  FirstP:=p;
+  InLit:=false;
+  s:='';
+  repeat
+    c:=p^;
+    if (c=#0) and (p-FirstP=Count) then
+      break
+    else if IsSpecialChar(p) then
+    begin
+      if InLit then begin
+        InLit:=false;
+        Result:=Result+'''';
+      end;
+      Result:=Result+'#'+Format('%.4d',[ord(c)]);
+      inc(p);
+    end else begin
+      if not InLit then begin
+        InLit:=true;
+        Result:=Result+'''';
+      end;
+      if c='''' then begin
+        Result:=Result+'''''';
+        inc(p);
+      end else begin
+        StartP:=p;
+        repeat
+          inc(p,IsValidUTF16(p));
+          c:=p^;
+        until ((c=#0) and (p-FirstP=Count)) or IsSpecialChar(p) or (c='''');
+        AddLen:=p-StartP;
+        if length(s)<AddLen*3 then SetLength(s,AddLen*3);
+        if ConvertUTF16ToUTF8(@s[1],length(s),StartP,AddLen,
+            [toInvalidCharError,toUnfinishedCharError],AddLen)=trNoError then
+          dec(AddLen); // omit #0
+        OldLen:=length(Result);
+        SetLength(Result,OldLen+AddLen);
+        System.Move(s[1],Result[OldLen+1],AddLen);
+      end;
+    end;
+  until false;
+  if InLit then
+    Result:=Result+'''';
 end;
 
-procedure TPASObjectWriter.WriteBoolean(Value: Boolean);
-begin
-  if Value then
-    WritePropertyAssignment('true')
-  else
-    WritePropertyAssignment('false');
-end;
-
-procedure TPASObjectWriter.WriteFloat(const Value: Extended);
-begin
-  WritePropertyAssignment(FloatToStr(Value));
-end;
-
-{$IF FPC_FULLVERSION >= 30000}
-procedure TPASObjectWriter.WriteSignature;
-begin
-
-end;
-{$ENDIF}
-
-procedure TPASObjectWriter.WriteSingle(const Value: Single);
-begin
-  WritePropertyAssignment(FloatToStr(Value));
-end;
-
-procedure TPASObjectWriter.WriteCurrency(const Value: Currency);
-begin
-  WritePropertyAssignment(FloatToStr(Value));
-end;
-
-procedure TPASObjectWriter.WriteDate(const Value: TDateTime);
-begin
-  WritePropertyAssignment(FloatToStr(Value));
-end;
-
-procedure TPASObjectWriter.WriteIdent(const Ident: string);
-begin
-  WritePropertyAssignment(Ident);
-end;
-
-procedure TPASObjectWriter.WriteInteger(Value: Int64);
-begin
-  WritePropertyAssignment(IntToStr(Value));
-end;
-
-procedure TPASObjectWriter.WriteMethodName(const Name: String);
-begin
-  WritePropertyAssignment('@'+Name);
-end;
-
-procedure TPASObjectWriter.WriteSet(Value: LongInt; SetType: Pointer);
+function TCompWriterPas.GetFloatLiteral(const e: Extended): string;
 var
-  i: Integer;
-  Mask: LongInt;
   s: String;
 begin
-  Mask := 1;
   s:='';
-  for i := 0 to 31 do begin
-    if (Value and Mask) <> 0 then begin
-      if s<>'' then s:=s+',';
-      s:=s+GetEnumName(PTypeInfo(SetType), i);
-    end;
-    Mask := Mask shl 1;
-  end;
-  WritePropertyAssignment('['+s+']');
+  str(e,s);
+  Result:=ShortenFloat(s);
 end;
 
-procedure TPASObjectWriter.WriteString(const Value: String);
+function TCompWriterPas.GetCurrencyLiteral(const c: currency): string;
+var
+  i: int64 absolute c;
+var
+  s: String;
 begin
-  WritePropertyAssignment(StringToConstant(Value));
-end;
-
-procedure TPASObjectWriter.WriteWideString(const Value: WideString);
-// save widestrings as utf8
-begin
-  WritePropertyAssignment('System.UTF8Decode('+StringToConstant(System.UTF8Encode(Value))+')');
-end;
-
-procedure TPASObjectWriter.WriteUInt64(Value: QWord);
-begin
-  WritePropertyAssignment(IntToStr(Value));
-end;
-
-procedure TPASObjectWriter.WriteUnicodeString(const Value: UnicodeString);
-// save unicodestrings as utf8
-begin
-  WritePropertyAssignment(StringToConstant(String(Value)));
-end;
-
-procedure TPASObjectWriter.WriteVariant(const VarValue: Variant);
-begin
-  case tvardata(VarValue).vtype of
-    varEmpty:
-      begin
-        WritePropertyAssignment('nil'); // ToDo
-      end;
-    varNull:
-      begin
-        WritePropertyAssignment('nil'); // ToDo
-      end;
-    { all integer sizes must be split for big endian systems }
-    varShortInt,varSmallInt,varInteger,varInt64:
-      begin
-        WriteInteger(VarValue);
-      end;
-    varQWord:
-      begin
-        WriteUInt64(VarValue);
-      end;
-    varBoolean:
-      begin
-        WriteBoolean(VarValue);
-      end;
-    varCurrency:
-      begin
-        WriteCurrency(VarValue);
-      end;
-    varSingle:
-      begin
-        WriteSingle(VarValue);
-      end;
-    varDouble:
-      begin
-        WriteFloat(VarValue);
-      end;
-    varDate:
-      begin
-        WriteDate(VarValue);
-      end;
-    varString:
-      begin
-        WriteString(VarValue);
-      end;
-    varOleStr:
-      begin
-        WriteWideString(VarValue);
-      end;
+  if i mod 10000=0 then
+    s:=IntToStr(i div 10000)
+  else begin
+    s:=IntToStr(i);
+    while length(s)<4 do
+      s:='0'+s;
+    if length(s)=4 then
+      s:='0.'+s
     else
-      raise EWriteError.CreateFmt('Unsupported property variant type %d', [Ord(tvardata(VarValue).vtype)]);
+      system.insert('.',s,length(s)-3);
+  end;
+  Result:=s;
+end;
+
+function TCompWriterPas.ShortenFloat(s: string): string;
+var
+  p, i: SizeInt;
+begin
+  // remove unneeded leading 0 of exponent
+  p:=Pos('E',s);
+  if p<1 then exit;
+  i:=p;
+  if s[i+1]='+' then inc(i);
+  while (i<length(s)) and (s[i+1]='0') do
+    inc(i);
+  if i>p then
+    if i=length(s) then
+      Delete(s,p,i-p+1) // delete whole exponent
+    else
+      Delete(s,p+1,i-p);
+  // remove trailing 0 of base
+  i:=p;
+  while (i>2) and (s[i-1]='0') do
+    dec(i);
+  if not (s[i-1] in ['0'..'9']) then inc(i);
+  if i<p then
+    Delete(s,i,p-i);
+  // remove leading space
+  if s[1]=' ' then
+    Delete(s,1,1);
+  Result:=s;
+end;
+
+function TCompWriterPas.GetEnumExpr(TypeInfo: PTypeInfo; Value: integer;
+  AllowOutOfRange: boolean): string;
+var
+  PT: PTypeData;
+begin
+  PT:=GetTypeData(TypeInfo);
+  if (Value>=PT^.MinValue) and (Value<=PT^.MaxValue) then
+    case TypeInfo^.Kind of
+    tkBool: Result:=GetBoolLiteral(Value=ord(true));
+    tkChar: Result:=GetCharLiteral(Value);
+    tkEnumeration: Result:=GetEnumName(TypeInfo,Value);
+    else Result:=IntToStr(Value);
+    end
+  else if AllowOutOfRange then
+    Result:=TypeInfo^.Name+'('+IntToStr(Value)+')'
+  else
+    raise EWriteError.Create('enum '+IntToStr(Value)+' is out of range of type "'+TypeInfo^.Name+'"');
+end;
+
+constructor TCompWriterPas.Create(AStream: TStream);
+var
+  C: TAccessComp;
+begin
+  FIndentStep:=2;
+  FStream:=AStream;
+  FLineEnding:=system.LineEnding;
+  FAssignOp:=':=';
+  FSignature:=CSPDefaultSignature;
+  FMaxColumn:=CSPDefaultMaxColumn;
+  FExecCustomData:=CSPDefaultExecCustomLFM;
+  FAccessClass:=CSPDefaultAccessClass;
+  C:=TAccessComp.Create(nil);
+  FDefaultDefineProperties:=TMethod(@C.DefineProperties).Code;
+  C.Free;
+end;
+
+destructor TCompWriterPas.Destroy;
+begin
+  inherited Destroy;
+end;
+
+procedure TCompWriterPas.WriteComponentCreate(Component: TComponent);
+var
+  OldAncestor: TPersistent;
+  OldRoot, OldRootAncestor: TComponent;
+  HasAncestor: boolean;
+begin
+  if (Component=LookupRoot) then exit;
+  OldRoot:=FRoot;
+  OldAncestor:=FAncestor;
+  OldRootAncestor:=FRootAncestor;
+  Try
+    DetermineAncestor(Component);
+    HasAncestor:=FAncestor is TComponent;
+    if not CreatedByAncestor(Component) then
+      WriteAssign(Component.Name,Component.ClassName+'.Create(Self)');
+    if HasAncestor then begin
+      if (csInline in Component.ComponentState)
+      and not (csInline in TComponent(Ancestor).ComponentState) then
+      begin
+        NeedAccessClass:=true;
+        WriteStatement(AccessClass+'(TComponent('+Component.Name+')).SetInline('+GetBoolLiteral(true)+');');
+      end;
+      if (csAncestor in Component.ComponentState)
+      and not (csAncestor in TComponent(Ancestor).ComponentState) then
+      begin
+        NeedAccessClass:=true;
+        WriteStatement(AccessClass+'(TComponent('+Component.Name+')).SetAncestor('+GetBoolLiteral(true)+');');
+      end;
+    end;
+    if not IgnoreChildren then
+      WriteChildren(Component,cwpcsCreate);
+  finally
+    FAncestor:=OldAncestor;
+    FRoot:=OldRoot;
+    FRootAncestor:=OldRootAncestor;
   end;
 end;
 
-procedure TPASObjectWriter.Write(const Buffer; Count: Longint);
+procedure TCompWriterPas.WriteComponent(Component: TComponent);
+var
+  OldAncestor : TPersistent;
+  OldRoot, OldRootAncestor : TComponent;
 begin
-  // there can be arbitrary lots of Write calls
-  // ToDo
-  raise Exception.Create('TPASObjectWriter.Write not supported');
+  OldRoot:=FRoot;
+  OldAncestor:=FAncestor;
+  OldRootAncestor:=FRootAncestor;
+  Try
+    // Component.ComponentState:=Component.FComponentState+[csWriting];
+    DetermineAncestor(Component);
+    WriteComponentData(Component);
+  finally
+    FAncestor:=OldAncestor;
+    FRoot:=OldRoot;
+    FRootAncestor:=OldRootAncestor;
+  end;
+end;
+
+procedure TCompWriterPas.WriteDescendant(ARoot: TComponent; AAncestor: TComponent);
+begin
+  FRoot := ARoot;
+  FAncestor := AAncestor;
+  FRootAncestor := AAncestor;
+  FLookupRoot := ARoot;
+  FNeedAccessClass := false;
+  if not (cwpoNoSignature in Options) then
+    WriteSignature;
+  WriteComponent(ARoot);
+end;
+
+procedure TCompWriterPas.WriteSignature;
+begin
+  WriteStatement(Signature);
+end;
+
+procedure TCompWriterPas.WriteIndent;
+begin
+  Write(StringOfChar(' ',CurIndent));
+end;
+
+procedure TCompWriterPas.Write(const s: string);
+begin
+  if s='' then exit;
+  FStream.Write(s[1],length(s));
+end;
+
+procedure TCompWriterPas.WriteLn;
+begin
+  Write(LineEnding);
+end;
+
+procedure TCompWriterPas.WriteStatement(const s: string);
+begin
+  WriteIndent;
+  Write(s);
+  WriteLn;
+end;
+
+procedure TCompWriterPas.WriteAssign(const LHS, RHS: string);
+begin
+  WriteIndent;
+  Write(LHS);
+  Write(AssignOp);
+  Write(RHS);
+  Write(';');
+  WriteLn;
+end;
+
+function TCompWriterPas.CreatedByAncestor(Component: TComponent): boolean;
+begin
+  Result:=(FAncestor is TComponent)
+    and (TComponent(FAncestor).Owner = FRootAncestor)
+    and (Component.Owner = Root)
+    and SameText(Component.Name,TComponent(FAncestor).Name)
+end;
+
+procedure TCompWriterPas.Indent;
+begin
+  CurIndent:=CurIndent+IndentStep;
+end;
+
+procedure TCompWriterPas.Unindent;
+begin
+  CurIndent:=CurIndent-IndentStep;
 end;
 
 end.
diff --git a/examples/pascalstream/PascalStream1.lpr b/examples/pascalstream/PascalStream1.lpr
index 6470995d8f..b64bedf434 100644
--- a/examples/pascalstream/PascalStream1.lpr
+++ b/examples/pascalstream/PascalStream1.lpr
@@ -6,7 +6,7 @@ uses
   {$IFDEF UNIX}{$IFDEF UseCThreads}
   cthreads,
   {$ENDIF}{$ENDIF}
-  Classes, XMLStreaming, Unit1;
+  Classes, Unit1;
 
 begin
   StreamAsPasForm:=TStreamAsPasForm.Create(nil);
diff --git a/examples/pascalstream/unit1.pas b/examples/pascalstream/unit1.pas
index bdfdfd594d..bf1abe79a4 100644
--- a/examples/pascalstream/unit1.pas
+++ b/examples/pascalstream/unit1.pas
@@ -5,7 +5,7 @@ unit Unit1;
 interface
 
 uses
-  Classes, SysUtils, LCLProc, typinfo, CompWriterPas;
+  Classes, SysUtils, typinfo, CompWriterPas, LazLogger;
 
 type
   TMyEnum = (myEnum1, myEnum2, myEnum3);
@@ -199,7 +199,7 @@ begin
     SetLength(s,ms.Size);
     if s<>'' then
       ms.Read(s[1],length(s));
-    debugln(['TStreamAsPasForm.WriteComponents ',s]);
+    DebugLn(['TStreamAsPasForm.WriteComponents ',s]);
   finally
     ms.Free;
   end;