+ Removed from 2.0 tree

git-svn-id: trunk@28 -

.gitattributes

@@ -609,36 +609,6 @@ fcl/beos/eventlog.inc svneol=native#text/plain
 fcl/beos/ezcgi.inc svneol=native#text/plain
 fcl/beos/pipes.inc svneol=native#text/plain
 fcl/beos/thread.inc svneol=native#text/plain
-fcl/classes/action.inc svneol=native#text/plain
-fcl/classes/bits.inc svneol=native#text/plain
-fcl/classes/classes.inc svneol=native#text/plain
-fcl/classes/classesh.inc svneol=native#text/plain
-fcl/classes/collect.inc svneol=native#text/plain
-fcl/classes/compon.inc svneol=native#text/plain
-fcl/classes/constse.inc svneol=native#text/plain
-fcl/classes/constsg.inc svneol=native#text/plain
-fcl/classes/constss.inc svneol=native#text/plain
-fcl/classes/cregist.inc svneol=native#text/plain
-fcl/classes/dm.inc svneol=native#text/plain
-fcl/classes/filer.inc svneol=native#text/plain
-fcl/classes/filerec.inc svneol=native#text/plain
-fcl/classes/freebsd/classes.pp svneol=native#text/plain
-fcl/classes/go32v2/classes.pp svneol=native#text/plain
-fcl/classes/intf.inc svneol=native#text/plain
-fcl/classes/linux/classes.pp svneol=native#text/plain
-fcl/classes/lists.inc svneol=native#text/plain
-fcl/classes/netbsd/classes.pp svneol=native#text/plain
-fcl/classes/openbsd/classes.pp svneol=native#text/plain
-fcl/classes/os2/classes.pp svneol=native#text/plain
-fcl/classes/parser.inc svneol=native#text/plain
-fcl/classes/persist.inc svneol=native#text/plain
-fcl/classes/reader.inc svneol=native#text/plain
-fcl/classes/streams.inc svneol=native#text/plain
-fcl/classes/stringl.inc svneol=native#text/plain
-fcl/classes/twriter.inc svneol=native#text/plain
-fcl/classes/util.inc svneol=native#text/plain
-fcl/classes/win32/classes.pp svneol=native#text/plain
-fcl/classes/writer.inc svneol=native#text/plain
 fcl/darwin/syncobjs.pp svneol=native#text/plain
 fcl/db/Dataset.txt svneol=native#text/plain
 fcl/db/Makefile -text

fcl/classes/action.inc

@@ -1,193 +0,0 @@
-{
-    $Id: action.inc,v 1.2 2005/02/14 17:13:11 peter Exp $
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1999-2000 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-{****************************************************************************}
-{*                           TBasicActionLink                               *}
-{****************************************************************************}
-
-constructor TBasicActionLink.Create(AClient: TObject);
-begin
-  inherited Create;
-  AssignClient(AClient);
-end;
-
-
-procedure TBasicActionLink.AssignClient(AClient: TObject);
-begin
-end;
-
-
-destructor TBasicActionLink.Destroy;
-begin
-  if FAction <> nil then
-    FAction.UnRegisterChanges(Self);
-  inherited Destroy;
-end;
-
-
-procedure TBasicActionLink.Change;
-begin
-  if Assigned(OnChange) then
-    OnChange(FAction);
-end;
-
-
-function TBasicActionLink.Execute(AComponent: TComponent): Boolean;
-begin
-  FAction.ActionComponent := AComponent;
-  try
-    Result := FAction.Execute;
-  finally
-    if FAction <> nil then
-      FAction.ActionComponent := nil;
-  end;
-end;
-
-
-procedure TBasicActionLink.SetAction(Value: TBasicAction);
-begin
-  if Value <> FAction then
-  begin
-    if FAction <> nil then FAction.UnRegisterChanges(Self);
-    FAction := Value;
-    if Value <> nil then Value.RegisterChanges(Self);
-  end;
-end;
-
-
-function TBasicActionLink.IsOnExecuteLinked: Boolean;
-begin
-  Result := True;
-end;
-
-
-procedure TBasicActionLink.SetOnExecute(Value: TNotifyEvent);
-begin
-end;
-
-
-function TBasicActionLink.Update: Boolean;
-begin
-  Result := FAction.Update;
-end;
-
-{****************************************************************************}
-{*                             TBasicAction                                 *}
-{****************************************************************************}
-
-constructor TBasicAction.Create(AOwner: TComponent);
-begin
-  inherited Create(AOwner);
-  FClients := TList.Create;
-end;
-
-
-destructor TBasicAction.Destroy;
-begin
-  inherited Destroy;
-  while FClients.Count > 0 do
-    UnRegisterChanges(TBasicActionLink(FClients.Last));
-  FClients.Free;
-end;
-
-
-function TBasicAction.HandlesTarget(Target: TObject): Boolean;
-begin
-  Result := False;
-end;
-
-
-procedure TBasicAction.ExecuteTarget(Target: TObject);
-begin
-end;
-
-
-procedure TBasicAction.UpdateTarget(Target: TObject);
-begin
-end;
-
-
-function TBasicAction.Execute: Boolean;
-begin
-  if Assigned(FOnExecute) then
-   begin
-     FOnExecute(Self);
-     Result := True;
-   end
-  else
-   Result := False;
-end;
-
-
-function TBasicAction.Update: Boolean;
-begin
-  if Assigned(FOnUpdate) then
-   begin
-     FOnUpdate(Self);
-     Result := True;
-   end
-  else
-   Result := False;
-end;
-
-
-procedure TBasicAction.SetOnExecute(Value: TNotifyEvent);
-var
-  I: Integer;
-begin
-  if (TMethod(Value).Code <> TMethod(OnExecute).Code) or
-     (TMethod(Value).Data <> TMethod(OnExecute).Data) then
-  begin
-    for I := 0 to FClients.Count - 1 do
-      TBasicActionLink(FClients[I]).SetOnExecute(Value);
-    FOnExecute := Value;
-    Change;
-  end;
-end;
-
-
-procedure TBasicAction.Change;
-begin
-  if Assigned(FOnChange) then
-    FOnChange(Self);
-end;
-
-
-procedure TBasicAction.RegisterChanges(Value: TBasicActionLink);
-begin
-  Value.FAction := Self;
-  FClients.Add(Value);
-end;
-
-
-procedure TBasicAction.UnRegisterChanges(Value: TBasicActionLink);
-var
-  I: Integer;
-begin
-  for I := 0 to FClients.Count - 1 do
-    if TBasicActionLink(FClients[I]) = Value then
-     begin
-       Value.FAction := nil;
-       FClients.Delete(I);
-       break;
-     end;
-end;
-
-
-{
-  $Log: action.inc,v $
-  Revision 1.2  2005/02/14 17:13:11  peter
-    * truncate log
-
-}

fcl/classes/bits.inc

@@ -1,386 +0,0 @@
-{
-    $Id: bits.inc,v 1.2 2005/02/14 17:13:11 peter Exp $
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1999-2000 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-{****************************************************************************}
-{*                               TBits                                      *}
-{****************************************************************************}
-
-ResourceString
-  SErrInvalidBitIndex = 'Invalid bit index : %d';
-  SErrindexTooLarge   = 'Bit index exceeds array limit: %d';
-  SErrOutOfMemory     = 'Out of memory';
-
-Procedure BitsError (Msg : string);
-
-begin
-{$ifdef VER1_0}
-  Raise EBitsError.Create(Msg) at longint(get_caller_addr(get_frame));
-{$else VER1_0}
-  Raise EBitsError.Create(Msg) at get_caller_addr(get_frame);
-{$endif VER1_0}
-end;
-
-Procedure BitsErrorFmt (Msg : string; const Args : array of const);
-
-begin
-{$ifdef VER1_0}
-  Raise EBitsError.CreateFmt(Msg,args) at longint(get_caller_addr(get_frame));
-{$else VER1_0}
-  Raise EBitsError.CreateFmt(Msg,args) at get_caller_addr(get_frame);
-{$endif VER1_0}
-end;
-
-procedure TBits.CheckBitIndex (Bit : longint;CurrentSize : Boolean);
-
-begin
- if (bit<0) or (CurrentSize and (Bit>Size)) then
-   BitsErrorFmt(SErrInvalidBitIndex,[bit]);
- if (bit>=MaxBitFlags) then
-   BitsErrorFmt(SErrIndexTooLarge,[bit])
-
-end;
-
-{ ************* functions to match TBits class ************* }
-
-function TBits.getSize : longint;
-begin
-   result := (FSize shl BITSHIFT) - 1;
-end;
-
-procedure TBits.setSize(value : longint);
-begin
-   grow(value - 1);
-end;
-
-procedure TBits.SetBit(bit : longint; value : Boolean);
-begin
-   if value = True then
-      seton(bit)
-   else
-      clear(bit);
-end;
-
-function TBits.OpenBit : longint;
-var
-   loop : longint;
-   loop2 : longint;
-   startIndex : longint;
-begin
-   result := -1; {should only occur if the whole array is set}
-   for loop := 0 to FSize - 1 do
-   begin
-      if FBits^[loop] <> $FFFFFFFF then
-      begin
-         startIndex := loop * 32;
-         for loop2 := startIndex to startIndex + 31 do
-         begin
-            if get(loop2) = False then
-            begin
-               result := loop2;
-               break; { use this as the index to return }
-            end;
-         end;
-         break;  {stop looking for empty bit in records }
-      end;
-   end;
-
-   if result = -1 then
-      if FSize < MaxBitRec then
-          result := FSize * 32;  {first bit of next record}
-end;
-
-{ ******************** TBits ***************************** }
-
-constructor TBits.Create(theSize : longint);
-begin
-   FSize := 0;
-   FBits := nil;
-   findIndex := -1;
-   findState := True;  { no reason just setting it to something }
-   grow(theSize);
-end;
-
-destructor TBits.Destroy;
-begin
-   if FBits <> nil then
-      FreeMem(FBits, FSize * SizeOf(longint));
-   FBits := nil;
-
-   inherited Destroy;
-end;
-
-procedure TBits.grow(nbit : longint);
-var
-   newSize : longint;
-   loop : longint;
-begin
-   CheckBitindex(nbit,false);
-
-   newSize :=  (nbit shr BITSHIFT) + 1;
-
-   if newSize > FSize then
-   begin
-      ReAllocMem(FBits, newSize * SizeOf(longint));
-      if FBits <> nil then
-        begin
-         if newSize > FSize then
-            for loop := FSize to newSize - 1 do
-               FBits^[loop] := 0;
-         FSize := newSize;
-       end
-      else
-        BitsError(SErrOutOfMemory);
-   end;
-end;
-
-function TBits.getFSize : longint;
-begin
-   result := FSize;
-end;
-
-procedure TBits.seton(bit : longint);
-var
-   n : longint;
-begin
-   n := bit shr BITSHIFT;
-   grow(bit);
-   FBits^[n] := FBits^[n] or (longint(1) shl (bit and MASK));
-end;
-
-procedure TBits.clear(bit : longint);
-var
-   n : longint;
-begin
-   CheckBitIndex(bit,false);
-   n := bit shr BITSHIFT;
-   grow(bit);
-   FBits^[n] := FBits^[n] and not(longint(1) shl (bit and MASK));
-end;
-
-procedure TBits.clearall;
-var
-   loop : longint;
-begin
-   for loop := 0 to FSize - 1 do
-      FBits^[loop] := 0;
-end;
-
-function TBits.get(bit : longint) : Boolean;
-var
-   n : longint;
-begin
-   CheckBitIndex(bit,true);
-   result := False;
-   n := bit shr BITSHIFT;
-   if (n < FSize) then
-      result := (FBits^[n] and (longint(1) shl (bit and MASK))) <> 0;
-end;
-
-procedure TBits.andbits(bitset : TBits);
-var
-   n : longint;
-   loop : longint;
-begin
-   if FSize < bitset.getFSize then
-      n := FSize - 1
-   else
-      n := bitset.getFSize - 1;
-
-   for loop := 0 to n do
-      FBits^[loop] := FBits^[loop] and bitset.FBits^[loop];
-
-   for loop := n + 1 to FSize - 1 do
-      FBits^[loop] := 0;
-end;
-
-procedure TBits.notbits(bitset : TBits);
-var
-   n : longint;
-   jj : longint;
-   loop : longint;
-begin
-   if FSize < bitset.getFSize then
-      n := FSize - 1
-   else
-      n := bitset.getFSize - 1;
-
-   for loop := 0 to n do
-   begin
-      jj := FBits^[loop];
-      FBits^[loop] := FBits^[loop] and (jj xor bitset.FBits^[loop]);
-   end;
-end;
-
-procedure TBits.orbits(bitset : TBits);
-var
-   n : longint;
-   loop : longint;
-begin
-   if FSize < bitset.getFSize then
-      n := bitset.getFSize - 1
-   else
-      n := FSize - 1;
-
-   grow(n shl BITSHIFT);
-
-   for loop := 0 to n do
-      FBits^[loop] := FBits^[loop] or bitset.FBits^[loop];
-end;
-
-procedure TBits.xorbits(bitset : TBits);
-var
-   n : longint;
-   loop : longint;
-begin
-   if FSize < bitset.getFSize then
-      n := bitset.getFSize - 1
-   else
-      n := FSize - 1;
-
-   grow(n shl BITSHIFT);
-
-   for loop := 0 to n do
-      FBits^[loop] := FBits^[loop] xor bitset.FBits^[loop];
-end;
-
-function TBits.equals(bitset : TBits) : Boolean;
-var
-   n : longint;
-   loop : longint;
-begin
-   result := False;
-
-   if FSize < bitset.getFSize then
-      n := FSize - 1
-   else
-      n := bitset.getFSize - 1;
-
-   for loop := 0 to n do
-      if FBits^[loop] <> bitset.FBits^[loop] then exit;
-
-   if FSize - 1 > n then
-   begin
-      for loop := n to FSize - 1 do
-         if FBits^[loop] <> 0 then exit;
-   end
-   else if bitset.getFSize - 1 > n then
-      for loop := n to bitset.getFSize - 1 do
-         if bitset.FBits^[loop] <> 0 then exit;
-
-   result := True;  {passed all tests}
-end;
-
-
-{ us this in place of calling FindFirstBit. It sets the current }
-{ index used by FindNextBit and FindPrevBit                     }
-
-procedure TBits.SetIndex(index : longint);
-begin
-   findIndex := index;
-end;
-
-
-{ When state is set to True it looks for bits that are turned On (1) }
-{ and when it is set to False it looks for bits that are turned      }
-{ off (0).                                                           }
-
-function TBits.FindFirstBit(state : boolean) : longint;
-var
-   loop : longint;
-   loop2 : longint;
-   startIndex : longint;
-   compareVal : cardinal;
-begin
-   result := -1; {should only occur if none are set}
-
-   findState := state;
-
-   if state = False then
-      compareVal := $FFFFFFFF  { looking for off bits }
-   else
-      compareVal := $00000000; { looking for on bits }
-
-   for loop := 0 to FSize - 1 do
-   begin
-      if FBits^[loop] <> compareVal then
-      begin
-         startIndex := loop * 32;
-         for loop2 := startIndex to startIndex + 31 do
-         begin
-            if get(loop2) = state then
-            begin
-               result := loop2;
-               break; { use this as the index to return }
-            end;
-         end;
-         break;  {stop looking for bit in records }
-      end;
-   end;
-
-   findIndex := result;
-end;
-
-function TBits.FindNextBit : longint;
-var
-   loop : longint;
-   maxVal : longint;
-begin
-   result := -1;  { will occur only if no other bits set to }
-                  { current findState                        }
-
-   if findIndex > -1 then { must have called FindFirstBit first }
-   begin                  { or set the start index              }
-      maxVal := (FSize * 32) - 1;
-
-      for loop := findIndex + 1 to maxVal  do
-      begin
-         if get(loop) = findState then
-         begin
-            result := loop;
-            break;
-         end;
-      end;
-
-      findIndex := result;
-   end;
-end;
-
-function TBits.FindPrevBit : longint;
-var
-   loop : longint;
-begin
-   result := -1;  { will occur only if no other bits set to }
-                  { current findState                        }
-
-   if findIndex > -1 then { must have called FindFirstBit first }
-   begin                  { or set the start index              }
-      for loop := findIndex - 1 downto 0  do
-      begin
-         if get(loop) = findState then
-         begin
-            result := loop;
-            break;
-         end;
-      end;
-
-      findIndex := result;
-   end;
-end;
-
-
-{
-  $Log: bits.inc,v $
-  Revision 1.2  2005/02/14 17:13:11  peter
-    * truncate log
-
-}

fcl/classes/classes.inc

@@ -1,1234 +0,0 @@
-{
-    $Id: classes.inc,v 1.3 2005/02/14 17:13:11 peter Exp $
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1999-2000 by Michael Van Canneyt and Florian Klaempfl
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-{**********************************************************************
- *       Class implementations are in separate files.                 *
- **********************************************************************}
-
-var
-  ClassList : TThreadlist;
-  ClassAliasList : TStringList;
-
-{
- Include all message strings
-
- Add a language with IFDEF LANG_NAME
- just befor the final ELSE. This way English will always be the default.
-}
-
-{$IFDEF LANG_GERMAN}
-{$i constsg.inc}
-{$ELSE}
-{$IFDEF LANG_SPANISH}
-{$i constss.inc}
-{$ELSE}
-{$i constse.inc}
-{$ENDIF}
-{$ENDIF}
-
-{ Utility routines }
-{$i util.inc}
-
-{ TBits implementation }
-{$i bits.inc}
-
-{ All streams implementations: }
-{ Tstreams THandleStream TFileStream TResourcseStreams TStringStream }
-{ TCustomMemoryStream TMemoryStream }
-{$i streams.inc}
-
-{ TParser implementation}
-{$i parser.inc}
-
-{ TCollection and TCollectionItem implementations }
-{$i collect.inc}
-
-{ TList and TThreadList implementations }
-{$i lists.inc}
-
-{ TStrings and TStringList implementations }
-{$i stringl.inc}
-
-{$ifndef VER1_0}
-{ TThread implementation }
-{$i tthread.inc}
-{$endif}
-
-{ TPersistent implementation }
-{$i persist.inc }
-
-{ TComponent implementation }
-{$i compon.inc}
-
-{ TBasicAction implementation }
-{$i action.inc}
-
-{ TDataModule implementation }
-{$i dm.inc}
-
-{ Class and component registration routines }
-{$I cregist.inc}
-
-
-
-{ Interface related stuff }
-{$ifdef HASINTF}
-{$I intf.inc}
-{$endif HASINTF}
-
-{**********************************************************************
- *       Miscellaneous procedures and functions                       *
- **********************************************************************}
-
-{ Point and rectangle constructors }
-
-function Point(AX, AY: Integer): TPoint;
-
-begin
-  with Result do
-  begin
-    X := AX;
-    Y := AY;
-  end;
-end;
-
-
-function SmallPoint(AX, AY: SmallInt): TSmallPoint;
-
-begin
-  with Result do
-  begin
-    X := AX;
-    Y := AY;
-  end;
-end;
-
-
-function Rect(ALeft, ATop, ARight, ABottom: Integer): TRect;
-
-begin
-  with Result do
-  begin
-    Left := ALeft;
-    Top := ATop;
-    Right := ARight;
-    Bottom := ABottom;
-  end;
-end;
-
-
-function Bounds(ALeft, ATop, AWidth, AHeight: Integer): TRect;
-
-begin
-  with Result do
-  begin
-    Left := ALeft;
-    Top := ATop;
-    Right := ALeft + AWidth;
-    Bottom :=  ATop + AHeight;
-  end;
-end;
-
-
-
-
-
-{ Object filing routines }
-
-var
-  IntConstList: TThreadList;
-
-
-type
-  TIntConst = class
-    IntegerType: PTypeInfo;             // The integer type RTTI pointer
-    IdentToIntFn: TIdentToInt;          // Identifier to Integer conversion
-    IntToIdentFn: TIntToIdent;          // Integer to Identifier conversion
-    constructor Create(AIntegerType: PTypeInfo; AIdentToInt: TIdentToInt;
-      AIntToIdent: TIntToIdent);
-  end;
-
-constructor TIntConst.Create(AIntegerType: PTypeInfo; AIdentToInt: TIdentToInt;
-  AIntToIdent: TIntToIdent);
-begin
-  IntegerType := AIntegerType;
-  IdentToIntFn := AIdentToInt;
-  IntToIdentFn := AIntToIdent;
-end;
-
-procedure RegisterIntegerConsts(IntegerType: Pointer; IdentToIntFn: TIdentToInt;
-  IntToIdentFn: TIntToIdent);
-begin
-  IntConstList.Add(TIntConst.Create(IntegerType, IdentToIntFn, IntToIdentFn));
-end;
-
-function FindIntToIdent(AIntegerType: Pointer): TIntToIdent;
-var
-  i: Integer;
-begin
-  with IntConstList.LockList do
-  try
-    for i := 0 to Count - 1 do
-      if TIntConst(Items[i]).IntegerType = AIntegerType then
-        exit(TIntConst(Items[i]).IntToIdentFn);
-    Result := nil;
-  finally
-    IntConstList.UnlockList;
-  end;
-end;
-
-function FindIdentToInt(AIntegerType: Pointer): TIdentToInt;
-var
-  i: Integer;
-begin
-  with IntConstList.LockList do
-  try
-    for i := 0 to Count - 1 do
-      with TIntConst(Items[I]) do
-        if TIntConst(Items[I]).IntegerType = AIntegerType then
-          exit(IdentToIntFn);
-    Result := nil;
-  finally
-    IntConstList.UnlockList;
-  end;
-end;
-
-function IdentToInt(const Ident: String; var Int: LongInt;
-  const Map: array of TIdentMapEntry): Boolean;
-var
-  i: Integer;
-begin
-  for i := Low(Map) to High(Map) do
-    if CompareText(Map[i].Name, Ident) = 0 then
-    begin
-      Int := Map[i].Value;
-      exit(True);
-    end;
-  Result := False;
-end;
-
-function IntToIdent(Int: LongInt; var Ident: String;
-  const Map: array of TIdentMapEntry): Boolean;
-var
-  i: Integer;
-begin
-  for i := Low(Map) to High(Map) do
-    if Map[i].Value = Int then
-    begin
-      Ident := Map[i].Name;
-      exit(True);
-    end;
-  Result := False;
-end;
-
-function GlobalIdentToInt(const Ident: String; var Int: LongInt):boolean;
-var
-  i : Integer;
-begin
-  with IntConstList.LockList do
-    try
-      for i := 0 to Count - 1 do
-        if TIntConst(Items[I]).IdentToIntFn(Ident, Int) then
-          Exit(True);
-      Result := false;
-    finally
-      IntConstList.UnlockList;
-    end;
-end;
-
-{ TPropFixup }
-
-type
-  TPropFixup = class
-    FInstance: TPersistent;
-    FInstanceRoot: TComponent;
-    FPropInfo: PPropInfo;
-    FRootName: string;
-    FName: string;
-    constructor Create(AInstance: TPersistent; AInstanceRoot: TComponent;
-      APropInfo: PPropInfo; const ARootName, AName: String);
-    function MakeGlobalReference: Boolean;
-  end;
-
-var
-  GlobalFixupList: TThreadList;
-
-constructor TPropFixup.Create(AInstance: TPersistent; AInstanceRoot: TComponent;
-  APropInfo: PPropInfo; const ARootName, AName: String);
-begin
-  FInstance := AInstance;
-  FInstanceRoot := AInstanceRoot;
-  FPropInfo := APropInfo;
-  FRootName := ARootName;
-  FName := AName;
-end;
-
-function TPropFixup.MakeGlobalReference: Boolean;
-var
-  i: Integer;
-  s, p: PChar;
-begin
-  i := Pos('.', FName);
-  if i = 0 then
-    exit(False);
-  FRootName := Copy(FName, 1, i - 1);
-  FName := Copy(FName, i + 1, Length(FName));
-  Result := True;
-end;
-
-Type
-  TInitHandler = Class(TObject)
-    AHandler : TInitComponentHandler;
-    AClass : TComponentClass;
-  end;
-
-Var
-  InitHandlerList : TList;
-
-procedure RegisterInitComponentHandler(ComponentClass: TComponentClass;   Handler: TInitComponentHandler);
-
-Var
-  I : Integer;
-  H: TInitHandler;
-
-begin
-  If (InitHandlerList=Nil) then
-    InitHandlerList:=TList.Create;
-  H:=TInitHandler.Create;
-  H.Aclass:=ComponentClass;
-  H.AHandler:=Handler;
-  With InitHandlerList do
-    begin
-    I:=0;
-    While (I<Count) and not H.AClass.InheritsFrom(TInitHandler(Items[i]).AClass) do
-      Inc(I);
-    InitHandlerList.Insert(I,H);
-    end;
-end;
-
-function InitInheritedComponent(Instance: TComponent; RootAncestor: TClass): Boolean;
-
-Var
-  I : Integer;
-
-begin
-  I:=0;
-  Result:=False;
-  With InitHandlerList do
-    begin
-    I:=0;
-    // Instance is the normally the lowest one, so that one should be used when searching.
-    While Not result and (I<Count) do
-      begin
-      If (Instance.InheritsFrom(TInitHandler(Items[i]).AClass)) then
-        Result:=TInitHandler(Items[i]).AHandler(Instance,RootAncestor);
-      Inc(I);
-      end;
-    end;
-end;
-
-
-function InitComponentRes(const ResName: String; Instance: TComponent): Boolean;
-
-begin
-  { !!!: Too Win32-specific }
-  InitComponentRes := False;
-end;
-
-
-function ReadComponentRes(const ResName: String; Instance: TComponent): TComponent;
-
-begin
-  { !!!: Too Win32-specific }
-  ReadComponentRes := nil;
-end;
-
-
-function ReadComponentResEx(HInstance: THandle; const ResName: String): TComponent;
-
-begin
-  { !!!: Too Win32-specific in VCL }
-  ReadComponentResEx := nil;
-end;
-
-
-function ReadComponentResFile(const FileName: String; Instance: TComponent): TComponent;
-var
-  FileStream: TStream;
-begin
-  FileStream := TFileStream.Create(FileName, fmOpenRead {!!!:or fmShareDenyWrite});
-  try
-    Result := FileStream.ReadComponentRes(Instance);
-  finally
-    FileStream.Free;
-  end;
-end;
-
-
-procedure WriteComponentResFile(const FileName: String; Instance: TComponent);
-var
-  FileStream: TStream;
-begin
-  FileStream := TFileStream.Create(FileName, fmCreate);
-  try
-    FileStream.WriteComponentRes(Instance.ClassName, Instance);
-  finally
-    FileStream.Free;
-  end;
-end;
-
-
-procedure GlobalFixupReferences;
-var
-  GlobalList, DoneList, ToDoList: TList;
-  I, Index: Integer;
-  Root: TComponent;
-  Instance: TPersistent;
-  Reference: Pointer;
-begin
-  if not Assigned(FindGlobalComponent) then
-    exit;
-
-  {!!!: GlobalNameSpace.BeginWrite;
-  try}
-    GlobalList := GlobalFixupList.LockList;
-    try
-      if GlobalList.Count > 0 then
-      begin
-        ToDoList := nil;
-        DoneList := TList.Create;
-        ToDoList := TList.Create;
-        try
-          i := 0;
-          while i < GlobalList.Count do
-            with TPropFixup(GlobalList[i]) do
-            begin
-              Root := FindGlobalComponent(FRootName);
-              if Assigned(Root) or (GetOrdProp(FInstance, FPropInfo) <> 0) then
-              begin
-                if Assigned(Root) then
-                begin
-                  Reference := FindNestedComponent(Root, FName);
-                  SetOrdProp(FInstance, FPropInfo, Longint(Reference));
-                end;
-                // Move component to list of done components, if necessary
-                if (DoneList.IndexOf(FInstance) < 0) and
-                  (ToDoList.IndexOf(FInstance) >= 0) then
-                  DoneList.Add(FInstance);
-                GlobalList.Delete(i);
-                Free;   // ...the fixup
-              end else
-              begin
-                // Move component to list of components to process, if necessary
-                Index := DoneList.IndexOf(FInstance);
-                if Index <> -1 then
-                  DoneList.Delete(Index);
-                if ToDoList.IndexOf(FInstance) < 0 then
-                  ToDoList.Add(FInstance);
-                Inc(i);
-              end;
-            end;
-            for i := 0 to DoneList.Count - 1 do
-            begin
-              Instance := TPersistent(DoneList[I]);
-              if Instance.InheritsFrom(TComponent) then
-                Exclude(TComponent(Instance).FComponentState, csFixups);
-            end;
-          finally
-            ToDoList.Free;
-            DoneList.Free;
-          end;
-        end;
-    finally
-      GlobalFixupList.UnlockList;
-    end;
-  {finally
-    GlobalNameSpace.EndWrite;
-  end;}
-end;
-
-
-function IsStringInList(const AString: String; AList: TStrings): Boolean;
-var
-  i: Integer;
-begin
-  for i := 0 to AList.Count - 1 do
-    if CompareText(AList[i], AString) = 0 then
-      exit(True);
-  Result := False;
-end;
-
-
-procedure GetFixupReferenceNames(Root: TComponent; Names: TStrings);
-var
-  i: Integer;
-  CurFixup: TPropFixup;
-begin
-  with GlobalFixupList.LockList do
-    try
-      for i := 0 to Count - 1 do
-      begin
-        CurFixup := TPropFixup(Items[i]);
-        if ((not Assigned(Root)) or (CurFixup.FInstanceRoot = Root)) and
-          not IsStringInList(CurFixup.FRootName, Names) then
-          Names.Add(CurFixup.FRootName);
-      end;
-    finally
-      GlobalFixupList.UnlockList;
-    end;
-end;
-
-
-procedure GetFixupInstanceNames(Root: TComponent;
-  const ReferenceRootName: string; Names: TStrings);
-var
-  i: Integer;
-  CurFixup: TPropFixup;
-begin
-  with GlobalFixupList.LockList do
-    try
-      for i := 0 to Count - 1 do
-      begin
-        CurFixup := TPropFixup(Items[i]);
-        if (CurFixup.FInstanceRoot = Root) and
-          (UpperCase(ReferenceRootName) = UpperCase(CurFixup.FRootName)) and
-          not IsStringInList(CurFixup.FName, Names) then
-          Names.Add(CurFixup.FName);
-      end;
-    finally
-      GlobalFixupList.UnlockList;
-    end;
-end;
-
-
-procedure RedirectFixupReferences(Root: TComponent; const OldRootName,
-  NewRootName: string);
-var
-  i: Integer;
-  CurFixup: TPropFixup;
-begin
-  with GlobalFixupList.LockList do
-    try
-      for i := 0 to Count - 1 do
-      begin
-        CurFixup := TPropFixup(Items[i]);
-        if ((not Assigned(Root)) or (CurFixup.FInstanceRoot = Root)) and
-          (UpperCase(OldRootName) = UpperCase(CurFixup.FRootName)) then
-          CurFixup.FRootName := NewRootName;
-      end;
-      GlobalFixupReferences;
-    finally
-      GlobalFixupList.Unlocklist;
-    end;
-end;
-
-
-procedure RemoveFixupReferences(Root: TComponent; const RootName: string);
-var
-  i: Integer;
-  CurFixup: TPropFixup;
-begin
-  if not Assigned(GlobalFixupList) then
-    exit;
-
-  with GlobalFixupList.LockList do
-    try
-      for i := Count - 1 downto 0 do
-      begin
-        CurFixup := TPropFixup(Items[i]);
-        if ((not Assigned(Root)) or (CurFixup.FInstanceRoot = Root)) and
-          ((Length(RootName) = 0) or
-          (UpperCase(RootName) = UpperCase(CurFixup.FRootName))) then
-        begin
-          Delete(i);
-          CurFixup.Free;
-        end;
-      end;
-    finally
-      GlobalFixupList.UnlockList;
-    end;
-end;
-
-
-procedure RemoveFixups(Instance: TPersistent);
-var
-  i: Integer;
-  CurFixup: TPropFixup;
-begin
-  if not Assigned(GlobalFixupList) then
-    exit;
-
-  with GlobalFixupList.LockList do
-    try
-      for i := Count - 1 downto 0 do
-      begin
-        CurFixup := TPropFixup(Items[i]);
-        if (CurFixup.FInstance = Instance) then
-        begin
-          Delete(i);
-          CurFixup.Free;
-        end;
-      end;
-    finally
-      GlobalFixupList.UnlockList;
-    end;
-end;
-
-
-function FindNestedComponent(Root: TComponent; const NamePath: string): TComponent;
-var
-  Current, Found: TComponent;
-  s, p: PChar;
-  Name: String;
-begin
-  Result := nil;
-  if Length(NamePath) > 0 then
-  begin
-    Current := Root;
-    p := PChar(NamePath);
-    while p[0] <> #0 do
-    begin
-      s := p;
-      while not (p^ in ['.', '-', #0]) do
-        Inc(p);
-      SetString(Name, s, p - s);
-      Found := Current.FindComponent(Name);
-      if (not Assigned(Found)) and (UpperCase(Name) = 'OWNER') then
-        Found := Current;
-      if not Assigned(Found) then exit;
-
-      // Remove the dereference operator from the name
-      if p[0] = '.' then
-        Inc(P);
-      if p[0] = '-' then
-        Inc(P);
-      if p[0] = '>' then
-        Inc(P);
-
-      Current := Found;
-    end;
-  end;
-  Result := Current;
-end;
-
-{!!!: Should be threadvar  -  doesn't work for all platforms yet!}
-var
-  GlobalLoaded, GlobalLists: TList;
-
-
-procedure BeginGlobalLoading;
-
-begin
-  if not Assigned(GlobalLists) then
-    GlobalLists := TList.Create;
-  GlobalLists.Add(GlobalLoaded);
-  GlobalLoaded := TList.Create;
-end;
-
-
-{ Notify all global components that they have been loaded completely }
-procedure NotifyGlobalLoading;
-var
-  i: Integer;
-begin
-  for i := 0 to GlobalLoaded.Count - 1 do
-    TComponent(GlobalLoaded[i]).Loaded;
-end;
-
-
-procedure EndGlobalLoading;
-begin
-  { Free the memory occupied by BeginGlobalLoading }
-  GlobalLoaded.Free;
-  GlobalLoaded := TList(GlobalLists.Last);
-  GlobalLists.Delete(GlobalLists.Count - 1);
-  if GlobalLists.Count = 0 then
-  begin
-    GlobalLists.Free;
-    GlobalLists := nil;
-  end;
-end;
-
-
-function CollectionsEqual(C1, C2: TCollection): Boolean;
-begin
-  // !!!: Implement this
-  CollectionsEqual:=false;
-end;
-
-
-
-{ Object conversion routines }
-
-procedure ObjectBinaryToText(Input, Output: TStream);
-
-  procedure OutStr(s: String);
-  begin
-    if Length(s) > 0 then
-      Output.Write(s[1], Length(s));
-  end;
-
-  procedure OutLn(s: String);
-  begin
-    OutStr(s + #10);
-  end;
-
-  procedure OutString(s: String);
-  var
-    res, NewStr: String;
-    i: Integer;
-    InString, NewInString: Boolean;
-  begin
-    res := '';
-    InString := False;
-    for i := 1 to Length(s) do begin
-      NewInString := InString;
-      case s[i] of
-        #0..#31: begin
-            if InString then
-              NewInString := False;
-            NewStr := '#' + IntToStr(Ord(s[i]));
-          end;
-        '''':
-            if InString then NewStr := ''''''
-            else NewStr := '''''''';
-        else begin
-          if not InString then
-            NewInString := True;
-          NewStr := s[i];
-        end;
-      end;
-      if NewInString <> InString then begin
-        NewStr := '''' + NewStr;
-        InString := NewInString;
-      end;
-      res := res + NewStr;
-    end;
-    if InString then res := res + '''';
-    OutStr(res);
-  end;
-
-  function ReadInt(ValueType: TValueType): LongInt;
-  begin
-    case ValueType of
-      vaInt8: Result := ShortInt(Input.ReadByte);
-      vaInt16: Result := SmallInt(Input.ReadWord);
-      vaInt32: Result := LongInt(Input.ReadDWord);
-    end;
-  end;
-
-  function ReadInt: LongInt;
-  begin
-    Result := ReadInt(TValueType(Input.ReadByte));
-  end;
-
-  function ReadSStr: String;
-  var
-    len: Byte;
-  begin
-    len := Input.ReadByte;
-    SetLength(Result, len);
-    Input.Read(Result[1], len);
-  end;
-
-  procedure ReadPropList(indent: String);
-
-    procedure ProcessValue(ValueType: TValueType; Indent: String);
-
-      procedure Stop(s: String);
-      begin
-        WriteLn(s);
-        Halt;
-      end;
-
-      procedure ProcessBinary;
-      var
-        ToDo, DoNow, i: LongInt;
-        lbuf: array[0..31] of Byte;
-        s: String;
-      begin
-        ToDo := Input.ReadDWord;
-        OutLn('{');
-        while ToDo > 0 do begin
-          DoNow := ToDo;
-          if DoNow > 32 then DoNow := 32;
-          Dec(ToDo, DoNow);
-          s := Indent + '  ';
-          Input.Read(lbuf, DoNow);
-          for i := 0 to DoNow - 1 do
-            s := s + IntToHex(lbuf[i], 2);
-          OutLn(s);
-        end;
-        OutLn(indent + '}');
-      end;
-
-    var
-      s: String;
-      len: LongInt;
-      IsFirst: Boolean;
-      ext: Extended;
-
-    begin
-      case ValueType of
-        vaList: begin
-            OutStr('(');
-            IsFirst := True;
-            while True do begin
-              ValueType := TValueType(Input.ReadByte);
-              if ValueType = vaNull then break;
-              if IsFirst then begin
-                OutLn('');
-                IsFirst := False;
-              end;
-              OutStr(Indent + '  ');
-              ProcessValue(ValueType, Indent + '  ');
-            end;
-            OutLn(Indent + ')');
-          end;
-        vaInt8: OutLn(IntToStr(ShortInt(Input.ReadByte)));
-        vaInt16: OutLn( IntToStr(SmallInt(Input.ReadWord)));
-        vaInt32: OutLn(IntToStr(LongInt(Input.ReadDWord)));
-        vaExtended: begin
-            Input.Read(ext, SizeOf(ext));
-            OutLn(FloatToStr(ext));
-          end;
-        vaString: begin
-            OutString(ReadSStr);
-            OutLn('');
-          end;
-        vaIdent: OutLn(ReadSStr);
-        vaFalse: OutLn('False');
-        vaTrue: OutLn('True');
-        vaBinary: ProcessBinary;
-        vaSet: begin
-            OutStr('[');
-            IsFirst := True;
-            while True do begin
-              s := ReadSStr;
-              if Length(s) = 0 then break;
-              if not IsFirst then OutStr(', ');
-              IsFirst := False;
-              OutStr(s);
-            end;
-            OutLn(']');
-          end;
-        vaLString:
-          Stop('!!LString!!');
-        vaNil:
-          OutLn('nil');
-        vaCollection: begin
-            OutStr('<');
-            while Input.ReadByte <> 0 do begin
-              OutLn(Indent);
-              Input.Seek(-1, soFromCurrent);
-              OutStr(indent + '  item');
-              ValueType := TValueType(Input.ReadByte);
-              if ValueType <> vaList then
-                OutStr('[' + IntToStr(ReadInt(ValueType)) + ']');
-              OutLn('');
-              ReadPropList(indent + '    ');
-              OutStr(indent + '  end');
-            end;
-            OutLn('>');
-          end;
-        {vaSingle: begin OutLn('!!Single!!'); exit end;
-        vaCurrency: begin OutLn('!!Currency!!'); exit end;
-        vaDate: begin OutLn('!!Date!!'); exit end;
-        vaWString: begin OutLn('!!WString!!'); exit end;}
-        else
-          Stop(IntToStr(Ord(ValueType)));
-      end;
-    end;
-
-  begin
-    while Input.ReadByte <> 0 do begin
-      Input.Seek(-1, soFromCurrent);
-      OutStr(indent + ReadSStr + ' = ');
-      ProcessValue(TValueType(Input.ReadByte), Indent);
-    end;
-  end;
-
-  procedure ReadObject(indent: String);
-  var
-    b: Byte;
-    ObjClassName, ObjName: String;
-    ChildPos: LongInt;
-  begin
-    // Check for FilerFlags
-    b := Input.ReadByte;
-    if (b and $f0) = $f0 then begin
-      if (b and 2) <> 0 then ChildPos := ReadInt;
-    end else begin
-      b := 0;
-      Input.Seek(-1, soFromCurrent);
-    end;
-
-    ObjClassName := ReadSStr;
-    ObjName := ReadSStr;
-
-    OutStr(Indent);
-    if (b and 1) <> 0 then OutStr('inherited')
-    else OutStr('object');
-    OutStr(' ');
-    if ObjName <> '' then
-      OutStr(ObjName + ': ');
-    OutStr(ObjClassName);
-    if (b and 2) <> 0 then OutStr('[' + IntToStr(ChildPos) + ']');
-    OutLn('');
-
-    ReadPropList(indent + '  ');
-
-    while Input.ReadByte <> 0 do begin
-      Input.Seek(-1, soFromCurrent);
-      ReadObject(indent + '  ');
-    end;
-    OutLn(indent + 'end');
-  end;
-
-type
-  PLongWord = ^LongWord;
-const
-  signature: PChar = 'TPF0';
-begin
-  if Input.ReadDWord <> PLongWord(Pointer(signature))^ then
-    raise EReadError.Create('Illegal stream image' {###SInvalidImage});
-  ReadObject('');
-end;
-
-
-procedure ObjectTextToBinary(Input, Output: TStream);
-var
-  parser: TParser;
-
-  procedure WriteString(s: String);
-  begin
-    Output.WriteByte(Length(s));
-    if Length(s) > 0 then
-      Output.Write(s[1], Length(s));
-  end;
-
-  procedure WriteInteger(value: LongInt);
-  begin
-    if (value >= -128) and (value <= 127) then begin
-      Output.WriteByte(Ord(vaInt8));
-      Output.WriteByte(Byte(value));
-    end else if (value >= -32768) and (value <= 32767) then begin
-      Output.WriteByte(Ord(vaInt16));
-      Output.WriteWord(Word(value));
-    end else begin
-      Output.WriteByte(ord(vaInt32));
-      Output.WriteDWord(LongWord(value));
-    end;
-  end;
-
-  procedure ProcessProperty; forward;
-
-  procedure ProcessValue;
-  var
-    flt: Extended;
-    s: String;
-    stream: TMemoryStream;
-  begin
-    case parser.Token of
-      toInteger:
-        begin
-          WriteInteger(parser.TokenInt);
-          parser.NextToken;
-        end;
-      toFloat:
-        begin
-          Output.WriteByte(Ord(vaExtended));
-          flt := Parser.TokenFloat;
-          Output.Write(flt, SizeOf(flt));
-          parser.NextToken;
-        end;
-      toString:
-        begin
-          s := parser.TokenString;
-          while parser.NextToken = '+' do
-          begin
-            parser.NextToken;   // Get next string fragment
-            parser.CheckToken(toString);
-            s := s + parser.TokenString;
-          end;
-          Output.WriteByte(Ord(vaString));
-          WriteString(s);
-        end;
-      toSymbol:
-        begin
-          if CompareText(parser.TokenString, 'True') = 0 then
-            Output.WriteByte(Ord(vaTrue))
-          else if CompareText(parser.TokenString, 'False') = 0 then
-            Output.WriteByte(Ord(vaFalse))
-          else if CompareText(parser.TokenString, 'nil') = 0 then
-            Output.WriteByte(Ord(vaNil))
-          else
-          begin
-            Output.WriteByte(Ord(vaIdent));
-            WriteString(parser.TokenComponentIdent);
-          end;
-          Parser.NextToken;
-        end;
-      // Set
-      '[':
-        begin
-          parser.NextToken;
-          Output.WriteByte(Ord(vaSet));
-          if parser.Token <> ']' then
-            while True do
-            begin
-              parser.CheckToken(toSymbol);
-              WriteString(parser.TokenString);
-              parser.NextToken;
-              if parser.Token = ']' then
-                break;
-              parser.CheckToken(',');
-              parser.NextToken;
-            end;
-          Output.WriteByte(0);
-          parser.NextToken;
-        end;
-      // List
-      '(':
-        begin
-          parser.NextToken;
-          Output.WriteByte(Ord(vaList));
-          while parser.Token <> ')' do
-            ProcessValue;
-          Output.WriteByte(0);
-          parser.NextToken;
-        end;
-      // Collection
-      '<':
-        begin
-          parser.NextToken;
-          Output.WriteByte(Ord(vaCollection));
-          while parser.Token <> '>' do
-          begin
-            parser.CheckTokenSymbol('item');
-            parser.NextToken;
-            // ConvertOrder
-            Output.WriteByte(Ord(vaList));
-            while not parser.TokenSymbolIs('end') do
-              ProcessProperty;
-            parser.NextToken;   // Skip 'end'
-            Output.WriteByte(0);
-          end;
-          Output.WriteByte(0);
-          parser.NextToken;
-        end;
-      // Binary data
-      '{':
-        begin
-          Output.WriteByte(Ord(vaBinary));
-          stream := TMemoryStream.Create;
-          try
-            parser.HexToBinary(stream);
-            Output.WriteDWord(stream.Size);
-            Output.Write(Stream.Memory^, stream.Size);
-          finally
-            stream.Free;
-          end;
-          parser.NextToken;
-        end;
-      else
-        parser.Error(SInvalidProperty);
-    end;
-  end;
-
-  procedure ProcessProperty;
-  var
-    name: String;
-  begin
-    // Get name of property
-    parser.CheckToken(toSymbol);
-    name := parser.TokenString;
-    while True do begin
-      parser.NextToken;
-      if parser.Token <> '.' then break;
-      parser.NextToken;
-      parser.CheckToken(toSymbol);
-      name := name + '.' + parser.TokenString;
-    end;
-    WriteString(name);
-    parser.CheckToken('=');
-    parser.NextToken;
-    ProcessValue;
-  end;
-
-  procedure ProcessObject;
-  var
-    IsInherited: Boolean;
-    ObjectName, ObjectType: String;
-  begin
-    if parser.TokenSymbolIs('OBJECT') then
-      IsInherited := False
-    else begin
-      parser.CheckTokenSymbol('INHERITED');
-      IsInherited := True;
-    end;
-    parser.NextToken;
-    parser.CheckToken(toSymbol);
-    ObjectName := '';
-    ObjectType := parser.TokenString;
-    parser.NextToken;
-    if parser.Token = ':' then begin
-      parser.NextToken;
-      parser.CheckToken(toSymbol);
-      ObjectName := ObjectType;
-      ObjectType := parser.TokenString;
-      parser.NextToken;
-    end;
-    WriteString(ObjectType);
-    WriteString(ObjectName);
-
-    // Convert property list
-    while not (parser.TokenSymbolIs('END') or
-      parser.TokenSymbolIs('OBJECT') or
-      parser.TokenSymbolIs('INHERITED')) do
-      ProcessProperty;
-    Output.WriteByte(0);        // Terminate property list
-
-    // Convert child objects
-    while not parser.TokenSymbolIs('END') do ProcessObject;
-    parser.NextToken;           // Skip end token
-    Output.WriteByte(0);        // Terminate property list
-  end;
-
-const
-  signature: PChar = 'TPF0';
-begin
-  parser := TParser.Create(Input);
-  try
-    Output.Write(signature[0], 4);
-    ProcessObject;
-  finally
-    parser.Free;
-  end;
-end;
-
-
-procedure ObjectResourceToText(Input, Output: TStream);
-begin
-  Input.ReadResHeader;
-  ObjectBinaryToText(Input, Output);
-end;
-
-
-procedure ObjectTextToResource(Input, Output: TStream);
-var
-  StartPos, SizeStartPos, BinSize: LongInt;
-  parser: TParser;
-  name: String;
-begin
-  // Get form type name
-  StartPos := Input.Position;
-  parser := TParser.Create(Input);
-  try
-    if not parser.TokenSymbolIs('OBJECT') then parser.CheckTokenSymbol('INHERITED');
-    parser.NextToken;
-    parser.CheckToken(toSymbol);
-    parser.NextToken;
-    parser.CheckToken(':');
-    parser.NextToken;
-    parser.CheckToken(toSymbol);
-    name := parser.TokenString;
-  finally
-    parser.Free;
-    Input.Position := StartPos;
-  end;
-
-  // Write resource header
-  name := UpperCase(name);
-  Output.WriteByte($ff);
-  Output.WriteByte(10);
-  Output.WriteByte(0);
-  Output.Write(name[1], Length(name) + 1);      // Write null-terminated form type name
-  Output.WriteWord($1030);
-  SizeStartPos := Output.Position;
-  Output.WriteDWord(0);                 // Placeholder for data size
-  ObjectTextToBinary(Input, Output);    // Convert the stuff!
-  BinSize := Output.Position - SizeStartPos - 4;
-  Output.Position := SizeStartPos;
-  Output.WriteDWord(BinSize);           // Insert real resource data size
-end;
-
-
-
-{ Utility routines }
-
-function LineStart(Buffer, BufPos: PChar): PChar;
-
-begin
-  Result := BufPos;
-  while Result > Buffer do begin
-    Dec(Result);
-    if Result[0] = #10 then break;
-  end;
-end;
-
-procedure CommonInit;
-begin
-  InitHandlerList:=Nil;
-  IntConstList := TThreadList.Create;
-  GlobalFixupList := TThreadList.Create;
-  ClassList := TThreadList.Create;
-  ClassAliasList := TStringList.Create;
-end;
-
-procedure CommonCleanup;
-var
-  i: Integer;
-begin
-  // !!!: GlobalNameSpace.BeginWrite;
-  with IntConstList.LockList do
-    try
-      for i := 0 to Count - 1 do
-        TIntConst(Items[I]).Free;
-    finally
-      IntConstList.UnlockList;
-    end;
-    IntConstList.Free;
-  ClassList.Free;
-  ClassAliasList.Free;
-  RemoveFixupReferences(nil, '');
-  GlobalFixupList.Free;
-  GlobalFixupList := nil;
-  GlobalLists.Free;
-  ComponentPages.Free;
-  {!!!: GlobalNameSpace.Free;
-  GlobalNameSpace := nil;}
-  InitHandlerList.Free;
-  InitHandlerList:=Nil;
-end;
-
-
-
-{ TFiler implementation }
-{$i filer.inc}
-
-{ TReader implementation }
-{$i reader.inc}
-
-{ TWriter implementations }
-{$i writer.inc}
-{$i twriter.inc}
-
-
-{
-  $Log: classes.inc,v $
-  Revision 1.3  2005/02/14 17:13:11  peter
-    * truncate log
-
-}

fcl/classes/classesh.inc

@@ -1,1484 +0,0 @@
-{
-    $Id: classesh.inc,v 1.5 2005/02/14 17:13:11 peter Exp $
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1999-2000 by Michael Van Canneyt and Florian Klaempfl
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-{$H+}
-
-{ The 1.0 compiler cannot compile the Seek(int64) overloading correct }
-{$ifndef ver1_0}
-  {$define seek64bit}
-{$endif ver1_0}
-
-type
-   { extra types to compile with FPC }
-   HRSRC = longint;
-   THANDLE = longint;
-   TComponentName = string;
-{$ifdef ver1_0}
-   // 1.0 doesn't have thread
-   TRTLCriticalSection = record
-     locked : longint;
-   end;
-   // 1.1 and above has interfaces
-   IUnknown = class(TObject);
-   TGUID = longint;
-{$endif ver1_0}
-   HMODULE = longint;
-
-   TPoint = record
-      x,y : integer;
-   end;
-   TRect = record
-      Case Integer of
-       0 : ( Left,Top,Right,Bottom : integer);
-       1 : ( TopLeft,BottomRight : TPoint);
-   end;
-
-   TSmallPoint = record
-      x,y : smallint;
-   end;
-
-
-const
-
-{ Maximum TList size }
-
-  MaxListSize = Maxint div 16;
-
-{ values for TShortCut }
-
-  scShift = $2000;
-  scCtrl = $4000;
-  scAlt = $8000;
-  scNone = 0;
-
-{ TStream seek origins }
-const
-  soFromBeginning = 0;
-  soFromCurrent = 1;
-  soFromEnd = 2;
-
-type
-  TSeekOrigin = (soBeginning, soCurrent, soEnd);
-
-{ TFileStream create mode }
-const
-  fmCreate        = $FFFF;
-  fmOpenRead      = 0;
-  fmOpenWrite     = 1;
-  fmOpenReadWrite = 2;
-
-{ TParser special tokens }
-
-  toEOF     = Char(0);
-  toSymbol  = Char(1);
-  toString  = Char(2);
-  toInteger = Char(3);
-  toFloat   = Char(4);
-
-Const
-  FilerSignature : Array[1..4] of char = 'TPF0';
-
-type
-
-{ Text alignment types }
-
-  TAlignment = (taLeftJustify, taRightJustify, taCenter);
-
-  { TLeftRight = taLeftJustify..taRightJustify; }
-
-{ Types used by standard events }
-
-  TShiftState = set of (ssShift, ssAlt, ssCtrl,
-    ssLeft, ssRight, ssMiddle, ssDouble,
-    // Extra additions
-    ssMeta, ssSuper, ssHyper, ssAltGr, ssCaps, ssNum,
-    ssScroll,ssTriple,ssQuad);
-
-  THelpContext = -MaxLongint..MaxLongint;
-  THelpType = (htKeyword, htContext);
-
-  TShortCut = Low(Word)..High(Word);
-
-{ Standard events }
-
-
-  TNotifyEvent = procedure(Sender: TObject) of object;
-  THelpEvent = function (Command: Word; Data: Longint;
-    var CallHelp: Boolean): Boolean of object;
-  TGetStrProc = procedure(const S: string) of object;
-
-{ Exception classes }
-
-  EStreamError = class(Exception);
-  EFCreateError = class(EStreamError);
-  EFOpenError = class(EStreamError);
-  EFilerError = class(EStreamError);
-  EReadError = class(EFilerError);
-  EWriteError = class(EFilerError);
-  EClassNotFound = class(EFilerError);
-  EMethodNotFound = class(EFilerError);
-  EInvalidImage = class(EFilerError);
-  EResNotFound = class(Exception);
-  EListError = class(Exception);
-  EBitsError = class(Exception);
-  EStringListError = class(Exception);
-  EComponentError = class(Exception);
-  EParserError = class(Exception);
-  EOutOfResources = class(EOutOfMemory);
-  EInvalidOperation = class(Exception);
-
-{ Forward class declarations }
-
-  TStream = class;
-  TFiler = class;
-  TReader = class;
-  TWriter = class;
-  TComponent = class;
-
-{ TList class }
-
-  PPointerList = ^TPointerList;
-  TPointerList = array[0..MaxListSize - 1] of Pointer;
-  TListSortCompare = function (Item1, Item2: Pointer): Integer;
-  TListNotification = (lnAdded, lnExtracted, lnDeleted);
-
-  TList = class(TObject)
-  private
-    FList: PPointerList;
-    FCount: Integer;
-    FCapacity: Integer;
-  protected
-    function Get(Index: Integer): Pointer;
-    procedure Grow; virtual;
-    procedure Put(Index: Integer; Item: Pointer);
-    procedure Notify(Ptr: Pointer; Action: TListNotification); virtual;
-    procedure SetCapacity(NewCapacity: Integer);
-    procedure SetCount(NewCount: Integer);
-  public
-    destructor Destroy; override;
-    function Add(Item: Pointer): Integer;
-    procedure Clear; dynamic;
-    procedure Delete(Index: Integer);
-    class procedure Error(const Msg: string; Data: Integer); virtual;
-    procedure Exchange(Index1, Index2: Integer);
-    function Expand: TList;
-    function Extract(item: Pointer): Pointer;
-    function First: Pointer;
-    procedure Assign(Obj:TList);
-    function IndexOf(Item: Pointer): Integer;
-    procedure Insert(Index: Integer; Item: Pointer);
-    function Last: Pointer;
-    procedure Move(CurIndex, NewIndex: Integer);
-    function Remove(Item: Pointer): Integer;
-    procedure Pack;
-    procedure Sort(Compare: TListSortCompare);
-    property Capacity: Integer read FCapacity write SetCapacity;
-    property Count: Integer read FCount write SetCount;
-    property Items[Index: Integer]: Pointer read Get write Put; default;
-    property List: PPointerList read FList;
-  end;
-
-{ TThreadList class }
-
-  TThreadList = class
-  private
-    FList: TList;
-{$ifdef FPC_THREADING}
-    FLock: TRTLCriticalSection;
-{$endif FPC_THREADING}
-  public
-    constructor Create;
-    destructor Destroy; override;
-    procedure Add(Item: Pointer);
-    procedure Clear;
-    function  LockList: TList;
-    procedure Remove(Item: Pointer);
-    procedure UnlockList;
-  end;
-
-const
-   BITSHIFT = 5;
-   MASK = 31; {for longs that are 32-bit in size}
-   MaxBitRec = $FFFF Div (SizeOf(longint));
-   MaxBitFlags = MaxBitRec * 32;
-
-type
-   TBitArray = array[0..MaxBitRec - 1] of cardinal;
-
-   TBits = class(TObject)
-   private
-      { Private declarations }
-      FBits : ^TBitArray;
-      FSize : longint;  { total longints currently allocated }
-      findIndex : longint;
-      findState : boolean;
-
-      { functions and properties to match TBits class }
-      procedure SetBit(bit : longint; value : Boolean);
-      function GetSize : longint;
-      procedure SetSize(value : longint);
-      procedure CheckBitIndex (Bit : longint;CurrentSize : Boolean);
-
-   public
-      { Public declarations }
-      constructor Create(TheSize : longint); virtual;
-      destructor Destroy; override;
-      function  GetFSize : longint;
-      procedure SetOn(Bit : longint);
-      procedure Clear(Bit : longint);
-      procedure Clearall;
-      procedure AndBits(BitSet : TBits);
-      procedure OrBits(BitSet : TBits);
-      procedure XorBits(BitSet : TBits);
-      procedure NotBits(BitSet : TBits);
-      function  Get(Bit : longint) : boolean;
-      procedure Grow(NBit : longint);
-      function  Equals(BitSet : TBits) : Boolean;
-      procedure SetIndex(Index : longint);
-      function  FindFirstBit(State : boolean) : longint;
-      function  FindNextBit : longint;
-      function  FindPrevBit : longint;
-
-      { functions and properties to match TBits class }
-      function OpenBit: longint;
-      property Bits[Bit: longint]: Boolean read get write SetBit; default;
-      property Size: longint read getSize write setSize;
-   end;
-
-{ TPersistent abstract class }
-
-{$M+}
-
-  TPersistent = class(TObject)
-  private
-    procedure AssignError(Source: TPersistent);
-  protected
-    procedure AssignTo(Dest: TPersistent); virtual;
-    procedure DefineProperties(Filer: TFiler); virtual;
-    function  GetOwner: TPersistent; dynamic;
-  public
-    destructor Destroy; override;
-    procedure Assign(Source: TPersistent); virtual;
-    function  GetNamePath: string; virtual; {dynamic;}
-  end;
-
-{$M-}
-
-{ TPersistent class reference type }
-
-  TPersistentClass = class of TPersistent;
-
-{ TInterfaced Persistent }
-
-{$ifdef HASINTF}
-  TInterfacedPersistent = class(TPersistent, IInterface)
-  private
-    FOwnerInterface: IInterface;
-  protected
-    { IInterface }
-    function _AddRef: Integer; stdcall;
-    function _Release: Integer; stdcall;
-  public
-    function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
-    procedure AfterConstruction; override;
-  end;
-{$endif HASINTF}
-
-{ TRecall class }
-
-  TRecall = class(TObject)
-  private
-    FStorage, FReference: TPersistent;
-  public
-    constructor Create(AStorage, AReference: TPersistent);
-    destructor Destroy; override;
-    procedure Store;
-    procedure Forget;
-    property Reference: TPersistent read FReference;
-  end;
-
-{ TCollection class }
-
-  TCollection = class;
-
-  TCollectionItem = class(TPersistent)
-  private
-    FCollection: TCollection;
-    FID: Integer;
-    function GetIndex: Integer;
-    procedure SetCollection(Value: TCollection);
-  protected
-    procedure Changed(AllItems: Boolean);
-    function GetNamePath: string; override;
-    function GetOwner: TPersistent; override;
-    function GetDisplayName: string; virtual;
-    procedure SetIndex(Value: Integer); virtual;
-    procedure SetDisplayName(const Value: string); virtual;
-  public
-    constructor Create(ACollection: TCollection); virtual;
-    destructor Destroy; override;
-    property Collection: TCollection read FCollection write SetCollection;
-    property ID: Integer read FID;
-    property Index: Integer read GetIndex write SetIndex;
-    property DisplayName: string read GetDisplayName write SetDisplayName;
-  end;
-
-  TCollectionItemClass = class of TCollectionItem;
-
-  TCollection = class(TPersistent)
-  private
-    FItemClass: TCollectionItemClass;
-    FItems: TList;
-    FUpdateCount: Integer;
-    FNextID: Integer;
-    FPropName: string;
-    function GetCount: Integer;
-    function GetPropName: string;
-    procedure InsertItem(Item: TCollectionItem);
-    procedure RemoveItem(Item: TCollectionItem);
-  protected
-    { Design-time editor support }
-    function GetAttrCount: Integer; dynamic;
-    function GetAttr(Index: Integer): string; dynamic;
-    function GetItemAttr(Index, ItemIndex: Integer): string; dynamic;
-    function GetNamePath: string; override;
-    procedure Changed;
-    function GetItem(Index: Integer): TCollectionItem;
-    procedure SetItem(Index: Integer; Value: TCollectionItem);
-    procedure SetItemName(Item: TCollectionItem); virtual;
-    procedure SetPropName; virtual;
-    procedure Update(Item: TCollectionItem); virtual;
-    property PropName: string read GetPropName write FPropName;
-  public
-    constructor Create(AItemClass: TCollectionItemClass);
-    destructor Destroy; override;
-    function Add: TCollectionItem;
-    procedure Assign(Source: TPersistent); override;
-    procedure BeginUpdate;
-    procedure Clear;
-    procedure EndUpdate;
-    function FindItemID(ID: Integer): TCollectionItem;
-    property Count: Integer read GetCount;
-    property ItemClass: TCollectionItemClass read FItemClass;
-    property Items[Index: Integer]: TCollectionItem read GetItem write SetItem;
-  end;
-
-  TStrings = class;
-
-{ IStringsAdapter interface }
-
-{$ifdef HASINTF}
-  { Maintains link between TStrings and IStrings implementations }
-  IStringsAdapter = interface ['{739C2F34-52EC-11D0-9EA6-0020AF3D82DA}']
-    procedure ReferenceStrings(S: TStrings);
-    procedure ReleaseStrings;
-  end;
-{$else HASINTF}
-  IStringsAdapter = class(TObject);
-{$endif HASINTF}
-
-{ TStrings class }
-
-  TStrings = class(TPersistent)
-  private
-    FUpdateCount: Integer;
-    FAdapter: IStringsAdapter;
-    function GetCommaText: string;
-    function GetName(Index: Integer): string;
-    function GetValue(const Name: string): string;
-    procedure ReadData(Reader: TReader);
-    procedure SetCommaText(const Value: string);
-    procedure SetStringsAdapter(const Value: IStringsAdapter);
-    procedure SetValue(const Name, Value: string);
-    procedure WriteData(Writer: TWriter);
-  protected
-    procedure DefineProperties(Filer: TFiler); override;
-    procedure Error(const Msg: string; Data: Integer);
-    function Get(Index: Integer): string; virtual; abstract;
-    function GetCapacity: Integer; virtual;
-    function GetCount: Integer; virtual; abstract;
-    function GetObject(Index: Integer): TObject; virtual;
-    function GetTextStr: string; virtual;
-    procedure Put(Index: Integer; const S: string); virtual;
-    procedure PutObject(Index: Integer; AObject: TObject); virtual;
-    procedure SetCapacity(NewCapacity: Integer); virtual;
-    procedure SetTextStr(const Value: string); virtual;
-    procedure SetUpdateState(Updating: Boolean); virtual;
-  public
-    destructor Destroy; override;
-    function Add(const S: string): Integer; virtual;
-    function AddObject(const S: string; AObject: TObject): Integer; virtual;
-    procedure Append(const S: string);
-    procedure AddStrings(TheStrings: TStrings); virtual;
-    procedure Assign(Source: TPersistent); override;
-    procedure BeginUpdate;
-    procedure Clear; virtual; abstract;
-    procedure Delete(Index: Integer); virtual; abstract;
-    procedure EndUpdate;
-    function Equals(TheStrings: TStrings): Boolean;
-    procedure Exchange(Index1, Index2: Integer); virtual;
-    function GetText: PChar; virtual;
-    function IndexOf(const S: string): Integer; virtual;
-    function IndexOfName(const Name: string): Integer;
-    function IndexOfObject(AObject: TObject): Integer;
-    procedure Insert(Index: Integer; const S: string); virtual; abstract;
-    procedure InsertObject(Index: Integer; const S: string;
-      AObject: TObject);
-    procedure LoadFromFile(const FileName: string); virtual;
-    procedure LoadFromStream(Stream: TStream); virtual;
-    procedure Move(CurIndex, NewIndex: Integer); virtual;
-    procedure SaveToFile(const FileName: string); virtual;
-    procedure SaveToStream(Stream: TStream); virtual;
-    procedure SetText(TheText: PChar); virtual;
-    property Capacity: Integer read GetCapacity write SetCapacity;
-    property CommaText: string read GetCommaText write SetCommaText;
-    property Count: Integer read GetCount;
-    property Names[Index: Integer]: string read GetName;
-    property Objects[Index: Integer]: TObject read GetObject write PutObject;
-    property Values[const Name: string]: string read GetValue write SetValue;
-    property Strings[Index: Integer]: string read Get write Put; default;
-    property Text: string read GetTextStr write SetTextStr;
-    property StringsAdapter: IStringsAdapter read FAdapter write SetStringsAdapter;
-  end;
-
-{ TStringList class }
-
-  TDuplicates = (dupIgnore, dupAccept, dupError);
-  TStringList = class;
-
-  PStringItem = ^TStringItem;
-  TStringItem = record
-    FString: string;
-    FObject: TObject;
-  end;
-
-  PStringItemList = ^TStringItemList;
-  TStringItemList = array[0..MaxListSize] of TStringItem;
-  TStringListSortCompare = function(List: TStringList; Index1, Index2: Integer): Integer;
-
-  TStringList = class(TStrings)
-  private
-    FList: PStringItemList;
-    FCount: Integer;
-    FCapacity: Integer;
-    FSorted: Boolean;
-    FDuplicates: TDuplicates;
-    FOnChange: TNotifyEvent;
-    FOnChanging: TNotifyEvent;
-    procedure ExchangeItems(Index1, Index2: Integer);
-    procedure Grow;
-    procedure QuickSort(L, R: Integer; CompareFn: TStringListSortCompare);
-    procedure InsertItem(Index: Integer; const S: string);
-    procedure SetSorted(Value: Boolean);
-  protected
-    procedure Changed; virtual;
-    procedure Changing; virtual;
-    function Get(Index: Integer): string; override;
-    function GetCapacity: Integer; override;
-    function GetCount: Integer; override;
-    function GetObject(Index: Integer): TObject; override;
-    procedure Put(Index: Integer; const S: string); override;
-    procedure PutObject(Index: Integer; AObject: TObject); override;
-    procedure SetCapacity(NewCapacity: Integer); override;
-    procedure SetUpdateState(Updating: Boolean); override;
-  public
-    destructor Destroy; override;
-    function Add(const S: string): Integer; override;
-    procedure Clear; override;
-    procedure Delete(Index: Integer); override;
-    procedure Exchange(Index1, Index2: Integer); override;
-    function Find(const S: string; var Index: Integer): Boolean; virtual;
-    function IndexOf(const S: string): Integer; override;
-    procedure Insert(Index: Integer; const S: string); override;
-    procedure Sort; virtual;
-    procedure CustomSort(CompareFn: TStringListSortCompare);
-    property Duplicates: TDuplicates read FDuplicates write FDuplicates;
-    property Sorted: Boolean read FSorted write SetSorted;
-    property OnChange: TNotifyEvent read FOnChange write FOnChange;
-    property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
-  end;
-
-{ TStream abstract class }
-
-  TStream = class(TObject)
-  private
-{$ifdef seek64bit}
-    function GetPosition: Int64;
-    procedure SetPosition(Pos: Int64);
-    function GetSize: Int64;
-    procedure SetSize64(NewSize: Int64);
-{$else seek64bit}
-    function GetPosition: Longint;
-    procedure SetPosition(Pos: Longint);
-    function GetSize: Longint;
-{$endif seek64bit}
-  protected
-{$ifdef seek64bit}
-    procedure SetSize(NewSize: Longint); virtual;overload;
-    procedure SetSize(NewSize: Int64); virtual;overload;
-{$else seek64bit}
-    procedure SetSize(NewSize: Longint); virtual;
-{$endif seek64bit}
-  public
-    function Read(var Buffer; Count: Longint): Longint; virtual; abstract;
-    function Write(const Buffer; Count: Longint): Longint; virtual; abstract;
-{$ifdef seek64bit}
-    function Seek(Offset: Longint; Origin: Word): Longint; virtual; overload;
-    function Seek(Offset: Int64; Origin: TSeekOrigin): Int64; virtual; overload;
-{$else seek64bit}
-    function Seek(Offset: Longint; Origin: Word): Longint; virtual; abstract;
-{$endif seek64bit}
-    procedure ReadBuffer(var Buffer; Count: Longint);
-    procedure WriteBuffer(const Buffer; Count: Longint);
-    function CopyFrom(Source: TStream; Count: Int64): Int64;
-    function ReadComponent(Instance: TComponent): TComponent;
-    function ReadComponentRes(Instance: TComponent): TComponent;
-    procedure WriteComponent(Instance: TComponent);
-    procedure WriteComponentRes(const ResName: string; Instance: TComponent);
-    procedure WriteDescendent(Instance, Ancestor: TComponent);
-    procedure WriteDescendentRes(const ResName: string; Instance, Ancestor: TComponent);
-    procedure WriteResourceHeader(const ResName: string; {!!!:out} var FixupInfo: Integer);
-    procedure FixupResourceHeader(FixupInfo: Integer);
-    procedure ReadResHeader;
-    function ReadByte : Byte;
-    function ReadWord : Word;
-    function ReadDWord : Cardinal;
-    function ReadAnsiString : String;
-    procedure WriteByte(b : Byte);
-    procedure WriteWord(w : Word);
-    procedure WriteDWord(d : Cardinal);
-    Procedure WriteAnsiString (S : String);
-{$ifdef seek64bit}
-    property Position: Int64 read GetPosition write SetPosition;
-    property Size: Int64 read GetSize write SetSize64;
-{$else seek64bit}
-    property Position: Longint read GetPosition write SetPosition;
-    property Size: Longint read GetSize write SetSize;
-{$endif seek64bit}
-  end;
-
-{$ifdef HASINTF}
-  IStreamPersist = interface ['{B8CD12A3-267A-11D4-83DA-00C04F60B2DD}']
-    procedure LoadFromStream(Stream: TStream);
-    procedure SaveToStream(Stream: TStream);
-  end;
-{$endif HASINTF}
-
-{ THandleStream class }
-
-  THandleStream = class(TStream)
-  private
-    FHandle: Integer;
-  protected
-{$ifdef seek64bit}
-    procedure SetSize(NewSize: Longint); override;
-    procedure SetSize(NewSize: Int64); override;
-{$else seek64bit}
-    procedure SetSize(NewSize: Longint); override;
-{$endif seek64bit}
-  public
-    constructor Create(AHandle: Integer);
-    function Read(var Buffer; Count: Longint): Longint; override;
-    function Write(const Buffer; Count: Longint): Longint; override;
-{$ifdef seek64bit}
-    function Seek(Offset: Int64; Origin: TSeekOrigin): Int64; override;
-{$else seek64bit}
-    function Seek(Offset: Longint; Origin: Word): Longint; override;
-{$endif seek64bit}
-    property Handle: Integer read FHandle;
-  end;
-
-{ TFileStream class }
-
-  TFileStream = class(THandleStream)
-  Private
-    FFileName : String;
-  public
-    constructor Create(const AFileName: string; Mode: Word);
-    constructor Create(const AFileName: string; Mode: Word; Rights: Cardinal);
-    destructor Destroy; override;
-    property FileName : String Read FFilename;
-  end;
-
-{ TCustomMemoryStream abstract class }
-
-  TCustomMemoryStream = class(TStream)
-  private
-    FMemory: Pointer;
-    FSize, FPosition: Longint;
-  protected
-    procedure SetPointer(Ptr: Pointer; ASize: Longint);
-  public
-    function Read(var Buffer; Count: Longint): Longint; override;
-    function Seek(Offset: Longint; Origin: Word): Longint; override;
-    procedure SaveToStream(Stream: TStream);
-    procedure SaveToFile(const FileName: string);
-    property Memory: Pointer read FMemory;
-  end;
-
-{ TMemoryStream }
-
-  TMemoryStream = class(TCustomMemoryStream)
-  private
-    FCapacity: Longint;
-    procedure SetCapacity(NewCapacity: Longint);
-  protected
-    function Realloc(var NewCapacity: Longint): Pointer; virtual;
-    property Capacity: Longint read FCapacity write SetCapacity;
-  public
-    destructor Destroy; override;
-    procedure Clear;
-    procedure LoadFromStream(Stream: TStream);
-    procedure LoadFromFile(const FileName: string);
-    procedure SetSize(NewSize: Longint); override;
-    function Write(const Buffer; Count: Longint): Longint; override;
-  end;
-
-{ TStringStream }
-
-  TStringStream = class(TStream)
-  private
-    FDataString: string;
-    FPosition: Integer;
-  protected
-    procedure SetSize(NewSize: Longint); override;
-  public
-    constructor Create(const AString: string);
-    function Read(var Buffer; Count: Longint): Longint; override;
-    function ReadString(Count: Longint): string;
-    function Seek(Offset: Longint; Origin: Word): Longint; override;
-    function Write(const Buffer; Count: Longint): Longint; override;
-    procedure WriteString(const AString: string);
-    property DataString: string read FDataString;
-  end;
-
-{ TResourceStream }
-
-  TResourceStream = class(TCustomMemoryStream)
-  private
-    HResInfo: HRSRC;
-    HGlobal: THandle;
-    procedure Initialize(Instance: THandle; Name, ResType: PChar);
-  public
-    constructor Create(Instance: THandle; const ResName: string; ResType: PChar);
-    constructor CreateFromID(Instance: THandle; ResID: Integer; ResType: PChar);
-    destructor Destroy; override;
-    function Write(const Buffer; Count: Longint): Longint; override;
-  end;
-
-{ TStreamAdapter }
-{ Implements OLE IStream on VCL TStream }
-{ we don't need that yet
-  TStreamAdapter = class(TInterfacedObject, IStream)
-  private
-    FStream: TStream;
-  public
-    constructor Create(Stream: TStream);
-    function Read(pv: Pointer; cb: Longint;
-      pcbRead: PLongint): HResult; stdcall;
-    function Write(pv: Pointer; cb: Longint;
-      pcbWritten: PLongint): HResult; stdcall;
-    function Seek(dlibMove: Largeint; dwOrigin: Longint;
-      out libNewPosition: Largeint): HResult; stdcall;
-    function SetSize(libNewSize: Largeint): HResult; stdcall;
-    function CopyTo(stm: IStream; cb: Largeint; out cbRead: Largeint;
-      out cbWritten: Largeint): HResult; stdcall;
-    function Commit(grfCommitFlags: Longint): HResult; stdcall;
-    function Revert: HResult; stdcall;
-    function LockRegion(libOffset: Largeint; cb: Largeint;
-      dwLockType: Longint): HResult; stdcall;
-    function UnlockRegion(libOffset: Largeint; cb: Largeint;
-      dwLockType: Longint): HResult; stdcall;
-    function Stat(out statstg: TStatStg;
-      grfStatFlag: Longint): HResult; stdcall;
-    function Clone(out stm: IStream): HResult; stdcall;
-  end;
-}
-
-{ TFiler }
-
-  TValueType = (vaNull, vaList, vaInt8, vaInt16, vaInt32, vaExtended,
-    vaString, vaIdent, vaFalse, vaTrue, vaBinary, vaSet, vaLString,
-    vaNil, vaCollection, vaSingle, vaCurrency, vaDate, vaWString, vaInt64);
-
-  TFilerFlag = (ffInherited, ffChildPos, ffInline);
-  TFilerFlags = set of TFilerFlag;
-
-  TReaderProc = procedure(Reader: TReader) of object;
-  TWriterProc = procedure(Writer: TWriter) of object;
-  TStreamProc = procedure(Stream: TStream) of object;
-
-  TFiler = class(TObject)
-  private
-    FRoot: TComponent;
-    FLookupRoot: TComponent;
-    FAncestor: TPersistent;
-    FIgnoreChildren: Boolean;
-  protected
-    procedure SetRoot(ARoot: TComponent); virtual;
-  public
-    procedure DefineProperty(const Name: string;
-      ReadData: TReaderProc; WriteData: TWriterProc;
-      HasData: Boolean); virtual; abstract;
-    procedure DefineBinaryProperty(const Name: string;
-      ReadData, WriteData: TStreamProc;
-      HasData: Boolean); virtual; abstract;
-    property Root: TComponent read FRoot write SetRoot;
-    property LookupRoot: TComponent read FLookupRoot;
-    property Ancestor: TPersistent read FAncestor write FAncestor;
-    property IgnoreChildren: Boolean read FIgnoreChildren write FIgnoreChildren;
-  end;
-
-
-{ TComponent class reference type }
-
-  TComponentClass = class of TComponent;
-
-
-{ TReader }
-
-  TAbstractObjectReader = class
-  public
-    function NextValue: TValueType; virtual; abstract;
-    function ReadValue: TValueType; virtual; abstract;
-    procedure BeginRootComponent; virtual; abstract;
-    procedure BeginComponent(var Flags: TFilerFlags; var AChildPos: Integer;
-      var CompClassName, CompName: String); virtual; abstract;
-    function BeginProperty: String; virtual; abstract;
-
-    { All ReadXXX methods are called _after_ the value type has been read! }
-    procedure ReadBinary(const DestData: TMemoryStream); virtual; abstract;
-    function ReadFloat: Extended; virtual; abstract;
-    function ReadSingle: Single; virtual; abstract;
-    {!!!: function ReadCurrency: Currency; virtual; abstract;}
-    function ReadDate: TDateTime; virtual; abstract;
-    function ReadIdent(ValueType: TValueType): String; virtual; abstract;
-    function ReadInt8: ShortInt; virtual; abstract;
-    function ReadInt16: SmallInt; virtual; abstract;
-    function ReadInt32: LongInt; virtual; abstract;
-    function ReadInt64: Int64; virtual; abstract;
-    function ReadSet(EnumType: Pointer): Integer; virtual; abstract;
-    function ReadStr: String; virtual; abstract;
-    function ReadString(StringType: TValueType): String; virtual; abstract;
-    procedure SkipComponent(SkipComponentInfos: Boolean); virtual; abstract;
-    procedure SkipValue; virtual; abstract;
-  end;
-
-  TBinaryObjectReader = class(TAbstractObjectReader)
-  private
-    FStream: TStream;
-    FBuffer: Pointer;
-    FBufSize: Integer;
-    FBufPos: Integer;
-    FBufEnd: Integer;
-    procedure Read(var Buf; Count: LongInt);
-    procedure SkipProperty;
-    procedure SkipSetBody;
-  public
-    constructor Create(Stream: TStream; BufSize: Integer);
-    destructor Destroy; override;
-
-    function NextValue: TValueType; override;
-    function ReadValue: TValueType; override;
-    procedure BeginRootComponent; override;
-    procedure BeginComponent(var Flags: TFilerFlags; var AChildPos: Integer;
-      var CompClassName, CompName: String); override;
-    function BeginProperty: String; override;
-
-    procedure ReadBinary(const DestData: TMemoryStream); override;
-    function ReadFloat: Extended; override;
-    function ReadSingle: Single; override;
-    {!!!: function ReadCurrency: Currency; override;}
-    function ReadDate: TDateTime; override;
-    function ReadIdent(ValueType: TValueType): String; override;
-    function ReadInt8: ShortInt; override;
-    function ReadInt16: SmallInt; override;
-    function ReadInt32: LongInt; override;
-    function ReadInt64: Int64; override;
-    function ReadSet(EnumType: Pointer): Integer; override;
-    function ReadStr: String; override;
-    function ReadString(StringType: TValueType): String; override;
-    procedure SkipComponent(SkipComponentInfos: Boolean); override;
-    procedure SkipValue; override;
-  end;
-
-
-  TFindMethodEvent = procedure(Reader: TReader; const MethodName: string;
-    var Address: Pointer; var Error: Boolean) of object;
-  TSetMethodPropertyEvent = procedure(Reader: TReader; Instance: TPersistent;
-    PropInfo: PPropInfo; const TheMethodName: string;
-    var Handled: boolean) of object;
-  TSetNameEvent = procedure(Reader: TReader; Component: TComponent;
-    var Name: string) of object;
-  TReferenceNameEvent = procedure(Reader: TReader; var Name: string) of object;
-  TAncestorNotFoundEvent = procedure(Reader: TReader; const ComponentName: string;
-    ComponentClass: TPersistentClass; var Component: TComponent) of object;
-  TReadComponentsProc = procedure(Component: TComponent) of object;
-  TReaderError = procedure(Reader: TReader; const Message: string;
-    var Handled: Boolean) of object;
-  TPropertyNotFoundEvent = procedure(Reader: TReader; Instance: TPersistent;
-    var PropName: string; IsPath: boolean; var Handled, Skip: Boolean) of object;
-  TFindComponentClassEvent = procedure(Reader: TReader; const ClassName: string;
-    var ComponentClass: TComponentClass) of object;
-  TCreateComponentEvent = procedure(Reader: TReader;
-    ComponentClass: TComponentClass; var Component: TComponent) of object;
-
-  TReadWriteStringPropertyEvent = procedure(Sender:TObject;
-    const Instance: TPersistent; PropInfo: PPropInfo;
-    var Content:string) of object;
-
-  TReader = class(TFiler)
-  private
-    FDriver: TAbstractObjectReader;
-    FOwner: TComponent;
-    FParent: TComponent;
-    FFixups: TList;
-    FLoaded: TList;
-    FOnFindMethod: TFindMethodEvent;
-    FOnSetMethodProperty: TSetMethodPropertyEvent;
-    FOnSetName: TSetNameEvent;
-    FOnReferenceName: TReferenceNameEvent;
-    FOnAncestorNotFound: TAncestorNotFoundEvent;
-    FOnError: TReaderError;
-    FOnPropertyNotFound: TPropertyNotFoundEvent;
-    FOnFindComponentClass: TFindComponentClassEvent;
-    FOnCreateComponent: TCreateComponentEvent;
-    FPropName: string;
-    FCanHandleExcepts: Boolean;
-    FOnReadStringProperty:TReadWriteStringPropertyEvent;
-    procedure DoFixupReferences;
-    procedure FreeFixups;
-    function FindComponentClass(const AClassName: string): TComponentClass;
-  protected
-    function Error(const Message: string): Boolean; virtual;
-    function FindMethod(ARoot: TComponent; const AMethodName: string): Pointer; virtual;
-    procedure ReadProperty(AInstance: TPersistent);
-    procedure ReadPropValue(Instance: TPersistent; PropInfo: Pointer);
-    procedure PropertyError;
-    procedure ReadData(Instance: TComponent);
-    property PropName: string read FPropName;
-    property CanHandleExceptions: Boolean read FCanHandleExcepts;
-  public
-    constructor Create(Stream: TStream; BufSize: Integer);
-    destructor Destroy; override;
-    procedure BeginReferences;
-    procedure CheckValue(Value: TValueType);
-    procedure DefineProperty(const Name: string;
-      AReadData: TReaderProc; WriteData: TWriterProc;
-      HasData: Boolean); override;
-    procedure DefineBinaryProperty(const Name: string;
-      AReadData, WriteData: TStreamProc;
-      HasData: Boolean); override;
-    function EndOfList: Boolean;
-    procedure EndReferences;
-    procedure FixupReferences;
-    function NextValue: TValueType;
-    function ReadBoolean: Boolean;
-    function ReadChar: Char;
-    procedure ReadCollection(Collection: TCollection);
-    function ReadComponent(Component: TComponent): TComponent;
-    procedure ReadComponents(AOwner, AParent: TComponent;
-      Proc: TReadComponentsProc);
-    function ReadFloat: Extended;
-    function ReadSingle: Single;
-    {!!!: function ReadCurrency: Currency;}
-    function ReadDate: TDateTime;
-    function ReadIdent: string;
-    function ReadInteger: Longint;
-    function ReadInt64: Int64;
-    procedure ReadListBegin;
-    procedure ReadListEnd;
-    function ReadRootComponent(ARoot: TComponent): TComponent;
-    function ReadString: string;
-    {!!!: function ReadWideString: WideString;}
-    function ReadValue: TValueType;
-    procedure CopyValue(Writer: TWriter);
-    property Driver: TAbstractObjectReader read FDriver;
-    property Owner: TComponent read FOwner write FOwner;
-    property Parent: TComponent read FParent write FParent;
-    property OnError: TReaderError read FOnError write FOnError;
-    property OnPropertyNotFound: TPropertyNotFoundEvent read FOnPropertyNotFound write FOnPropertyNotFound;
-    property OnFindMethod: TFindMethodEvent read FOnFindMethod write FOnFindMethod;
-    property OnSetMethodProperty: TSetMethodPropertyEvent read FOnSetMethodProperty write FOnSetMethodProperty;
-    property OnSetName: TSetNameEvent read FOnSetName write FOnSetName;
-    property OnReferenceName: TReferenceNameEvent read FOnReferenceName write FOnReferenceName;
-    property OnAncestorNotFound: TAncestorNotFoundEvent read FOnAncestorNotFound write FOnAncestorNotFound;
-    property OnCreateComponent: TCreateComponentEvent read FOnCreateComponent write FOnCreateComponent;
-    property OnFindComponentClass: TFindComponentClassEvent read FOnFindComponentClass write FOnFindComponentClass;
-    property OnReadStringProperty: TReadWriteStringPropertyEvent read FOnReadStringProperty write FOnReadStringProperty;
-  end;
-
-
-{ TWriter }
-
-  TAbstractObjectWriter = class
-  public
-    { 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; virtual; abstract;  { Ends with the next "EndList" }
-    procedure BeginComponent(Component: TComponent; Flags: TFilerFlags;
-      ChildPos: Integer); virtual; abstract;  { Ends after the second "EndList" }
-    procedure BeginList; virtual; abstract;
-    procedure EndList; virtual; abstract;
-    procedure BeginProperty(const PropName: String); virtual; abstract;
-    procedure EndProperty; virtual; abstract;
-
-    procedure WriteBinary(const Buffer; Count: Longint); virtual; abstract;
-    procedure WriteBoolean(Value: Boolean); virtual; abstract;
-    // procedure WriteChar(Value: Char);
-    procedure WriteFloat(const Value: Extended); virtual; abstract;
-    procedure WriteSingle(const Value: Single); virtual; abstract;
-    {!!!: procedure WriteCurrency(const Value: Currency); virtual; abstract;}
-    procedure WriteDate(const Value: TDateTime); virtual; abstract;
-    procedure WriteIdent(const Ident: string); virtual; abstract;
-    procedure WriteInteger(Value: Int64); virtual; abstract;
-    procedure WriteMethodName(const Name: String); virtual; abstract;
-    procedure WriteSet(Value: LongInt; SetType: Pointer); virtual; abstract;
-    procedure WriteString(const Value: String); virtual; abstract;
-  end;
-
-  TBinaryObjectWriter = class(TAbstractObjectWriter)
-  private
-    FStream: TStream;
-    FBuffer: Pointer;
-    FBufSize: Integer;
-    FBufPos: Integer;
-    FBufEnd: Integer;
-    FSignatureWritten: Boolean;
-    procedure FlushBuffer;
-    procedure Write(const Buffer; Count: Longint);
-    procedure WriteValue(Value: TValueType);
-    procedure WriteStr(const Value: String);
-  public
-    constructor Create(Stream: TStream; BufSize: Integer);
-    destructor Destroy; override;
-
-    procedure BeginCollection; override;
-    procedure BeginComponent(Component: TComponent; Flags: TFilerFlags;
-      ChildPos: Integer); override;
-    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 WriteFloat(const Value: Extended); override;
-    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;
-  end;
-
-  TTextObjectWriter = class(TAbstractObjectWriter)
-  end;
-
-
-  TFindAncestorEvent = procedure (Writer: TWriter; Component: TComponent;
-    const Name: string; var Ancestor, RootAncestor: TComponent) of object;
-  TWriteMethodPropertyEvent = procedure (Writer: TWriter; Instance: TPersistent;
-    PropInfo: PPropInfo; const MethodValue: TMethod;
-    const DefMethodCodeValue: Pointer; var Handled: boolean) of object;
-
-  TWriter = class(TFiler)
-  private
-    FDriver: TAbstractObjectWriter;
-    FDestroyDriver: Boolean;
-    FRootAncestor: TComponent;
-    FPropPath: String;
-    FAncestorList: TList;
-    FAncestorPos: Integer;
-    FChildPos: Integer;
-    FOnFindAncestor: TFindAncestorEvent;
-    FOnWriteMethodProperty: TWriteMethodPropertyEvent;
-    FOnWriteStringProperty: TReadWriteStringPropertyEvent;
-    procedure AddToAncestorList(Component: TComponent);
-    procedure WriteComponentData(Instance: TComponent);
-  protected
-    procedure SetRoot(ARoot: TComponent); override;
-    procedure WriteBinary(AWriteData: TStreamProc);
-    procedure WriteProperty(Instance: TPersistent; PropInfo: Pointer);
-    procedure WriteProperties(Instance: TPersistent);
-  public
-    constructor Create(ADriver: TAbstractObjectWriter);
-    constructor Create(Stream: TStream; BufSize: Integer);
-    destructor Destroy; override;
-    procedure DefineProperty(const Name: string;
-      ReadData: TReaderProc; AWriteData: TWriterProc;
-      HasData: Boolean); override;
-    procedure DefineBinaryProperty(const Name: string;
-      ReadData, AWriteData: TStreamProc;
-      HasData: Boolean); override;
-    procedure WriteBoolean(Value: Boolean);
-    procedure WriteCollection(Value: TCollection);
-    procedure WriteComponent(Component: TComponent);
-    procedure WriteChar(Value: Char);
-    procedure WriteDescendent(ARoot: TComponent; AAncestor: TComponent);
-    procedure WriteFloat(const Value: Extended);
-    procedure WriteSingle(const Value: Single);
-    {!!!: procedure WriteCurrency(const Value: Currency);}
-    procedure WriteDate(const Value: TDateTime);
-    procedure WriteIdent(const Ident: string);
-    procedure WriteInteger(Value: Longint); overload;
-    procedure WriteInteger(Value: Int64); overload;
-    procedure WriteListBegin;
-    procedure WriteListEnd;
-    procedure WriteRootComponent(ARoot: TComponent);
-    procedure WriteString(const Value: string);
-    {!!!: procedure WriteWideString(const Value: WideString);}
-    property RootAncestor: TComponent read FRootAncestor write FRootAncestor;
-    property OnFindAncestor: TFindAncestorEvent read FOnFindAncestor write FOnFindAncestor;
-    property OnWriteMethodProperty: TWriteMethodPropertyEvent read FOnWriteMethodProperty write FOnWriteMethodProperty;
-    property OnWriteStringProperty: TReadWriteStringPropertyEvent read FOnWriteStringProperty write FOnWriteStringProperty;
-
-    property Driver: TAbstractObjectWriter read FDriver;
-  end;
-
-
-{ TParser }
-
-  TParser = class(TObject)
-  private
-    FStream: TStream;
-    FOrigin: Longint;
-    FBuffer: PChar;
-    FBufPtr: PChar;
-    FBufEnd: PChar;
-    FSourcePtr: PChar;
-    FSourceEnd: PChar;
-    FTokenPtr: PChar;
-    FStringPtr: PChar;
-    FSourceLine: Integer;
-    FSaveChar: Char;
-    FToken: Char;
-    procedure ReadBuffer;
-    procedure SkipBlanks;
-  public
-    constructor Create(Stream: TStream);
-    destructor Destroy; override;
-    procedure CheckToken(T: Char);
-    procedure CheckTokenSymbol(const S: string);
-    procedure Error(const Ident: string);
-    procedure ErrorFmt(const Ident: string; const Args: array of const);
-    procedure ErrorStr(const Message: string);
-    procedure HexToBinary(Stream: TStream);
-    function NextToken: Char;
-    function SourcePos: Longint;
-    function TokenComponentIdent: String;
-    function TokenFloat: Extended;
-    function TokenInt: Longint;
-    function TokenString: string;
-    function TokenSymbolIs(const S: string): Boolean;
-    property SourceLine: Integer read FSourceLine;
-    property Token: Char read FToken;
-  end;
-
-{ TComponent class }
-
-  TOperation = (opInsert, opRemove);
-  TComponentState = set of (csLoading, csReading, csWriting, csDestroying,
-    csDesigning, csAncestor, csUpdating, csFixups, csFreeNotification,
-    csInline, csDesignInstance);
-  TComponentStyle = set of (csInheritable, csCheckPropAvail);
-  TGetChildProc = procedure (Child: TComponent) of object;
-
-  {
-  TComponentName = type string;
-
-  IVCLComObject = interface
-    function GetTypeInfoCount(out Count: Integer): Integer; stdcall;
-    function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): Integer; stdcall;
-    function GetIDsOfNames(const IID: TGUID; Names: Pointer;
-      NameCount, LocaleID: Integer; DispIDs: Pointer): Integer; stdcall;
-    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
-      Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): Integer; stdcall;
-    function SafeCallException(ExceptObject: TObject;
-      ExceptAddr: Pointer): Integer;
-    procedure FreeOnRelease;
-  end;
-  }
-
-  TBasicAction = class;
-
-  TComponent = class(TPersistent)
-  private
-    FOwner: TComponent;
-    FName: TComponentName;
-    FTag: Longint;
-    FComponents: TList;
-    FFreeNotifies: TList;
-    FDesignInfo: Longint;
-    FVCLComObject: Pointer;
-    FComponentState: TComponentState;
-    // function GetComObject: IUnknown;
-    function GetComponent(AIndex: Integer): TComponent;
-    function GetComponentCount: Integer;
-    function GetComponentIndex: Integer;
-    procedure Insert(AComponent: TComponent);
-    procedure ReadLeft(Reader: TReader);
-    procedure ReadTop(Reader: TReader);
-    procedure Remove(AComponent: TComponent);
-    procedure RemoveNotification(AComponent: TComponent);
-    procedure SetComponentIndex(Value: Integer);
-    procedure SetReference(Enable: Boolean);
-    procedure WriteLeft(Writer: TWriter);
-    procedure WriteTop(Writer: TWriter);
-  protected
-    FComponentStyle: TComponentStyle;
-    procedure ChangeName(const NewName: TComponentName);
-    procedure DefineProperties(Filer: TFiler); override;
-    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); dynamic;
-    function GetChildOwner: TComponent; dynamic;
-    function GetChildParent: TComponent; dynamic;
-    function GetNamePath: string; override;
-    function GetOwner: TPersistent; override;
-    procedure Loaded; virtual;
-    procedure Notification(AComponent: TComponent;
-      Operation: TOperation); virtual;
-    procedure ReadState(Reader: TReader); virtual;
-    procedure SetAncestor(Value: Boolean);
-    procedure SetDesigning(Value: Boolean);
-    procedure SetName(const NewName: TComponentName); virtual;
-    procedure SetChildOrder(Child: TComponent; Order: Integer); dynamic;
-    procedure SetParentComponent(Value: TComponent); dynamic;
-    procedure Updating; dynamic;
-    procedure Updated; dynamic;
-    class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); dynamic;
-    procedure ValidateRename(AComponent: TComponent;
-      const CurName, NewName: string); virtual;
-    procedure ValidateContainer(AComponent: TComponent); dynamic;
-    procedure ValidateInsert(AComponent: TComponent); dynamic;
-    { IUnknown }
-    //!!!!! function QueryInterface(const IID: TGUID; out Obj): Integer; stdcall;
-    //!!!! function _AddRef: Integer; stdcall;
-    //!!!! function _Release: Integer; stdcall;
-    { IDispatch }
-    //!!!! function GetTypeInfoCount(out Count: Integer): Integer; stdcall;
-    //!!!! function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): Integer; stdcall;
-    //!!!! function GetIDsOfNames(const IID: TGUID; Names: Pointer;
-    //!!!!   NameCount, LocaleID: Integer; DispIDs: Pointer): Integer; stdcall;
-    //!!!! function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
-    //!!!!   Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): Integer; stdcall;
-  public
-    //!! Moved temporary
-    procedure WriteState(Writer: TWriter); virtual;
-    constructor Create(AOwner: TComponent); virtual;
-    destructor Destroy; override;
-    procedure BeforeDestruction; override;
-    procedure DestroyComponents;
-    procedure Destroying;
-    function ExecuteAction(Action: TBasicAction): Boolean; dynamic;
-    function FindComponent(const AName: string): TComponent;
-    procedure FreeNotification(AComponent: TComponent);
-    procedure RemoveFreeNotification(AComponent: TComponent);
-    procedure FreeOnRelease;
-    function GetParentComponent: TComponent; dynamic;
-    function HasParent: Boolean; dynamic;
-    procedure InsertComponent(AComponent: TComponent);
-    procedure RemoveComponent(AComponent: TComponent);
-    function SafeCallException(ExceptObject: TObject;
-      ExceptAddr: Pointer): Integer; override;
-    function UpdateAction(Action: TBasicAction): Boolean; dynamic;
-    // property ComObject: IUnknown read GetComObject;
-    property Components[Index: Integer]: TComponent read GetComponent;
-    property ComponentCount: Integer read GetComponentCount;
-    property ComponentIndex: Integer read GetComponentIndex write SetComponentIndex;
-    property ComponentState: TComponentState read FComponentState;
-    property ComponentStyle: TComponentStyle read FComponentStyle;
-    property DesignInfo: Longint read FDesignInfo write FDesignInfo;
-    property Owner: TComponent read FOwner;
-    property VCLComObject: Pointer read FVCLComObject write FVCLComObject;
-  published
-    property Name: TComponentName read FName write SetName stored False;
-    property Tag: Longint read FTag write FTag default 0;
-  end;
-
-{ TBasicActionLink }
-
-  TBasicActionLink = class(TObject)
-  private
-    FOnChange: TNotifyEvent;
-  protected
-    FAction: TBasicAction;
-    procedure AssignClient(AClient: TObject); virtual;
-    procedure Change; virtual;
-    function IsOnExecuteLinked: Boolean; virtual;
-    procedure SetAction(Value: TBasicAction); virtual;
-    procedure SetOnExecute(Value: TNotifyEvent); virtual;
-  public
-    constructor Create(AClient: TObject); virtual;
-    destructor Destroy; override;
-    function Execute(AComponent: TComponent{$ifndef VER1_0} = nil{$endif}): Boolean; virtual;
-    function Update: Boolean; virtual;
-    property Action: TBasicAction read FAction write SetAction;
-    property OnChange: TNotifyEvent read FOnChange write FOnChange;
-  end;
-
-  TBasicActionLinkClass = class of TBasicActionLink;
-
-{ TBasicAction }
-
-  TBasicAction = class(TComponent)
-  private
-    FActionComponent: TComponent;
-    FOnChange: TNotifyEvent;
-    FOnExecute: TNotifyEvent;
-    FOnUpdate: TNotifyEvent;
-  protected
-    FClients: TList;
-    procedure Change; virtual;
-    procedure SetOnExecute(Value: TNotifyEvent); virtual;
-    property OnChange: TNotifyEvent read FOnChange write FOnChange;
-  public
-    constructor Create(AOwner: TComponent); override;
-    destructor Destroy; override;
-    function HandlesTarget(Target: TObject): Boolean; virtual;
-    procedure UpdateTarget(Target: TObject); virtual;
-    procedure ExecuteTarget(Target: TObject); virtual;
-    function Execute: Boolean; dynamic;
-    procedure RegisterChanges(Value: TBasicActionLink);
-    procedure UnRegisterChanges(Value: TBasicActionLink);
-    function Update: Boolean; virtual;
-    property ActionComponent: TComponent read FActionComponent write FActionComponent;
-    property OnExecute: TNotifyEvent read FOnExecute write SetOnExecute;
-    property OnUpdate: TNotifyEvent read FOnUpdate write FOnUpdate;
-  end;
-
-{ TBasicAction class reference type }
-
-  TBasicActionClass = class of TBasicAction;
-
-{ Component registration handlers }
-
-  TActiveXRegType = (axrComponentOnly, axrIncludeDescendants);
-
-{$ifdef HASINTF}
-  IInterfaceList = interface ['{285DEA8A-B865-11D1-AAA7-00C04FB17A72}']
-    function Get(i : Integer) : IUnknown;
-    function GetCapacity : Integer;
-    function GetCount : Integer;
-    procedure Put(i : Integer;item : IUnknown);
-    procedure SetCapacity(NewCapacity : Integer);
-    procedure SetCount(NewCount : Integer);
-    procedure Clear;
-    procedure Delete(index : Integer);
-    procedure Exchange(index1,index2 : Integer);
-    function First : IUnknown;
-    function IndexOf(item : IUnknown) : Integer;
-    function Add(item : IUnknown) : Integer;
-    procedure Insert(i : Integer;item : IUnknown);
-    function Last : IUnknown;
-    function Remove(item : IUnknown): Integer;
-    procedure Lock;
-    procedure Unlock;
-    property Capacity : Integer read GetCapacity write SetCapacity;
-    property Count : Integer read GetCount write SetCount;
-    property Items[index : Integer] : IUnknown read Get write Put;default;
-  end;
-
-  TInterfaceList = class(TInterfacedObject,IInterfaceList)
-  private
-    FList : TThreadList;
-  protected
-    function Get(i : Integer) : IUnknown;
-    function GetCapacity : Integer;
-    function GetCount : Integer;
-    procedure Put(i : Integer;item : IUnknown);
-    procedure SetCapacity(NewCapacity : Integer);
-    procedure SetCount(NewCount : Integer);
-  public
-    constructor Create;
-    destructor Destroy;
-
-    procedure Clear;
-    procedure Delete(index : Integer);
-    procedure Exchange(index1,index2 : Integer);
-    function First : IUnknown;
-    function IndexOf(item : IUnknown) : Integer;
-    function Add(item : IUnknown) : Integer;
-    procedure Insert(i : Integer;item : IUnknown);
-    function Last : IUnknown;
-    function Remove(item : IUnknown): Integer;
-    procedure Lock;
-    procedure Unlock;
-
-    function Expand : TInterfaceList;
-
-    property Capacity : Integer read GetCapacity write SetCapacity;
-    property Count : Integer read GetCount write SetCount;
-    property Items[Index : Integer] : IUnknown read Get write Put;default;
-  end;
-{$endif HASINTF}
-
-{ ---------------------------------------------------------------------
-    TDatamodule support
-  ---------------------------------------------------------------------}
-  TDataModule = class(TComponent)
-  private
-    FDPos: TPoint;
-    FDSize: TPoint;
-    FOnCreate: TNotifyEvent;
-    FOnDestroy: TNotifyEvent;
-    FOldOrder : Boolean;
-    Procedure ReadT(Reader: TReader);
-    Procedure WriteT(Writer: TWriter);
-    Procedure ReadL(Reader: TReader);
-    Procedure WriteL(Writer: TWriter);
-    Procedure ReadW(Reader: TReader);
-    Procedure WriteW(Writer: TWriter);
-    Procedure ReadH(Reader: TReader);
-    Procedure WriteH(Writer: TWriter);
-  protected
-    Procedure DoCreate; virtual;
-    Procedure DoDestroy; virtual;
-    Procedure DefineProperties(Filer: TFiler); override;
-    Procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
-    Function HandleCreateException: Boolean; virtual;
-    Procedure ReadState(Reader: TReader); override;
-  public
-    constructor Create(AOwner: TComponent); override;
-    Constructor CreateNew(AOwner: TComponent);
-    Constructor CreateNew(AOwner: TComponent; CreateMode: Integer); virtual;
-    destructor Destroy; override;
-    Procedure AfterConstruction; override;
-    Procedure BeforeDestruction; override;
-    property DesignOffset: TPoint read FDPos write FDPos;
-    property DesignSize: TPoint read FDSize write FDSize;
-  published
-    property OnCreate: TNotifyEvent read FOnCreate write FOnCreate;
-    property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
-    property OldCreateOrder: Boolean read FOldOrder write FOldOrder;
-  end;
-
-var
-  // IDE hooks for TDatamodule support.
-  AddDataModule              : procedure (DataModule: TDataModule) of object;
-  RemoveDataModule           : procedure (DataModule: TDataModule) of object;
-  ApplicationHandleException : procedure (Sender: TObject) of object;
-  ApplicationShowException   : procedure (E: Exception) of object;
-
-{ ---------------------------------------------------------------------
-    General streaming and registration routines
-  ---------------------------------------------------------------------}
-
-
-var
-  RegisterComponentsProc: procedure(const Page: string;
-    ComponentClasses: array of TComponentClass);
-  RegisterNoIconProc: procedure(ComponentClasses: array of TComponentClass);
-{!!!!  RegisterNonActiveXProc: procedure(ComponentClasses: array of TComponentClass;
-    AxRegType: TActiveXRegType) = nil;
-  CurrentGroup: Integer = -1;
-  CreateVCLComObjectProc: procedure(Component: TComponent) = nil;}
-
-{ Point and rectangle constructors }
-
-function Point(AX, AY: Integer): TPoint;
-function SmallPoint(AX, AY: SmallInt): TSmallPoint;
-function Rect(ALeft, ATop, ARight, ABottom: Integer): TRect;
-function Bounds(ALeft, ATop, AWidth, AHeight: Integer): TRect;
-
-{ Class registration routines }
-
-procedure RegisterClass(AClass: TPersistentClass);
-procedure RegisterClasses(AClasses: array of TPersistentClass);
-procedure RegisterClassAlias(AClass: TPersistentClass; const Alias: string);
-procedure UnRegisterClass(AClass: TPersistentClass);
-procedure UnRegisterClasses(AClasses: array of TPersistentClass);
-procedure UnRegisterModuleClasses(Module: HMODULE);
-function FindClass(const AClassName: string): TPersistentClass;
-function GetClass(const AClassName: string): TPersistentClass;
-
-{ Component registration routines }
-
-procedure RegisterComponents(const Page: string;
-  ComponentClasses: array of TComponentClass);
-procedure RegisterNoIcon(ComponentClasses: array of TComponentClass);
-procedure RegisterNonActiveX(ComponentClasses: array of TComponentClass;
-  AxRegType: TActiveXRegType);
-
-{!!!: var
-  GlobalNameSpace: TMultiReadExclusiveWriteSynchronizer;}
-
-
-{ Object filing routines }
-
-type
-  TIdentMapEntry = record
-    Value: Integer;
-    Name: String;
-  end;
-
-  TIdentToInt = function(const Ident: string; var Int: Longint): Boolean;
-  TIntToIdent = function(Int: Longint; var Ident: string): Boolean;
-  TFindGlobalComponent = function(const Name: string): TComponent;
-  TInitComponentHandler = function(Instance: TComponent; RootAncestor : TClass): boolean;
-
-var
-  MainThreadID: THandle;
-  FindGlobalComponent: TFindGlobalComponent;
-
-procedure RegisterIntegerConsts(IntegerType: Pointer; IdentToIntFn: TIdentToInt;
-  IntToIdentFn: TIntToIdent);
-function IdentToInt(const Ident: string; var Int: Longint; const Map: array of TIdentMapEntry): Boolean;
-function IntToIdent(Int: Longint; var Ident: string; const Map: array of TIdentMapEntry): Boolean;
-
-function InitInheritedComponent(Instance: TComponent; RootAncestor: TClass): Boolean;
-function InitComponentRes(const ResName: string; Instance: TComponent): Boolean;
-function ReadComponentRes(const ResName: string; Instance: TComponent): TComponent;
-function ReadComponentResEx(HInstance: THandle; const ResName: string): TComponent;
-function ReadComponentResFile(const FileName: string; Instance: TComponent): TComponent;
-procedure WriteComponentResFile(const FileName: string; Instance: TComponent);
-procedure RegisterInitComponentHandler(ComponentClass: TComponentClass;   Handler: TInitComponentHandler);
-
-procedure GlobalFixupReferences;
-procedure GetFixupReferenceNames(Root: TComponent; Names: TStrings);
-procedure GetFixupInstanceNames(Root: TComponent;
-  const ReferenceRootName: string; Names: TStrings);
-procedure RedirectFixupReferences(Root: TComponent; const OldRootName,
-  NewRootName: string);
-procedure RemoveFixupReferences(Root: TComponent; const RootName: string);
-procedure RemoveFixups(Instance: TPersistent);
-function FindNestedComponent(Root: TComponent; const NamePath: string): TComponent;
-
-procedure BeginGlobalLoading;
-procedure NotifyGlobalLoading;
-procedure EndGlobalLoading;
-
-function CollectionsEqual(C1, C2: TCollection): Boolean;
-
-{ Object conversion routines }
-
-procedure ObjectBinaryToText(Input, Output: TStream);
-procedure ObjectTextToBinary(Input, Output: TStream);
-
-procedure ObjectResourceToText(Input, Output: TStream);
-procedure ObjectTextToResource(Input, Output: TStream);
-
-{ Utility routines }
-
-function LineStart(Buffer, BufPos: PChar): PChar;
-
-{
-  $Log: classesh.inc,v $
-  Revision 1.5  2005/02/14 17:13:11  peter
-    * truncate log
-
-}

fcl/classes/collect.inc

@@ -1,347 +0,0 @@
-{
-    $Id: collect.inc,v 1.2 2005/02/14 17:13:11 peter Exp $
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1999-2000 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-{****************************************************************************}
-{*                             TCollectionItem                              *}
-{****************************************************************************}
-
-
-function TCollectionItem.GetIndex: Integer;
-
-begin
-  if FCollection<>nil then
-    Result:=FCollection.FItems.IndexOf(Pointer(Self))
-  else
-    Result:=-1;
-end;
-
-
-
-procedure TCollectionItem.SetCollection(Value: TCollection);
-
-begin
-  IF Value<>FCollection then
-    begin
-    If FCollection<>Nil then FCollection.RemoveItem(Self);
-    if Value<>Nil then Value.InsertItem(Self);
-    FCollection:=Value;
-    end;
-end;
-
-
-
-procedure TCollectionItem.Changed(AllItems: Boolean);
-
-begin
- If (FCollection<>Nil) then
-  begin
-  If AllItems then
-    FCollection.Update(Nil)
-  else
-    FCollection.Update(Self);
-  end;
-end;
-
-
-
-function TCollectionItem.GetNamePath: string;
-
-begin
-  If FCollection<>Nil then
-    Result:=FCollection.GetNamePath+'['+IntToStr(Index)+']'
-  else
-    Result:=ClassName;
-end;
-
-
-function TCollectionItem.GetOwner: TPersistent;
-
-begin
-  Result:=FCollection;
-end;
-
-
-
-function TCollectionItem.GetDisplayName: string;
-
-begin
-  Result:=ClassName;
-end;
-
-
-
-procedure TCollectionItem.SetIndex(Value: Integer);
-
-Var Temp : Longint;
-
-begin
-  Temp:=GetIndex;
-  If (Temp>-1) and (Temp<>Value) then
-    begin
-    FCollection.FItems.Move(Temp,Value);
-    Changed(True);
-    end;
-end;
-
-
-procedure TCollectionItem.SetDisplayName(const Value: string);
-
-begin
-  Changed(False);
-end;
-
-
-
-constructor TCollectionItem.Create(ACollection: TCollection);
-
-begin
-  Inherited Create;
-  SetCollection(ACollection);
-end;
-
-
-
-destructor TCollectionItem.Destroy;
-
-begin
-  SetCollection(Nil);
-  Inherited Destroy;
-end;
-
-{****************************************************************************}
-{*                             TCollection                                  *}
-{****************************************************************************}
-
-
-
-function TCollection.GetCount: Integer;
-
-begin
-  If Assigned(FItems) Then
-    Result:=FItems.Count
-  else
-    Result:=0;
-end;
-
-
-Procedure TCollection.SetPropName;
-
-begin
-  //!! Should be replaced by the proper routines.
-  FPropName:='';
-end;
-
-
-function TCollection.GetPropName: string;
-
-Var TheOWner : TPersistent;
-
-begin
-  Result:=FPropNAme;
-  TheOWner:=GetOwner;
-  If (Result<>'') or (TheOwner=Nil) Or (TheOwner.Classinfo=Nil) then exit;
-  SetPropName;
-  Result:=FPropName;
-end;
-
-
-
-procedure TCollection.InsertItem(Item: TCollectionItem);
-
-begin
-  If Not(Item Is FitemClass) then
-    exit;
-  FItems.add(Pointer(Item));
-  Item.FID:=FNextID;
-  inc(FNextID);
-  SetItemName(Item);
-  Changed;
-end;
-
-
-
-procedure TCollection.RemoveItem(Item: TCollectionItem);
-
-begin
-  FItems.Remove(Pointer(Item));
-  Item.FCollection:=Nil;
-  Changed;
-end;
-
-
-function TCollection.GetAttrCount: Integer;
-
-begin
-  Result:=0;
-end;
-
-
-function TCollection.GetAttr(Index: Integer): string;
-
-begin
-  Result:='';
-end;
-
-
-
-function TCollection.GetItemAttr(Index, ItemIndex: Integer): string;
-
-
-begin
-   Result:=TCollectionItem(FItems.Items[ItemIndex]).DisplayName;
-end;
-
-
-
-function TCollection.GetNamePath: string;
-
-Var OwnerName,ThePropName : String;
-
-begin
-  Result:=ClassName;
-  If GetOwner=Nil then Exit;
-  OwnerName:=GetOwner.GetNamePath;
-  If OwnerName='' then Exit;
-  ThePropName:=PropName;
-  if ThePropName='' then exit;
-  Result:=OwnerName+'.'+PropName;
-end;
-
-
-
-procedure TCollection.Changed;
-
-begin
-  Update(Nil);
-end;
-
-
-
-function TCollection.GetItem(Index: Integer): TCollectionItem;
-
-begin
-   Result:=TCollectionItem(FItems.Items[Index]);
-end;
-
-
-
-procedure TCollection.SetItem(Index: Integer; Value: TCollectionItem);
-
-begin
-  TCollectionItem(FItems.items[Index]).Assign(Value);
-end;
-
-
-
-procedure TCollection.SetItemName(Item: TCollectionItem);
-
-begin
-end;
-
-
-
-procedure TCollection.Update(Item: TCollectionItem);
-
-begin
-end;
-
-
-
-constructor TCollection.Create(AItemClass: TCollectionItemClass);
-
-begin
-  inherited create;
-  FItemClass:=AItemClass;
-  FItems:=TList.Create;
-end;
-
-
-
-destructor TCollection.Destroy;
-
-begin
-  If Assigned(FItems) Then Clear;
-  FItems.Free;
-  Inherited Destroy;
-end;
-
-
-
-function TCollection.Add: TCollectionItem;
-
-begin
-  Result:=FItemClass.Create(Self);
-end;
-
-
-
-procedure TCollection.Assign(Source: TPersistent);
-
-Var I : Longint;
-
-begin
-  If Source is TCollection then
-    begin
-    Clear;
-    For I:=0 To TCollection(Source).Count-1 do
-     Add.Assign(TCollection(Source).Items[I]);
-    exit;
-    end
-  else
-    Inherited Assign(Source);
-end;
-
-
-
-procedure TCollection.BeginUpdate;
-
-begin
-end;
-
-
-
-procedure TCollection.Clear;
-
-begin
-  If Assigned(FItems) then
-    While FItems.Count>0 do TCollectionItem(FItems.Last).Free;
-end;
-
-
-
-procedure TCollection.EndUpdate;
-
-begin
-end;
-
-
-
-function TCollection.FindItemID(ID: Integer): TCollectionItem;
-
-Var I : Longint;
-
-begin
-  Result:=Nil;
-  For I:=0 to Fitems.Count-1 do
-   begin
-   Result:=TCollectionItem(FItems.items[I]);
-   If Result.Id=Id then exit;
-   end;
-end;
-
-{
-  $Log: collect.inc,v $
-  Revision 1.2  2005/02/14 17:13:11  peter
-    * truncate log
-
-}

fcl/classes/compon.inc

@@ -1,546 +0,0 @@
-{
-    $Id: compon.inc,v 1.3 2005/02/14 17:13:11 peter Exp $
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1999-2000 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-{****************************************************************************}
-{*                             TComponent                                   *}
-{****************************************************************************}
-
-Type
-  Longrec = Record
-    Hi,lo : word;
-    end;
-
-Function  TComponent.GetComponent(AIndex: Integer): TComponent;
-
-begin
-  If not assigned(FComponents) then
-    Result:=Nil
-  else
-    Result:=TComponent(FComponents.Items[Aindex]);
-end;
-
-
-Function  TComponent.GetComponentCount: Integer;
-
-begin
-  If not assigned(FComponents) then
-    result:=0
-  else
-    Result:=FComponents.Count;
-end;
-
-
-Function  TComponent.GetComponentIndex: Integer;
-
-begin
-  If Assigned(FOwner) and Assigned(FOwner.FComponents) then
-    Result:=FOWner.FComponents.IndexOf(Self)
-  else
-    Result:=-1;
-end;
-
-
-Procedure TComponent.Insert(AComponent: TComponent);
-
-begin
-  If not assigned(FComponents) then
-    FComponents:=TList.Create;
-  FComponents.Add(AComponent);
-  AComponent.FOwner:=Self;
-end;
-
-
-Procedure TComponent.ReadLeft(Reader: TReader);
-
-begin
-  LongRec(FDesignInfo).Lo:=Reader.ReadInteger;
-end;
-
-
-Procedure TComponent.ReadTop(Reader: TReader);
-
-begin
-  LongRec(FDesignInfo).Hi:=Reader.ReadInteger;
-end;
-
-
-Procedure TComponent.Remove(AComponent: TComponent);
-
-begin
-  AComponent.FOwner:=Nil;
-  If assigned(FCOmponents) then
-    begin
-    FComponents.Remove(AComponent);
-    IF FComponents.Count=0 then
-      begin
-      FComponents.Free;
-      FComponents:=Nil;
-      end;
-    end;
-end;
-
-
-Procedure TComponent.RemoveNotification(AComponent: TComponent);
-
-begin
-  if FFreeNotifies<>nil then
-    begin
-    FFreeNotifies.Remove(AComponent);
-    if FFreeNotifies.Count=0 then
-      begin
-      FFreeNotifies.Free;
-      FFreeNotifies:=nil;
-      Exclude(FComponentState,csFreeNotification);
-      end;
-    end;
-end;
-
-
-Procedure TComponent.SetComponentIndex(Value: Integer);
-
-Var Temp,Count : longint;
-
-begin
-  If Not assigned(Fowner) then exit;
-  Temp:=getcomponentindex;
-  If temp<0 then exit;
-  If value<0 then value:=0;
-  Count:=Fowner.FComponents.Count;
-  If Value>=Count then value:=count-1;
-  If Value<>Temp then
-    begin
-    FOWner.FComponents.Delete(Temp);
-    FOwner.FComponents.Insert(Value,Self);
-    end;
-end;
-
-
-Procedure TComponent.SetReference(Enable: Boolean);
-
-var
-  Field: ^TComponent;
-begin
-  if Assigned(Owner) then
-  begin
-    Field := Owner.FieldAddress(Name);
-    if Assigned(Field) then
-      if Enable then
-        Field^ := Self
-      else
-        Field^ := nil;
-  end;
-end;
-
-
-Procedure TComponent.WriteLeft(Writer: TWriter);
-
-begin
-  Writer.WriteInteger(LongRec(FDesignInfo).Lo);
-end;
-
-
-Procedure TComponent.WriteTop(Writer: TWriter);
-
-begin
-  Writer.WriteInteger(LongRec(FDesignInfo).Hi);
-end;
-
-
-Procedure TComponent.ChangeName(const NewName: TComponentName);
-
-begin
-  FName:=NewName;
-end;
-
-
-Procedure TComponent.DefineProperties(Filer: TFiler);
-
-Var Ancestor : TComponent;
-    Temp : longint;
-
-begin
-  Temp:=0;
-  Ancestor:=TComponent(Filer.Ancestor);
-  If Assigned(Ancestor) then Temp:=Ancestor.FDesignInfo;
-  Filer.Defineproperty('left',@readleft,@writeleft,
-                       (longrec(FDesignInfo).Lo<>Longrec(temp).Lo));
-  Filer.Defineproperty('top',@readtop,@writetop,
-                       (longrec(FDesignInfo).Hi<>Longrec(temp).Hi));
-end;
-
-
-Procedure TComponent.GetChildren(Proc: TGetChildProc; Root: TComponent);
-
-begin
-  // Does nothing.
-end;
-
-
-Function  TComponent.GetChildOwner: TComponent;
-
-begin
- Result:=Nil;
-end;
-
-
-Function  TComponent.GetChildParent: TComponent;
-
-begin
-  Result:=Self;
-end;
-
-
-Function  TComponent.GetNamePath: string;
-
-begin
-  Result:=FName;
-end;
-
-
-Function  TComponent.GetOwner: TPersistent;
-
-begin
-  Result:=FOwner;
-end;
-
-
-Procedure TComponent.Loaded;
-
-begin
-  Exclude(FComponentState,csLoading);
-end;
-
-
-Procedure TComponent.Notification(AComponent: TComponent;
-  Operation: TOperation);
-
-Var Runner : Longint;
-
-begin
-  If (Operation=opRemove) and Assigned(FFreeNotifies) then
-    begin
-    FFreeNotifies.Remove(AComponent);
-            If FFreeNotifies.Count=0 then
-      begin
-      FFreeNotifies.Free;
-      FFreenotifies:=Nil;
-      end;
-    end;
-  If assigned(FComponents) then
-    For Runner:=0 To FComponents.Count-1 do
-      TComponent(FComponents.Items[Runner]).Notification(AComponent,Operation);
-end;
-
-
-Procedure TComponent.ReadState(Reader: TReader);
-
-begin
-  Reader.ReadData(Self);
-end;
-
-
-Procedure TComponent.SetAncestor(Value: Boolean);
-
-Var Runner : Longint;
-
-begin
-  If Value then
-    Include(FComponentState,csAncestor)
-  else
-    Include(FCOmponentState,csAncestor);
-  if Assigned(FComponents) then
-    For Runner:=0 To FComponents.Count-1 do
-      TComponent(FComponents.Items[Runner]).SetAncestor(Value);
-end;
-
-
-Procedure TComponent.SetDesigning(Value: Boolean);
-
-Var Runner : Longint;
-
-begin
-  If Value then
-    Include(FComponentSTate,csDesigning)
-  else
-    Exclude(FComponentSTate,csDesigning);
-  if Assigned(FComponents) then
-    For Runner:=0 To FComponents.Count - 1 do
-      TComponent(FComponents.items[Runner]).SetDesigning(Value);
-end;
-
-
-Procedure TComponent.SetName(const NewName: TComponentName);
-
-begin
-  If FName=NewName then exit;
-  If not IsValidIdent(NewName) then
-    Raise EComponentError.CreateFmt(SInvalidName,[NewName]);
-  If Assigned(FOwner) Then
-    FOwner.ValidateRename(Self,FName,NewName)
-  else
-    ValidateRename(Nil,FName,NewName);
-  SetReference(False);
-  ChangeName(NewName);
-  Setreference(True);
-end;
-
-
-Procedure TComponent.SetChildOrder(Child: TComponent; Order: Integer);
-
-begin
-  // does nothing
-end;
-
-
-Procedure TComponent.SetParentComponent(Value: TComponent);
-
-begin
-  // Does nothing
-end;
-
-
-Procedure TComponent.Updating;
-
-begin
-  Include (FComponentState,csUpdating);
-end;
-
-
-Procedure TComponent.Updated;
-
-begin
-  Exclude(FComponentState,csUpdating);
-end;
-
-
-class Procedure TComponent.UpdateRegistry(Register: Boolean; const ClassID, ProgID: string);
-
-begin
-  // For compatibility only.
-end;
-
-
-Procedure TComponent.ValidateRename(AComponent: TComponent;
-  const CurName, NewName: string);
-
-begin
-//!! This contradicts the Delphi manual.
-  If (AComponent<>Nil) and (CurName<>NewName) and (AComponent.Owner = Self) and
-     (FindComponent(NewName)<>Nil) then
-      raise EComponentError.Createfmt(SDuplicateName,[newname]);
-  If (csDesigning in FComponentState) and (FOwner<>Nil) then
-    FOwner.ValidateRename(AComponent,Curname,Newname);
-end;
-
-
-Procedure TComponent.ValidateContainer(AComponent: TComponent);
-
-begin
-end;
-
-
-Procedure TComponent.ValidateInsert(AComponent: TComponent);
-
-begin
-  // Does nothing.
-end;
-
-
-Procedure TComponent.WriteState(Writer: TWriter);
-
-begin
-  Writer.WriteComponentData(Self);
-end;
-
-
-Constructor TComponent.Create(AOwner: TComponent);
-
-begin
-  FComponentStyle:=[csInheritable];
-  If Assigned(AOwner) then AOwner.InsertComponent(Self);
-end;
-
-
-Destructor TComponent.Destroy;
-
-Var Runner : Longint;
-
-begin
-  Destroying;
-  If Assigned(FFreeNotifies) then
-    begin
-    For Runner:=0 To FFreeNotifies.Count-1 do
-      TComponent(FFreeNotifies.Items[Runner]).Notification (self,opRemove);
-    FFreeNotifies.Free;
-    FFreeNotifies:=Nil;
-    end;
-  DestroyComponents;
-  If FOwner<>Nil Then FOwner.RemoveComponent(Self);
-  inherited destroy;
-end;
-
-
-Procedure TComponent.BeforeDestruction;
-begin
-  if not(csDestroying in ComponentState) then
-    Destroying;
-end;
-
-
-Procedure TComponent.DestroyComponents;
-
-Var acomponent: TComponent;
-
-begin
-  While assigned(FComponents) do
-    begin
-    aComponent:=TComponent(FComponents.Last);
-    Remove(aComponent);
-    Acomponent.Destroy;
-    end;
-end;
-
-
-Procedure TComponent.Destroying;
-
-Var Runner : longint;
-
-begin
-  If csDestroying in FComponentstate Then Exit;
-  include (FComponentState,csDestroying);
-  If Assigned(FComponents) then
-    for Runner:=0 to FComponents.Count-1 do
-      TComponent(FComponents.Items[Runner]).Destroying;
-end;
-
-
-function TComponent.ExecuteAction(Action: TBasicAction): Boolean;
-begin
-  if Action.HandlesTarget(Self) then
-   begin
-     Action.ExecuteTarget(Self);
-     Result := True;
-   end
-  else
-   Result := False;
-end;
-
-
-Function  TComponent.FindComponent(const AName: string): TComponent;
-
-Var I : longint;
-
-begin
-  Result:=Nil;
-  If (AName='') or Not assigned(FComponents) then exit;
-  For i:=0 to FComponents.Count-1 do
-    if TComponent(FComponents[I]).Name=AName then
-      begin
-      Result:=TComponent(FComponents.Items[I]);
-      exit;
-      end;
-end;
-
-
-Procedure TComponent.FreeNotification(AComponent: TComponent);
-
-begin
-  If (Owner<>Nil) and (AComponent=Owner) then exit;
-  If not (Assigned(FFreeNotifies)) then
-    FFreeNotifies:=TList.Create;
-  If FFreeNotifies.IndexOf(AComponent)=-1 then
-    begin
-    FFreeNotifies.Add(AComponent);
-    AComponent.FreeNotification (self);
-    end;
-end;
-
-
-procedure TComponent.RemoveFreeNotification(AComponent: TComponent);
-begin
-  RemoveNotification(AComponent);
-  AComponent.RemoveNotification (self);
-end;
-
-
-Procedure TComponent.FreeOnRelease;
-
-begin
-  // Delphi compatibility only at the moment.
-end;
-
-
-Function  TComponent.GetParentComponent: TComponent;
-
-begin
-  Result:=Nil;
-end;
-
-
-Function  TComponent.HasParent: Boolean;
-
-begin
-  Result:=False;
-end;
-
-
-Procedure TComponent.InsertComponent(AComponent: TComponent);
-
-begin
-  AComponent.ValidateContainer(Self);
-  ValidateRename(AComponent,'',AComponent.FName);
-  Insert(AComponent);
-  AComponent.SetReference(True);
-  If csDesigning in FComponentState then
-    AComponent.SetDesigning(true);
-  Notification(AComponent,opInsert);
-end;
-
-
-Procedure TComponent.RemoveComponent(AComponent: TComponent);
-
-begin
-  Notification(AComponent,opRemove);
-  AComponent.SetReference(False);
-  Remove(AComponent);
-  Acomponent.Setdesigning(False);
-  ValidateRename(AComponent,AComponent.FName,'');
-end;
-
-
-Function  TComponent.SafeCallException(ExceptObject: TObject;
-  ExceptAddr: Pointer): Integer;
-
-begin
-  SafeCallException:=0;
-end;
-
-
-function TComponent.UpdateAction(Action: TBasicAction): Boolean;
-begin
-  if Action.HandlesTarget(Self) then
-    begin
-      Action.UpdateTarget(Self);
-      Result := True;
-    end
-  else
-    Result := False;
-end;
-
-{
-  $Log: compon.inc,v $
-  Revision 1.3  2005/02/14 17:13:11  peter
-    * truncate log
-
-}

fcl/classes/constse.inc

@@ -1,282 +0,0 @@
-{
-    $Id: constse.inc,v 1.2 2005/02/14 17:13:11 peter Exp $
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1999-2000 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-const
-  SAssignError = '%s can not be assigned to %s';
-  SFCreateError = 'File %s can not be created';
-  SFOpenError = 'File %s can not be opened';
-  SReadError = 'Stream read error';
-  SWriteError = 'Stream write error';
-  SMemoryStreamError = 'Cannot expand memory stream';
-  SCantWriteResourceStreamError = 'Can not write to read-only ResourceStream';
-  SDuplicateReference = 'WriteObject was called twice for one instance';
-  SClassNotFound = 'Class %s not found';
-  SInvalidImage = 'Illegal stream image';
-  SResNotFound = 'Resource %s not found';
-  SClassMismatch = 'Resource %s has wrong class';
-  SListIndexError = 'List index exceeds bounds (%d)';
-  SListCapacityError = 'The maximum list capacity is reached (%d)';
-  SListCountError = 'List count too large (%d)';
-  SSortedListError = 'Operation not allowed on sorted StringLists';
-  SDuplicateString = 'Duplicate entries not allowed in StringList';
-  SInvalidTabIndex = 'Registerindex out of bounds';
-  SDuplicateName = 'A Component with name %s exists already';
-  SInvalidName = '"%s" is not a valid identifier name';
-  SDuplicateClass = 'A class with name %s exists already';
-  SNoComSupport = '%s is not registered as COM Class';
-  SLineTooLong = 'Line too long';
-  SRangeError = 'Range error';
-  SSeekNotImplemented = '64bit Seek not implemented for class %s';
-  SErrNoStreaming = 'Failed to initialize component: No streaming method available.';
-
-  SInvalidPropertyValue = 'Invalid property value';
-  SInvalidPropertyPath = 'Invalid property path';
-  SUnknownProperty = 'Unknown property';
-  SReadOnlyProperty = 'Read-only property';
-  SUnknownPropertyType = 'Unknown property type %d';
-  SPropertyException = 'Error while reading %s%s%s: %s';
-  SAncestorNotFound = 'Ancestor of ''%s'' not found';
-  SInvalidBitmap = 'Invalid Bitmap';
-  SInvalidIcon = 'Invalid Icon';
-  SInvalidMetafile = 'Invalid Metafile';
-  SInvalidPixelFormat = 'Invalid Pixelformat';
-  SBitmapEmpty = 'Bitmap is empty';
-  SScanLine = 'Line index out of bounds';
-  SChangeIconSize = 'Can not change icon size';
-  SOleGraphic = 'Invalid operation for TOleGraphic';
-  SUnknownExtension = 'Unknown extension (.%s)';
-  SUnknownClipboardFormat = 'Unknown clipboard format';
-  SOutOfResources = 'Out of system resources';
-  SNoCanvasHandle = 'Canvas handle does not allow drawing';
-  SInvalidImageSize = 'Invalid image size';
-  STooManyImages = 'Too many images';
-  SDimsDoNotMatch = 'Image size mismatch';
-  SInvalidImageList = 'Invalid ImageList';
-  SReplaceImage = 'Image can not be replaced';
-  SImageIndexError = 'Invalid ImageList index';
-  SImageReadFail = 'The ImageList data could not be read from stream';
-  SImageWriteFail = 'The ImageList data could not be written to stream';
-  SWindowDCError = 'Error when??';
-  SClientNotSet = 'Client of TDrag was not initialized';
-  SWindowClass = 'Error when initializing Window Class';
-  SWindowCreate = 'Error when creating Window';
-  SCannotFocus = 'A disbled or invisible Window cannot get focus';
-  SParentRequired = 'Element ''%s'' has no parent Window';
-  SMDIChildNotVisible = 'A MDI-Child Windows can not be hidden.';
-  SVisibleChanged = 'Visible property cannot be changed in OnShow or OnHide handlers';
-  SCannotShowModal = 'A visible Window can not be made modal';
-  SScrollBarRange = 'Scrollbar property out of range';
-  SPropertyOutOfRange = 'Property %s out of range';
-  SMenuIndexError = 'Menu Index out of range';
-  SMenuReinserted = 'Menu reinserted';
-  SMenuNotFound = 'Menu entry not found in menu';
-  SNoTimers = 'No timers available';
-  SNotPrinting = 'Printer is not printing';
-  SPrinting = 'Printer is busy';
-  SPrinterIndexError = 'PrinterIndex out of range';
-  SInvalidPrinter = 'Selected printer is invalid';
-  SDeviceOnPort = '%s on %s';
-  SGroupIndexTooLow = 'GroupIndex must be greater than preceding menu groupindex';
-  STwoMDIForms = 'There is only one MDI window available';
-  SNoMDIForm = 'No MDI form is available, none is active';
-  SRegisterError = 'Invalid registry';
-  SImageCanvasNeedsBitmap = 'A Canvas can only be changedif it contains a bitmap';
-  SControlParentSetToSelf = 'A component can not have itself as parent';
-  SOKButton = 'OK';
-  SCancelButton = 'Cancel';
-  SYesButton = '&Yes';
-  SNoButton = '&No';
-  SHelpButton = '&Help';
-  SCloseButton = '&Close';
-  SIgnoreButton = '&Ignore';
-  SRetryButton = '&Retry';
-  SAbortButton = 'Abort';
-  SAllButton = '&All';
-
-  SFB = 'VH';
-  SFG = 'VG';
-  SBG = 'HG';
-  SOldTShape = 'Can not load older version of TShape';
-  SVMetafiles = 'MetaFiles';
-  SVEnhMetafiles = 'Enhanced MetaFiles';
-  SVIcons = 'Icons';
-  SVBitmaps = 'Bitmaps';
-  SGridTooLarge = 'Grid to large for this operation';
-  STooManyDeleted = 'Zu viele Zeilen oder Spalten gelöscht';
-  SIndexOutOfRange = 'Grid index out of range';
-  SFixedColTooBig = 'The number of fixed Columns must be less than the Column count';
-  SFixedRowTooBig = 'The number of fixed Rows must be less that the Row count';
-  SInvalidStringGridOp = 'Es können keine Zeilen des ''Grids'' gelöscht oder eingefügt werden';
-  SParseError = '%s in Line %d';
-
-  SIdentifierExpected = 'Identifier expected';
-  SStringExpected = 'String expected';
-  SNumberExpected = 'Number expected';
-
-  SCharExpected = '%s expected';
-
-  SSymbolExpected = '%s expected';
-
-  SInvalidNumber = 'Invalid numerical value';
-  SInvalidString = 'Invalid string constant';
-  SInvalidProperty = 'Invalid property value';
-  SInvalidBinary = 'Invalid binary';
-  SOutlineIndexError = 'Node index not found';
-  SOutlineExpandError = 'Parent node must be expanded';
-  SInvalidCurrentItem = 'Invalid item';
-  SMaskErr = 'Invalid mask';
-  SMaskEditErr = 'Invalid mask. Use the ESC-key to undo changes.';
-  SOutlineError = 'Invalid Node index';
-  SOutlineBadLevel = '???';
-  SOutlineSelection = 'Ungültige Auswahl';
-  SOutlineFileLoad = 'Fehler beim Dateiladen';
-  SOutlineLongLine = 'Zeile zu lang';
-  SOutlineMaxLevels = 'Maximale Gliederungstiefe überschritten';
-
-  SMsgDlgWarning = 'Warning';
-  SMsgDlgError = 'Error';
-  SMsgDlgInformation = 'Information';
-  SMsgDlgConfirm = 'Confirm';
-  SMsgDlgYes = '&Yes';
-  SMsgDlgNo = '&No';
-  SMsgDlgOK = 'OK';
-  SMsgDlgCancel = 'Cancel';
-  SMsgDlgHelp = '&Help';
-  SMsgDlgHelpNone = 'No help available';
-  SMsgDlgHelpHelp = 'Help';
-  SMsgDlgAbort = '&Abort';
-  SMsgDlgRetry = '&Retry';
-  SMsgDlgIgnore = '&Ignore';
-  SMsgDlgAll = '&All';
-  SMsgDlgNoToAll = 'N&o to all';
-  SMsgDlgYesToAll = 'Yes to A&lle';
-
-  SmkcBkSp = 'Backspace';
-  SmkcTab = 'Tab';
-  SmkcEsc = 'Esc';
-  SmkcEnter = 'Enter';
-  SmkcSpace = 'Space';
-  SmkcPgUp = 'Page up';
-  SmkcPgDn = 'Page down';
-  SmkcEnd = 'End';
-  SmkcHome = 'Home';
-  SmkcLeft = 'Left';
-  SmkcUp = 'Up';
-  SmkcRight = 'Right';
-  SmkcDown = 'Down';
-  SmkcIns = 'Insert';
-  SmkcDel = 'Delete';
-  SmkcShift = 'Shift+';
-  SmkcCtrl = 'Ctrl+';
-  SmkcAlt = 'Alt+';
-
-  srUnknown = '(Ukknown)';
-  srNone = '(Empty)';
-  SOutOfRange = 'Value must be between %d and %d';
-  SCannotCreateName = 'Cannot use standard name for and unknown component';
-
-  SDateEncodeError = 'Ungültiges Argument für Datumskodierung';
-  STimeEncodeError = 'Ungültiges Argument für Zeitkodierung';
-  SInvalidDate = '''''%s'''' ist kein gültiges Datum';
-  SInvalidTime = '''''%s'''' ist keine gültige Zeit';
-  SInvalidDateTime = '''''%s'''' ist kein gültiges Datum und Zeit';
-  SInsertLineError = 'Zeile kann nicht eingefügt werden';
-
-  SCannotDragForm = 'Formulare können nicht gezogen werden';
-  SPutObjectError = 'PutObject auf undefiniertes Element';
-  SCardDLLNotLoaded = 'CARDS.DLL kann nicht geladen werden';
-  SDuplicateCardId = 'Doppelte CardId gefunden';
-
-  SDdeErr = 'Ein Fehler wurde von der DDE zurückgeliefert  ($0%x)';
-  SDdeConvErr = 'DDE Fehler - Konversation wurde nicht hergestellt ($0%x)';
-  SDdeMemErr = 'Fehler trat auf, da unzureichender Speicher für DDE ($0%x)';
-  SDdeNoConnect = 'DDE-Konversation kann nicht eingerichtet werden';
-
-
-  SDefaultFilter = 'Alle Dateien (*.*)|*.*';
-  sAllFilter = 'Alle Dateien';
-  SNoVolumeLabel = ': [ - Ohne Namen - ]';
-
-  SConfirmCreateDir = 'Das angegebene Verzeichnis existiert nicht. Soll es angelegt werden?';
-  SSelectDirCap = 'Verzeichnis auswählen';
-  SCannotCreateDir = 'Das Verzeichnis kann nicht erstellt werden';
-  SDirNameCap = 'Verzeichnis&name:';
-  SDrivesCap = '&Laufwerke:';
-  SDirsCap = '&Verzeichnisse:';
-  SFilesCap = '&Dateien: (*.*)';
-  SNetworkCap = 'Ne&tzwerk...';
-
-  SColorPrefix = 'Farbe';
-  SColorTags = 'ABCDEFGHIJKLMNOP';
-
-  SInvalidClipFmt = 'Ungültiges Format der Zwischenablage';
-  SIconToClipboard = 'Zwischenablage unterstützt keine Symbole';
-
-  SDefault = 'Vorgabe';
-
-  SInvalidMemoSize = 'Text überschreitet Memo-Kapazität';
-  SCustomColors = 'Selbstdefinierte Farben';
-  SInvalidPrinterOp = 'Operation auf ausgewähltem Drucker nicht verfügbar';
-  SNoDefaultPrinter = 'Zur Zeit ist kein Standard-Drucker gewählt';
-
-  SIniFileWriteError = 'nach %s kann nicht geschrieben werden';
-
-  SBitsIndexError = 'Bits-Index außerhalb des zulässigen Bereichs';
-
-  SUntitled = '(Unbenannt)';
-
-  SInvalidRegType = 'Ungültiger Datentyp für ''%s''';
-  SRegCreateFailed = 'Erzeugung von Schlüssel %s misslungen';
-  SRegSetDataFailed = 'Konnte Daten für ''%s'' nicht setzen';
-  SRegGetDataFailed = 'Konnte Daten für ''%s'' nicht holen';
-
-  SUnknownConversion = 'Unbekannte Dateierweiterung für RichEdit-Konvertierung (.%s)';
-  SDuplicateMenus = 'Menü ''%s'' wird bereits von einem anderen Formular benutzt';
-
-  SPictureLabel = 'Bild:';
-  SPictureDesc = ' (%dx%d)';
-  SPreviewLabel = 'Vorschau';
-
-  SCannotOpenAVI = 'AVI kann nicht geöffnet werden';
-
-  SNotOpenErr = 'Kein MCI-Gerät geöffnet';
-  SMPOpenFilter = 'Alle Dateien (*.*)|*.*|Wave-Dateien (*.WAV)|*.WAV|Midi-Dateien (*.MID)|*.MID|Video für Windows (*.avi)|*.avi';
-  SMCINil = '';
-  SMCIAVIVideo = 'AVIVideo';
-  SMCICDAudio = 'CDAudio';
-  SMCIDAT = 'DAT';
-  SMCIDigitalVideo = 'DigitalVideo';
-  SMCIMMMovie = 'MMMovie';
-  SMCIOther = 'Andere';
-  SMCIOverlay = 'Overlay';
-  SMCIScanner = 'Scanner';
-  SMCISequencer = 'Sequencer';
-  SMCIVCR = 'VCR';
-  SMCIVideodisc = 'Videodisc';
-  SMCIWaveAudio = 'WaveAudio';
-  SMCIUnknownError = 'Unbekannter Fehlercode';
-
-  SBoldItalicFont = 'Fett kursiv';
-  SBoldFont = 'Fett';
-  SItalicFont = 'Kursiv';
-  SRegularFont = 'Normal';
-
-  SPropertiesVerb = 'Eigenschaften';
-
-{
-  $Log: constse.inc,v $
-  Revision 1.2  2005/02/14 17:13:11  peter
-    * truncate log
-
-}

fcl/classes/constsg.inc

@@ -1,280 +0,0 @@
-{
-    $Id: constsg.inc,v 1.2 2005/02/14 17:13:11 peter Exp $
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1999-2000 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-const
-  SAssignError = '%s kann nicht zu  %s zugewiesen werden';
-  SFCreateError = 'Datei %s kann nicht erstellt werden';
-  SFOpenError = 'Datei %s kann nicht geöffnet werden';
-  SReadError = 'Stream-Read-Fehler';
-  SWriteError = 'Stream-Write-Fehler';
-  SMemoryStreamError = 'Expandieren des Speicher-Stream wegen Speichermangel nicht möglich';
-  SCantWriteResourceStreamError = 'In einen zum Lesen geöffneten Ressourcen-Stream kann nicht geschrieben werden';
-  SDuplicateReference = 'Zweimaliger Aufruf von WriteObject für die gleiche Instanz';
-  SClassNotFound = 'Klasse %s nicht gefunden';
-  SInvalidImage = 'Ungültiges Stream-Format';
-  SResNotFound = 'Ressource %s nicht gefunden';
-  SClassMismatch = 'Ressource %s hat die falsche Klasse';
-  SListIndexError = 'Der Index der Liste überschreitet das Maximum (%d)';
-  SListCapacityError = 'Die Kapazität der Liste ist erschöpft (%d)';
-  SListCountError = 'Zu viele Einträge in der Liste (%d)';
-  SSortedListError = 'Operation bei sortierten Stringlisten nicht erlaubt';
-  SDuplicateString = 'In der Stringliste sind Duplikate nicht erlaubt';
-  SInvalidTabIndex = 'Registerindex außerhalb des zulässigen Bereichs';
-  SDuplicateName = 'Eine Komponente mit der Bezeichnung %s existiert bereits';
-  SInvalidName = '''''%s'''' ist kein gültiger Komponentenname';
-  SDuplicateClass = 'Eine Klasse mit der Bezeichnung %s existiert bereits';
-  SNoComSupport = '%s wurde nicht als COM-Klasse registriert';
-  SInvalidInteger = '''''%s'''' ist kein gültiger Integerwert';
-  SLineTooLong = 'Zeile zu lang';
-
-  SInvalidPropertyValue = 'Ungültiger Wert der Eigenschaft';
-  SInvalidPropertyPath = 'Ungültiger Pfad für Eigenschaft';
-  SUnknownProperty = 'Eigenschaft existiert nicht';
-  SReadOnlyProperty = 'Eigenschaft kann nur gelesen werden';
-  SUnknownPropertyType = 'Unbekannter Eigenschaftstyp %d';
-  SPropertyException = 'Fehler beim Lesen von %s%s: %s';
-  SAncestorNotFound = 'Vorfahr für ''%s'' nicht gefunden';
-  SInvalidBitmap = 'Bitmap ist ungültig';
-  SInvalidIcon = 'Ungültiges Symbol';
-  SInvalidMetafile = 'Metadatei ist ungültig';
-  SInvalidPixelFormat = 'Ungültiges Pixelformat';
-  SBitmapEmpty = 'Bitmap ist leer';
-  SScanLine = 'Bereichsüberschreitung bei Zeilenindex';
-  SChangeIconSize = 'Die Größe eines Symbols kann nicht geändert werden';
-  SOleGraphic = 'Ungültige Operation für TOleGraphic';
-  SUnknownExtension = 'Unbekannte Bilddateierweiterung (.%s)';
-  SUnknownClipboardFormat = 'Format der Zwischenablage wird nicht unterstützt';
-  SOutOfResources = 'Systemressourcen erschöpft.';
-  SNoCanvasHandle = 'Leinwand/Bild erlaubt kein Zeichnen';
-  SInvalidImageSize = 'Ungültige Bildgröße';
-  STooManyImages = 'Zu viele Bilder';
-  SDimsDoNotMatch = 'Bildgröße und Bildlistengröße stimmen nicht überein';
-  SInvalidImageList = 'Ungültige ImageList';
-  SReplaceImage = 'Bild kann nicht ersetzt werden';
-  SImageIndexError = 'Ungültiger ImageList-Index';
-  SImageReadFail = 'Die ImageList-Daten konnten nicht aus dem Stream gelesen werden';
-  SImageWriteFail = 'Die ImageList-Daten konnten nicht in den Stream geschrieben werden';
-  SWindowDCError = 'Fehler beim Erstellen des Fenster-Gerätekontexts';
-  SClientNotSet = 'Client von TDrag wurde nicht initialisiert';
-  SWindowClass = 'Fehler beim Erzeugen einer Fensterklasse';
-  SWindowCreate = 'Fehler beim Erzeugen eines Fensters';
-  SCannotFocus = 'Ein deaktiviertes oder unsichtbares Fenster kann nicht den Fokus erhalten';
-  SParentRequired = 'Element ''%s'' hat kein übergeordnetes Fenster';
-  SMDIChildNotVisible = 'Ein MDI-Kindformular kann nicht verborgen werden';
-  SVisibleChanged = 'Eigenschaft Visible kann in OnShow oder OnHide nicht verändert werden';
-  SCannotShowModal = 'Aus einem sichtbaren Fenster kann kein modales gemacht werden';
-  SScrollBarRange = 'Eigenschaft Scrollbar außerhalb des zulässigen Bereichs';
-  SPropertyOutOfRange = 'Eigenschaft %s außerhalb des gültigen Bereichs';
-  SMenuIndexError = 'Menüindex außerhalb des zulässigen Bereichs';
-  SMenuReinserted = 'Menü zweimal eingefügt';
-  SMenuNotFound = 'Untermenü ist nicht im Menü';
-  SNoTimers = 'Nicht genügend Timer verfügbar';
-  SNotPrinting = 'Der Drucker ist nicht am Drucken';
-  SPrinting = 'Das Drucken ist im Gang';
-  SPrinterIndexError = 'Druckerindex außerhalb des zulässigen Bereichs';
-  SInvalidPrinter = 'Ausgewählter Drucker ist ungültig';
-  SDeviceOnPort = '%s an %s';
-  SGroupIndexTooLow = 'GroupIndex kann nicht kleiner sein als der GroupIndex eines vorhergehenden Menüelementes';
-  STwoMDIForms = 'Es ist nur ein MDI-Formular pro Anwendung möglich';
-  SNoMDIForm = 'Formular kann nicht erstellt werden. Zur Zeit sind keine MDI-Formulare aktiv';
-  SRegisterError = 'Ungültige Komponentenregistrierung';
-  SImageCanvasNeedsBitmap = 'Ein Bild kann nur geändert werden, wenn es ein Bitmap enthält';
-  SControlParentSetToSelf = 'Ein Steuerelement kann nicht sich selbst als Vorfahr haben';
-  SOKButton = 'OK';
-  SCancelButton = 'Abbrechen';
-  SYesButton = '&Ja';
-  SNoButton = '&Nein';
-  SHelpButton = '&Hilfe';
-  SCloseButton = '&Schließen';
-  SIgnoreButton = '&Ignorieren';
-  SRetryButton = '&Wiederholen';
-  SAbortButton = 'Abbruch';
-  SAllButton = '&Alles';
-
-  SFB = 'VH';
-  SFG = 'VG';
-  SBG = 'HG';
-  SOldTShape = 'Kann ältere Version von TShape nicht laden';
-  SVMetafiles = 'Metadateien';
-  SVEnhMetafiles = 'Erweiterte Metadateien';
-  SVIcons = 'Symbole';
-  SVBitmaps = 'Bitmaps';
-  SGridTooLarge = 'Gitter zu groß für Operation';
-  STooManyDeleted = 'Zu viele Zeilen oder Spalten gelöscht';
-  SIndexOutOfRange = 'Gitterindex außerhalb des zulässigen Bereichs';
-  SFixedColTooBig = 'Die Anzahl fester Spalten muß kleiner sein als die Spaltenanzahl';
-  SFixedRowTooBig = 'Die Anzahl fester Zeilen muß kleiner sein als die Zeilenanzahl';
-  SInvalidStringGridOp = 'Es können keine Zeilen des ''Grids'' gelöscht oder eingefügt werden';
-  SParseError = '%s in Zeile %d';
-
-  SIdentifierExpected = 'Bezeichner erwartet';
-  SStringExpected = 'String erwartet';
-  SNumberExpected = 'Zahl erwartet';
-
-  SCharExpected = '%s erwartet';
-
-  SSymbolExpected = '%s erwartet';
-
-  SInvalidNumber = 'Ungültiger numerischer Wert';
-  SInvalidString = 'Ungültige Stringkonstante';
-  SInvalidProperty = 'Ungültiger Wert der Eigenschaft';
-  SInvalidBinary = 'Ungültiger Binärwert';
-  SOutlineIndexError = 'Gliederungsindex nicht gefunden';
-  SOutlineExpandError = 'Elternknoten muß expandiert sein';
-  SInvalidCurrentItem = 'Ungültiger Wert';
-  SMaskErr = 'Ungültiger Eingabewert';
-  SMaskEditErr = 'Ungültiger Eingabewert. Benutzen Sie die ESC-Taste, um die Änderungen rückgängig zu machen.';
-  SOutlineError = 'Ungültiger Gliederungsindex';
-  SOutlineBadLevel = 'Ungültige Zuweisung von Ebenen';
-  SOutlineSelection = 'Ungültige Auswahl';
-  SOutlineFileLoad = 'Fehler beim Dateiladen';
-  SOutlineLongLine = 'Zeile zu lang';
-  SOutlineMaxLevels = 'Maximale Gliederungstiefe überschritten';
-
-  SMsgDlgWarning = 'Warnung';
-  SMsgDlgError = 'Fehler';
-  SMsgDlgInformation = 'Information';
-  SMsgDlgConfirm = 'Bestätigen';
-  SMsgDlgYes = '&Ja';
-  SMsgDlgNo = '&Nein';
-  SMsgDlgOK = 'OK';
-  SMsgDlgCancel = 'Abbrechen';
-  SMsgDlgHelp = '&Hilfe';
-  SMsgDlgHelpNone = 'Keine Hilfe verfügbar';
-  SMsgDlgHelpHelp = 'Hilfe';
-  SMsgDlgAbort = '&Abbrechen';
-  SMsgDlgRetry = '&Wiederholen';
-  SMsgDlgIgnore = '&Ignorieren';
-  SMsgDlgAll = '&Alles';
-  SMsgDlgNoToAll = '&Alle Nein';
-  SMsgDlgYesToAll = 'A&lle Ja';
-
-  SmkcBkSp = 'Rück';
-  SmkcTab = 'Tab';
-  SmkcEsc = 'Esc';
-  SmkcEnter = 'Enter';
-  SmkcSpace = 'Leertaste';
-  SmkcPgUp = 'BildAuf';
-  SmkcPgDn = 'BildAb';
-  SmkcEnd = 'Ende';
-  SmkcHome = 'Pos1';
-  SmkcLeft = 'Linksbündig';
-  SmkcUp = 'Nach oben';
-  SmkcRight = 'Rechts';
-  SmkcDown = 'Nach unten';
-  SmkcIns = 'Einfg';
-  SmkcDel = 'Entf';
-  SmkcShift = 'Umsch+';
-  SmkcCtrl = 'Strg+';
-  SmkcAlt = 'Alt+';
-
-  srUnknown = '(Unbekannt)';
-  srNone = '(Leer)';
-  SOutOfRange = 'Wert muß zwischen %d und %d liegen';
-  SCannotCreateName = 'Für eine unbenannte Komponente kann kein Standard-Methodennamen erstellt werden';
-
-  SDateEncodeError = 'Ungültiges Argument für Datumskodierung';
-  STimeEncodeError = 'Ungültiges Argument für Zeitkodierung';
-  SInvalidDate = '''''%s'''' ist kein gültiges Datum';
-  SInvalidTime = '''''%s'''' ist keine gültige Zeit';
-  SInvalidDateTime = '''''%s'''' ist kein gültiges Datum und Zeit';
-  SInsertLineError = 'Zeile kann nicht eingefügt werden';
-
-  SCannotDragForm = 'Formulare können nicht gezogen werden';
-  SPutObjectError = 'PutObject auf undefiniertes Element';
-  SCardDLLNotLoaded = 'CARDS.DLL kann nicht geladen werden';
-  SDuplicateCardId = 'Doppelte CardId gefunden';
-
-  SDdeErr = 'Ein Fehler wurde von der DDE zurückgeliefert  ($0%x)';
-  SDdeConvErr = 'DDE Fehler - Konversation wurde nicht hergestellt ($0%x)';
-  SDdeMemErr = 'Fehler trat auf, da unzureichender Speicher für DDE ($0%x)';
-  SDdeNoConnect = 'DDE-Konversation kann nicht eingerichtet werden';
-
-
-  SDefaultFilter = 'Alle Dateien (*.*)|*.*';
-  sAllFilter = 'Alle Dateien';
-  SNoVolumeLabel = ': [ - Ohne Namen - ]';
-
-  SConfirmCreateDir = 'Das angegebene Verzeichnis existiert nicht. Soll es angelegt werden?';
-  SSelectDirCap = 'Verzeichnis auswählen';
-  SCannotCreateDir = 'Das Verzeichnis kann nicht erstellt werden';
-  SDirNameCap = 'Verzeichnis&name:';
-  SDrivesCap = '&Laufwerke:';
-  SDirsCap = '&Verzeichnisse:';
-  SFilesCap = '&Dateien: (*.*)';
-  SNetworkCap = 'Ne&tzwerk...';
-
-  SColorPrefix = 'Farbe';
-  SColorTags = 'ABCDEFGHIJKLMNOP';
-
-  SInvalidClipFmt = 'Ungültiges Format der Zwischenablage';
-  SIconToClipboard = 'Zwischenablage unterstützt keine Symbole';
-
-  SDefault = 'Vorgabe';
-
-  SInvalidMemoSize = 'Text überschreitet Memo-Kapazität';
-  SCustomColors = 'Selbstdefinierte Farben';
-  SInvalidPrinterOp = 'Operation auf ausgewähltem Drucker nicht verfügbar';
-  SNoDefaultPrinter = 'Zur Zeit ist kein Standard-Drucker gewählt';
-
-  SIniFileWriteError = 'nach %s kann nicht geschrieben werden';
-
-  SBitsIndexError = 'Bits-Index außerhalb des zulässigen Bereichs';
-
-  SUntitled = '(Unbenannt)';
-
-  SInvalidRegType = 'Ungültiger Datentyp für ''%s''';
-  SRegCreateFailed = 'Erzeugung von Schlüssel %s misslungen';
-  SRegSetDataFailed = 'Konnte Daten für ''%s'' nicht setzen';
-  SRegGetDataFailed = 'Konnte Daten für ''%s'' nicht holen';
-
-  SUnknownConversion = 'Unbekannte Dateierweiterung für RichEdit-Konvertierung (.%s)';
-  SDuplicateMenus = 'Menü ''%s'' wird bereits von einem anderen Formular benutzt';
-
-  SPictureLabel = 'Bild:';
-  SPictureDesc = ' (%dx%d)';
-  SPreviewLabel = 'Vorschau';
-
-  SCannotOpenAVI = 'AVI kann nicht geöffnet werden';
-
-  SNotOpenErr = 'Kein MCI-Gerät geöffnet';
-  SMPOpenFilter = 'Alle Dateien (*.*)|*.*|Wave-Dateien (*.WAV)|*.WAV|Midi-Dateien (*.MID)|*.MID|Video für Windows (*.avi)|*.avi';
-  SMCINil = '';
-  SMCIAVIVideo = 'AVIVideo';
-  SMCICDAudio = 'CDAudio';
-  SMCIDAT = 'DAT';
-  SMCIDigitalVideo = 'DigitalVideo';
-  SMCIMMMovie = 'MMMovie';
-  SMCIOther = 'Andere';
-  SMCIOverlay = 'Overlay';
-  SMCIScanner = 'Scanner';
-  SMCISequencer = 'Sequencer';
-  SMCIVCR = 'VCR';
-  SMCIVideodisc = 'Videodisc';
-  SMCIWaveAudio = 'WaveAudio';
-  SMCIUnknownError = 'Unbekannter Fehlercode';
-
-  SBoldItalicFont = 'Fett kursiv';
-  SBoldFont = 'Fett';
-  SItalicFont = 'Kursiv';
-  SRegularFont = 'Normal';
-
-  SPropertiesVerb = 'Eigenschaften';
-
-{
-  $Log: constsg.inc,v $
-  Revision 1.2  2005/02/14 17:13:11  peter
-    * truncate log
-
-}

fcl/classes/constss.inc

@@ -1,279 +0,0 @@
-{
-    $Id: constss.inc,v 1.2 2005/02/14 17:13:11 peter Exp $
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1999-2000 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-const
-  SAssignError = '%s no puede ser assignado a  %s';
-  SFCreateError = 'Fichero %s no puede ser creado';
-  SFOpenError = 'Fichero %s no puede ser abierto';
-  SReadError = 'Error-Lectura-Stream';
-  SWriteError = 'Error-Escritura-Stream';
-  SMemoryStreamError = 'No es posible expandir Memoria Stream';
-  SCantWriteResourceStreamError = 'No se puede escribir en un ResourceStream de solo lectura';
-  SDuplicateReference = 'WriteObject fue llamado dos veces por una sola instancia';
-  SClassNotFound = 'Clase %s no encontrada';
-  SInvalidImage = 'Imagen stream ilegal';
-  SResNotFound = 'No se encontro el resource %s';
-  SClassMismatch = 'El resource %s tiene una clase erronea';
-  SListIndexError = 'El indice de lista excede los limites (%d)';
-  SListCapacityError = 'La maxima capacidad de lista a sido alcanzada (%d)';
-  SListCountError = 'Contador de lista demasiado grande (%d)';
-  SSortedListError = 'Operacion no permitida en StringLists ordenado';
-  SDuplicateString = 'Entradas duplicadas no permitidas en StringList';
-  SInvalidTabIndex = 'Registerindex fuera de limites';
-  SDuplicateName = 'Un componente con el nombre %s existe actualmente';
-  SInvalidName = '"%s" no es un nombre identificador valido';
-  SDuplicateClass = 'Una Clase con el nombre %s existe actualmente';
-  SNoComSupport = '%s no esta registrado como COM-Class';
-  SLineTooLong = 'Linea demasiado larga';
-
-  SInvalidPropertyValue = 'Valor de propiedad no valido';
-  SInvalidPropertyPath = 'Path de propiedad no valido';
-  SUnknownProperty = 'Propiedad desconocidad';
-  SReadOnlyProperty = 'Propiedad de solo lectura';
-{N}  SUnknownPropertyType = 'Unknown property type %d';
-  SPropertyException = 'Error leyendo %s%s: %s';
-{N}  SAncestorNotFound = 'Ancestor of ''%s'' not found.';
-  SInvalidBitmap = 'Bitmap no valido';
-  SInvalidIcon = 'Icono no valido';
-  SInvalidMetafile = 'MetaFile no valido';
-  SInvalidPixelFormat = 'PixelFormat no valido';
-  SBitmapEmpty = 'El bitmap esta vacio';
-  SScanLine = 'Indice de linea fuera de limites';
-  SChangeIconSize = 'No se puede cambiar el tama¤o del icono';
-  SOleGraphic = 'Operacion no valida para TOleGraphic';
-  SUnknownExtension = 'Extension desconocida (.%s)';
-  SUnknownClipboardFormat = 'Formato de Portapapeles desconocido';
-  SOutOfResources = 'Recursos de sistema agotados';
-  SNoCanvasHandle = 'El manejador Canvas no permite dibujar';
-  SInvalidImageSize = 'Tama¤o de imagen no valido';
-  STooManyImages = 'Demasiadas imagenes';
-  SDimsDoNotMatch = 'El tama¤o de la imagen no coincide';
-  SInvalidImageList = 'ImageList no valido';
-  SReplaceImage = 'La imagen no puede ser reemplazada';
-  SImageIndexError = 'ImageList-Index no valido';
-  SImageReadFail = 'Los datos de ImageList no pueden ser leido desde Stream';
-  SImageWriteFail = 'Los datos de ImageList no pueden ser escritos en Stream';
-  SWindowDCError = 'Error cuando??';
-  SClientNotSet = 'El cliente de TDrag no fue iniciado';
-  SWindowClass = 'Error inicializando Window Class';
-  SWindowCreate = 'Error creando una Ventana';
-{?}  SCannotFocus = 'Una Ventana invisible or desactivada no puede obtener el foco';
-  SParentRequired = 'El elemento ''%s'' no tiene una ventana padre';
-  SMDIChildNotVisible = 'Una ventana MDI-Child no puede ser ocultada.';
-  SVisibleChanged = 'Una propiedad visual no puede ser cambiada en el manejador OnShow o OnHide';
-{?}  SCannotShowModal = 'Una Ventana visible no puede ser hecha modal';
-  SScrollBarRange = 'Propiedad de Scrollbar fuera de limites';
-  SPropertyOutOfRange = 'Propiedad %s fuera de limites';
-  SMenuIndexError = 'Indice de menu fuera de rango';
-  SMenuReinserted = 'Menu reinsertado';
-  SMenuNotFound = 'Entrada de menu no encontra en menu';
-  SNoTimers = 'No hay timers disponibles';
-  SNotPrinting = 'La impresora no esta imprimiendo';
-  SPrinting = 'La impresora esta ocupada';
-  SPrinterIndexError = 'PrinterIndex fuera de rango';
-  SInvalidPrinter = 'La impresora seleccionada no es valida';
-  SDeviceOnPort = '%s en %s';
-  SGroupIndexTooLow = 'GroupIndex tiene que ser mayor que el goupindex del menu predecesor';
-  STwoMDIForms = 'Solo hay una ventana MDI disponible';
-  SNoMDIForm = 'No hay ningun MDI form disponible, none esta activado';
-  SRegisterError = 'Registro invalido';
-  SImageCanvasNeedsBitmap = 'Un Canvas solo puede ser cambiado si contiene un bitmap';
-  SControlParentSetToSelf = 'Un componente no puede tenerse a si mismo como padre';
-  SOKButton = 'Aceptar';
-  SCancelButton = 'Cancelar';
-  SYesButton = '&Si';
-  SNoButton = '&No';
-  SHelpButton = '&Ayuda';
-  SCloseButton = '&Cerrar';
-  SIgnoreButton = '&Ignorar';
-  SRetryButton = '&Reintentar';
-  SAbortButton = 'Abortar';
-  SAllButton = '&Todo';
-
-{?}  SFB = 'VH';
-{?}  SFG = 'VG';
-{?}  SBG = 'HG';
-  SOldTShape = 'No es posible cargar versiones antiguas de TShape';
-  SVMetafiles = 'MetaFiles';
-  SVEnhMetafiles = 'MetaFiles ampliados';
-  SVIcons = 'Iconos';
-  SVBitmaps = 'Bitmaps';
-  SGridTooLarge = 'Malla demasiado grande para esta operacion';
-{?}  STooManyDeleted = 'Zu viele Zeilen oder Spalten gelöscht';
-  SIndexOutOfRange = 'Indice de malla fuera de rango';
-  SFixedColTooBig = 'El numero de columnas fijas tiene que ser menor que el contador Column';
-  SFixedRowTooBig = 'El numero de filas fijas tiene que ser menor que el contador Row';
-{?}  SInvalidStringGridOp = 'Es können keine Zeilen des ''Grids'' gelöscht oder eingefügt werden';
-  SParseError = '%s en Linia %d';
-
-  SIdentifierExpected = 'Falta identificador';
-  SStringExpected = 'Falta string';
-  SNumberExpected = 'Falta numero';
-
-  SCharExpected = 'Falta %s';
-
-  SSymbolExpected = 'Falta %s';
-
-  SInvalidNumber = 'Valor numerico no valido';
-  SInvalidString = 'Constante string no valida';
-  SInvalidProperty = 'Valor de propiedad no valido';
-  SInvalidBinary = 'Binario no valido';
-  SOutlineIndexError = 'Indice de nodo no encontrado';
-  SOutlineExpandError = 'El nodo padre tiene que ser expandido';
-  SInvalidCurrentItem = 'Item no valido';
-  SMaskErr = 'Mascara no valida';
-  SMaskEditErr = 'Mascara no valida. Usa la tecla ESC para deshacer los cambios.';
-  SOutlineError = 'Indice de nodo no valido';
-  SOutlineBadLevel = '???';
-{?}  SOutlineSelection = 'Ungültige Auswahl';
-{?}  SOutlineFileLoad = 'Fehler beim Dateiladen';
-{?}  SOutlineLongLine = 'Zeile zu lang';
-{?}  SOutlineMaxLevels = 'Maximale Gliederungstiefe überschritten';
-
-  SMsgDlgWarning = 'Atencion';
-  SMsgDlgError = 'Error';
-  SMsgDlgInformation = 'Informacion';
-  SMsgDlgConfirm = 'Confirmar';
-  SMsgDlgYes = '&Si';
-  SMsgDlgNo = '&No';
-  SMsgDlgOK = 'Aceptar';
-  SMsgDlgCancel = 'Cancelar';
-  SMsgDlgHelp = '&Ayuda';
-  SMsgDlgHelpNone = 'No hay ayuda disponible';
-  SMsgDlgHelpHelp = 'Ayuda';
-  SMsgDlgAbort = 'A&bortar';
-  SMsgDlgRetry = '&Reintentar';
-  SMsgDlgIgnore = '&Ignorar';
-  SMsgDlgAll = '&Todo';
-  SMsgDlgNoToAll = 'N&o a todo';
-  SMsgDlgYesToAll = 'Si a To&do';
-
-  SmkcBkSp = 'Backspace';
-  SmkcTab = 'Tabulador';
-  SmkcEsc = 'Esc';
-  SmkcEnter = 'Intro';
-  SmkcSpace = 'Espacio';
-  SmkcPgUp = 'Pagina arriva';
-  SmkcPgDn = 'Pagina abajo';
-  SmkcEnd = 'Fin';
-  SmkcHome = 'Inicio';
-  SmkcLeft = 'Izquierda';
-  SmkcUp = 'Arriba';
-  SmkcRight = 'Derecha';
-  SmkcDown = 'Abajo';
-  SmkcIns = 'Insertar';
-  SmkcDel = 'Suprimir';
-  SmkcShift = 'Shift+';
-  SmkcCtrl = 'Ctrl+';
-  SmkcAlt = 'Alt+';
-
-  srUnknown = '(Desconocido)';
-  srNone = '(Vacio)';
-  SOutOfRange = 'El valor tiene que estar entre %d y %d';
-  SCannotCreateName = 'No es posible use el nombre estandard para un componente desconocido';
-
-{?}  SDateEncodeError = 'Ungültiges Argument für Datumskodierung';
-{?}  STimeEncodeError = 'Ungültiges Argument für Zeitkodierung';
-{?}  SInvalidDate = '''''%s'''' ist kein gültiges Datum';
-{?}  SInvalidTime = '''''%s'''' ist keine gültige Zeit';
-{?}  SInvalidDateTime = '''''%s'''' ist kein gültiges Datum und Zeit';
-{?}  SInsertLineError = 'Zeile kann nicht eingefügt werden';
-
-{?}  SCannotDragForm = 'Formulare können nicht gezogen werden';
-{?}  SPutObjectError = 'PutObject auf undefiniertes Element';
-{?}  SCardDLLNotLoaded = 'CARDS.DLL kann nicht geladen werden';
-{?}  SDuplicateCardId = 'Doppelte CardId gefunden';
-
-{?}  SDdeErr = 'Ein Fehler wurde von der DDE zurückgeliefert  ($0%x)';
-{?}  SDdeConvErr = 'DDE Fehler - Konversation wurde nicht hergestellt ($0%x)';
-{?}  SDdeMemErr = 'Fehler trat auf, da unzureichender Speicher für DDE ($0%x)';
-{?}  SDdeNoConnect = 'DDE-Konversation kann nicht eingerichtet werden';
-
-
-{?}  SDefaultFilter = 'Alle Dateien (*.*)|*.*';
-{?}  sAllFilter = 'Alle Dateien';
-{?}  SNoVolumeLabel = ': [ - Ohne Namen - ]';
-
-{?}  SConfirmCreateDir = 'Das angegebene Verzeichnis existiert nicht. Soll es angelegt werden?';
-{?}  SSelectDirCap = 'Verzeichnis auswählen';
-{?}  SCannotCreateDir = 'Das Verzeichnis kann nicht erstellt werden';
-{?}  SDirNameCap = 'Verzeichnis&name:';
-{?}  SDrivesCap = '&Laufwerke:';
-{?}  SDirsCap = '&Verzeichnisse:';
-{?}  SFilesCap = '&Dateien: (*.*)';
-{?}  SNetworkCap = 'Ne&tzwerk...';
-
-{?}  SColorPrefix = 'Farbe';
-  SColorTags = 'ABCDEFGHIJKLMNOP';
-
-{?}  SInvalidClipFmt = 'Ungültiges Format der Zwischenablage';
-{?}  SIconToClipboard = 'Zwischenablage unterstützt keine Symbole';
-
-{?}  SDefault = 'Vorgabe';
-
-{?}  SInvalidMemoSize = 'Text überschreitet Memo-Kapazität';
-{?}  SCustomColors = 'Selbstdefinierte Farben';
-{?}  SInvalidPrinterOp = 'Operation auf ausgewähltem Drucker nicht verfügbar';
-{?}  SNoDefaultPrinter = 'Zur Zeit ist kein Standard-Drucker gewählt';
-
-{?}  SIniFileWriteError = 'nach %s kann nicht geschrieben werden';
-
-{?}  SBitsIndexError = 'Bits-Index außerhalb des zulässigen Bereichs';
-
-{?}  SUntitled = '(Unbenannt)';
-
-{?}  SInvalidRegType = 'Ungültiger Datentyp für ''%s''';
-{?}  SRegCreateFailed = 'Erzeugung von Schlüssel %s misslungen';
-{?}  SRegSetDataFailed = 'Konnte Daten für ''%s'' nicht setzen';
-{?}  SRegGetDataFailed = 'Konnte Daten für ''%s'' nicht holen';
-
-{?}  SUnknownConversion = 'Unbekannte Dateierweiterung für RichEdit-Konvertierung (.%s)';
-{?}  SDuplicateMenus = 'Menü ''%s'' wird bereits von einem anderen Formular benutzt';
-
-{?}  SPictureLabel = 'Bild:';
-  SPictureDesc = ' (%dx%d)';
-{?}  SPreviewLabel = 'Vorschau';
-
-{?}  SCannotOpenAVI = 'AVI kann nicht geöffnet werden';
-
-{?}  SNotOpenErr = 'Kein MCI-Gerät geöffnet';
-{?}  SMPOpenFilter = 'Alle Dateien (*.*)|*.*|Wave-Dateien (*.WAV)|*.WAV|Midi-Dateien (*.MID)|*.MID|Video für Windows (*.avi)|*.avi';
-  SMCINil = '';
-  SMCIAVIVideo = 'AVIVideo';
-  SMCICDAudio = 'CDAudio';
-  SMCIDAT = 'DAT';
-  SMCIDigitalVideo = 'DigitalVideo';
-  SMCIMMMovie = 'MMMovie';
-  SMCIOther = 'Andere';
-  SMCIOverlay = 'Overlay';
-  SMCIScanner = 'Scanner';
-  SMCISequencer = 'Sequencer';
-  SMCIVCR = 'VCR';
-  SMCIVideodisc = 'Videodisc';
-  SMCIWaveAudio = 'WaveAudio';
-  SMCIUnknownError = 'Unbekannter Fehlercode';
-
-  SBoldItalicFont = 'Negrita cursiva';
-  SBoldFont = 'Negrita';
-  SItalicFont = 'Cursiva';
-  SRegularFont = 'Normal';
-
-{?}  SPropertiesVerb = 'Eigenschaften';
-
-{
-  $Log: constss.inc,v $
-  Revision 1.2  2005/02/14 17:13:11  peter
-    * truncate log
-
-}

fcl/classes/cregist.inc

@@ -1,203 +0,0 @@
-{
-    $Id: cregist.inc,v 1.2 2005/02/14 17:13:11 peter Exp $
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1999-2000 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-
-
-{ Class registration routines }
-
-procedure RegisterClass(AClass: TPersistentClass);
-var
-aClassname : String;
-begin
-  //Classlist is created during initialization.
-  with Classlist.Locklist do
-     try
-      while Indexof(AClass) = -1 do
-         begin
-           aClassname := AClass.ClassName;
-           if GetClass(aClassName) <> nil then  //class alread registered!
-                 Begin
-                 //raise an error
-                 exit;
-                 end;
-          Add(AClass);
-          if AClass = TPersistent then break;
-          AClass := TPersistentClass(AClass.ClassParent);
-         end;
-     finally
-       ClassList.UnlockList;
-     end;
-end;
-
-
-procedure RegisterClasses(AClasses: array of TPersistentClass);
-var
-I : Integer;
-begin
-for I := low(aClasses) to high(aClasses) do
-       RegisterClass(aClasses[I]);
-end;
-
-
-procedure RegisterClassAlias(AClass: TPersistentClass; const Alias: string);
-
-begin
-end;
-
-
-procedure UnRegisterClass(AClass: TPersistentClass);
-
-begin
-end;
-
-
-procedure UnRegisterClasses(AClasses: array of TPersistentClass);
-
-begin
-end;
-
-
-procedure UnRegisterModuleClasses(Module: HMODULE);
-
-begin
-end;
-
-
-function FindClass(const AClassName: string): TPersistentClass;
-
-begin
-  Result := GetClass(AClassName);
-  if not Assigned(Result) then
-    raise EClassNotFound.CreateFmt(SClassNotFound, [AClassName]);
-end;
-
-
-function GetClass(const AClassName: string): TPersistentClass;
-var
-I : Integer;
-begin
-  with ClassList.LockList do
-   try
-    for I := 0 to Count-1 do
-       begin
-        Result := TPersistentClass(Items[I]);
-        if Result.ClassNameIs(AClassName) then Exit;
-       end;
-       I := ClassAliasList.Indexof(AClassName);
-       if I >= 0 then  //found
-          Begin
-          Result := TPersistentClass(ClassAliasList.Objects[i]);
-          exit;
-          end;
-       Result := nil;
-    finally
-      ClassList.Unlocklist;
-    end;
-end;
-
-{ Component registration routines }
-
-type
-  TComponentPage = class(TCollectionItem)
-  public
-    Name: String;
-    Classes: TList;
-    destructor Destroy; override;
-  end;
-
-{ TComponentPage }
-
-destructor TComponentPage.Destroy;
-begin
-  Classes.Free;
-  inherited Destroy;
-end;
-
-var
-  ComponentPages: TCollection;
-
-procedure InitComponentPages;
-begin
-  ComponentPages := TCollection.Create(TComponentPage);
-  { Add a empty page which will be used for storing the NoIcon components }
-  ComponentPages.Add;
-end;
-
-procedure RegisterComponents(const Page: string;
-  ComponentClasses: array of TComponentClass);
-var
-  i: Integer;
-  pg: TComponentPage;
-begin
-  if Page = '' then exit;  { prevent caller from doing nonsense }
-
-  pg := nil;
-  if not Assigned(ComponentPages) then
-    InitComponentPages
-  else
-    for i := 0 to ComponentPages.Count - 1 do
-      if TComponentPage(ComponentPages.Items[i]).Name = Page then begin
-        pg := TComponentPage(ComponentPages.Items[i]);
-        break;
-      end;
-
-  if pg = nil then begin
-    pg := TComponentPage(ComponentPages.Add);
-    pg.Name := Page;
-  end;
-
-  if pg.Classes = nil then
-    pg.Classes := TList.Create;
-
-  for i := Low(ComponentClasses) to High(ComponentClasses) do
-    pg.Classes.Add(ComponentClasses[i]);
-
-  if Assigned(RegisterComponentsProc) then
-    RegisterComponentsProc(Page, ComponentClasses);
-end;
-
-
-procedure RegisterNoIcon(ComponentClasses: array of TComponentClass);
-var
-  pg: TComponentPage;
-  i: Integer;
-begin
-  if not Assigned(ComponentPages) then
-    InitComponentPages;
-
-  pg := TComponentPage(ComponentPages.Items[0]);
-  if pg.Classes = nil then
-    pg.Classes := TList.Create;
-
-  for i := Low(ComponentClasses) to High(ComponentClasses) do
-    pg.Classes.Add(ComponentClasses[i]);
-
-  if Assigned(RegisterNoIconProc) then
-    RegisterNoIconProc(ComponentClasses);
-end;
-
-
-procedure RegisterNonActiveX(ComponentClasses: array of TComponentClass;
-  AxRegType: TActiveXRegType);
-
-begin
-end;
-
-
-{
-  $Log: cregist.inc,v $
-  Revision 1.2  2005/02/14 17:13:11  peter
-    * truncate log
-
-}

fcl/classes/dm.inc

@@ -1,173 +0,0 @@
-{
-    $Id: dm.inc,v 1.2 2005/02/14 17:13:11 peter Exp $
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 2003 by the Free Pascal development team
-
-    <What does this file>
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-Constructor TDataModule.Create(AOwner: TComponent);
-begin
-  CreateNew(AOwner);
-  if (ClassType <> TDataModule) and
-     not (csDesigning in ComponentState) then
-    begin
-    if not InitInheritedComponent(Self, TDataModule) then
-      raise EStreamError.CreateFmt(SErrNoSTreaming, [ClassName]);
-    if OldCreateOrder then
-      DoCreate;
-    end;
-end;
-
-Constructor TDataModule.CreateNew(AOwner: TComponent);
-
-begin
-  CreateNew(AOwner,0);
-end;
-
-constructor TDataModule.CreateNew(AOwner: TComponent; CreateMode: Integer);
-begin
-  inherited Create(AOwner);
-  if Assigned(AddDataModule) and (CreateMode>=0) then
-    AddDataModule(Self);
-end;
-
-Procedure TDataModule.AfterConstruction;
-begin
-   If not OldCreateOrder then
-     DoCreate;
-end;
-
-Procedure TDataModule.BeforeDestruction;
-begin
-  Destroying;
-  RemoveFixupReferences(Self, '');
-  if not OldCreateOrder then
-    DoDestroy;
-end;
-
-destructor TDataModule.Destroy;
-begin
-  if OldCreateOrder then
-    DoDestroy;
-  if Assigned(RemoveDataModule) then
-    RemoveDataModule(Self);
-  inherited Destroy;
-end;
-
-Procedure TDataModule.DoCreate;
-begin
-  if Assigned(FOnCreate) then
-    try
-      FOnCreate(Self);
-    except
-      if not HandleCreateException then
-        raise;
-    end;
-end;
-
-Procedure TDataModule.DoDestroy;
-begin
-  if Assigned(FOnDestroy) then
-    try
-      FOnDestroy(Self);
-    except
-      if Assigned(ApplicationHandleException) then
-        ApplicationHandleException(Self);
-    end;
-end;
-
-procedure TDataModule.DefineProperties(Filer: TFiler);
-
-var
-  Ancestor : TDataModule;
-  HaveData : Boolean;
-
-begin
-  inherited DefineProperties(Filer);
-  Ancestor := TDataModule(Filer.Ancestor);
-  HaveData:=(Ancestor=Nil) or
-            (FDSize.X<>Ancestor.FDSize.X) or
-            (FDSize.Y<>Ancestor.FDSize.Y) or
-            (FDPos.Y<>Ancestor.FDPos.Y) or
-            (FDPos.X<>Ancestor.FDPos.X);
-  Filer.DefineProperty('Height', @ReadH, @WriteH, HaveData);
-  Filer.DefineProperty('HorizontalOffset', @ReadL, @WriteL, HaveData);
-  Filer.DefineProperty('VerticalOffset', @ReadT,@WriteT, HaveData);
-  Filer.DefineProperty('Width', @ReadW, @WriteW, HaveData);
-end;
-
-procedure TDataModule.GetChildren(Proc: TGetChildProc; Root: TComponent);
-
-var
-  I : Integer;
-
-begin
-  inherited GetChildren(Proc, Root);
-  if (Root=Self) then
-    for I:=0 to ComponentCount-1 do
-      If Not Components[I].HasParent then
-         Proc(Components[i]);
-end;
-
-
-function TDataModule.HandleCreateException: Boolean;
-begin
-  Result:=Assigned(ApplicationHandleException);
-  if Result then
-    ApplicationHandleException(Self);
-end;
-
-Procedure TDataModule.ReadState(Reader: TReader);
-begin
-  FOldOrder := false;
-  inherited ReadState(Reader);
-end;
-
-Procedure TDataModule.ReadT(Reader: TReader);
-begin
-  FDPos.Y := Reader.ReadInteger;
-end;
-
-Procedure TDataModule.WriteT(Writer: TWriter);
-begin
-  Writer.WriteInteger(FDPos.Y);
-end;
-
-Procedure TDataModule.ReadL(Reader: TReader);
-begin
-  FDPos.X := Reader.ReadInteger;
-end;
-
-Procedure TDataModule.WriteL(Writer: TWriter);
-begin
-  Writer.WriteInteger(FDPos.X);
-end;
-
-Procedure TDataModule.ReadW(Reader: TReader);
-begin
-  FDSIze.X := Reader.ReadInteger;
-end;
-
-Procedure TDataModule.WriteW(Writer: TWriter);
-begin
-  Writer.WriteInteger(FDSIze.X);
-end;
-
-Procedure TDataModule.ReadH(Reader: TReader);
-begin
-  FDSIze.Y := Reader.ReadInteger;
-end;
-
-Procedure TDataModule.WriteH(Writer: TWriter);
-begin
-  Writer.WriteInteger(FDSIze.Y);
-end;

fcl/classes/filer.inc

@@ -1,29 +0,0 @@
-{
-    $Id: filer.inc,v 1.2 2005/02/14 17:13:11 peter Exp $
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1999-2000 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-{ *********************************************************************
-  *                         TFiler                                    *
-  *********************************************************************}
-
-procedure TFiler.SetRoot(ARoot: TComponent);
-begin
-  FRoot := ARoot;
-end;
-
-
-{
-  $Log: filer.inc,v $
-  Revision 1.2  2005/02/14 17:13:11  peter
-    * truncate log
-
-}

fcl/classes/filerec.inc

@@ -1,41 +0,0 @@
-{
-    $Id: filerec.inc,v 1.2 2005/02/14 17:13:11 peter Exp $
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2000 by the Free Pascal development team
-
-    FileRec record definition
-
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-{
-  This file contains the definition of the filerec record.
-  It is put separately, so it is available outside the system
-  unit without sacrificing TP compatibility.
-}
-
-const
-  filerecnamelength = 255;
-type
-  FileRec = Packed Record
-    Handle,
-    Mode,
-    RecSize   : longint;
-    _private  : array[1..32] of byte;
-    UserData  : array[1..16] of byte;
-    name      : array[0..filerecnamelength] of char;
-  End;
-
-{
-  $Log: filerec.inc,v $
-  Revision 1.2  2005/02/14 17:13:11  peter
-    * truncate log
-
-}

fcl/classes/freebsd/classes.pp

@@ -1,61 +0,0 @@
-{
-    $Id: classes.pp,v 1.2 2005/02/14 17:13:11 peter Exp $
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1999-2000 by Michael Van Canneyt and Florian Klaempfl
-
-    Classes unit for linux
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-{$mode objfpc}
-
-{ determine the type of the resource/form file }
-{$define Win16Res}
-
-unit Classes;
-
-interface
-
-uses
-  sysutils,
-  typinfo;
-
-{$i classesh.inc}
-
-implementation
-
-uses
-{$ifdef ver1_0}
-  linux
-{$else}
-  baseunix,unix
-{$endif}
-  ;
-
-{ OS - independent class implementations are in /inc directory. }
-{$i classes.inc}
-
-
-initialization
-  CommonInit;
-
-finalization
-  CommonCleanup;
-
-  if ThreadsInited then
-     DoneThreads;
-
-end.
-{
-  $Log: classes.pp,v $
-  Revision 1.2  2005/02/14 17:13:11  peter
-    * truncate log
-
-}

fcl/classes/go32v2/classes.pp

@@ -1,49 +0,0 @@
-{
-    $Id: classes.pp,v 1.2 2005/02/14 17:13:11 peter Exp $
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1999-2000 by Michael Van Canneyt and Florian Klaempfl
-
-    Classes unit for win32
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-{$mode objfpc}
-
-{ determine the type of the resource/form file }
-{$define Win16Res}
-
-unit Classes;
-
-interface
-
-uses
-  typinfo,
-  sysutils;
-
-{$i classesh.inc}
-
-implementation
-
-{ OS - independent class implementations are in /inc directory. }
-{$i classes.inc}
-
-initialization
-  CommonInit;
-
-finalization
-  CommonCleanup;
-
-end.
-{
-  $Log: classes.pp,v $
-  Revision 1.2  2005/02/14 17:13:11  peter
-    * truncate log
-
-}

fcl/classes/intf.inc

@@ -1,120 +0,0 @@
-{
-    $Id: intf.inc,v 1.2 2005/02/14 17:13:11 peter Exp $
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 2002 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-    constructor TInterfaceList.Create;
-      begin
-      end;
-
-
-    destructor TInterfaceList.Destroy;
-      begin
-      end;
-
-
-    function TInterfaceList.Get(i : Integer) : IUnknown;
-      begin
-      end;
-
-
-    function TInterfaceList.GetCapacity : Integer;
-      begin
-      end;
-
-
-    function TInterfaceList.GetCount : Integer;
-      begin
-      end;
-
-
-    procedure TInterfaceList.Put(i : Integer;item : IUnknown);
-      begin
-      end;
-
-
-    procedure TInterfaceList.SetCapacity(NewCapacity : Integer);
-      begin
-      end;
-
-
-    procedure TInterfaceList.SetCount(NewCount : Integer);
-      begin
-      end;
-
-
-    procedure TInterfaceList.Clear;
-      begin
-      end;
-
-
-    procedure TInterfaceList.Delete(index : Integer);
-      begin
-      end;
-
-
-    procedure TInterfaceList.Exchange(index1,index2 : Integer);
-      begin
-      end;
-
-
-    function TInterfaceList.First : IUnknown;
-      begin
-      end;
-
-
-    function TInterfaceList.IndexOf(item : IUnknown) : Integer;
-      begin
-      end;
-
-
-    function TInterfaceList.Add(item : IUnknown) : Integer;
-      begin
-      end;
-
-
-    procedure TInterfaceList.Insert(i : Integer;item : IUnknown);
-      begin
-      end;
-
-
-    function TInterfaceList.Last : IUnknown;
-      begin
-      end;
-
-
-    function TInterfaceList.Remove(item : IUnknown): Integer;
-      begin
-      end;
-
-
-    procedure TInterfaceList.Lock;
-      begin
-      end;
-
-
-    procedure TInterfaceList.Unlock;
-      begin
-      end;
-
-
-    function TInterfaceList.Expand : TInterfaceList;
-      begin
-      end;
-
-
-{
-  $Log: intf.inc,v $
-  Revision 1.2  2005/02/14 17:13:11  peter
-    * truncate log
-
-}

fcl/classes/linux/classes.pp

@@ -1,58 +0,0 @@
-{
-    $Id: classes.pp,v 1.2 2005/02/14 17:13:11 peter Exp $
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1999-2000 by Michael Van Canneyt and Florian Klaempfl
-
-    Classes unit for linux
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-{$mode objfpc}
-
-{ determine the type of the resource/form file }
-{$define Win16Res}
-
-unit Classes;
-
-interface
-
-uses
-  sysutils,
-  typinfo;
-
-{$i classesh.inc}
-
-implementation
-
-uses
-{$ifdef ver1_0}
-  linux
-{$else}
-  BaseUnix,unix
-{$endif}
-  ;
-
-{ OS - independent class implementations are in /inc directory. }
-{$i classes.inc}
-
-
-initialization
-  CommonInit;
-
-finalization
-  CommonCleanup;
-
-end.
-{
-  $Log: classes.pp,v $
-  Revision 1.2  2005/02/14 17:13:11  peter
-    * truncate log
-
-}

fcl/classes/lists.inc

@@ -1,462 +0,0 @@
-{
-    $Id: lists.inc,v 1.4 2005/05/12 21:47:34 hajny Exp $
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1999-2000 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-{****************************************************************************}
-{*                             TList                                        *}
-{****************************************************************************}
-
-{  TList = class(TObject)
-  private
-    FList: PPointerList;
-    FCount: Integer;
-    FCapacity: Integer;
-}
-Const
-  // Ratio of Pointer and Word Size.
-  WordRatio = SizeOf(Pointer) Div SizeOf(Word);
-
-function TList.Get(Index: Integer): Pointer;
-
-begin
-  If (Index<0) or (Index>=FCount) then
-    Error(SListIndexError,Index);
-  Result:=FList^[Index];
-end;
-
-
-
-procedure TList.Grow;
-
-begin
-  // Only for compatibility with Delphi. Not needed.
-end;
-
-
-
-procedure TList.Put(Index: Integer; Item: Pointer);
-
-begin
-  if (Index<0) or (Index>=FCount) then
-    Error(SListIndexError,Index);
-  Flist^[Index]:=Item;
-end;
-
-
-function TList.Extract(item: Pointer): Pointer;
-var
-  i : Integer;
-begin
-  result:=nil;
-  i:=IndexOf(item);
-  if i>=0 then
-   begin
-     Result:=item;
-     FList^[i]:=nil;
-     Delete(i);
-     Notify(Result,lnExtracted);
-   end;
-end;
-
-
-procedure TList.Notify(Ptr: Pointer; Action: TListNotification);
-begin
-end;
-
-
-procedure TList.SetCapacity(NewCapacity: Integer);
-
-Var NewList,ToFree : PPointerList;
-
-begin
-  If (NewCapacity<0) or (NewCapacity>MaxListSize) then
-     Error (SListCapacityError,NewCapacity);
-  if NewCapacity=FCapacity then
-    exit;
-  ReallocMem(FList,SizeOf(Pointer)*NewCapacity);
-  if NewCapacity > FCapacity then
-    FillChar (FList^ [FCapacity],
-                              (NewCapacity - FCapacity) * SizeOf (pointer), 0);
-  FCapacity:=NewCapacity;
-end;
-
-
-
-procedure TList.SetCount(NewCount: Integer);
-
-begin
-  If (NewCount<0) or (NewCount>MaxListSize)then
-    Error(SListCountError,NewCount);
-  If NewCount<FCount then
-    FCount:=NewCount
-  else If NewCount>FCount then
-    begin
-    If NewCount>FCapacity then
-      SetCapacity (NewCount);
-    If FCount<NewCount then
-      FillWord (Flist^[FCount],(NewCount-FCount)* WordRatio ,0);
-    FCount:=Newcount;
-    end;
-end;
-
-
-
-destructor TList.Destroy;
-
-begin
-  Self.Clear;
-  inherited Destroy;
-end;
-
-
-Function TList.Add(Item: Pointer): Integer;
-
-begin
-  Self.Insert (Count,Item);
-  Result:=Count-1;
-end;
-
-
-
-Procedure TList.Clear;
-
-begin
-  If Assigned(FList) then
-    begin
-    FreeMem (Flist,FCapacity*SizeOf(Pointer));
-    FList:=Nil;
-    FCapacity:=0;
-    FCount:=0;
-    end;
-end;
-
-
-
-Procedure TList.Delete(Index: Integer);
-
-Var
-  OldPointer :Pointer;
-
-begin
-  If (Index<0) or (Index>=FCount) then
-    Error (SListIndexError,Index);
-  FCount:=FCount-1;
-  OldPointer:=Flist^[Index];
-  System.Move (FList^[Index+1],FList^[Index],(FCount-Index)*SizeOf(Pointer));
-  // Shrink the list if appropiate
-  if (FCapacity > 256) and (FCount < FCapacity shr 2) then
-  begin
-    FCapacity := FCapacity shr 1;
-    ReallocMem(FList, SizeOf(Pointer) * FCapacity);
-  end;
-  If OldPointer<>nil then
-    Notify(OldPointer,lnDeleted);
-end;
-
-
-class procedure TList.Error(const Msg: string; Data: Integer);
-
-begin
-{$ifdef VER1_0}
-  Raise EListError.CreateFmt(Msg,[Data]) at longint(get_caller_addr(get_frame));
-{$else VER1_0}
-  Raise EListError.CreateFmt(Msg,[Data]) at get_caller_addr(get_frame);
-{$endif VER1_0}
-end;
-
-procedure TList.Exchange(Index1, Index2: Integer);
-
-var Temp : Pointer;
-
-begin
-  If ((Index1>=FCount) or (Index1<0)) then
-    Error(SListIndexError,Index1);
-  If ((Index2>=FCount) or (Index2<0)) then
-    Error(SListIndexError,Index2);
-  Temp:=FList^[Index1];
-  FList^[Index1]:=FList^[Index2];
-  FList^[Index2]:=Temp;
-end;
-
-
-
-function TList.Expand: TList;
-
-Var IncSize : Longint;
-
-begin
-  if FCount<FCapacity then exit;
-  IncSize:=4;
-  if FCapacity>3 then IncSize:=IncSize+4;
-  if FCapacity>8 then IncSize:=IncSize+8;
-  if FCapacity>127 then Inc(IncSize, FCapacity shr 2);
-  SetCapacity(FCapacity+IncSize);
-  Result:=Self;
-end;
-
-
-function TList.First: Pointer;
-
-begin
-  If FCount=0 then
-    Result:=Nil
-  else
-    Result:=Items[0];
-end;
-
-
-
-function TList.IndexOf(Item: Pointer): Integer;
-
-begin
-  Result:=0;
-  While (Result<FCount) and (Flist^[Result]<>Item) do Result:=Result+1;
-  If Result=FCount  then Result:=-1;
-end;
-
-
-
-procedure TList.Insert(Index: Integer; Item: Pointer);
-
-begin
-  If (Index<0) or (Index>FCount )then
-    Error(SlistIndexError,Index);
-  IF FCount=FCapacity Then Self.Expand;
-  If Index<FCount then
-    System.Move (Flist^[Index],Flist^[Index+1],(FCount-Index)*SizeOf(Pointer));
-  FList^[Index]:=Item;
-  FCount:=FCount+1;
-  If Item<>NIl then
-    Notify(Item,lnAdded);
-end;
-
-
-
-function TList.Last: Pointer;
-
-begin
-  // Wouldn't it be better to return nil if the count is zero ?
-  If FCount=0 then
-    Result:=Nil
-  else
-    Result:=Items[FCount-1];
-end;
-
-
-procedure TList.Move(CurIndex, NewIndex: Integer);
-
-Var Temp : Pointer;
-
-begin
-  If ((CurIndex<0) or (CurIndex>Count-1)) then
-    Error(SListIndexError,CurIndex);
-  If (NewINdex<0) then
-    Error(SlistIndexError,NewIndex);
-  Temp:=FList^[CurIndex];
-  FList^[CurIndex]:=Nil;
-  Self.Delete(CurIndex);
-  // ?? If NewIndex>CurIndex then NewIndex:=NewIndex-1;
-  // Newindex changes when deleting ??
-  Self.Insert (NewIndex,Nil);
-  FList^[NewIndex]:=Temp;
-end;
-
-
-function TList.Remove(Item: Pointer): Integer;
-
-begin
-  Result:=IndexOf(Item);
-  If Result<>-1 then
-    Self.Delete (Result);
-end;
-
-
-
-Procedure TList.Pack;
-
-Var  {Last,I,J,}Runner : Longint;
-
-begin
-  // Not the fastest; but surely correct
-  For Runner:=Fcount-1 downto 0 do
-    if Items[Runner]=Nil then Self.Delete(Runner);
-{ The following may be faster in case of large and defragmented lists
-  If count=0 then exit;
-  Runner:=0;I:=0;
-  TheLast:=Count;
-  while runner<count do
-    begin
-    // Find first Nil
-    While (FList^[Runner]<>Nil) and (Runner<Count) do Runner:=Runner+1;
-    if Runner<Count do
-      begin
-      // Start searching for non-nil from last known nil+1
-      if i<Runner then I:=Runner+1;
-      While (Flist[I]^=Nil) and (I<Count) do I:=I+1;
-      // Start looking for last non-nil of block.
-      J:=I+1;
-      While (Flist^[J]<>Nil) and (J<Count) do J:=J+1;
-      // Move block and zero out
-      Move (Flist^[I],Flist^[Runner],J*SizeOf(Pointer));
-      FillWord (Flist^[I],(J-I)*WordRatio,0);
-      // Update Runner and Last to point behind last block
-      TheLast:=Runner+(J-I);
-      If J=Count then
-         begin
-         // Shortcut, when J=Count we checked all pointers
-         Runner:=Count
-      else
-         begin
-         Runner:=TheLast;
-         I:=j;
-      end;
-    end;
-  Count:=TheLast;
-}
-end;
-
-// Needed by Sort method.
-
-Procedure QuickSort (Flist : PPointerList; L,R : Longint;
-                     Compare : TListSortCompare);
-
-Var I,J : Longint;
-    P,Q : Pointer;
-
-begin
- Repeat
-   I:=L;
-   J:=R;
-   P:=FList^[ (L+R) div 2 ];
-   repeat
-     While Compare(P,FList^[i])>0 Do I:=I+1;
-     While Compare(P,FList^[J])<0 Do J:=J-1;
-     If I<=J then
-       begin
-       Q:=Flist^[I];
-       Flist^[I]:=FList^[J];
-       FList^[J]:=Q;
-       I:=I+1;
-       J:=j-1;
-       end;
-   Until I>J;
-   If L<J then QuickSort (FList,L,J,Compare);
-   L:=I;
- Until I>=R;
-end;
-
-procedure TList.Sort(Compare: TListSortCompare);
-
-begin
-  If Not Assigned(FList) or (FCount<2) then exit;
-  QuickSort (Flist, 0, FCount-1,Compare);
-end;
-
-procedure TList.Assign(Obj:TList);
-// Principle copied from TCollection
-
-var i : Integer;
-begin
-  Clear;
-  For I:=0 To Obj.Count-1 Do
-    Add(Obj[i]);
-end;
-
-{****************************************************************************}
-{*                             TThreadList                                  *}
-{****************************************************************************}
-
-
-constructor TThreadList.Create;
-begin
-inherited Create;
-//InitializeCriticalSection(FLock);
-FList := TList.Create;
-end;
-
-
-
-destructor TThreadList.Destroy;
-begin
-  LockList;
-  try
-    FList.Free;
-    inherited Destroy;
-  finally
-    UnlockList;
-  end;
-end;
-
-
-
-procedure TThreadList.Add(Item: Pointer);
-begin
-  Locklist;
-  try
-    //make sure it's not already in the list
-    if FList.indexof(Item) = -1 then
-       FList.Add(Item);
-  finally
-  UnlockList;
-  end;
-end;
-
-
-procedure TThreadList.Clear;
-begin
-  Locklist;
-  try
-    FList.Clear;
-  finally
-    UnLockList;
-  end;
-end;
-
-
-
-function TThreadList.LockList: TList;
-
-
-begin
-  Result := FList;
-end;
-
-
-
-procedure TThreadList.Remove(Item: Pointer);
-begin
-  LockList;
-  try
-    FList.Remove(Item);
-  finally
-    UnlockList;
-  end;
-end;
-
-
-
-procedure TThreadList.UnlockList;
-begin
-
-end;
-
-
-{
-  $Log: lists.inc,v $
-  Revision 1.4  2005/05/12 21:47:34  hajny
-    * fix for SIGSEGV due to access to uninitialized pointers in TList
-
-  Revision 1.3  2005/02/14 17:13:11  peter
-    * truncate log
-
-}

fcl/classes/netbsd/classes.pp

@@ -1,61 +0,0 @@
-{
-    $Id: classes.pp,v 1.2 2005/02/14 17:13:11 peter Exp $
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1999-2000 by Michael Van Canneyt and Florian Klaempfl
-
-    Classes unit for linux
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-{$mode objfpc}
-
-{ determine the type of the resource/form file }
-{$define Win16Res}
-
-unit Classes;
-
-interface
-
-uses
-  sysutils,
-  typinfo;
-
-{$i classesh.inc}
-
-implementation
-
-uses
-{$ifdef ver1_0}
-  linux
-{$else}
-  unix
-{$endif}
-  ;
-
-{ OS - independent class implementations are in /inc directory. }
-{$i classes.inc}
-
-
-initialization
-  CommonInit;
-
-finalization
-  CommonCleanup;
-
-  if ThreadsInited then
-     DoneThreads;
-
-end.
-{
-  $Log: classes.pp,v $
-  Revision 1.2  2005/02/14 17:13:11  peter
-    * truncate log
-
-}

fcl/classes/openbsd/classes.pp

@@ -1,61 +0,0 @@
-{
-    $Id: classes.pp,v 1.2 2005/02/14 17:13:11 peter Exp $
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1999-2000 by Michael Van Canneyt and Florian Klaempfl
-
-    Classes unit for linux
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-{$mode objfpc}
-
-{ determine the type of the resource/form file }
-{$define Win16Res}
-
-unit Classes;
-
-interface
-
-uses
-  sysutils,
-  typinfo;
-
-{$i classesh.inc}
-
-implementation
-
-uses
-{$ifdef ver1_0}
-  linux
-{$else}
-  unix
-{$endif}
-  ;
-
-{ OS - independent class implementations are in /inc directory. }
-{$i classes.inc}
-
-
-initialization
-  CommonInit;
-
-finalization
-  CommonCleanup;
-
-  if ThreadsInited then
-     DoneThreads;
-
-end.
-{
-  $Log: classes.pp,v $
-  Revision 1.2  2005/02/14 17:13:11  peter
-    * truncate log
-
-}

fcl/classes/os2/classes.pp

@@ -1,53 +0,0 @@
-{
-    $Id: classes.pp,v 1.2 2005/02/14 17:13:11 peter Exp $
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1999-2002 by the Free Pascal development team
-
-    Classes unit for OS/2
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-{$mode objfpc}
-
-{ determine the type of the resource/form file }
-{$define Win16Res}
-
-unit Classes;
-
-interface
-
-uses
-  strings,
-  sysutils,
-  typinfo;
-
-{$i classesh.inc}
-
-
-implementation
-
-
-{ OS - independent class implementations are in /inc directory. }
-{$i classes.inc}
-
-
-initialization
-  CommonInit;
-
-finalization
-  CommonCleanup;
-
-end.
-{
-  $Log: classes.pp,v $
-  Revision 1.2  2005/02/14 17:13:11  peter
-    * truncate log
-
-}

fcl/classes/parser.inc

@@ -1,314 +0,0 @@
-{
-    $Id: parser.inc,v 1.2 2005/02/14 17:13:11 peter Exp $
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1999-2000 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-{****************************************************************************}
-{*                             TParser                                      *}
-{****************************************************************************}
-
-const
-  ParseBufSize     = 4096;
-
-procedure TParser.ReadBuffer;
-var
-  Count            : Integer;
-begin
-  Inc(FOrigin, FSourcePtr - FBuffer);
-
-  FSourceEnd[0] := FSaveChar;
-  Count         := FBufPtr - FSourcePtr;
-  if Count <> 0 then
-  begin
-    Move(FSourcePtr[0], FBuffer[0], Count);
-  end;
-
-  FBufPtr := FBuffer + Count;
-  Inc(FBufPtr, FStream.Read(FBufPtr[0], FBufEnd - FBufPtr));
-
-  FSourcePtr := FBuffer;
-  FSourceEnd := FBufPtr;
-  if (FSourceEnd = FBufEnd) then
-  begin
-    FSourceEnd := LineStart(FBuffer, FSourceEnd - 1);
-    if FSourceEnd = FBuffer then
-    begin
-      Error(SLineTooLong);
-    end;
-  end;
-  FSaveChar := FSourceEnd[0];
-  FSourceEnd[0] := #0;
-end;
-
-procedure TParser.SkipBlanks;
-begin
-  while FSourcePtr^ < #33 do begin
-    if FSourcePtr^ = #0 then begin
-      ReadBuffer;
-      if FSourcePtr^ = #0 then exit;
-      continue;
-    end else if FSourcePtr^ = #10 then Inc(FSourceLine);
-    Inc(FSourcePtr);
-  end;
-end;
-
-constructor TParser.Create(Stream: TStream);
-begin
-  inherited Create;
-
-  FStream := Stream;
-  GetMem(FBuffer, ParseBufSize);
-
-  FBuffer[0]  := #0;
-  FBufPtr     := FBuffer;
-  FBufEnd     := FBuffer + ParseBufSize;
-  FSourcePtr  := FBuffer;
-  FSourceEnd  := FBuffer;
-  FTokenPtr   := FBuffer;
-  FSourceLine := 1;
-
-  NextToken;
-end;
-
-
-destructor TParser.Destroy;
-begin
-  if Assigned(FBuffer) then
-  begin
-    FStream.Seek(Longint(FTokenPtr) - Longint(FBufPtr), 1);
-    FreeMem(FBuffer, ParseBufSize);
-  end;
-
-  inherited Destroy;
-end;
-
-procedure TParser.CheckToken(T : Char);
-begin
-  if Token <> T then
-  begin
-    case T of
-      toSymbol:
-        Error(SIdentifierExpected);
-      toString:
-        Error(SStringExpected);
-      toInteger, toFloat:
-        Error(SNumberExpected);
-    else
-      ErrorFmt(SCharExpected, [T]);
-    end;
-  end;
-end;
-
-procedure TParser.CheckTokenSymbol(const S: string);
-begin
-  if not TokenSymbolIs(S) then
-    ErrorFmt(SSymbolExpected, [S]);
-end;
-
-Procedure TParser.Error(const Ident: string);
-begin
-  ErrorStr(Ident);
-end;
-
-Procedure TParser.ErrorFmt(const Ident: string; const Args: array of const);
-begin
-  ErrorStr(Format(Ident, Args));
-end;
-
-Procedure TParser.ErrorStr(const Message: string);
-begin
-  raise EParserError.CreateFmt(SParseError, [Message, FSourceLine]);
-end;
-
-
-procedure TParser.HexToBinary(Stream: TStream);
-
-  function HexDigitToInt(c: Char): Integer;
-  begin
-    if (c >= '0') and (c <= '9') then Result := Ord(c) - Ord('0')
-    else if (c >= 'A') and (c <= 'F') then Result := Ord(c) - Ord('A') + 10
-    else if (c >= 'a') and (c <= 'f') then Result := Ord(c) - Ord('a') + 10
-    else Result := -1;
-  end;
-
-var
-  buf: array[0..255] of Byte;
-  digit1: Integer;
-  bytes: Integer;
-begin
-  SkipBlanks;
-  while FSourcePtr^ <> '}' do begin
-    bytes := 0;
-    while True do begin
-      digit1 := HexDigitToInt(FSourcePtr[0]);
-      if digit1 < 0 then break;
-      buf[bytes] := digit1 shl 4 or HexDigitToInt(FSourcePtr[1]);
-      Inc(FSourcePtr, 2);
-      Inc(bytes);
-    end;
-    if bytes = 0 then Error(SInvalidBinary);
-    Stream.Write(buf, bytes);
-    SkipBlanks;
-  end;
-  NextToken;
-end;
-
-
-Function TParser.NextToken: Char;
-var
-  I                : Integer;
-  P, S             : PChar;
-begin
-  SkipBlanks;
-  P := FSourcePtr;
-  FTokenPtr := P;
-  case P^ of
-    'A'..'Z', 'a'..'z', '_':
-      begin
-        Inc(P);
-        while P^ in ['A'..'Z', 'a'..'z', '0'..'9', '_'] do Inc(P);
-        Result := toSymbol;
-      end;
-    '#', '''':
-      begin
-        S := P;
-        while True do
-          case P^ of
-            '#':
-              begin
-                Inc(P);
-                I := 0;
-                while P^ in ['0'..'9'] do
-                begin
-                  I := I * 10 + (Ord(P^) - Ord('0'));
-                  Inc(P);
-                end;
-                S^ := Chr(I);
-                Inc(S);
-              end;
-            '''':
-              begin
-                Inc(P);
-                while True do
-                begin
-                  case P^ of
-                    #0, #10, #13:
-                      Error(SInvalidString);
-                    '''':
-                      begin
-                        Inc(P);
-                        if P^ <> '''' then Break;
-                      end;
-                  end;
-                  S^ := P^;
-                  Inc(S);
-                  Inc(P);
-                end;
-              end;
-          else
-            Break;
-          end;
-        FStringPtr := S;
-        Result := toString;
-      end;
-    '$':
-      begin
-        Inc(P);
-        while P^ in ['0'..'9', 'A'..'F', 'a'..'f'] do Inc(P);
-        Result := toInteger;
-      end;
-    '-', '0'..'9':
-      begin
-        Inc(P);
-        while P^ in ['0'..'9'] do Inc(P);
-        Result := toInteger;
-        while (P^ in ['0'..'9', '.', 'e', 'E', '+', '-']) and not
-          ((P[0] = '.') and not (P[1] in ['0'..'9', 'e', 'E'])) do
-        begin
-          Inc(P);
-          Result := toFloat;
-        end;
-      end;
-  else
-    Result := P^;
-    if Result <> toEOF then Inc(P);
-  end;
-  FSourcePtr := P;
-  FToken := Result;
-end;
-
-Function TParser.SourcePos: Longint;
-begin
-  Result := FOrigin + (FTokenPtr - FBuffer);
-end;
-
-
-Function TParser.TokenComponentIdent: String;
-var
-  P                : PChar;
-begin
-  CheckToken(toSymbol);
-
-  P := FSourcePtr;
-  while P^ = '.' do
-  begin
-    Inc(P);
-    if not (P^ in ['A'..'Z', 'a'..'z', '_']) then
-      Error(SIdentifierExpected);
-    repeat
-      Inc(P)
-    until not (P^ in ['A'..'Z', 'a'..'z', '0'..'9', '_']);
-  end;
-  FSourcePtr := P;
-  Result := TokenString;
-end;
-
-Function TParser.TokenFloat: Extended;
-var
-  FloatError       : Integer;
-  Back             : Real;
-begin
-  Result   := 0;
-  Val(TokenString, Back, FloatError);
-  Result := Back;
-end;
-
-Function TParser.TokenInt: Longint;
-begin
-  Result := StrToInt(TokenString);
-end;
-
-Function TParser.TokenString: string;
-var
-  L                : Integer;
-  StrBuf           : array[0..1023] of Char;
-begin
-  if FToken = toString then begin
-    L := FStringPtr - FTokenPtr
-  end else begin
-    L := FSourcePtr - FTokenPtr;
-  end;
-
-  StrLCopy(StrBuf, FTokenPtr, L);
-  Result := StrPas(StrBuf);
-end;
-
-Function TParser.TokenSymbolIs(const S: string): Boolean;
-begin
-  Result := (Token = toSymbol) and (CompareText(S, TokenString) = 0);
-end;
-{
-  $Log: parser.inc,v $
-  Revision 1.2  2005/02/14 17:13:11  peter
-    * truncate log
-
-}

fcl/classes/persist.inc

@@ -1,166 +0,0 @@
-{
-    $Id: persist.inc,v 1.2 2005/02/14 17:13:11 peter Exp $
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1999-2000 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-{****************************************************************************}
-{*                             TPersistent                                  *}
-{****************************************************************************}
-
-procedure TPersistent.AssignError(Source: TPersistent);
-
-Var SourceName : String;
-
-begin
-  If Source<>Nil then
-    SourceName:=Source.ClassName
-  else
-    SourceName:='Nil';
-  Writeln ('Error assigning to ',ClassName,' from : ',SourceName);
-  raise EConvertError.CreateFmt (SAssignError,[SourceName,ClassName]);
-end;
-
-
-
-procedure TPersistent.AssignTo(Dest: TPersistent);
-
-
-begin
-  Dest.AssignError(Self);
-end;
-
-
-procedure TPersistent.DefineProperties(Filer: TFiler);
-
-begin
-end;
-
-
-function  TPersistent.GetOwner: TPersistent;
-
-begin
-  Result:=Nil;
-end;
-
-destructor TPersistent.Destroy;
-
-begin
-  Inherited Destroy;
-end;
-
-
-procedure TPersistent.Assign(Source: TPersistent);
-
-begin
-  If Source<>Nil then
-    Source.AssignTo(Self)
-  else
-    AssignError(Nil);
-end;
-
-function  TPersistent.GetNamePath: string;
-
-Var OwnerName :String;
-
-begin
- Result:=ClassNAme;
- If GetOwner<>Nil then
-   begin
-   OwnerName:=GetOwner.GetNamePath;
-   If OwnerName<>'' then Result:=OwnerName+'.'+Result;
-   end;
-end;
-
-
-{****************************************************************************}
-{*                          TInterfacedPersistent                           *}
-{****************************************************************************}
-
-{$ifdef HASINTF}
-procedure TInterfacedPersistent.AfterConstruction;
-begin
-  inherited;
-//  if GetOwner<>nil then
-//   GetOwner.GetInterface(IUnknown,FOwnerInterface);
-end;
-
-
-function TInterfacedPersistent._AddRef: Integer;stdcall;
-begin
-  if FOwnerInterface<>nil then
-    Result:=FOwnerInterface._AddRef
-  else
-    Result:=-1;
-end;
-
-
-function TInterfacedPersistent._Release: Integer;stdcall;
-begin
-  if FOwnerInterface <> nil then
-    Result:=FOwnerInterface._Release
-  else
-    Result:=-1;
-end;
-
-
-function TInterfacedPersistent.QueryInterface(const IID: TGUID; out Obj): HResult;stdcall;
-begin
-  if GetInterface(IID, Obj) then
-    Result:=0
-  else
-    Result:=HResult($80004002);
-end;
-{$endif HASINTF}
-
-
-{****************************************************************************}
-{*                                TRecall                                   *}
-{****************************************************************************}
-
-constructor TRecall.Create(AStorage,AReference: TPersistent);
-begin
-  inherited Create;
-  FStorage:=AStorage;
-  FReference:=AReference;
-  Store;
-end;
-
-
-destructor TRecall.Destroy;
-begin
-  if Assigned(FReference) then
-   FReference.Assign(FStorage);
-  Forget;
-  inherited;
-end;
-
-
-procedure TRecall.Forget;
-begin
-  FReference:=nil;
-  FreeAndNil(FStorage);
-end;
-
-
-procedure TRecall.Store;
-begin
-  if Assigned(FReference) then
-    FStorage.Assign(FReference);
-end;
-
-
-{
-  $Log: persist.inc,v $
-  Revision 1.2  2005/02/14 17:13:11  peter
-    * truncate log
-
-}

fcl/classes/reader.inc

@@ -1,1316 +0,0 @@
-{
-    $Id: reader.inc,v 1.4 2005/02/14 17:13:11 peter Exp $
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1999-2000 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-{****************************************************************************}
-{*                       TBinaryObjectReader                                *}
-{****************************************************************************}
-
-constructor TBinaryObjectReader.Create(Stream: TStream; BufSize: Integer);
-begin
-  inherited Create;
-  FStream := Stream;
-  FBufSize := BufSize;
-  GetMem(FBuffer, BufSize);
-end;
-
-destructor TBinaryObjectReader.Destroy;
-begin
-  { Seek back the amount of bytes that we didn't process until now: }
-  FStream.Seek(Integer(FBufPos) - Integer(FBufEnd), soFromCurrent);
-
-  if Assigned(FBuffer) then
-    FreeMem(FBuffer, FBufSize);
-
-  inherited Destroy;
-end;
-
-function TBinaryObjectReader.ReadValue: TValueType;
-begin
-  Result := vaNull; { Necessary in FPC as TValueType is larger than 1 byte! }
-  Read(Result, 1);
-end;
-
-function TBinaryObjectReader.NextValue: TValueType;
-begin
-  Result := ReadValue;
-  { We only 'peek' at the next value, so seek back to unget the read value: }
-  Dec(FBufPos);
-end;
-
-procedure TBinaryObjectReader.BeginRootComponent;
-var
-  Signature: LongInt;
-begin
-  { Read filer signature }
-  Read(Signature, 4);
-  if Signature <> LongInt(FilerSignature) then
-    raise EReadError.Create(SInvalidImage);
-end;
-
-procedure TBinaryObjectReader.BeginComponent(var Flags: TFilerFlags;
-  var AChildPos: Integer; var CompClassName, CompName: String);
-var
-  Prefix: Byte;
-  ValueType: TValueType;
-begin
-  { Every component can start with a special prefix: }
-  Flags := [];
-  if (Byte(NextValue) and $f0) = $f0 then
-  begin
-    Prefix := Byte(ReadValue);
-    Flags := TFilerFlags(Prefix and $0f);
-    if ffChildPos in Flags then
-    begin
-      ValueType := NextValue;
-      case ValueType of
-        vaInt8:
-          AChildPos := ReadInt8;
-        vaInt16:
-          AChildPos := ReadInt16;
-        vaInt32:
-          AChildPos := ReadInt32;
-        else
-          raise EReadError.Create(SInvalidPropertyValue);
-      end;
-    end;
-  end;
-
-  CompClassName := ReadStr;
-  CompName := ReadStr;
-end;
-
-function TBinaryObjectReader.BeginProperty: String;
-begin
-  Result := ReadStr;
-end;
-
-procedure TBinaryObjectReader.ReadBinary(const DestData: TMemoryStream);
-var
-  BinSize: LongInt;
-begin
-  Read(BinSize, 4);
-  DestData.Size := BinSize;
-  Read(DestData.Memory^, BinSize);
-end;
-
-function TBinaryObjectReader.ReadFloat: Extended;
-begin
-  Read(Result, SizeOf(Extended))
-end;
-
-function TBinaryObjectReader.ReadSingle: Single;
-begin
-  Read(Result, SizeOf(Single))
-end;
-
-{!!!: function TBinaryObjectReader.ReadCurrency: Currency;
-begin
-  Read(Result, SizeOf(Currency))
-end;}
-
-function TBinaryObjectReader.ReadDate: TDateTime;
-begin
-  Read(Result, SizeOf(TDateTime))
-end;
-
-function TBinaryObjectReader.ReadIdent(ValueType: TValueType): String;
-var
-  i: Byte;
-begin
-  case ValueType of
-    vaIdent:
-      begin
-        Read(i, 1);
-        SetLength(Result, i);
-        Read(Pointer(@Result[1])^, i);
-      end;
-    vaNil:
-      Result := 'nil';
-    vaFalse:
-      Result := 'False';
-    vaTrue:
-      Result := 'True';
-    vaNull:
-      Result := 'Null';
-  end;
-end;
-
-function TBinaryObjectReader.ReadInt8: ShortInt;
-begin
-  Read(Result, 1);
-end;
-
-function TBinaryObjectReader.ReadInt16: SmallInt;
-begin
-  Read(Result, 2);
-end;
-
-function TBinaryObjectReader.ReadInt32: LongInt;
-begin
-  Read(Result, 4);
-end;
-
-function TBinaryObjectReader.ReadInt64: Int64;
-begin
-  Read(Result, 8);
-end;
-
-function TBinaryObjectReader.ReadSet(EnumType: Pointer): Integer;
-var
-  Name: String;
-  Value: Integer;
-begin
-  try
-    Result := 0;
-    while True do
-    begin
-      Name := ReadStr;
-      if Length(Name) = 0 then
-        break;
-      Value := GetEnumValue(PTypeInfo(EnumType), Name);
-      if Value = -1 then
-        raise EReadError.Create(SInvalidPropertyValue);
-      Result := Result or (1 shl Value);
-    end;
-  except
-    SkipSetBody;
-    raise;
-  end;
-end;
-
-function TBinaryObjectReader.ReadStr: String;
-var
-  i: Byte;
-begin
-  Read(i, 1);
-  SetLength(Result, i);
-  if i > 0 then
-    Read(Pointer(@Result[1])^, i);
-end;
-
-function TBinaryObjectReader.ReadString(StringType: TValueType): String;
-var
-  i: Integer;
-begin
-  case StringType of
-    vaString:
-      begin
-        i := 0;
-        Read(i, 1);
-      end;
-    vaLString:
-      Read(i, 4);
-  end;
-  SetLength(Result, i);
-  if i > 0 then
-    Read(Pointer(@Result[1])^, i);
-end;
-
-{!!!: function TBinaryObjectReader.ReadWideString: WideString;
-var
-  i: Integer;
-begin
-  FDriver.Read(i, 4);
-  SetLength(Result, i);
-  if i > 0 then
-    Read(PWideChar(Result), i * 2);
-end;}
-
-procedure TBinaryObjectReader.SkipComponent(SkipComponentInfos: Boolean);
-var
-  Flags: TFilerFlags;
-  Dummy: Integer;
-  CompClassName, CompName: String;
-begin
-  if SkipComponentInfos then
-    { Skip prefix, component class name and component object name }
-    BeginComponent(Flags, Dummy, CompClassName, CompName);
-
-  { Skip properties }
-  while NextValue <> vaNull do
-    SkipProperty;
-  ReadValue;
-
-  { Skip children }
-  while NextValue <> vaNull do
-    SkipComponent(True);
-  ReadValue;
-end;
-
-procedure TBinaryObjectReader.SkipValue;
-
-  procedure SkipBytes(Count: LongInt);
-  var
-    Dummy: array[0..1023] of Byte;
-    SkipNow: Integer;
-  begin
-    while Count > 0 do
-    begin
-      if Count > 1024 then
-        SkipNow := 1024
-      else
-        SkipNow := Count;
-      Read(Dummy, SkipNow);
-      Dec(Count, SkipNow);
-    end;
-  end;
-
-var
-  Count: LongInt;
-begin
-  case ReadValue of
-    vaNull, vaFalse, vaTrue, vaNil: ;
-    vaList:
-      begin
-        while NextValue <> vaNull do
-          SkipValue;
-        ReadValue;
-      end;
-    vaInt8:
-      SkipBytes(1);
-    vaInt16:
-      SkipBytes(2);
-    vaInt32:
-      SkipBytes(4);
-    vaExtended:
-      SkipBytes(SizeOf(Extended));
-    vaString, vaIdent:
-      ReadStr;
-    vaBinary, vaLString, vaWString:
-      begin
-        Read(Count, 4);
-        SkipBytes(Count);
-      end;
-    vaSet:
-      SkipSetBody;
-    vaCollection:
-      begin
-        while NextValue <> vaNull do
-        begin
-          { Skip the order value if present }
-          if NextValue in [vaInt8, vaInt16, vaInt32] then
-            SkipValue;
-          SkipBytes(1);
-          while NextValue <> vaNull do
-            SkipProperty;
-          ReadValue;
-        end;
-        ReadValue;
-      end;
-    vaSingle:
-      SkipBytes(Sizeof(Single));
-    {!!!: vaCurrency:
-      SkipBytes(SizeOf(Currency));}
-    vaDate:
-      SkipBytes(Sizeof(TDateTime));
-    vaInt64:
-      SkipBytes(8);
-  end;
-end;
-
-{ private methods }
-
-procedure TBinaryObjectReader.Read(var Buf; Count: LongInt);
-var
-  CopyNow: LongInt;
-  Dest: Pointer;
-begin
-  Dest := @Buf;
-  while Count > 0 do
-  begin
-    if FBufPos >= FBufEnd then
-    begin
-      FBufEnd := FStream.Read(FBuffer^, FBufSize);
-      if FBufEnd = 0 then
-        raise EReadError.Create(SReadError);
-      FBufPos := 0;
-    end;
-    CopyNow := FBufEnd - FBufPos;
-    if CopyNow > Count then
-      CopyNow := Count;
-    Move(PChar(FBuffer)[FBufPos], Dest^, CopyNow);
-    Inc(FBufPos, CopyNow);
-    Inc(Dest, CopyNow);
-    Dec(Count, CopyNow);
-  end;
-end;
-
-procedure TBinaryObjectReader.SkipProperty;
-begin
-  { Skip property name, then the property value }
-  ReadStr;
-  SkipValue;
-end;
-
-procedure TBinaryObjectReader.SkipSetBody;
-begin
-  while Length(ReadStr) > 0 do;
-end;
-
-
-
-{****************************************************************************}
-{*                             TREADER                                      *}
-{****************************************************************************}
-
-
-// This may be better put somewhere else:
-
-type
-
-  TFieldInfo = packed record
-    FieldOffset: LongWord;
-    ClassTypeIndex: Word;
-    Name: ShortString;
-  end;
-
-  PFieldClassTable = ^TFieldClassTable;
-  TFieldClassTable = packed record
-    Count: Word;
-    Entries: array[Word] of TPersistentClass;
-  end;
-
-  PFieldTable = ^TFieldTable;
-  TFieldTable = packed record
-    FieldCount: Word;
-    ClassTable: PFieldClassTable;
-    // Fields: array[Word] of TFieldInfo;  Elements have variant size!
-  end;
-
-
-function GetFieldClass(Instance: TObject; const ClassName: string): TPersistentClass;
-var
-  UClassName: String;
-  ClassType: TClass;
-  ClassTable: PFieldClassTable;
-  i: Integer;
-  FieldTable: PFieldTable;
-begin
-  // At first, try to locate the class in the class tables
-  UClassName := UpperCase(ClassName);
-  ClassType := Instance.ClassType;
-  while ClassType <> TPersistent do
-  begin
-    FieldTable := PFieldTable((Pointer(ClassType) + vmtFieldTable)^);
-    ClassTable := PFieldTable((Pointer(ClassType) + vmtFieldTable)^)^.ClassTable;
-    if Assigned(ClassTable) then
-      for i := 0 to ClassTable^.Count - 1 do
-      begin
-        Result := ClassTable^.Entries[i];
-        if UpperCase(Result.ClassName) = UClassName then
-          exit;
-      end;
-     // Try again with the parent class type
-     ClassType := ClassType.ClassParent;
-  end;
-  Result := Classes.GetClass(ClassName);
-end;
-
-
-constructor TReader.Create(Stream: TStream; BufSize: Integer);
-begin
-  inherited Create;
-  FDriver := TBinaryObjectReader.Create(Stream, BufSize);
-end;
-
-destructor TReader.Destroy;
-begin
-  FDriver.Free;
-  inherited Destroy;
-end;
-
-procedure TReader.BeginReferences;
-begin
-  FLoaded := TList.Create;
-  try
-    FFixups := TList.Create;
-  except
-    FLoaded.Free;
-    raise;
-  end;
-end;
-
-procedure TReader.CheckValue(Value: TValueType);
-begin
-  if FDriver.NextValue <> Value then
-    raise EReadError.Create(SInvalidPropertyValue)
-  else
-    FDriver.ReadValue;
-end;
-
-procedure TReader.DefineProperty(const Name: String; AReadData: TReaderProc;
-  WriteData: TWriterProc; HasData: Boolean);
-begin
-  if Assigned(AReadData) and (UpperCase(Name) = UpperCase(FPropName)) then
-  begin
-    AReadData(Self);
-    SetLength(FPropName, 0);
-  end;
-end;
-
-procedure TReader.DefineBinaryProperty(const Name: String;
-  AReadData, WriteData: TStreamProc; HasData: Boolean);
-var
-  MemBuffer: TMemoryStream;
-begin
-  if Assigned(AReadData) and (UpperCase(Name) = UpperCase(FPropName)) then
-  begin
-    { Check if the next property really is a binary property}
-    if FDriver.NextValue <> vaBinary then
-    begin
-      FDriver.SkipValue;
-      FCanHandleExcepts := True;
-      raise EReadError.Create(SInvalidPropertyValue);
-    end else
-      FDriver.ReadValue;
-
-    MemBuffer := TMemoryStream.Create;
-    try
-      FDriver.ReadBinary(MemBuffer);
-      FCanHandleExcepts := True;
-      AReadData(MemBuffer);
-    finally
-      MemBuffer.Free;
-    end;
-    SetLength(FPropName, 0);
-  end;
-end;
-
-function TReader.EndOfList: Boolean;
-begin
-  Result := FDriver.NextValue = vaNull;
-end;
-
-procedure TReader.EndReferences;
-begin
-  FreeFixups;
-  FLoaded.Free;
-  FLoaded := nil;
-end;
-
-function TReader.Error(const Message: String): Boolean;
-begin
-  Result := False;
-  if Assigned(FOnError) then
-    FOnError(Self, Message, Result);
-end;
-
-function TReader.FindMethod(ARoot: TComponent; const AMethodName: String): Pointer;
-var
-  ErrorResult: Boolean;
-begin
-  Result := ARoot.MethodAddress(AMethodName);
-  ErrorResult := Result = nil;
-
-  { always give the OnFindMethod callback a chance to locate the method }
-  if Assigned(FOnFindMethod) then
-    FOnFindMethod(Self, AMethodName, Result, ErrorResult);
-
-  if ErrorResult then
-    raise EReadError.Create(SInvalidPropertyValue);
-end;
-
-procedure RemoveGlobalFixup(Fixup: TPropFixup);
-var
-  i: Integer;
-begin
-  with GlobalFixupList.LockList do
-    try
-      for i := Count - 1 downto 0 do
-        with TPropFixup(Items[i]) do
-          if (FInstance = Fixup.FInstance) and
-            (FPropInfo = Fixup.FPropInfo) then
-          begin
-            Free;
-            Delete(i);
-          end;
-    finally
-      GlobalFixupList.UnlockList;
-    end;
-end;
-
-procedure TReader.DoFixupReferences;
-var
-  i: Integer;
-  CurFixup: TPropFixup;
-  CurName: String;
-  Target: Pointer;
-begin
-  if Assigned(FFixups) then
-    try
-      for i := 0 to FFixups.Count - 1 do
-      begin
-        CurFixup := TPropFixup(FFixups[i]);
-        CurName := CurFixup.FName;
-        if Assigned(FOnReferenceName) then
-          FOnReferenceName(Self, CurName);
-        Target := FindNestedComponent(CurFixup.FInstanceRoot, CurName);
-        RemoveGlobalFixup(CurFixup);
-        if (not Assigned(Target)) and CurFixup.MakeGlobalReference then
-        begin
-          GlobalFixupList.Add(CurFixup);
-          FFixups[i] := nil;
-        end else
-          SetOrdProp(CurFixup.FInstance, CurFixup.FPropInfo, LongInt(Target));
-      end;
-    finally
-      FreeFixups;
-    end;
-end;
-
-procedure TReader.FixupReferences;
-var
-  i: Integer;
-begin
-  DoFixupReferences;
-  GlobalFixupReferences;
-  for i := 0 to FLoaded.Count - 1 do
-    TComponent(FLoaded[I]).Loaded;
-end;
-
-procedure TReader.FreeFixups;
-var
-  i: Integer;
-begin
-  if Assigned(FFixups) then
-  begin
-    for i := 0 to FFixups.Count - 1 do
-      TPropFixup(FFixups[I]).Free;
-    FFixups.Free;
-    FFixups := nil;
-  end;
-end;
-
-function TReader.NextValue: TValueType;
-begin
-  Result := FDriver.NextValue;
-end;
-
-procedure TReader.PropertyError;
-begin
-  FDriver.SkipValue;
-  raise EReadError.Create(SUnknownProperty);
-end;
-
-function TReader.ReadBoolean: Boolean;
-var
-  ValueType: TValueType;
-begin
-  ValueType := FDriver.ReadValue;
-  if ValueType = vaTrue then
-    Result := True
-  else if ValueType = vaFalse then
-    Result := False
-  else
-    raise EReadError.Create(SInvalidPropertyValue);
-end;
-
-function TReader.ReadChar: Char;
-var
-  s: String;
-begin
-  s := ReadString;
-  if Length(s) = 1 then
-    Result := s[1]
-  else
-    raise EReadError.Create(SInvalidPropertyValue);
-end;
-
-procedure TReader.ReadCollection(Collection: TCollection);
-var
-  Item: TPersistent;
-begin
-  Collection.BeginUpdate;
-  try
-    if not EndOfList then
-      Collection.Clear;
-    while not EndOfList do
-    begin
-      if FDriver.NextValue in [vaInt8, vaInt16, vaInt32] then
-        ReadInteger;            { Skip order value }
-      Item := Collection.Add;
-      ReadListBegin;
-      while not EndOfList do
-        ReadProperty(Item);
-      ReadListEnd;
-    end;
-    ReadListEnd;
-  finally
-    Collection.EndUpdate;
-  end;
-end;
-
-function TReader.ReadComponent(Component: TComponent): TComponent;
-var
-  Flags: TFilerFlags;
-
-  function Recover(var Component: TComponent): Boolean;
-  begin
-    Result := False;
-    if ExceptObject.InheritsFrom(Exception) then
-    begin
-      if not ((ffInherited in Flags) or Assigned(Component)) then
-        Component.Free;
-      Component := nil;
-      FDriver.SkipComponent(False);
-      Result := Error(Exception(ExceptObject).Message);
-    end;
-  end;
-
-var
-  CompClassName, Name: String;
-  ChildPos: Integer;
-  SavedParent, SavedLookupRoot: TComponent;
-  ComponentClass: TComponentClass;
-  NewComponent: TComponent;
-begin
-  FDriver.BeginComponent(Flags, ChildPos, CompClassName, Name);
-  SavedParent := Parent;
-  SavedLookupRoot := FLookupRoot;
-  try
-    Result := Component;
-    if not Assigned(Result) then
-      try
-        if ffInherited in Flags then
-        begin
-          { Try to locate the existing ancestor component }
-
-          if Assigned(FLookupRoot) then
-            Result := FLookupRoot.FindComponent(Name)
-          else
-            Result := nil;
-
-          if not Assigned(Result) then
-          begin
-            if Assigned(FOnAncestorNotFound) then
-              FOnAncestorNotFound(Self, Name,
-                FindComponentClass(CompClassName), Result);
-            if not Assigned(Result) then
-              raise EReadError.CreateFmt(SAncestorNotFound, [Name]);
-          end;
-
-          Parent := Result.GetParentComponent;
-          if not Assigned(Parent) then
-            Parent := Root;
-        end else
-        begin
-          Result := nil;
-          ComponentClass := FindComponentClass(CompClassName);
-          if Assigned(FOnCreateComponent) then
-            FOnCreateComponent(Self, ComponentClass, Result);
-          if not Assigned(Result) then
-          begin
-            NewComponent := TComponent(ComponentClass.NewInstance);
-            if ffInline in Flags then
-              NewComponent.FComponentState :=
-                NewComponent.FComponentState + [csLoading, csInline];
-            NewComponent.Create(Owner);
-
-            { Don't set Result earlier because else we would come in trouble
-              with the exception recover mechanism! (Result should be NIL if
-              an error occured) }
-            Result := NewComponent;
-          end;
-          Include(Result.FComponentState, csLoading);
-        end;
-      except
-        if not Recover(Result) then
-          raise;
-      end;
-
-    if Assigned(Result) then
-      try
-        Include(Result.FComponentState, csLoading);
-        if not (ffInherited in Flags) then
-          try
-            Result.SetParentComponent(Parent);
-            if Assigned(FOnSetName) then
-              FOnSetName(Self, Result, Name);
-            Result.Name := Name;
-            if Assigned(FindGlobalComponent) and
-              (FindGlobalComponent(Name) = Result) then
-              Include(Result.FComponentState, csInline);
-          except
-            if not Recover(Result) then
-              raise;
-          end;
-        if not Assigned(Result) then
-          exit;
-        if csInline in Result.ComponentState then
-          FLookupRoot := Result;
-
-        { Read the component state }
-        Include(Result.FComponentState, csReading);
-        Result.ReadState(Self);
-        Exclude(Result.FComponentState, csReading);
-
-        if ffChildPos in Flags then
-          Parent.SetChildOrder(Result, ChildPos);
-
-        { Add component to list of loaded components, if necessary }
-        if (not ((ffInherited in Flags) or (csInline in Result.ComponentState))) or
-          (FLoaded.IndexOf(Result) < 0) then
-          FLoaded.Add(Result);
-      except
-        if ((ffInherited in Flags) or Assigned(Component)) then
-          Result.Free;
-        raise;
-      end;
-  finally
-    Parent := SavedParent;
-    FLookupRoot := SavedLookupRoot;
-  end;
-end;
-
-procedure TReader.ReadData(Instance: TComponent);
-var
-  DoFreeFixups: Boolean;
-  SavedOwner, SavedParent: TComponent;
-begin
-  if not Assigned(FFixups) then
-  begin
-    FFixups := TList.Create;
-    DoFreeFixups := True;
-  end else
-    DoFreeFixups := False;
-
-  try
-    { Read properties }
-    while not EndOfList do
-      ReadProperty(Instance);
-    ReadListEnd;
-
-    { Read children }
-    SavedOwner := Owner;
-    SavedParent := Parent;
-    try
-      Owner := Instance.GetChildOwner;
-      if not Assigned(Owner) then
-        Owner := Root;
-      Parent := Instance.GetChildParent;
-
-      while not EndOfList do
-        ReadComponent(nil);
-      ReadListEnd;
-    finally
-      Owner := SavedOwner;
-      Parent := SavedParent;
-    end;
-
-    { Fixup references if necessary (normally only if this is the root) }
-    if DoFreeFixups then
-      DoFixupReferences;
-
-  finally
-    if DoFreeFixups then
-      FreeFixups;
-  end;
-end;
-
-function TReader.ReadFloat: Extended;
-begin
-  if FDriver.NextValue = vaExtended then
-  begin
-    ReadValue;
-    Result := FDriver.ReadFloat
-  end else
-    Result := ReadInteger;
-end;
-
-function TReader.ReadSingle: Single;
-begin
-  if FDriver.NextValue = vaSingle then
-  begin
-    FDriver.ReadValue;
-    Result := FDriver.ReadSingle;
-  end else
-    Result := ReadInteger;
-end;
-
-{!!!: function TReader.ReadCurrency: Currency;
-begin
-  if FDriver.NextValue = vaCurrency then
-  begin
-    FDriver.ReadValue;
-    Result := FDriver.ReadCurrency;
-  end else
-    Result := ReadInteger;
-end;}
-
-function TReader.ReadDate: TDateTime;
-begin
-  if FDriver.NextValue = vaDate then
-  begin
-    FDriver.ReadValue;
-    Result := FDriver.ReadDate;
-  end else
-    Result := ReadInteger;
-end;
-
-function TReader.ReadIdent: String;
-var
-  ValueType: TValueType;
-begin
-  ValueType := FDriver.ReadValue;
-  if ValueType in [vaIdent, vaNil, vaFalse, vaTrue, vaNull] then
-    Result := FDriver.ReadIdent(ValueType)
-  else
-    raise EReadError.Create(SInvalidPropertyValue);
-end;
-
-
-function TReader.ReadInteger: LongInt;
-begin
-  case FDriver.ReadValue of
-    vaInt8:
-      Result := FDriver.ReadInt8;
-    vaInt16:
-      Result := FDriver.ReadInt16;
-    vaInt32:
-      Result := FDriver.ReadInt32;
-  else
-    raise EReadError.Create(SInvalidPropertyValue);
-  end;
-end;
-
-function TReader.ReadInt64: Int64;
-begin
-  if FDriver.NextValue = vaInt64 then
-  begin
-    FDriver.ReadValue;
-    Result := FDriver.ReadInt64;
-  end else
-    Result := ReadInteger;
-end;
-
-procedure TReader.ReadListBegin;
-begin
-  CheckValue(vaList);
-end;
-
-procedure TReader.ReadListEnd;
-begin
-  CheckValue(vaNull);
-end;
-
-procedure TReader.ReadProperty(AInstance: TPersistent);
-var
-  Path: String;
-  Instance: TPersistent;
-  DotPos, NextPos: PChar;
-  PropInfo: PPropInfo;
-  Obj: TObject;
-  Name: String;
-  Skip: Boolean;
-  Handled: Boolean;
-  OldPropName: String;
-
-  function HandleMissingProperty(IsPath: Boolean): boolean;
-  begin
-    Result:=true;
-    if Assigned(OnPropertyNotFound) then begin
-      // user defined property error handling
-      OldPropName:=FPropName;
-      Handled:=false;
-      Skip:=false;
-      OnPropertyNotFound(Self,Instance,FPropName,IsPath,Handled,Skip);
-      if Handled and (not Skip) and (OldPropName<>FPropName) then
-        // try alias property
-        PropInfo := GetPropInfo(Instance.ClassInfo, FPropName);
-      if Skip then begin
-        FDriver.SkipValue;
-        Result:=false;
-        exit;
-      end;
-    end;
-  end;
-
-begin
-  try
-    Path := FDriver.BeginProperty;
-    try
-      Instance := AInstance;
-      FCanHandleExcepts := True;
-      DotPos := PChar(Path);
-      while True do
-      begin
-        NextPos := StrScan(DotPos, '.');
-        if Assigned(NextPos) then
-          FPropName := Copy(String(DotPos), 1, Integer(NextPos - DotPos))
-        else
-        begin
-          FPropName := DotPos;
-          break;
-        end;
-        DotPos := NextPos + 1;
-
-        PropInfo := GetPropInfo(Instance.ClassInfo, FPropName);
-        if not Assigned(PropInfo) then begin
-          if not HandleMissingProperty(true) then exit;
-          if not Assigned(PropInfo) then
-            PropertyError;
-        end;
-
-        if PropInfo^.PropType^.Kind = tkClass then
-          Obj := TObject(GetOrdProp(Instance, PropInfo))
-        else
-          Obj := nil;
-
-        if not Obj.InheritsFrom(TPersistent) then
-        begin
-          { All path elements must be persistent objects! }
-          FDriver.SkipValue;
-          raise EReadError.Create(SInvalidPropertyPath);
-        end;
-        Instance := TPersistent(Obj);
-      end;
-
-      PropInfo := GetPropInfo(Instance.ClassInfo, FPropName);
-      if not Assigned(PropInfo) then
-        if not HandleMissingProperty(false) then exit;
-      if Assigned(PropInfo) then
-        ReadPropValue(Instance, PropInfo)
-      else
-      begin
-        FCanHandleExcepts := False;
-        Instance.DefineProperties(Self);
-        FCanHandleExcepts := True;
-        if Length(FPropName) > 0 then
-          PropertyError;
-      end;
-    except
-      on e: Exception do
-      begin
-        SetLength(Name, 0);
-        if AInstance.InheritsFrom(TComponent) then
-          Name := TComponent(AInstance).Name;
-        if Length(Name) = 0 then
-          Name := AInstance.ClassName;
-        raise EReadError.CreateFmt(SPropertyException,
-          [Name, DotSep, Path, e.Message]);
-      end;
-    end;
-  except
-    on e: Exception do
-      if not FCanHandleExcepts or not Error(E.Message) then
-        raise;
-  end;
-end;
-
-procedure TReader.ReadPropValue(Instance: TPersistent; PropInfo: Pointer);
-const
-  NullMethod: TMethod = (Code: nil; Data: nil);
-var
-  PropType: PTypeInfo;
-  Value: LongInt;
-  IdentToIntFn: TIdentToInt;
-  Ident: String;
-  Method: TMethod;
-  Handled: Boolean;
-  TmpStr: String;
-begin
-  if not Assigned(PPropInfo(PropInfo)^.SetProc) then
-    raise EReadError.Create(SReadOnlyProperty);
-
-  PropType := PPropInfo(PropInfo)^.PropType;
-  case PropType^.Kind of
-    tkInteger:
-      if FDriver.NextValue = vaIdent then
-      begin
-        Ident := ReadIdent;
-        if GlobalIdentToInt(Ident,Value) then
-          SetOrdProp(Instance, PropInfo, Value)
-        else
-          raise EReadError.Create(SInvalidPropertyValue);
-      end else
-        SetOrdProp(Instance, PropInfo, ReadInteger);
-    tkBool:
-      SetOrdProp(Instance, PropInfo, Ord(ReadBoolean));
-    tkChar:
-      SetOrdProp(Instance, PropInfo, Ord(ReadChar));
-    tkEnumeration:
-      begin
-        Value := GetEnumValue(PropType, ReadIdent);
-        if Value = -1 then
-          raise EReadError.Create(SInvalidPropertyValue);
-        SetOrdProp(Instance, PropInfo, Value);
-      end;
-    tkFloat:
-      SetFloatProp(Instance, PropInfo, ReadFloat);
-    tkSet:
-      begin
-        CheckValue(vaSet);
-        SetOrdProp(Instance, PropInfo,
-          FDriver.ReadSet(GetTypeData(PropType)^.CompType));
-      end;
-    tkMethod:
-      if FDriver.NextValue = vaNil then
-      begin
-        FDriver.ReadValue;
-        SetMethodProp(Instance, PropInfo, NullMethod);
-      end else
-      begin
-        Handled:=false;
-        Ident:=ReadIdent;
-        if Assigned(OnSetMethodProperty) then
-          OnSetMethodProperty(Self,Instance,PPropInfo(PropInfo),Ident,
-                              Handled);
-        if not Handled then begin
-          Method.Code := FindMethod(Root, Ident);
-          Method.Data := Root;
-          if Assigned(Method.Code) then
-            SetMethodProp(Instance, PropInfo, Method);
-        end;
-      end;
-    tkSString, tkLString, tkAString, tkWString:
-      begin
-        TmpStr:=ReadString;
-        if Assigned(FOnReadStringProperty) then
-          FOnReadStringProperty(Self,Instance,PropInfo,TmpStr);
-        SetStrProp(Instance, PropInfo, TmpStr);
-      end;
-    {!!!: tkVariant}
-    tkClass:
-      case FDriver.NextValue of
-        vaNil:
-          begin
-            FDriver.ReadValue;
-            SetOrdProp(Instance, PropInfo, 0)
-          end;
-        vaCollection:
-          begin
-            FDriver.ReadValue;
-            ReadCollection(TCollection(GetOrdProp(Instance, PropInfo)));
-          end
-        else
-          FFixups.Add(TPropFixup.Create(Instance, Root, PropInfo, '', ReadIdent));
-      end;
-    tkInt64: SetInt64Prop(Instance, PropInfo, ReadInt64);
-    else
-      raise EReadError.CreateFmt(SUnknownPropertyType, [Ord(PropType^.Kind)]);
-  end;
-end;
-
-function TReader.ReadRootComponent(ARoot: TComponent): TComponent;
-var
-  Dummy, i: Integer;
-  Flags: TFilerFlags;
-  CompClassName, CompName, ResultName: String;
-begin
-  FDriver.BeginRootComponent;
-  Result := nil;
-  {!!!: GlobalNameSpace.BeginWrite;  // Loading from stream adds to name space
-  try}
-    try
-      FDriver.BeginComponent(Flags, Dummy, CompClassName, CompName);
-      if not Assigned(ARoot) then
-      begin
-        { Read the class name and the object name and create a new object: }
-        Result := TComponentClass(FindClass(CompClassName)).Create(nil);
-        Result.Name := CompName;
-      end else
-      begin
-        Result := ARoot;
-
-        if not (csDesigning in Result.ComponentState) then
-        begin
-          Result.FComponentState :=
-            Result.FComponentState + [csLoading, csReading];
-
-          if Assigned(FindGlobalComponent) then
-          begin
-            { We need an unique name }
-            i := 0;
-            { Don't use Result.Name directly, as this would influence
-              FindGlobalComponent in successive loop runs }
-            ResultName := CompName;
-            while Assigned(FindGlobalComponent(ResultName)) do
-            begin
-              Inc(i);
-              ResultName := CompName + '_' + IntToStr(i);
-            end;
-            Result.Name := ResultName;
-          end else
-            Result.Name := '';
-        end;
-      end;
-
-      FRoot := Result;
-      FLookupRoot := Result;
-      if Assigned(GlobalLoaded) then
-        FLoaded := GlobalLoaded
-      else
-        FLoaded := TList.Create;
-
-      try
-        if FLoaded.IndexOf(FRoot) < 0 then
-          FLoaded.Add(FRoot);
-        FOwner := FRoot;
-        FRoot.FComponentState := FRoot.FComponentState + [csLoading, csReading];
-        FRoot.ReadState(Self);
-        Exclude(FRoot.FComponentState, csReading);
-
-        if not Assigned(GlobalLoaded) then
-          for i := 0 to FLoaded.Count - 1 do
-            TComponent(FLoaded[i]).Loaded;
-
-      finally
-        if not Assigned(GlobalLoaded) then
-          FLoaded.Free;
-        FLoaded := nil;
-      end;
-      GlobalFixupReferences;
-    except
-      RemoveFixupReferences(ARoot, '');
-      if not Assigned(ARoot) then
-        Result.Free;
-      raise;
-    end;
-  {finally
-    GlobalNameSpace.EndWrite;
-  end;}
-end;
-
-procedure TReader.ReadComponents(AOwner, AParent: TComponent;
-  Proc: TReadComponentsProc);
-var
-  Component: TComponent;
-begin
-  Root := AOwner;
-  Owner := AOwner;
-  Parent := AParent;
-  BeginReferences;
-  try
-    while not EndOfList do
-    begin
-      FDriver.BeginRootComponent;
-      Component := ReadComponent(nil);
-      if Assigned(Proc) then
-        Proc(Component);
-    end;
-    ReadListEnd;
-    FixupReferences;
-  finally
-    EndReferences;
-  end;
-end;
-
-
-function TReader.ReadString: String;
-var
-  StringType: TValueType;
-begin
-  StringType := FDriver.ReadValue;
-  if StringType in [vaString, vaLString] then
-    Result := FDriver.ReadString(StringType)
-  else
-    raise EReadError.Create(SInvalidPropertyValue);
-end;
-
-{!!!: function TReader.ReadWideString: WideString;
-begin
-  CheckValue(vaWString);
-  Result := FDriver.ReadWideString;
-end;}
-
-function TReader.ReadValue: TValueType;
-begin
-  Result := FDriver.ReadValue;
-end;
-
-procedure TReader.CopyValue(Writer: TWriter);
-
-  procedure CopyBytes(Count: Integer);
-  var
-    Buffer: array[0..1023] of Byte;
-  begin
-{!!!:    while Count > 1024 do
-    begin
-      FDriver.Read(Buffer, 1024);
-      Writer.Driver.Write(Buffer, 1024);
-      Dec(Count, 1024);
-    end;
-    if Count > 0 then
-    begin
-      FDriver.Read(Buffer, Count);
-      Writer.Driver.Write(Buffer, Count);
-    end;}
-  end;
-
-var
-  s: String;
-  Count: LongInt;
-begin
-  case FDriver.NextValue of
-    vaNull:
-      Writer.WriteIdent('NULL');
-    vaFalse:
-      Writer.WriteIdent('FALSE');
-    vaTrue:
-      Writer.WriteIdent('TRUE');
-    vaNil:
-      Writer.WriteIdent('NIL');
-    {!!!: vaList, vaCollection:
-      begin
-        Writer.WriteValue(FDriver.ReadValue);
-        while not EndOfList do
-          CopyValue(Writer);
-        ReadListEnd;
-        Writer.WriteListEnd;
-      end;}
-    vaInt8, vaInt16, vaInt32:
-      Writer.WriteInteger(ReadInteger);
-    vaExtended:
-      Writer.WriteFloat(ReadFloat);
-    {!!!: vaString:
-      Writer.WriteStr(ReadStr);}
-    vaIdent:
-      Writer.WriteIdent(ReadIdent);
-    {!!!: vaBinary, vaLString, vaWString:
-      begin
-        Writer.WriteValue(FDriver.ReadValue);
-        FDriver.Read(Count, SizeOf(Count));
-        Writer.Driver.Write(Count, SizeOf(Count));
-        CopyBytes(Count);
-      end;}
-    {!!!: vaSet:
-      Writer.WriteSet(ReadSet);}
-    vaSingle:
-      Writer.WriteSingle(ReadSingle);
-    {!!!: vaCurrency:
-      Writer.WriteCurrency(ReadCurrency);}
-    vaDate:
-      Writer.WriteDate(ReadDate);
-    vaInt64:
-      Writer.WriteInteger(ReadInt64);
-  end;
-end;
-
-function TReader.FindComponentClass(const AClassName: String): TComponentClass;
-begin
-  TPersistentClass(Result) := GetFieldClass(Root, AClassName);
-  if not Assigned(Result) and Assigned(FLookupRoot) and (FLookupRoot <> Root) then
-    TPersistentClass(Result) := GetFieldClass(FLookupRoot, AClassName);
-  if Assigned(FOnFindComponentClass) then
-    FOnFindComponentClass(Self, AClassName, Result);
-  if not (Assigned(Result) and Result.InheritsFrom(TComponent)) then
-    raise EClassNotFound.CreateFmt(SClassNotFound, [AClassName]);
-end;
-
-
-{
-  $Log: reader.inc,v $
-  Revision 1.4  2005/02/14 17:13:11  peter
-    * truncate log
-
-}

fcl/classes/streams.inc

@@ -1,793 +0,0 @@
-{
-    $Id: streams.inc,v 1.4 2005/02/14 17:13:11 peter Exp $
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1999-2000 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-{****************************************************************************}
-{*                             TStream                                      *}
-{****************************************************************************}
-
-{$ifdef seek64bit}
-  function TStream.GetPosition: Int64;
-
-    begin
-       Result:=Seek(0,soCurrent);
-    end;
-
-  procedure TStream.SetPosition(Pos: Int64);
-
-    begin
-       Seek(pos,soBeginning);
-    end;
-
-  procedure TStream.SetSize64(NewSize: Int64);
-
-    begin
-      // Required because can't use overloaded functions in properties
-      SetSize(NewSize);
-    end;
-
-  function TStream.GetSize: Int64;
-
-    var
-       p : longint;
-
-    begin
-       p:=GetPosition;
-       GetSize:=Seek(0,soEnd);
-       Seek(p,soBeginning);
-    end;
-
-  procedure TStream.SetSize(NewSize: Longint);
-
-    begin
-    // We do nothing. Pipe streams don't support this
-    // As wel as possible read-ony streams !!
-    end;
-
-  procedure TStream.SetSize(NewSize: Int64);
-
-    begin
-      // Backwards compatibility that calls the longint SetSize
-      if (NewSize<Low(longint)) or
-         (NewSize>High(longint)) then
-        raise ERangeError.Create(SRangeError);
-      SetSize(longint(NewSize));
-    end;
-
-  function TStream.Seek(Offset: Longint; Origin: Word): Longint;
-
-    type
-      TSeek64 = function(offset:Int64;Origin:TSeekorigin):Int64 of object;
-    var
-      CurrSeek,
-      TStreamSeek : TSeek64;
-      CurrClass   : TClass;
-    begin
-      // Redirect calls to 64bit Seek, but we can't call the 64bit Seek
-      // from TStream, because then we end up in an infinite loop
-      CurrSeek:=nil;
-      CurrClass:=Classtype;
-      while (CurrClass<>nil) and
-            (CurrClass<>TStream) do
-       CurrClass:=CurrClass.Classparent;
-      if CurrClass<>nil then
-       begin
-         CurrSeek:[email protected];
-         TStreamSeek:=@TStream(@CurrClass).Seek;
-         if TMethod(TStreamSeek).Code=TMethod(CurrSeek).Code then
-          CurrSeek:=nil;
-       end;
-      if CurrSeek<>nil then
-       Result:=Seek(Int64(offset),TSeekOrigin(origin))
-      else
-       raise EStreamError.CreateFmt(SSeekNotImplemented,[ClassName]);
-    end;
-
-  function TStream.Seek(Offset: Int64; Origin: TSeekorigin): Int64;
-
-    begin
-      // Backwards compatibility that calls the longint Seek
-      if (Offset<Low(longint)) or
-         (Offset>High(longint)) then
-        raise ERangeError.Create(SRangeError);
-      Result:=Seek(longint(Offset),ord(Origin));
-    end;
-
-{$else seek64bit}
-
-  function TStream.GetPosition: Longint;
-
-    begin
-       Result:=Seek(0,soFromCurrent);
-    end;
-
-  procedure TStream.SetPosition(Pos: Longint);
-
-    begin
-       Seek(pos,soFromBeginning);
-    end;
-
-  function TStream.GetSize: Longint;
-
-    var
-       p : longint;
-
-    begin
-       p:=GetPosition;
-       GetSize:=Seek(0,soFromEnd);
-       Seek(p,soFromBeginning);
-    end;
-
-  procedure TStream.SetSize(NewSize: Longint);
-
-    begin
-    // We do nothing. Pipe streams don't support this
-    // As wel as possible read-ony streams !!
-    end;
-
-{$endif seek64bit}
-
-  procedure TStream.ReadBuffer(var Buffer; Count: Longint);
-
-    begin
-       if Read(Buffer,Count)<Count then
-         Raise EReadError.Create(SReadError);
-    end;
-
-  procedure TStream.WriteBuffer(const Buffer; Count: Longint);
-
-    begin
-       if Write(Buffer,Count)<Count then
-         Raise EWriteError.Create(SWriteError);
-    end;
-
-  function TStream.CopyFrom(Source: TStream; Count: Int64): Int64;
-
-    var
-       i : Int64;
-       buffer : array[0..1023] of byte;
-
-    begin
-       CopyFrom:=0;
-       If (Count=0) then
-         begin
-         // This WILL fail for non-seekable streams...
-         Source.Position:=0;
-         Count:=Source.Size;
-         end;
-       while Count>0 do
-         begin
-         if (Count>sizeof(buffer)) then
-           i:=sizeof(Buffer)
-         else
-           i:=Count;
-         i:=Source.Read(buffer,i);
-         i:=Write(buffer,i);
-         dec(count,i);
-         CopyFrom:=CopyFrom+i;
-         end;
-    end;
-
-  function TStream.ReadComponent(Instance: TComponent): TComponent;
-
-    var
-      Reader: TReader;
-
-    begin
-
-      Reader := TReader.Create(Self, 4096);
-      try
-        Result := Reader.ReadRootComponent(Instance);
-      finally
-        Reader.Free;
-      end;
-
-    end;
-
-  function TStream.ReadComponentRes(Instance: TComponent): TComponent;
-
-    begin
-
-      ReadResHeader;
-      Result := ReadComponent(Instance);
-
-    end;
-
-  procedure TStream.WriteComponent(Instance: TComponent);
-
-    begin
-
-      WriteDescendent(Instance, nil);
-
-    end;
-
-  procedure TStream.WriteComponentRes(const ResName: string; Instance: TComponent);
-
-    begin
-
-      WriteDescendentRes(ResName, Instance, nil);
-
-    end;
-
-  procedure TStream.WriteDescendent(Instance, Ancestor: TComponent);
-
-    var
-       Driver : TAbstractObjectWriter;
-       Writer : TWriter;
-
-    begin
-
-       Driver := TBinaryObjectWriter.Create(Self, 4096);
-       Try
-         Writer := TWriter.Create(Driver);
-         Try
-           Writer.WriteDescendent(Instance, Ancestor);
-         Finally
-           Writer.Destroy;
-         end;
-       Finally
-         Driver.Free;
-       end;
-
-    end;
-
-  procedure TStream.WriteDescendentRes(const ResName: string; Instance, Ancestor: TComponent);
-
-    var
-      FixupInfo: Integer;
-
-    begin
-
-      { Write a resource header }
-      WriteResourceHeader(ResName, FixupInfo);
-      { Write the instance itself }
-      WriteDescendent(Instance, Ancestor);
-      { Insert the correct resource size into the resource header }
-      FixupResourceHeader(FixupInfo);
-
-    end;
-
-  procedure TStream.WriteResourceHeader(const ResName: string; {!!!: out} var FixupInfo: Integer);
-
-    begin
-       { Numeric resource type }
-       WriteByte($ff);
-       { Application defined data }
-       WriteWord($0a);
-       { write the name as asciiz }
-       WriteBuffer(ResName[1],length(ResName));
-       WriteByte(0);
-       { Movable, Pure and Discardable }
-       WriteWord($1030);
-       { Placeholder for the resource size }
-       WriteDWord(0);
-       { Return current stream position so that the resource size can be
-         inserted later }
-       FixupInfo := Position;
-    end;
-
-  procedure TStream.FixupResourceHeader(FixupInfo: Integer);
-
-    var
-       ResSize : Integer;
-
-    begin
-
-      ResSize := Position - FixupInfo;
-
-      { Insert the correct resource size into the placeholder written by
-        WriteResourceHeader }
-      Position := FixupInfo - 4;
-      WriteDWord(ResSize);
-      { Seek back to the end of the resource }
-      Position := FixupInfo + ResSize;
-
-    end;
-
-  procedure TStream.ReadResHeader;
-
-    begin
-       try
-         { application specific resource ? }
-         if ReadByte<>$ff then
-           raise EInvalidImage.Create(SInvalidImage);
-         if ReadWord<>$000a then
-           raise EInvalidImage.Create(SInvalidImage);
-         { read name }
-         while ReadByte<>0 do
-           ;
-         { check the access specifier }
-         if ReadWord<>$1030 then
-           raise EInvalidImage.Create(SInvalidImage);
-         { ignore the size }
-         ReadDWord;
-       except
-         on EInvalidImage do
-           raise;
-         else
-           raise EInvalidImage.create(SInvalidImage);
-       end;
-    end;
-
-  function TStream.ReadByte : Byte;
-
-    var
-       b : Byte;
-
-    begin
-       ReadBuffer(b,1);
-       ReadByte:=b;
-    end;
-
-  function TStream.ReadWord : Word;
-
-    var
-       w : Word;
-
-    begin
-       ReadBuffer(w,2);
-       ReadWord:=w;
-    end;
-
-  function TStream.ReadDWord : Cardinal;
-
-    var
-       d : Cardinal;
-
-    begin
-       ReadBuffer(d,4);
-       ReadDWord:=d;
-    end;
-
-  Function TStream.ReadAnsiString : String;
-  Type
-    PByte = ^Byte;
-  Var
-    TheSize : Longint;
-    P : PByte ;
-  begin
-    ReadBuffer (TheSize,SizeOf(TheSize));
-    SetLength(Result,TheSize);
-    // Illegal typecast if no AnsiStrings defined.
-    if TheSize>0 then
-     begin
-       ReadBuffer (Pointer(Result)^,TheSize);
-       P:=Pointer(Result)+TheSize;
-       p^:=0;
-     end;
-   end;
-
-  Procedure TStream.WriteAnsiString (S : String);
-
-  Var L : Longint;
-
-  begin
-    L:=Length(S);
-    WriteBuffer (L,SizeOf(L));
-    WriteBuffer (Pointer(S)^,L);
-  end;
-
-  procedure TStream.WriteByte(b : Byte);
-
-    begin
-       WriteBuffer(b,1);
-    end;
-
-  procedure TStream.WriteWord(w : Word);
-
-    begin
-       WriteBuffer(w,2);
-    end;
-
-  procedure TStream.WriteDWord(d : Cardinal);
-
-    begin
-       WriteBuffer(d,4);
-    end;
-
-
-{****************************************************************************}
-{*                             THandleStream                                *}
-{****************************************************************************}
-
-Constructor THandleStream.Create(AHandle: Integer);
-
-begin
-  FHandle:=AHandle;
-end;
-
-
-function THandleStream.Read(var Buffer; Count: Longint): Longint;
-
-begin
-  Result:=FileRead(FHandle,Buffer,Count);
-  If Result=-1 then Result:=0;
-end;
-
-
-function THandleStream.Write(const Buffer; Count: Longint): Longint;
-
-begin
-  Result:=FileWrite (FHandle,Buffer,Count);
-  If Result=-1 then Result:=0;
-end;
-
-{$ifdef seek64bit}
-
-Procedure THandleStream.SetSize(NewSize: Longint);
-
-begin
-  SetSize(Int64(NewSize));
-end;
-
-
-Procedure THandleStream.SetSize(NewSize: Int64);
-
-begin
-  FileTruncate(FHandle,NewSize);
-end;
-
-
-function THandleStream.Seek(Offset: Int64; Origin: TSeekOrigin): Int64;
-
-begin
-  Result:=FileSeek(FHandle,Offset,ord(Origin));
-end;
-
-{$else seek64bit}
-
-Procedure THandleStream.SetSize(NewSize: Longint);
-begin
-  FileTruncate(FHandle,NewSize);
-end;
-
-
-function THandleStream.Seek(Offset: Longint; Origin: Word): Longint;
-begin
-  Result:=FileSeek(FHandle,Offset,Origin);
-end;
-
-{$endif seek64bit}
-
-
-{****************************************************************************}
-{*                             TFileStream                                  *}
-{****************************************************************************}
-
-constructor TFileStream.Create(const AFileName: string; Mode: Word);
-
-begin
-  FFileName:=AFileName;
-  If Mode=fmcreate then
-    FHandle:=FileCreate(AFileName)
-  else
-    FHAndle:=FileOpen(AFileName,Mode);
-  If FHandle<0 then
-    If Mode=fmcreate then
-      raise EFCreateError.createfmt(SFCreateError,[AFileName])
-    else
-      raise EFOpenError.Createfmt(SFOpenError,[AFilename]);
-end;
-
-
-constructor TFileStream.Create(const AFileName: string; Mode: Word; Rights: Cardinal);
-
-begin
-  FFileName:=AFileName;
-  If Mode=fmcreate then
-    FHandle:=FileCreate(AFileName)
-  else
-    FHAndle:=FileOpen(AFileName,Mode);
-  If FHandle<0 then
-    If Mode=fmcreate then
-      raise EFCreateError.createfmt(SFCreateError,[AFileName])
-    else
-      raise EFOpenError.Createfmt(SFOpenError,[AFilename]);
-end;
-
-
-destructor TFileStream.Destroy;
-
-begin
-  FileClose(FHandle);
-end;
-
-{****************************************************************************}
-{*                             TCustomMemoryStream                          *}
-{****************************************************************************}
-
-procedure TCustomMemoryStream.SetPointer(Ptr: Pointer; ASize: Longint);
-
-begin
-  FMemory:=Ptr;
-  FSize:=ASize;
-end;
-
-
-function TCustomMemoryStream.Read(var Buffer; Count: Longint): Longint;
-
-begin
-  Result:=0;
-  If (FSize>0) and (FPosition<Fsize) then
-    begin
-    Result:=FSize-FPosition;
-    If Result>Count then Result:=Count;
-    Move ((FMemory+FPosition)^,Buffer,Result);
-    FPosition:=Fposition+Result;
-    end;
-end;
-
-
-function TCustomMemoryStream.Seek(Offset: Longint; Origin: Word): Longint;
-
-begin
-  Case Origin of
-    soFromBeginning : FPosition:=Offset;
-    soFromEnd       : FPosition:=FSize+Offset;
-    soFromCurrent   : FpoSition:=FPosition+Offset;
-  end;
-  Result:=FPosition;
-end;
-
-
-procedure TCustomMemoryStream.SaveToStream(Stream: TStream);
-
-begin
-  if FSize>0 then Stream.WriteBuffer (FMemory^,FSize);
-end;
-
-
-procedure TCustomMemoryStream.SaveToFile(const FileName: string);
-
-Var S : TFileStream;
-
-begin
-  Try
-    S:=TFileStream.Create (FileName,fmCreate);
-    SaveToStream(S);
-  finally
-    S.free;
-  end;
-end;
-
-
-{****************************************************************************}
-{*                             TMemoryStream                                *}
-{****************************************************************************}
-
-
-Const TMSGrow = 4096; { Use 4k blocks. }
-
-procedure TMemoryStream.SetCapacity(NewCapacity: Longint);
-
-begin
-  SetPointer (Realloc(NewCapacity),Fsize);
-  FCapacity:=NewCapacity;
-end;
-
-
-function TMemoryStream.Realloc(var NewCapacity: Longint): Pointer;
-
-Var MoveSize : Longint;
-
-begin
-  If NewCapacity>0 Then // round off to block size.
-    NewCapacity := (NewCapacity + (TMSGrow-1)) and not (TMSGROW-1);
-  // Only now check !
-  If NewCapacity=FCapacity then
-    Result:=FMemory
-  else
-    If NewCapacity=0 then
-      FreeMem (FMemory,Fcapacity)
-    else
-      begin
-      GetMem (Result,NewCapacity);
-      If Result=Nil then
-        Raise EStreamError.Create(SMemoryStreamError);
-      If FCapacity>0 then
-        begin
-        MoveSize:=FSize;
-        If MoveSize>NewCapacity then MoveSize:=NewCapacity;
-        Move (Fmemory^,Result^,MoveSize);
-        FreeMem (FMemory,FCapacity);
-        end;
-      end;
-end;
-
-
-destructor TMemoryStream.Destroy;
-
-begin
-  Clear;
-  Inherited Destroy;
-end;
-
-
-procedure TMemoryStream.Clear;
-
-begin
-  FSize:=0;
-  FPosition:=0;
-  SetCapacity (0);
-end;
-
-
-procedure TMemoryStream.LoadFromStream(Stream: TStream);
-
-begin
-  Stream.Position:=0;
-  SetSize(Stream.Size);
-  If FSize>0 then Stream.ReadBuffer(FMemory^,FSize);
-end;
-
-
-procedure TMemoryStream.LoadFromFile(const FileName: string);
-
-Var S : TFileStream;
-
-begin
-  S:=TFileStream.Create (FileName,fmOpenRead);
-  Try
-    LoadFromStream(S);
-  finally
-    S.free;
-  end;
-end;
-
-
-procedure TMemoryStream.SetSize(NewSize: Longint);
-
-begin
-  SetCapacity (NewSize);
-  FSize:=NewSize;
-  IF FPosition>FSize then
-    FPosition:=FSize;
-end;
-
-
-function TMemoryStream.Write(const Buffer; Count: Longint): Longint;
-
-Var NewPos : Longint;
-
-begin
-  If Count=0 then
-    exit(0);
-  NewPos:=FPosition+Count;
-  If NewPos>Fsize then
-    begin
-    IF NewPos>FCapacity then
-      SetCapacity (NewPos);
-    FSize:=Newpos;
-    end;
-  System.Move (Buffer,(FMemory+FPosition)^,Count);
-  FPosition:=NewPos;
-  Result:=Count;
-end;
-
-
-{****************************************************************************}
-{*                             TStringStream                                *}
-{****************************************************************************}
-
-procedure TStringStream.SetSize(NewSize: Longint);
-
-begin
- Setlength(FDataString,NewSize);
- If FPosition>NewSize then FPosition:=NewSize;
-end;
-
-
-constructor TStringStream.Create(const AString: string);
-
-begin
-  Inherited create;
-  FDataString:=AString;
-end;
-
-
-function TStringStream.Read(var Buffer; Count: Longint): Longint;
-
-begin
-  Result:=Length(FDataString)-FPosition;
-  If Result>Count then Result:=Count;
-  // This supposes FDataString to be of type AnsiString !
-  Move (Pchar(FDataString)[FPosition],Buffer,Result);
-  FPosition:=FPosition+Result;
-end;
-
-
-function TStringStream.ReadString(Count: Longint): string;
-
-Var NewLen : Longint;
-
-begin
-  NewLen:=Length(FDataString)-FPosition;
-  If NewLen>Count then NewLen:=Count;
-  SetLength(Result,NewLen);
-  Read (Pointer(Result)^,NewLen);
-end;
-
-
-function TStringStream.Seek(Offset: Longint; Origin: Word): Longint;
-
-begin
-  Case Origin of
-    soFromBeginning : FPosition:=Offset;
-    soFromEnd       : FPosition:=Length(FDataString)+Offset;
-    soFromCurrent   : FpoSition:=FPosition+Offset;
-  end;
-  If FPosition>Length(FDataString) then FPosition:=Length(FDataString);
-  If FPosition<0 then FPosition:=0;
-  Result:=FPosition;
-end;
-
-
-function TStringStream.Write(const Buffer; Count: Longint): Longint;
-
-begin
-  Result:=Count;
-  SetSize(FPosition+Count);
-  // This supposes that FDataString is of type AnsiString)
-  Move (Buffer,PCHar(FDataString)[Fposition],Count);
-  FPosition:=FPosition+Count;
-end;
-
-
-procedure TStringStream.WriteString(const AString: string);
-
-begin
-  Write (PChar(Astring)[0],Length(AString));
-end;
-
-
-
-{****************************************************************************}
-{*                             TResourceStream                              *}
-{****************************************************************************}
-
-procedure TResourceStream.Initialize(Instance: THandle; Name, ResType: PChar);
-
-begin
-end;
-
-
-constructor TResourceStream.Create(Instance: THandle; const ResName: string; ResType: PChar);
-
-begin
-end;
-
-
-constructor TResourceStream.CreateFromID(Instance: THandle; ResID: Integer; ResType: PChar);
-
-begin
-end;
-
-
-destructor TResourceStream.Destroy;
-
-begin
-end;
-
-
-function TResourceStream.Write(const Buffer; Count: Longint): Longint;
-
-begin
-  Write:=0;
-end;
-
-
-{
-  $Log: streams.inc,v $
-  Revision 1.4  2005/02/14 17:13:11  peter
-    * truncate log
-
- }

fcl/classes/stringl.inc

@@ -1,1057 +0,0 @@
-{
-    $Id: stringl.inc,v 1.3 2005/02/14 17:13:11 peter Exp $
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1999-2000 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-{****************************************************************************}
-{*                             TStrings                                     *}
-{****************************************************************************}
-
-// Function to quote text. Should move maybe to sysutils !!
-// Also, it is not clear at this point what exactly should be done.
-
-{ //!! is used to mark unsupported things. }
-
-Function QuoteString (Const S : String; Quote : String) : String;
-Var
-  I,J : Integer;
-begin
-  J:=0;
-  Result:=S;
-  for i:=1to length(s) do
-   begin
-     inc(j);
-     if S[i]=Quote then
-      begin
-        System.Insert(Quote,Result,J);
-        inc(j);
-      end;
-   end;
-  Result:=Quote+Result+Quote;
-end;
-
-
-function TStrings.GetCommaText: string;
-Var
-  I : integer;
-  p : pchar;
-begin
-  result:='';
-  For i:=0 to count-1 do
-   begin
-     p:=pchar(strings[i]);
-     while not(p^ in [#0..' ','"',',']) do
-      inc(p);
-     if p^<>#0 then
-      Result:=Result+QuoteString (Strings[I],'"')
-     else
-      result:=result+strings[i];
-     if I<Count-1 then Result:=Result+',';
-   end;
-  If Length(Result)=0 then
-   Result:='""';
-end;
-
-
-
-function TStrings.GetName(Index: Integer): string;
-
-Var L : longint;
-
-begin
-  Result:=Strings[Index];
-  L:=Pos('=',Result);
-  If L<>0 then
-    Result:=Copy(Result,1,L-1)
-  else
-    Result:='';
-end;
-
-
-
-Function TStrings.GetValue(const Name: string): string;
-
-Var L : longint;
-
-begin
-  Result:='';
-  L:=IndexOfName(Name);
-  If L<>-1 then
-    begin
-    Result:=Strings[L];
-    L:=Pos('=',Result);
-    System.Delete (Result,1,L);
-    end;
-end;
-
-
-
-procedure TStrings.ReadData(Reader: TReader);
-begin
-  Reader.ReadListBegin;
-  BeginUpdate;
-  try
-    Clear;
-    while not Reader.EndOfList do
-      Add(Reader.ReadString);
-  finally
-    EndUpdate;
-  end;
-  Reader.ReadListEnd;
-end;
-
-
-
-Function GetQuotedString (Var P : Pchar) : AnsiString;
-
-Var P1,L : Pchar;
-    ReplaceQuotes : boolean;
-
-begin
-  Result:='';
-  ReplaceQuotes := False;
-  P1:=P+1;
-  While P1^<>#0 do
-    begin
-      If (P1^='"') then
-       begin
-         if (P1[1]<>'"') then
-          break;
-         inc(p1);
-         ReplaceQuotes := True;
-       end;
-      inc(p1);
-    end;
-  // P1 points to last quote, or to #0;
-  P:=P+1;
-  If P1-P>0 then
-    begin
-    SetLength(Result,(P1-P));
-    L:=Pointer(Result);
-    Move (P^,L^,P1-P);
-    P:=P1+1;
-    end;
-  if ReplaceQuotes then
-    result := StringReplace (result, '""', '"', [rfReplaceAll]);
-end;
-
-
-Function GetNextQuotedChar (var P : PChar; Var S : String): Boolean;
-
-Var PS,L : PChar;
-
-begin
-  Result:=False;
-  S:='';
-  While (p^<>#0) and (byte(p^)<=byte(' ')) do
-   inc(p);
-  If P^=#0 then exit;
-  PS:=P;
-  If P^='"' then
-   begin
-     S:=GetQuotedString(P);
-     While (p^<>#0) and (byte(p^)<=byte(' ')) do
-      inc(p);
-   end
-  else
-   begin
-     While (p^>' ') and (P^<>',') do
-      inc(p);
-     Setlength (S,P-PS);
-     L:=Pointer(S);
-     Move (PS^,L^,P-PS);
-   end;
-  if p^=',' then
-   inc(p);
-  Result:=True;
-end;
-
-
-Procedure TStrings.SetCommaText(const Value: string);
-Var
-  P : PChar;
-  S : String;
-begin
-  BeginUpdate;
-  try
-    Clear;
-    P:=PChar(Value);
-    if assigned(p) then
-     begin
-       While GetNextQuotedChar (P,S) do
-        Add (S);
-     end;
-  finally
-    EndUpdate;
-  end;
-end;
-
-
-
-Procedure TStrings.SetStringsAdapter(const Value: IStringsAdapter);
-
-begin
-end;
-
-
-
-Procedure TStrings.SetValue(const Name, Value: string);
-
-Var L : longint;
-
-begin
-  L:=IndexOfName(Name);
-  if L=-1 then
-   Add (Name+'='+Value)
-  else
-   Strings[L]:=Name+'='+value;
-end;
-
-
-
-procedure TStrings.WriteData(Writer: TWriter);
-var
-  i: Integer;
-begin
-  Writer.WriteListBegin;
-  for i := 0 to Count - 1 do
-    Writer.WriteString(Strings[i]);
-  Writer.WriteListEnd;
-end;
-
-
-
-procedure TStrings.DefineProperties(Filer: TFiler);
-var
-  HasData: Boolean;
-begin
-  if Assigned(Filer.Ancestor) then
-    // Only serialize if string list is different from ancestor
-    if Filer.Ancestor.InheritsFrom(TStrings) then
-      HasData := not Equals(TStrings(Filer.Ancestor))
-    else
-      HasData := True
-  else
-    HasData := Count > 0;
-  Filer.DefineProperty('Strings', @ReadData, @WriteData, HasData);
-end;
-
-
-
-Procedure TStrings.Error(const Msg: string; Data: Integer);
-
-begin
-{$ifdef VER1_0}
-  Raise EStringListError.CreateFmt(Msg,[Data]) at longint(get_caller_addr(get_frame));
-{$else VER1_0}
-  Raise EStringListError.CreateFmt(Msg,[Data]) at get_caller_addr(get_frame);
-{$endif VER1_0}
-end;
-
-
-
-Function TStrings.GetCapacity: Integer;
-
-begin
-  Result:=Count;
-end;
-
-
-
-Function TStrings.GetObject(Index: Integer): TObject;
-
-begin
-  Result:=Nil;
-end;
-
-
-
-Function TStrings.GetTextStr: string;
-
-Const
-{$ifdef Unix}
-  NewLineSize=1;
-{$else}
-  NewLineSize=2;
-{$endif}
-
-Var P : Pchar;
-    I,L : Longint;
-    S : String;
-
-begin
-  // Determine needed place
-  L:=0;
-  For I:=0 to count-1 do
-    L:=L+Length(Strings[I])+NewLineSize;
-  Setlength(Result,L);
-  P:=Pointer(Result);
-  For i:=0 To count-1 do
-    begin
-    S:=Strings[I];
-    L:=Length(S);
-    if L<>0 then
-      System.Move(Pointer(S)^,P^,L);
-    P:=P+L;
-{$ifndef Unix}
-    p[0]:=#13;
-    p[1]:=#10;
-{$else}
-    p[0]:=#10;
-{$endif}
-    P:=P+NewLineSize;
-    end;
-end;
-
-
-
-Procedure TStrings.Put(Index: Integer; const S: string);
-
-Var Obj : TObject;
-
-begin
-  Obj:=Objects[Index];
-  Delete(Index);
-  InsertObject(Index,S,Obj);
-end;
-
-
-
-Procedure TStrings.PutObject(Index: Integer; AObject: TObject);
-
-begin
-  // Empty.
-end;
-
-
-
-Procedure TStrings.SetCapacity(NewCapacity: Integer);
-
-begin
-  // Empty.
-end;
-
-
-Procedure TStrings.SetTextStr(const Value: string);
-
-begin
-  SetText(PChar(Value));
-end;
-
-
-
-Procedure TStrings.SetUpdateState(Updating: Boolean);
-
-begin
-end;
-
-
-
-destructor TSTrings.Destroy;
-
-begin
-  inherited destroy;
-end;
-
-
-
-Function TStrings.Add(const S: string): Integer;
-
-begin
-  Result:=Count;
-  Insert (Count,S);
-end;
-
-
-
-Function TStrings.AddObject(const S: string; AObject: TObject): Integer;
-
-begin
-  Result:=Add(S);
-  Objects[result]:=AObject;
-end;
-
-
-
-Procedure TStrings.Append(const S: string);
-
-begin
-  Add (S);
-end;
-
-
-
-Procedure TStrings.AddStrings(TheStrings: TStrings);
-
-Var Runner : longint;
-
-begin
-  try
-    beginupdate;
-    For Runner:=0 to TheStrings.Count-1 do
-      self.AddObject (Thestrings[Runner],TheStrings.Objects[Runner]);
-  finally
-    EndUpdate;
-  end;
-end;
-
-
-
-Procedure TStrings.Assign(Source: TPersistent);
-
-begin
-  Try
-    BeginUpdate;
-    If Source is TStrings then
-      begin
-      clear;
-      AddStrings(TStrings(Source));
-      exit;
-      end;
-    Inherited Assign(Source);
-  finally
-    EndUpdate;
-  end;
-end;
-
-
-
-Procedure TStrings.BeginUpdate;
-
-begin
-   inc(FUpdateCount);
-   if FUpdateCount = 1 then SetUpdateState(true);
-end;
-
-
-
-Procedure TStrings.EndUpdate;
-
-begin
-  If FUpdateCount>0 then
-     Dec(FUpdateCount);
-  if FUpdateCount=0 then
-    SetUpdateState(False);
-end;
-
-
-
-Function TStrings.Equals(TheStrings: TStrings): Boolean;
-
-Var Runner,Nr : Longint;
-
-begin
-  Result:=False;
-  Nr:=Self.Count;
-  if Nr<>TheStrings.Count then exit;
-  For Runner:=0 to Nr-1 do
-    If Strings[Runner]<>TheStrings[Runner] then exit;
-  Result:=True;
-end;
-
-
-
-Procedure TStrings.Exchange(Index1, Index2: Integer);
-
-Var
-  Obj : TObject;
-  Str : String;
-
-begin
-  Try
-    beginUpdate;
-    Obj:=Objects[Index1];
-    Str:=Strings[Index1];
-    Objects[Index1]:=Objects[Index2];
-    Strings[Index1]:=Strings[Index2];
-    Objects[Index2]:=Obj;
-    Strings[Index2]:=Str;
-  finally
-    EndUpdate;
-  end;
-end;
-
-
-
-Function TStrings.GetText: PChar;
-
-begin
-  Result:=StrNew(Pchar(Self.Text));
-end;
-
-
-
-Function TStrings.IndexOf(const S: string): Integer;
-
-
-begin
-  Result:=0;
-  While (Result<Count) and (CompareText(Strings[Result],S)<>0) do Result:=Result+1;
-  if Result=Count then Result:=-1;
-end;
-
-
-
-Function TStrings.IndexOfName(const Name: string): Integer;
-
-Var
-  len : longint;
-  S : String;
-
-begin
-  Result:=0;
-  while (Result<Count) do
-    begin
-    S:=Strings[Result];
-    len:=pos('=',S)-1;
-    if (len>0) and (CompareText(Name,Copy(S,1,Len))=0) then
-      exit;
-    inc(result);
-    end;
-  result:=-1;
-end;
-
-
-
-Function TStrings.IndexOfObject(AObject: TObject): Integer;
-
-begin
-  Result:=0;
-  While (Result<count) and (Objects[Result]<>AObject) do Result:=Result+1;
-  If Result=Count then Result:=-1;
-end;
-
-
-
-Procedure TStrings.InsertObject(Index: Integer; const S: string;
-  AObject: TObject);
-
-begin
-  Insert (Index,S);
-  Objects[Index]:=AObject;
-end;
-
-
-
-Procedure TStrings.LoadFromFile(const FileName: string);
-
-Var TheStream : TFileStream;
-
-begin
-  TheStream:=TFileStream.Create(FileName,fmOpenRead);
-  LoadFromStream(TheStream);
-  TheStream.Free;
-end;
-
-
-
-Procedure TStrings.LoadFromStream(Stream: TStream);
-{
-   Borlands method is no good, since a pipe for
-   instance doesn't have a size.
-   So we must do it the hard way.
-}
-Const
-  BufSize = 1024;
-Var
-  Buffer     : Pointer;
-  BytesRead,
-  BufLen     : Longint;
-begin
-  // reread into a buffer
-  try
-    beginupdate;
-    Buffer:=Nil;
-    BufLen:=0;
-    Repeat
-      ReAllocMem(Buffer,BufLen+BufSize);
-      BytesRead:=Stream.Read((Buffer+BufLen)^,BufSize);
-      inc(BufLen,BufSize);
-    Until BytesRead<>BufSize;
-    // Null-terminate !!
-    Pchar(Buffer)[BufLen-BufSize+BytesRead]:=#0;
-    Text:=PChar(Buffer);
-    FreeMem(Buffer);
-  finally
-    EndUpdate;
-  end;
-end;
-
-
-Procedure TStrings.Move(CurIndex, NewIndex: Integer);
-Var
-  Obj : TObject;
-  Str : String;
-begin
-  BeginUpdate;
-  Obj:=Objects[CurIndex];
-  Str:=Strings[CurIndex];
-  Delete(Curindex);
-  InsertObject(NewIndex,Str,Obj);
-  EndUpdate;
-end;
-
-
-
-Procedure TStrings.SaveToFile(const FileName: string);
-
-Var TheStream : TFileStream;
-
-begin
-  TheStream:=TFileStream.Create(FileName,fmCreate);
-  SaveToStream(TheStream);
-  TheStream.Free;
-end;
-
-
-
-Procedure TStrings.SaveToStream(Stream: TStream);
-Var
-  S : String;
-begin
-  S:=Text;
-  Stream.Write(Pointer(S)^,Length(S));
-end;
-
-
-Function GetNextLine (Var P : Pchar; Var S : String) : Boolean;
-
-Var PS : PChar;
-
-begin
-  S:='';
-  Result:=False;
-  If P^=#0 then exit;
-  PS:=P;
-  While not (P^ in [#0,#10,#13]) do P:=P+1;
-  SetLength (S,P-PS);
-  System.Move (PS^,Pointer(S)^,P-PS);
-  If P^=#13 then P:=P+1;
-  If P^=#10 then
-    P:=P+1; // Point to character after #10(#13)
-  Result:=True;
-end;
-
-
-Procedure TStrings.SetText(TheText: PChar);
-
-Var S : String;
-
-begin
-  Try
-    beginUpdate;
-    Clear;
-    While GetNextLine (TheText,S) do
-    Add(S);
-  finally
-    EndUpdate;
-  end;
-end;
-
-
-{****************************************************************************}
-{*                             TStringList                                  *}
-{****************************************************************************}
-
-
-
-Procedure TStringList.ExchangeItems(Index1, Index2: Integer);
-
-Var P1,P2 : Pointer;
-
-begin
-  P1:=Pointer(Flist^[Index1].FString);
-  P2:=Pointer(Flist^[Index1].FObject);
-  Pointer(Flist^[Index1].Fstring):=Pointer(Flist^[Index2].Fstring);
-  Pointer(Flist^[Index1].FObject):=Pointer(Flist^[Index2].FObject);
-  Pointer(Flist^[Index2].Fstring):=P1;
-  Pointer(Flist^[Index2].FObject):=P2;
-end;
-
-
-
-Procedure TStringList.Grow;
-
-Var Extra : Longint;
-
-begin
-  If FCapacity>64 then
-    Extra:=FCapacity Div 4
-  Else If FCapacity>8 Then
-    Extra:=16
-  Else
-    Extra:=4;
-  SetCapacity(FCapacity+Extra);
-end;
-
-
-
-Procedure TStringList.QuickSort(L, R: Integer; CompareFn: TStringListSortCompare);
-
-Var I,J, Pivot : Longint;
-
-begin
-  Repeat
-    I:=L;
-    J:=R;
-    Pivot:=(L+R) div 2;
-    Repeat
-      While CompareFn(Self, I, Pivot)<0 do Inc(I);
-      While CompareFn(Self, J, Pivot)>0 do Dec(J);
-      If I<=J then
-        begin
-        ExchangeItems(I,J); // No check, indices are correct.
-        if Pivot=I then
-          Pivot:=J
-        else if Pivot=J then
-          Pivot := I;
-        Inc(I);
-        Dec(j);
-        end;
-    until I>J;
-    If L<J then QuickSort(L,J, CompareFn);
-    L:=I;
-  Until I>=R;
-end;
-
-
-
-Procedure TStringList.InsertItem(Index: Integer; const S: string);
-
-begin
-  Changing;
-  If FCount=Fcapacity then Grow;
-  If Index<FCount then
-    System.Move (FList^[Index],FList^[Index+1],
-                 (FCount-Index)*SizeOf(TStringItem));
-  Pointer(Flist^[Index].Fstring):=Nil;  // Needed to initialize...
-  Flist^[Index].FString:=S;
-  Flist^[Index].Fobject:=Nil;
-  Inc(FCount);
-  Changed;
-end;
-
-
-
-Procedure TStringList.SetSorted(Value: Boolean);
-
-begin
-  If FSorted<>Value then
-    begin
-    If Value then sort;
-    FSorted:=VAlue
-    end;
-end;
-
-
-
-Procedure TStringList.Changed;
-
-begin
-  If (FUpdateCount=0) Then
-   If Assigned(FOnChange) then
-     FOnchange(Self);
-end;
-
-
-
-Procedure TStringList.Changing;
-
-begin
-  If FUpdateCount=0 then
-    if Assigned(FOnChanging) then
-      FOnchanging(Self);
-end;
-
-
-
-Function TStringList.Get(Index: Integer): string;
-
-begin
-  If (Index<0) or (INdex>=Fcount)  then
-    Error (SListIndexError,Index);
-  Result:=Flist^[Index].FString;
-end;
-
-
-
-Function TStringList.GetCapacity: Integer;
-
-begin
-  Result:=FCapacity;
-end;
-
-
-
-Function TStringList.GetCount: Integer;
-
-begin
-  Result:=FCount;
-end;
-
-
-
-Function TStringList.GetObject(Index: Integer): TObject;
-
-begin
-  If (Index<0) or (INdex>=Fcount)  then
-    Error (SListIndexError,Index);
-  Result:=Flist^[Index].FObject;
-end;
-
-
-
-Procedure TStringList.Put(Index: Integer; const S: string);
-
-begin
-  If Sorted then
-    Error(SSortedListError,0);
-  If (Index<0) or (INdex>=Fcount)  then
-    Error (SListIndexError,Index);
-  Changing;
-  Flist^[Index].FString:=S;
-  Changed;
-end;
-
-
-
-Procedure TStringList.PutObject(Index: Integer; AObject: TObject);
-
-begin
-  If (Index<0) or (INdex>=Fcount)  then
-    Error (SListIndexError,Index);
-  Changing;
-  Flist^[Index].FObject:=AObject;
-  Changed;
-end;
-
-
-
-Procedure TStringList.SetCapacity(NewCapacity: Integer);
-
-Var NewList : Pointer;
-    MSize : Longint;
-
-begin
-  If (NewCapacity<0) then
-     Error (SListCapacityError,NewCapacity);
-  If NewCapacity>FCapacity then
-    begin
-    GetMem (NewList,NewCapacity*SizeOf(TStringItem));
-    If NewList=Nil then
-      Error (SListCapacityError,NewCapacity);
-    If Assigned(FList) then
-      begin
-      MSize:=FCapacity*Sizeof(TStringItem);
-      System.Move (FList^,NewList^,MSize);
-      FillWord (Pchar(NewList)[MSize],(NewCapacity-FCapacity)*WordRatio, 0);
-      FreeMem (Flist,MSize);
-      end;
-    Flist:=NewList;
-    FCapacity:=NewCapacity;
-    end
-  else if NewCapacity<FCapacity then
-    begin
-    if NewCapacity = 0 then
-    begin
-      FreeMem(FList);
-      FList := nil;
-    end else
-    begin
-      GetMem(NewList, NewCapacity * SizeOf(TStringItem));
-      System.Move(FList^, NewList^, NewCapacity * SizeOf(TStringItem));
-      FreeMem(FList);
-      FList := NewList;
-    end;
-    FCapacity:=NewCapacity;
-    end;
-end;
-
-
-
-Procedure TStringList.SetUpdateState(Updating: Boolean);
-
-begin
-  If Updating then
-    Changing
-  else
-    Changed
-end;
-
-
-
-destructor TStringList.Destroy;
-
-Var I : Longint;
-
-begin
-  FOnChange:=Nil;
-  FOnChanging:=Nil;
-  // This will force a dereference. Can be done better...
-  For I:=0 to FCount-1 do
-    FList^[I].FString:='';
-  FCount:=0;
-  SetCapacity(0);
-  Inherited destroy;
-end;
-
-
-
-Function TStringList.Add(const S: string): Integer;
-
-begin
-  If Not Sorted then
-    Result:=FCount
-  else
-    If Find (S,Result) then
-      Case DUplicates of
-        DupIgnore : Exit;
-        DupError : Error(SDuplicateString,0)
-      end;
-   InsertItem (Result,S);
-end;
-
-
-
-Procedure TStringList.Clear;
-
-Var I : longint;
-
-begin
-  if FCount = 0 then Exit;
-  Changing;
-  For I:=0 to FCount-1 do
-    Flist^[I].FString:='';
-  FCount:=0;
-  SetCapacity(0);
-  Changed;
-end;
-
-
-
-Procedure TStringList.Delete(Index: Integer);
-
-begin
-  If (Index<0) or (Index>=FCount) then
-    Error(SlistINdexError,Index);
-  Changing;
-  Flist^[Index].FString:='';
-  Dec(FCount);
-  If Index<FCount then
-    System.Move(Flist^[Index+1],
-                Flist^[Index],
-                (Fcount-Index)*SizeOf(TStringItem));
-  Changed;
-end;
-
-
-
-Procedure TStringList.Exchange(Index1, Index2: Integer);
-
-begin
-  If (Index1<0) or (Index1>=FCount) then
-    Error(SListIndexError,Index1);
-  If (Index2<0) or (Index2>=FCount) then
-    Error(SListIndexError,Index2);
-  Changing;
-  ExchangeItems(Index1,Index2);
-  changed;
-end;
-
-Function TStringList.Find(const S: string; var Index: Integer): Boolean;
-
-{ Searches for the first string <= S, returns True if exact match,
-  sets index to the index f the found string. }
-
-Var I,L,R,Temp : Longint;
-
-begin
-  Result:=False;
-  // Use binary search.
-  L:=0;
-  R:=FCount-1;
-  While L<=R do
-    begin
-    I:=(L+R) div 2;
-    Temp:=AnsiCompareText(FList^ [I].FString,S);
-    If Temp<0 then
-      L:=I+1
-    else
-      begin
-      R:=I-1;
-      If Temp=0 then
-        begin
-        Result:=True;
-        If Duplicates<>DupAccept then L:=I;
-        end;
-      end;
-    end;
-  Index:=L;
-end;
-
-
-
-Function TStringList.IndexOf(const S: string): Integer;
-
-begin
-  If Not Sorted then
-    Result:=Inherited indexOf(S)
-  else
-    // faster using binary search...
-    If Not Find (S,Result) then
-      Result:=-1;
-end;
-
-
-
-Procedure TStringList.Insert(Index: Integer; const S: string);
-
-begin
-  If Sorted then
-    Error (SSortedListError,0)
-  else
-    If (Index<0) or (Index>FCount) then
-      Error (SListIndexError,Index)
-    else
-      InsertItem (Index,S);
-end;
-
-
-Procedure TStringList.CustomSort(CompareFn: TStringListSortCompare);
-
-begin
-  If Not Sorted and (FCount>1) then
-    begin
-    Changing;
-    QuickSort(0,FCount-1, CompareFn);
-    Changed;
-    end;
-end;
-
-function StringListAnsiCompare(List: TStringList; Index1, Index: Integer): Integer;
-
-begin
-  Result := AnsiCompareText(List.FList^[Index1].FString,
-    List.FList^[Index].FString);
-end;
-
-Procedure TStringList.Sort;
-
-begin
-  CustomSort(@StringListAnsiCompare);
-end;
-
-{
-  $Log: stringl.inc,v $
-  Revision 1.3  2005/02/14 17:13:11  peter
-    * truncate log
-
-}

fcl/classes/twriter.inc

@@ -1,221 +0,0 @@
-{
-    $Id: twriter.inc,v 1.2 2005/02/14 17:13:11 peter Exp $
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1999-2000 by Michael Van Canneyt and Florian Klaempfl
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-(*Procedure TTextWriter.WriteLn(Const Msg : String);
-
-Const CRLF = #10;
-
-begin
-  Write(Msg+CRLF);
-end;
-
-Procedure TTextWriter.Write(Const Msg : String);
-
-Var S : String;
-
-begin
-  S:=FPrefix+Msg;
-  FStream.Write(Pointer(S)^,Length(S));
-end;
-
-
-Procedure TTextWriter.WriteFmt(Fmt : String; Args :  Array of const);
-
-begin
-  Writeln(Format(Fmt,Args));
-end;
-
-Procedure TTextWriter.StartObject(Const AClassName, AName : String);
-
-begin
-  WriteFmt('Object %s %s',[AName,AClassName]);
-  FPrefix:=FPrefix+'  ';
-end;
-
-Procedure TTextWriter.EndObject;
-
-Var L : longint;
-
-begin
-  L:=Length(FPrefix);
-  If L>2 Then
-    SetLength(FPrefix,L-2);
-  Writeln('end');
-end;
-
-Procedure TTextWriter.StartCollection(Const AName : String);
-
-begin
-  WriteFmt('%s = (',[AName]);
-  FPrefix:=FPrefix+'  ';
-end;
-
-Procedure TTextWriter.StartCollectionItem;
-
-begin
-end;
-
-Procedure TTextWriter.EndCollectionItem;
-
-begin
-end;
-
-Procedure TTextWriter.EndCollection;
-
-Var L : longint;
-
-begin
-  L:=Length(FPrefix);
-  If L>2 Then
-    SetLength(FPrefix,L-2);
-  Writeln(')');
-end;
-
-
-Procedure TTextWriter.WritePropName(const PropName: string);
-
-begin
-  Writeln(PropName);
-end;
-
-Constructor TTextWriter.Create(S : TStream);
-
-begin
-  Inherited Create;
-  FStream:=S;
-  FPrefix:='';
-end;
-
-Destructor TTextWriter.Destroy;
-
-begin
-end;
-
-Procedure TTextWriter.WriteIntegerProperty(Const Name : Shortstring;Value : Longint);
-
-begin
-  WriteFmt('%s = %d',[Name,Value]);
-end;
-
-Procedure TTextWriter.WriteSetProperty (Const Name : ShortString;Value : longint; BaseType : TTypeInfo);
-
-begin
-  //!! needs implementing.
-  WriteFmt('%s = []',[Name]);
-end;
-
-Procedure TTextWriter.WriteEnumerationProperty (Const Name : ShortString;Value : Longint; Const EnumName : ShortSTring);
-
-begin
-  WriteFmt('%s = %s',[Name,EnumName])
-end;
-
-Procedure TTextWriter.WriteStringProperty(Const Name : ShortString; Const Value : String);
-
-Type
-  TMode = (quoted,unquoted);
-
-Var
-  Mode : TMode;
-  S : String;
-  I,L : Longint;
-  c : char;
-
-   Procedure Add (A : String);
-
-   begin
-     S:=S+A;
-   end;
-
-begin
-  L:=Length(Value);
-  Mode:=unquoted;
-  S:=Name+' = ';
-  For I:=1 to L do
-    begin
-    C:=Value[i];
-    If (ord(C)>31) and (Ord(c)<=128) and (c<>'''') then
-      begin
-      If mode=Quoted then
-        Add(c)
-      else
-        begin
-        Add(''''+c);
-        mode:=quoted
-        end
-      end
-    else
-      begin
-      If Mode=quoted then
-        begin
-        Add('''');
-        mode:=unquoted;
-        end;
-      Add(Format('#%d',[ord(c)]));
-      end;
-    If Length(S)>72 then
-      begin
-      if mode=quoted then
-        Add ('''');
-      Add('+');
-      Writeln(S);
-      Mode:=unQuoted;
-      end;
-    end;
- if mode=quoted then Add('''');
- Writeln(S);
-end;
-
-Procedure TTextWriter.WriteFloatProperty(Const Name : ShortString; Value : Extended);
-
-begin
-  WriteFmt('%s = %e',[Name,Value])
-end;
-
-Procedure TTextWriter.WriteCollectionProperty(Const Name : ShortString;Value : TCollection);
-
-begin
-
-end;
-
-Procedure TTextWriter.WriteClassProperty(Instance : TPersistent;Propinfo :PPropInfo);
-
-begin
-end;
-
-Procedure TTextWriter.WriteComponentProperty(Const Name : ShortSTring; Value : TComponent);
-
-begin
-  WriteFmt ('%s = %s',[Name,Value.Name]);
-end;
-
-Procedure TTextWriter.WriteNilProperty(Const Name : Shortstring);
-
-begin
-  system.Writeln(stderr,'Nil : ',Name);
-  WriteFmt ('%s = Nil',[Name])
-end;
-
-Procedure TTextWriter.WriteMethodProperty(Const Name,AMethodName : ShortString);
-
-begin
-  WriteFmt ('%s = %s',[Name,AMethodName]);
-end;*)
-
-{
-  $Log: twriter.inc,v $
-  Revision 1.2  2005/02/14 17:13:11  peter
-    * truncate log
-
-}

fcl/classes/util.inc

@@ -1,32 +0,0 @@
-{
-    $Id: util.inc,v 1.2 2005/02/14 17:13:11 peter Exp $
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1999-2000 by Michael Van Canneyt and Florian Klaempfl
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-Function IntToStr (I : Longint) : String;
-
-begin
-  Str(I,Result);
-end;
-
-function IsValidIdent(const Ident: string): Boolean;
-
-begin
-  Result:=True;
-end;
-
-{
-  $Log: util.inc,v $
-  Revision 1.2  2005/02/14 17:13:11  peter
-    * truncate log
-
-}

fcl/classes/win32/classes.pp

@@ -1,57 +0,0 @@
-{
-    $Id: classes.pp,v 1.2 2005/02/14 17:13:12 peter Exp $
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1998 by Michael Van Canneyt and Florian Klaempfl
-
-    Classes unit for win32
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-{$mode objfpc}
-
-{ Require threading }
-{$ifndef ver1_0}
-  {$threading on}
-{$endif ver1_0}
-
-{ determine the type of the resource/form file }
-{$define Win16Res}
-
-unit Classes;
-
-interface
-
-uses
-  sysutils,
-  typinfo;
-
-{$i classesh.inc}
-
-implementation
-
-uses
-  windows;
-
-{ OS - independent class implementations are in /inc directory. }
-{$i classes.inc}
-
-initialization
-  CommonInit;
-
-finalization
-  CommonCleanup;
-
-end.
-{
-  $Log: classes.pp,v $
-  Revision 1.2  2005/02/14 17:13:12  peter
-    * truncate log
-
-}

fcl/classes/writer.inc

@@ -1,840 +0,0 @@
-{
-    $Id: writer.inc,v 1.3 2005/02/14 17:13:11 peter Exp $
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1999-2000 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-
-{****************************************************************************}
-{*                         TBinaryObjectWriter                              *}
-{****************************************************************************}
-
-constructor TBinaryObjectWriter.Create(Stream: TStream; BufSize: Integer);
-begin
-  inherited Create;
-  FStream := Stream;
-  FBufSize := BufSize;
-  GetMem(FBuffer, BufSize);
-end;
-
-destructor TBinaryObjectWriter.Destroy;
-begin
-  // Flush all data which hasn't been written yet
-  FlushBuffer;
-
-  if Assigned(FBuffer) then
-    FreeMem(FBuffer, FBufSize);
-
-  inherited Destroy;
-end;
-
-procedure TBinaryObjectWriter.BeginCollection;
-begin
-  WriteValue(vaCollection);
-end;
-
-procedure TBinaryObjectWriter.BeginComponent(Component: TComponent;
-  Flags: TFilerFlags; ChildPos: Integer);
-var
-  Prefix: Byte;
-begin
-  if not FSignatureWritten then
-  begin
-    Write(FilerSignature, SizeOf(FilerSignature));
-    FSignatureWritten := True;
-  end;
-
-  { Only write the flags if they are needed! }
-  if Flags <> [] then
-  begin
-    Prefix := Integer(Flags) or $f0;
-    Write(Prefix, 1);
-    if ffChildPos in Flags then
-      WriteInteger(ChildPos);
-  end;
-
-  WriteStr(Component.ClassName);
-  WriteStr(Component.Name);
-end;
-
-procedure TBinaryObjectWriter.BeginList;
-begin
-  WriteValue(vaList);
-end;
-
-procedure TBinaryObjectWriter.EndList;
-begin
-  WriteValue(vaNull);
-end;
-
-procedure TBinaryObjectWriter.BeginProperty(const PropName: String);
-begin
-  WriteStr(PropName);
-end;
-
-procedure TBinaryObjectWriter.EndProperty;
-begin
-end;
-
-procedure TBinaryObjectWriter.WriteBinary(const Buffer; Count: LongInt);
-begin
-  WriteValue(vaBinary);
-  Write(Count, 4);
-  Write(Buffer, Count);
-end;
-
-procedure TBinaryObjectWriter.WriteBoolean(Value: Boolean);
-begin
-  if Value then
-    WriteValue(vaTrue)
-  else
-    WriteValue(vaFalse);
-end;
-
-procedure TBinaryObjectWriter.WriteFloat(const Value: Extended);
-begin
-  WriteValue(vaExtended);
-  Write(Value, SizeOf(Value));
-end;
-
-procedure TBinaryObjectWriter.WriteSingle(const Value: Single);
-begin
-  WriteValue(vaSingle);
-  Write(Value, SizeOf(Value));
-end;
-
-{!!!: procedure TBinaryObjectWriter.WriteCurrency(const Value: Currency);
-begin
-  WriteValue(vaCurrency);
-  Write(Value, SizeOf(Value));
-end;}
-
-procedure TBinaryObjectWriter.WriteDate(const Value: TDateTime);
-begin
-  WriteValue(vaDate);
-  Write(Value, SizeOf(Value));
-end;
-
-procedure TBinaryObjectWriter.WriteIdent(const Ident: string);
-begin
-  { Check if Ident is a special identifier before trying to just write
-    Ident directly }
-  if UpperCase(Ident) = 'NIL' then
-    WriteValue(vaNil)
-  else if UpperCase(Ident) = 'FALSE' then
-    WriteValue(vaFalse)
-  else if UpperCase(Ident) = 'TRUE' then
-    WriteValue(vaTrue)
-  else if UpperCase(Ident) = 'NULL' then
-    WriteValue(vaNull) else
-  begin
-    WriteValue(vaIdent);
-    WriteStr(Ident);
-  end;
-end;
-
-procedure TBinaryObjectWriter.WriteInteger(Value: Int64);
-begin
-  { Use the smallest possible integer type for the given value: }
-  if (Value >= -128) and (Value <= 127) then
-  begin
-    WriteValue(vaInt8);
-    Write(Value, 1);
-  end else if (Value >= -32768) and (Value <= 32767) then
-  begin
-    WriteValue(vaInt16);
-    Write(Value, 2);
-  end else if (Value >= -$80000000) and (Value <= $7fffffff) then
-  begin
-    WriteValue(vaInt32);
-    Write(Value, 4);
-  end else
-  begin
-    WriteValue(vaInt64);
-    Write(Value, 8);
-  end;
-end;
-
-procedure TBinaryObjectWriter.WriteMethodName(const Name: String);
-begin
-  if Length(Name) > 0 then
-  begin
-    WriteValue(vaIdent);
-    WriteStr(Name);
-  end else
-    WriteValue(vaNil);
-end;
-
-procedure TBinaryObjectWriter.WriteSet(Value: LongInt; SetType: Pointer);
-var
-  i: Integer;
-  Mask: LongInt;
-begin
-  WriteValue(vaSet);
-  Mask := 1;
-  for i := 0 to 31 do
-  begin
-    if (Value and Mask) <> 0 then
-      WriteStr(GetEnumName(PTypeInfo(SetType), i));
-    Mask := Mask shl 1;
-  end;
-  WriteStr('');
-end;
-
-procedure TBinaryObjectWriter.WriteString(const Value: String);
-var
-  i: Integer;
-begin
-  i := Length(Value);
-  if i <= 255 then
-  begin
-    WriteValue(vaString);
-    Write(i, 1);
-  end else
-  begin
-    WriteValue(vaLString);
-    Write(i, 4);
-  end;
-  if i > 0 then
-    Write(Value[1], i);
-end;
-
-{!!!: procedure TBinaryObjectWriter.WriteWideString(const Value: WideString);
-var
-  i: Integer;
-begin
-  WriteValue(vaWString);
-  i := Length(Value);
-  Write(i, 4);
-  Write(Value[1], i * 2);
-end;}
-
-procedure TBinaryObjectWriter.FlushBuffer;
-begin
-  FStream.WriteBuffer(FBuffer^, FBufPos);
-  FBufPos := 0;
-end;
-
-procedure TBinaryObjectWriter.Write(const Buffer; Count: LongInt);
-var
-  CopyNow: LongInt;
-  SourceBuf: PChar;
-begin
-  SourceBuf:=@Buffer;
-  while Count > 0 do
-  begin
-    CopyNow := Count;
-    if CopyNow > FBufSize - FBufPos then
-      CopyNow := FBufSize - FBufPos;
-    Move(SourceBuf^, PChar(FBuffer)[FBufPos], CopyNow);
-    Dec(Count, CopyNow);
-    Inc(FBufPos, CopyNow);
-    inc(SourceBuf, CopyNow);
-    if FBufPos = FBufSize then
-      FlushBuffer;
-  end;
-end;
-
-procedure TBinaryObjectWriter.WriteValue(Value: TValueType);
-begin
-  Write(Value, 1);
-end;
-
-procedure TBinaryObjectWriter.WriteStr(const Value: String);
-var
-  i: Integer;
-begin
-  i := Length(Value);
-  if i > 255 then
-    i := 255;
-  Write(i, 1);
-  if i > 0 then
-    Write(Value[1], i);
-end;
-
-
-
-{****************************************************************************}
-{*                             TWriter                                      *}
-{****************************************************************************}
-
-
-constructor TWriter.Create(ADriver: TAbstractObjectWriter);
-begin
-  inherited Create;
-  FDriver := ADriver;
-end;
-
-constructor TWriter.Create(Stream: TStream; BufSize: Integer);
-begin
-  inherited Create;
-  FDriver := TBinaryObjectWriter.Create(Stream, BufSize);
-  FDestroyDriver := True;
-end;
-
-destructor TWriter.Destroy;
-begin
-  if FDestroyDriver then
-    FDriver.Free;
-  inherited Destroy;
-end;
-
-// Used as argument for calls to TComponent.GetChildren:
-procedure TWriter.AddToAncestorList(Component: TComponent);
-begin
-  FAncestorList.Add(Component);
-end;
-
-procedure TWriter.DefineProperty(const Name: String;
-  ReadData: TReaderProc; AWriteData: TWriterProc; HasData: Boolean);
-begin
-  if HasData and Assigned(AWriteData) then
-  begin
-    // Write the property name and then the data itself
-    Driver.BeginProperty(FPropPath + Name);
-    AWriteData(Self);
-    Driver.EndProperty;
-  end;
-end;
-
-procedure TWriter.DefineBinaryProperty(const Name: String;
-  ReadData, AWriteData: TStreamProc; HasData: Boolean);
-begin
-  if HasData and Assigned(AWriteData) then
-  begin
-    // Write the property name and then the data itself
-    Driver.BeginProperty(FPropPath + Name);
-    WriteBinary(AWriteData);
-    Driver.EndProperty;
-  end;
-end;
-
-procedure TWriter.SetRoot(ARoot: TComponent);
-begin
-  inherited SetRoot(ARoot);
-  // Use the new root as lookup root too
-  FLookupRoot := ARoot;
-end;
-
-procedure TWriter.WriteBinary(AWriteData: TStreamProc);
-var
-  MemBuffer: TMemoryStream;
-  BufferSize: Longint;
-begin
-  { First write the binary data into a memory stream, then copy this buffered
-    stream into the writing destination. This is necessary as we have to know
-    the size of the binary data in advance (we're assuming that seeking within
-    the writer stream is not possible) }
-  MemBuffer := TMemoryStream.Create;
-  try
-    AWriteData(MemBuffer);
-    BufferSize := MemBuffer.Size;
-    Driver.WriteBinary(MemBuffer.Memory^, BufferSize);
-  finally
-    MemBuffer.Free;
-  end;
-end;
-
-procedure TWriter.WriteBoolean(Value: Boolean);
-begin
-  Driver.WriteBoolean(Value);
-end;
-
-procedure TWriter.WriteChar(Value: Char);
-begin
-  WriteString(Value);
-end;
-
-procedure TWriter.WriteCollection(Value: TCollection);
-var
-  i: Integer;
-begin
-  Driver.BeginCollection;
-  if Assigned(Value) then
-    for i := 0 to Value.Count - 1 do
-    begin
-      { Each collection item needs its own ListBegin/ListEnd tag, or else the
-        reader wouldn't be able to know where an item ends and where the next
-        one starts }
-      WriteListBegin;
-      WriteProperties(Value.Items[i]);
-      WriteListEnd;
-    end;
-  WriteListEnd;
-end;
-
-procedure TWriter.WriteComponent(Component: TComponent);
-var
-  SavedAncestor: TPersistent;
-  SavedRootAncestor, AncestorComponent, CurAncestor: TComponent;
-  i: Integer;
-  s: String;
-begin
-  SavedAncestor := Ancestor;
-  SavedRootAncestor := RootAncestor;
-
-  try
-    // The component has to know that it is being written now...
-    Include(Component.FComponentState, csWriting);
-
-    // Locate the component in the ancestor list, if necessary
-    if Assigned(FAncestorList) then
-    begin
-      Ancestor := nil;
-      s := UpperCase(Component.Name);
-      for i := 0 to FAncestorList.Count - 1 do
-      begin
-        CurAncestor := TComponent(FAncestorList[i]);
-        if UpperCase(CurAncestor.Name) = s then
-        begin
-          Ancestor := CurAncestor;
-          break;
-        end;
-      end;
-    end;
-
-    // Do we have to call the OnFindAncestor callback?
-    if Assigned(FOnFindAncestor) and
-      ((not Assigned(Ancestor)) or Ancestor.InheritsFrom(TComponent)) then
-    begin
-      AncestorComponent := TComponent(Ancestor);
-      FOnFindAncestor(Self, Component, Component.Name,
-        AncestorComponent, FRootAncestor);
-      Ancestor := AncestorComponent;
-    end;
-
-    // Finally write the component state
-    Component.WriteState(Self);
-
-    // The writing has been finished now...
-    Exclude(Component.FComponentState, csWriting);
-
-  finally
-    Ancestor := SavedAncestor;
-    FRootAncestor := SavedRootAncestor;
-  end;
-end;
-
-procedure TWriter.WriteComponentData(Instance: TComponent);
-var
-  SavedAncestorList: TList;
-  SavedRoot, SavedRootAncestor: TComponent;
-  SavedAncestorPos, SavedChildPos: Integer;
-  Flags: TFilerFlags;
-begin
-  // Determine the filer flags to store
-  if Assigned(Ancestor) and ((not (csInline in Instance.ComponentState)) or
-    ((csAncestor in Instance.ComponentState) and Assigned(FAncestorList))) then
-    Flags := [ffInherited]
-  else if csInline in Instance.ComponentState then
-    Flags := [ffInline]
-  else
-    Flags := [];
-
-  if Assigned(FAncestorList) and (FAncestorPos < FAncestorList.Count) and
-    ((not Assigned(Ancestor)) or
-    (TPersistent(FAncestorList[FAncestorPos]) <> Ancestor)) then
-    Include(Flags, ffChildPos);
-
-  Driver.BeginComponent(Instance, Flags, FChildPos);
-
-  if Assigned(FAncestorList) and (FAncestorPos < FAncestorList.Count) then
-  begin
-    if Assigned(Ancestor) then
-      Inc(FAncestorPos);
-    Inc(FChildPos);
-  end;
-
-  // Write property list
-  WriteProperties(Instance);
-  WriteListEnd;
-
-  // Write children list
-  SavedAncestorList := FAncestorList;
-  SavedAncestorPos := FAncestorPos;
-  SavedChildPos := FChildPos;
-  SavedRoot := FRoot;
-  SavedRootAncestor := FRootAncestor;
-  try
-    FAncestorList := nil;
-    FAncestorPos := 0;
-    FChildPos := 0;
-    if not IgnoreChildren then
-      try
-        // Set up the ancestor list if we have an ancestor
-        if FAncestor is TComponent then
-        begin
-          if csInline in TComponent(FAncestor).ComponentState then
-            FRootAncestor := TComponent(FAncestor);
-          FAncestorList := TList.Create;
-          TComponent(FAncestor).GetChildren(@AddToAncestorList, FRootAncestor);
-        end;
-
-        if csInline in Instance.ComponentState then
-          FRoot := Instance;
-
-        Instance.GetChildren(@WriteComponent, FRoot);
-
-      finally
-        FAncestorList.Free;
-      end;
-
-  finally
-    FAncestorList := SavedAncestorList;
-    FAncestorPos := SavedAncestorPos;
-    FChildPos := SavedChildPos;
-    FRoot := SavedRoot;
-    FRootAncestor := SavedRootAncestor;
-  end;
-
-  WriteListEnd;
-end;
-
-procedure TWriter.WriteDescendent(ARoot: TComponent; AAncestor: TComponent);
-begin
-  FRoot := ARoot;
-  FAncestor := AAncestor;
-  FRootAncestor := AAncestor;
-  FLookupRoot := ARoot;
-
-  WriteComponent(ARoot);
-end;
-
-procedure TWriter.WriteFloat(const Value: Extended);
-begin
-  Driver.WriteFloat(Value);
-end;
-
-procedure TWriter.WriteSingle(const Value: Single);
-begin
-  Driver.WriteSingle(Value);
-end;
-
-{!!!: procedure TWriter.WriteCurrency(const Value: Currency);
-begin
-  Driver.WriteCurrency(Value);
-end;}
-
-procedure TWriter.WriteDate(const Value: TDateTime);
-begin
-  Driver.WriteDate(Value);
-end;
-
-procedure TWriter.WriteIdent(const Ident: string);
-begin
-  Driver.WriteIdent(Ident);
-end;
-
-procedure TWriter.WriteInteger(Value: LongInt);
-begin
-  Driver.WriteInteger(Value);
-end;
-
-procedure TWriter.WriteInteger(Value: Int64);
-begin
-  Driver.WriteInteger(Value);
-end;
-
-procedure TWriter.WriteListBegin;
-begin
-  Driver.BeginList;
-end;
-
-procedure TWriter.WriteListEnd;
-begin
-  Driver.EndList;
-end;
-
-procedure TWriter.WriteProperties(Instance: TPersistent);
-var
-  i, PropCount: Integer;
-  PropInfo: PPropInfo;
-  PropList: PPropList;
-begin
-  { First step: Write the properties given by the RTTI for Instance }
-  PropCount := GetTypeData(Instance.ClassInfo)^.PropCount;
-  if PropCount > 0 then
-  begin
-    GetMem(PropList, PropCount * SizeOf(PPropInfo));
-    try
-      GetPropInfos(Instance.ClassInfo, PropList);
-      for i := 0 to PropCount - 1 do
-      begin
-        PropInfo := PropList^[i];
-        if IsStoredProp(Instance, PropInfo) then
-          WriteProperty(Instance, PropInfo);
-      end;
-    finally
-      FreeMem(PropList);
-    end;
-  end;
-
-  { Second step: Give Instance the chance to write its own private data }
-  Instance.DefineProperties(Self);
-end;
-
-procedure TWriter.WriteProperty(Instance: TPersistent; PropInfo: Pointer);
-var
-  HasAncestor: Boolean;
-  PropType: PTypeInfo;
-  Value, DefValue: LongInt;
-  Ident: String;
-  IntToIdentFn: TIntToIdent;
-  FloatValue, DefFloatValue: Extended;
-  MethodValue: TMethod;
-  DefMethodCodeValue: Pointer;
-  StrValue, DefStrValue: String;
-  AncestorObj: TObject;
-  Component: TComponent;
-  ObjValue: TObject;
-  SavedAncestor: TPersistent;
-  SavedPropPath, Name: String;
-  Int64Value, DefInt64Value: Int64;
-  BoolValue, DefBoolValue: boolean;
-  Handled: Boolean;
-
-begin
-
-  if (not Assigned(PPropInfo(PropInfo)^.SetProc)) or
-    (not Assigned(PPropInfo(PropInfo)^.GetProc)) then
-    exit;
-
-  { Check if the ancestor can be used }
-  HasAncestor := Assigned(Ancestor) and ((Instance = Root) or
-    (Instance.ClassType = Ancestor.ClassType));
-
-  PropType := PPropInfo(PropInfo)^.PropType;
-  case PropType^.Kind of
-    tkInteger, tkChar, tkEnumeration, tkSet:
-      begin
-        Value := GetOrdProp(Instance, PropInfo);
-        if HasAncestor then
-          DefValue := GetOrdProp(Ancestor, PropInfo)
-        else
-          DefValue := PPropInfo(PropInfo)^.Default;
-
-        if Value <> DefValue then
-        begin
-          Driver.BeginProperty(FPropPath + PPropInfo(PropInfo)^.Name);
-          case PropType^.Kind of
-            tkInteger:
-              begin
-                // Check if this integer has a string identifier
-                IntToIdentFn := FindIntToIdent(PPropInfo(PropInfo)^.PropType);
-                if Assigned(IntToIdentFn) and IntToIdentFn(Value, Ident) then
-                  // Integer can be written a human-readable identifier
-                  WriteIdent(Ident)
-                else
-                  // Integer has to be written just as number
-                  WriteInteger(Value);
-              end;
-            tkChar:
-              WriteChar(Chr(Value));
-            tkSet:
-              Driver.WriteSet(Value, GetTypeData(PropType)^.CompType);
-            tkEnumeration:
-              WriteIdent(GetEnumName(PropType, Value));
-          end;
-          Driver.EndProperty;
-        end;
-      end;
-    tkFloat:
-      begin
-        FloatValue := GetFloatProp(Instance, PropInfo);
-        if HasAncestor then
-          DefFloatValue := GetFloatProp(Ancestor, PropInfo)
-        else
-          DefFloatValue := 0;
-        if FloatValue <> DefFloatValue then
-        begin
-          Driver.BeginProperty(FPropPath + PPropInfo(PropInfo)^.Name);
-          WriteFloat(FloatValue);
-          Driver.EndProperty;
-        end;
-      end;
-    tkMethod:
-      begin
-        MethodValue := GetMethodProp(Instance, PropInfo);
-        if HasAncestor then
-          DefMethodCodeValue := GetMethodProp(Ancestor, PropInfo).Code
-        else
-          DefMethodCodeValue := nil;
-
-        Handled:=false;
-        if Assigned(OnWriteMethodProperty) then
-          OnWriteMethodProperty(Self,Instance,PPropInfo(PropInfo),MethodValue,
-            DefMethodCodeValue,Handled);
-        if (not Handled) and
-          (MethodValue.Code <> DefMethodCodeValue) and
-          ((not Assigned(MethodValue.Code)) or
-          ((Length(FLookupRoot.MethodName(MethodValue.Code)) >= 0))) then
-        begin
-          Driver.BeginProperty(FPropPath + PPropInfo(PropInfo)^.Name);
-          if Assigned(MethodValue.Code) then
-            Driver.WriteMethodName(FLookupRoot.MethodName(MethodValue.Code))
-          else
-            Driver.WriteMethodName('');
-          Driver.EndProperty;
-        end;
-      end;
-    tkSString, tkLString, tkAString, tkWString:
-      // !!!: Can we really handle WideStrings here?
-      begin
-        StrValue := GetStrProp(Instance, PropInfo);
-        if HasAncestor then
-          DefStrValue := GetStrProp(Ancestor, PropInfo)
-        else
-          SetLength(DefStrValue, 0);
-
-        if StrValue <> DefStrValue then
-        begin
-          Driver.BeginProperty(FPropPath + PPropInfo(PropInfo)^.Name);
-          if Assigned(FOnWriteStringProperty) then
-            FOnWriteStringProperty(Self,Instance,PropInfo,StrValue);
-          WriteString(StrValue);
-          Driver.EndProperty;
-        end;
-      end;
-  {!!!: tkVariant:}
-    tkClass:
-      begin
-        ObjValue := TObject(GetOrdProp(Instance, PropInfo));
-        if HasAncestor then
-        begin
-          AncestorObj := TObject(GetOrdProp(Ancestor, PropInfo));
-          if Assigned(AncestorObj) then
-            if Assigned(ObjValue) and
-              (TComponent(AncestorObj).Owner = FRootAncestor) and
-              (TComponent(ObjValue).Owner = Root) and
-              (UpperCase(TComponent(AncestorObj).Name) = UpperCase(TComponent(ObjValue).Name)) then
-              AncestorObj := ObjValue
-            else
-              AncestorObj := nil;
-        end else
-          AncestorObj := nil;
-
-        if not Assigned(ObjValue) then
-        begin
-          if ObjValue <> AncestorObj then
-          begin
-            Driver.BeginProperty(FPropPath + PPropInfo(PropInfo)^.Name);
-            Driver.WriteIdent('NIL');
-            Driver.EndProperty;
-          end
-        end else if ObjValue.InheritsFrom(TPersistent) then
-          if ObjValue.InheritsFrom(TComponent) then
-          begin
-            Component := TComponent(ObjValue);
-            if ObjValue <> AncestorObj then
-            begin
-              { Determine the correct name of the component this property contains }
-              if Component.Owner = LookupRoot then
-                Name := Component.Name
-              else if Component = LookupRoot then
-                Name := 'Owner'
-              else if Assigned(Component.Owner) and (Length(Component.Owner.Name) > 0)
-                and (Length(Component.Name) > 0) then
-                Name := Component.Owner.Name + '.' + Component.Name
-              else if Length(Component.Name) > 0 then
-                Name := Component.Name + '.Owner'
-              else
-                SetLength(Name, 0);
-
-              if Length(Name) > 0 then
-              begin
-                Driver.BeginProperty(FPropPath + PPropInfo(PropInfo)^.Name);
-                WriteIdent(Name);
-                Driver.EndProperty;
-              end;
-            end;
-          end else if ObjValue.InheritsFrom(TCollection) then
-          begin
-            if (not HasAncestor) or (not CollectionsEqual(TCollection(ObjValue),
-              TCollection(GetOrdProp(Ancestor, PropInfo)))) then
-            begin
-              Driver.BeginProperty(FPropPath + PPropInfo(PropInfo)^.Name);
-              SavedPropPath := FPropPath;
-              try
-                SetLength(FPropPath, 0);
-                WriteCollection(TCollection(ObjValue));
-              finally
-                FPropPath := SavedPropPath;
-                Driver.EndProperty;
-              end;
-            end;
-          end else
-          begin
-            SavedAncestor := Ancestor;
-            SavedPropPath := FPropPath;
-            try
-              FPropPath := FPropPath + PPropInfo(PropInfo)^.Name + '.';
-              if HasAncestor then
-                Ancestor := TPersistent(GetOrdProp(Ancestor, PropInfo));
-              WriteProperties(TPersistent(ObjValue));
-            finally
-              Ancestor := SavedAncestor;
-              FPropPath := SavedPropPath;
-            end;
-          end;
-      end;
-    tkInt64:
-      begin
-        Int64Value := GetInt64Prop(Instance, PropInfo);
-        if HasAncestor then
-          DefInt64Value := GetInt64Prop(Ancestor, PropInfo)
-        else
-          DefInt64Value := 0;
-        if Int64Value <> DefInt64Value then
-        begin
-          Driver.BeginProperty(FPropPath + PPropInfo(PropInfo)^.Name);
-          WriteInteger(Int64Value);
-          Driver.EndProperty;
-        end;
-      end;
-    tkBool:
-      begin
-        BoolValue := GetOrdProp(Instance, PropInfo)<>0;
-        if HasAncestor then
-          DefBoolValue := GetOrdProp(Ancestor, PropInfo)<>0
-        else
-          DefBoolValue := PPropInfo(PropInfo)^.Default<>0;
-        if BoolValue <> DefBoolValue then
-          begin
-          Driver.BeginProperty(FPropPath + PPropInfo(PropInfo)^.Name);
-          WriteBoolean(BoolValue);
-          Driver.EndProperty;
-          end;
-      end;
-  end;
-end;
-
-procedure TWriter.WriteRootComponent(ARoot: TComponent);
-begin
-  WriteDescendent(ARoot, nil);
-end;
-
-procedure TWriter.WriteString(const Value: String);
-begin
-  Driver.WriteString(Value);
-end;
-
-{!!!: procedure TWriter.WriteWideString(const Value: WideString);
-begin
-  Driver.WriteWideString(Value);
-end;}
-
-
-{
-  $Log: writer.inc,v $
-  Revision 1.3  2005/02/14 17:13:11  peter
-    * truncate log
-
-}