home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sibdemo3.zip / SOURCE.DAT / SOURCE / SPCC / CLASSES.PAS < prev    next >
Pascal/Delphi Source File  |  1998-05-20  |  231KB  |  7,392 lines
  1.  
  2. {╔══════════════════════════════════════════════════════════════════════════╗
  3.  ║                                                                          ║
  4.  ║     Sibyl Portable Component Classes                                     ║
  5.  ║                                                                          ║
  6.  ║     Copyright (C) 1995,97 SpeedSoft Germany,   All rights reserved.      ║
  7.  ║                                                                          ║
  8.  ╚══════════════════════════════════════════════════════════════════════════╝}
  9.  
  10. Unit Classes;
  11.  
  12.  
  13. Interface
  14.  
  15. Uses Dos,SysUtils;
  16.  
  17. {$IFDEF OS2}
  18. Uses PmWin,BseDos;
  19. {$ENDIF}
  20. {$IFDEF Win95}
  21. Uses WinUser,WinBase;
  22. {$ENDIF}
  23.  
  24. //TStream Seek origins
  25. Const
  26.   soFromBeginning = 0;
  27.   soFromCurrent   = 1;
  28.   soFromEnd       = 2;
  29.  
  30. Type
  31.     EStreamError=Class(Exception);
  32.     EFCreateError=Class(EStreamError);
  33.     EFOpenError=Class(EStreamError);
  34.  
  35.     TStream=Class(TObject)
  36.       Private
  37.          Function GetSize:LongInt;Virtual;
  38.          Function GetPosition:LongInt;
  39.          Procedure SetPosition(NewPos:LongInt);
  40.          Procedure Error(ResourceId:Word);Virtual;
  41.       Public
  42.          Procedure ReadBuffer(Var Buffer;Count:LongInt);
  43.          Procedure WriteBuffer(Const Buffer;Count:LongInt);
  44.          Function CopyFrom(Source: TStream; Count: LongInt): LongInt;
  45.          Function Read(Var Buffer;Count:LongInt):LongInt;Virtual;Abstract;
  46.          Function Write(Const Buffer;Count:LongInt):LongInt;Virtual;Abstract;
  47.          Function Seek(Offset:LongInt;Origin:Word):LongInt;Virtual;Abstract;
  48.          Function EndOfData: Boolean; Virtual;
  49.          Function ReadLn: String; Virtual;
  50.          Procedure WriteLn(Const S: String); Virtual;
  51.       Public
  52.          Property Position:LongInt Read GetPosition Write SetPosition;
  53.          Property Size:LongInt Read GetSize;
  54.     End;
  55.  
  56.  
  57. Const
  58.     {FileStream Open modes}
  59.     fmCreate = $FFFF;            (* Delphi *)
  60.  
  61.     Stream_Create    = fmCreate; (* compatibility only *)
  62.     Stream_Open      = fmInOut;  (* compatibility only *)
  63.     Stream_OpenRead  = fmOpenRead Or fmShareDenyWrite;
  64.  
  65. Type
  66.     THandleStream= Class(TStream)
  67.       Private
  68.          FHandle: LongInt;
  69.       Public
  70.          Constructor Create(AHandle: LongInt);
  71.          Function Read(Var Buffer; Count: LongInt): LongInt; Override;
  72.          Function Write(Const Buffer; Count: LongInt): LongInt; Override;
  73.          Function Seek(Offset: LongInt; Origin: Word): LongInt; Override;
  74.       Public
  75.          Property Handle: LongInt Read FHandle;
  76.     End;
  77.  
  78. Type
  79.     TFileStream=Class(TStream)
  80.       Private
  81.          PStreamFile:File;
  82.       Public
  83.          Constructor Create(Const FileName:String;Mode:LongWord);
  84.          Destructor Destroy;Override;
  85.          Function Read(Var Buffer;Count:LongInt):LongInt;Override;
  86.          Function Write(Const Buffer;Count:LongInt):LongInt;Override;
  87.          Function Seek(Offset:LongInt;Origin:Word):LongInt;Override;
  88.     End;
  89.  
  90.  
  91.     TMemoryStream=Class(TStream)
  92.       Private
  93.          FBuffer: PByteArray;
  94.          FSize, FCapacity, FPosition: LongInt;
  95.          Procedure SetCapacity(NewCapacity: LongInt);
  96.       Protected
  97.          Property Capacity:LongInt Read FCapacity Write SetCapacity;
  98.       Public
  99.          Destructor Destroy;Override;
  100.          Function Read(Var Buffer;Count:LongInt):LongInt;Override;
  101.          Function Write(Const Buffer; Count: LongInt):LongInt;Override;
  102.          Function Seek(Offset: LongInt; Origin: Word):LongInt;Override;
  103.          Procedure LoadFromStream(Stream: TStream);
  104.          Procedure LoadFromFile(Const FileName:String);
  105.          Procedure SaveToStream(Stream: TStream);
  106.          Procedure SaveToFile(Const FileName:String);
  107.          Procedure SetSize(NewSize: LongInt);
  108.          Procedure Clear;
  109.       Public
  110.          Property Memory: PByteArray Read FBuffer;
  111.     End;
  112.  
  113.  
  114. Const
  115.     MaxListSize = MaxLongInt Div SizeOf(Pointer);
  116.  
  117.     { A notify event Is A method variable, I.E. A Procedure
  118.     variable For Objects. Some Classes allow the specification
  119.     Of Objects To be notified Of changes. }
  120.  
  121.  
  122. Type
  123.     TComponent=Class;
  124.  
  125. {$M+}
  126.     TNotifyEvent = Procedure(Sender:TObject) Of Object;
  127. {$M-}
  128.  
  129.     EListError = Class(Exception);
  130.  
  131.     {TList Class}
  132.     TList = Class;
  133.     PPointerList = ^TPointerList;
  134.     TPointerList = Array[0..MaxListSize-1] Of Pointer;
  135.     TListSortCompare = Function(Item1,Item2: Pointer):LongInt;
  136.  
  137.     TFreeListItem = Procedure(Sender:TObject;Item:Pointer) Of Object;
  138.  
  139.     TList = Class
  140.       Private
  141.          FList:PPointerList;
  142.          FCount:LongInt;
  143.          FCapacity:LongInt;
  144.          FGrowth:LongInt;
  145.          FOnFreeItem:TFreeListItem;
  146.          Function Get(Index:LongInt):Pointer;
  147.          Procedure Put(Index:LongInt;Item:Pointer);
  148.          Procedure SetCount(NewCount:LongInt);
  149.       Protected
  150.          Procedure Error; Virtual;
  151.          Procedure Grow; Virtual;
  152.          Procedure SetCapacity(NewCapacity:LongInt); Virtual;
  153.          Procedure FreeItem(Item:Pointer); Virtual;
  154.       Public
  155.          Destructor Destroy; Override;
  156.          Procedure Clear; Virtual;
  157.          Function Add(Item:Pointer):LongInt;
  158.          Procedure Delete(Index:LongInt);
  159.          Function Remove(Item:Pointer):LongInt;
  160.          Procedure Cut(Index1,Index2:LongInt);
  161.          Procedure Insert(Index:LongInt;Item:Pointer);
  162.          Procedure Exchange(Index1,Index2:LongInt);
  163.          Procedure Move(CurIndex,NewIndex:LongInt);
  164.          Function IndexOf(Item:Pointer):LongInt;
  165.          Function First:Pointer;
  166.          Function Last:Pointer;
  167.          Function Expand:TList;
  168.          Procedure Pack;
  169.          Procedure Sort(Compare: TListSortCompare);
  170.       Public
  171.          Property  Capacity:LongInt Read FCapacity Write SetCapacity;
  172.          Property  Count:LongInt Read FCount Write SetCount;
  173.          Property  Growth:LongInt Read FGrowth Write FGrowth;
  174.          Property  Items[Index:LongInt]:Pointer Read Get Write Put; Default;
  175.          Property  List:PPointerList Read FList;
  176.          Property  OnFreeItem:TFreeListItem Read FOnFreeItem Write FOnFreeItem;
  177.     End;
  178.  
  179.  
  180.     {TChainList Class}
  181.     PChainListItem = ^TChainListItem;
  182.     TChainListItem = Record
  183.                            Prev:PChainListItem;
  184.                            Item:Pointer;
  185.                            Next:PChainListItem;
  186.     End;
  187.  
  188.  
  189.     TChainList = Class(TObject)
  190.       Private
  191.          FList:PChainListItem;
  192.          FListEnd:PChainListItem;
  193.          FCount:LongInt;
  194.          FOnFreeItem:TFreeListItem;
  195.       Private
  196.          Function Index2PLE(Index:LongInt):PChainListItem;
  197.          Function Item2PLE(Item:Pointer):PChainListItem;
  198.          Function PLE2Index(ple:PChainListItem):LongInt;
  199.          Function Item2Index(Item:Pointer):LongInt;
  200.          Procedure Connect(ple1,ple2:PChainListItem);
  201.          Function Get(Index:LongInt):Pointer;
  202.          Procedure Put(Index:LongInt;Item:Pointer);
  203.       Protected
  204.          Procedure Error; Virtual;
  205.          Procedure FreeItem(Item:Pointer); Virtual;
  206.       Public
  207.          Destructor Destroy; Override;
  208.          Procedure Clear; Virtual;
  209.          Function Add(Item:Pointer):LongInt;
  210.          Function Remove(Item:Pointer):LongInt;
  211.          Procedure Delete(Index:LongInt);
  212.          Function First:Pointer;
  213.          Function Last:Pointer;
  214.          Function IndexOf(Item:Pointer):LongInt;
  215.          Procedure Insert(Index:LongInt;Item:Pointer);
  216.          Procedure Move(CurIndex,NewIndex:LongInt);
  217.          Procedure Exchange(Index1,Index2:LongInt);
  218.          Procedure Pack;
  219.       Public
  220.          Property  Count:LongInt Read FCount;
  221.          Property  Items[Index:LongInt]:Pointer Read Get Write Put; Default;
  222.          Property  OnFreeItem:TFreeListItem Read FOnFreeItem Write FOnFreeItem;
  223.     End;
  224.  
  225.  { TStrings Is an Abstract base Class For storing a
  226.   Number Of Strings. Every String can be associated
  227.   With A Value As well As With an Object. So, If you
  228.   want To Store simple Strings, Or collections Of
  229.   keys And values, Or collection Of named Objects,
  230.   TStrings Is the Abstract ancestor you should
  231.   derive your Class from. }
  232.  
  233. Type
  234.   EStringListError = Class(Exception);
  235.  
  236.   TStrings = Class(TObject)
  237.      Private
  238.        FUpdateSemaphore: LongInt;
  239.        FPreventFree: Boolean;
  240.        Function GetValue(Const Name: String): String;
  241.        Procedure SetValue(Const Name, Value: String);
  242.        Function FindValue(Const Name: String; Var Value: String): LongInt;
  243.        Function GetName(Index: LongInt): String;
  244.      Protected
  245.        Function Get(Index: LongInt): String; Virtual; Abstract;
  246.        Function GetCount: LongInt; Virtual; Abstract;
  247.        Function GetObject(Index: LongInt): TObject; Virtual;
  248.        Procedure Put(Index: LongInt; Const S: String); Virtual;
  249.        Procedure PutObject(Index: LongInt; AObject: TObject); Virtual;
  250.        Procedure SetUpdateState(Updating: Boolean); Virtual;
  251.        Function GetTextStr: AnsiString; Virtual;
  252.        Procedure SetTextStr(Const Value: AnsiString); Virtual;
  253.      Public
  254.        Function Add(Const S: String): LongInt; Virtual;
  255.        Function AddObject(Const S: String; AObject: TObject): LongInt; Virtual;
  256.        Procedure AddStrings(AStrings: TStrings); Virtual;
  257.        Procedure Append(Const S: String);
  258.        Procedure Assign(AStrings: TStrings); Virtual;
  259.        Procedure BeginUpdate;
  260.        Procedure Clear; Virtual; Abstract;
  261.        Procedure Delete(Index: LongInt); Virtual; Abstract;
  262.        Procedure EndUpdate;
  263.        Function Equals(AStrings: TStrings): Boolean;
  264.        Procedure Exchange(Index1, Index2: LongInt); Virtual;
  265.        Function GetText: PChar;Virtual;
  266.        Function IndexOf(Const S: String): LongInt; Virtual;
  267.        Function IndexOfName(Const Name: String): LongInt;
  268.        Function IndexOfObject(AObject: TObject): LongInt;
  269.        Procedure Insert(Index: LongInt; Const S: String); Virtual; Abstract;
  270.        Procedure InsertObject(Index: LongInt; Const S: String; AObject: TObject); Virtual;
  271.        Procedure LoadFromFile(Const FileName: String);
  272.        Procedure SetText(Text: PChar);Virtual;
  273.        Procedure LoadFromStream(Stream: TStream); Virtual;
  274.        Procedure Move(CurIndex, NewIndex: LongInt); Virtual;
  275.        Procedure SaveToFile(Const FileName: String);
  276.        Procedure SaveToStream(Stream: TStream); Virtual;
  277.      Public
  278.        Property Names[Index: LongInt]: String Read GetName;
  279.        Property Count: LongInt Read GetCount;
  280.        Property Objects[Index: LongInt]: TObject Read GetObject Write PutObject;
  281.        Property values[Const Name: String]: String Read GetValue Write SetValue;
  282.        Property Strings[Index: LongInt]: String Read Get Write Put; Default;
  283.        Property Text:AnsiString Read GetTextStr Write SetTextStr;
  284.   End;
  285.  
  286. { TStringList Is A concrete Class derived
  287.   from TStrings. TStringList stores its Items
  288.   In A Private field Of Type TList. It's very
  289.   fast, since it performs binary Search For
  290.   retrieving Objects by Name. you can specify
  291.   whether you want TStringList To be sorted Or
  292.   unsorted As well As Case-sensitive Or Not.
  293.   you can also specify the way A TStringList
  294.   Object handles duplicate entries.
  295.  
  296.   TStringList Is able To notify the user when
  297.   the list's Data changes Or has been changed.
  298.   Use the properties OnChange And OnChanged. }
  299.  
  300. Type
  301.   TDuplicates = (dupIgnore, dupAccept, dupError);
  302.  
  303.   TFreeStringListItem = Procedure(Sender:TObject;AObject:TObject) Of Object;
  304.  
  305. Type
  306.   TStringList = Class(TStrings)
  307.   Private
  308.     FList: TList;
  309.     FSorted: Boolean;
  310.     FDuplicates: TDuplicates;
  311.     FCaseSensitive: Boolean;
  312.     FOnChange: TNotifyEvent;
  313.     FOnChanging: TNotifyEvent;
  314.     FOnFreeItem: TFreeStringListItem;
  315.     FLockChange:Boolean;
  316.     Procedure BottomUpHeapSort;
  317.     Procedure SetSorted(Value: Boolean);
  318.     Procedure SetCaseSensitive(Value: Boolean);
  319.   Protected
  320.     Procedure changed; Virtual;
  321.     Procedure Changing; Virtual;
  322.     Function Get(Index: LongInt): String; Override;
  323.     Function GetCount: LongInt; Override;
  324.     Function GetObject(Index: LongInt): TObject; Override;
  325.     Procedure Put(Index: LongInt; Const S: String); Override;
  326.     Procedure PutObject(Index: LongInt; AObject: TObject); Override;
  327.     Procedure SetUpdateState(Updating: Boolean); Override;
  328.     Procedure FreeItem(AObject: TObject);Virtual;
  329.   Public
  330.     Constructor Create;
  331.     Destructor Destroy; Override;
  332.     Function Add(Const S: String): LongInt; Override;
  333.     Procedure Clear; Override;
  334.     Procedure Delete(Index: LongInt); Override;
  335.     Procedure Exchange(Index1, Index2: LongInt); Override;
  336.     Function Find(Const S: String; Var Index: LongInt): Boolean; Virtual;
  337.     Function IndexOf(Const S: String): LongInt; Override;
  338.     Procedure Insert(Index: LongInt; Const S: String); Override;
  339.     Procedure Sort; Virtual;
  340.     Property Duplicates: TDuplicates Read FDuplicates Write FDuplicates;
  341.     Property CaseSensitive: Boolean Read FCaseSensitive Write SetCaseSensitive;
  342.     Property sorted: Boolean Read FSorted Write SetSorted;
  343.     Property OnChange: TNotifyEvent Read FOnChange Write FOnChange;
  344.     Property OnChanging: TNotifyEvent Read FOnChanging Write FOnChanging;
  345.     Property OnFreeItem: TFreeStringListItem Read FOnFreeItem Write FOnFreeItem;
  346.   End;
  347.  
  348. { StrItem Is A space-efficient way To Store an Object
  349.   associated With A String. it Is used inside TStringList. }
  350.  
  351. Type
  352.   PStrItem = ^TStrItem;
  353.   TStrItem = Record
  354.      FObject: TObject;
  355.      FString: String;
  356.   End;
  357.  
  358. Function NewStrItem(Const AString: String; AObject: TObject): PStrItem;
  359. Procedure DisposeStrItem(P: PStrItem);
  360.  
  361. Type
  362.  
  363. { TBits implements A Boolean Array. entries are
  364.   numbered 0 .. Size - 1, As usual. Bits allows
  365.   Read / Write access To entries. OpenBit returns
  366.   Index Of First True bit, Or -1 If none Is True. }
  367.  
  368.   PBitsArray = ^TBitsArray;
  369.   TBitsArray = Array[0..MaxLongInt Div 4] Of LongWord;
  370.  
  371.   EBitsError = Class(Exception);
  372.  
  373.   TBits = Class
  374.   Private
  375.     FBits: PBitsArray;
  376.     FSize: LongInt;
  377.     Procedure Error;
  378.     Function GetBit(Index: LongInt): Boolean;
  379.     Procedure SetBit(Index: LongInt; bit: Boolean);
  380.     Procedure SetSize(NewSize: LongInt);
  381.   Public
  382.     Destructor Destroy; Override;
  383.     Function OpenBit: LongInt;
  384.     Property Bits[Index: LongInt]: Boolean Read GetBit Write SetBit; Default;
  385.     Property Size: LongInt Read FSize Write SetSize;
  386.   End;
  387.  
  388.  
  389. Type
  390.     //General types
  391.     HWindow=LongWord;
  392.  
  393.     PMessage=^TMessage;
  394. {$M+}
  395.     TMessage=Record
  396. {$M-}
  397.          Msg:LongWord;
  398.          ReceiverClass: TObject;
  399.          Receiver: HWindow;
  400.          Handled: LongBool;  {True If the Message was Handled}
  401.          Case Integer Of
  402.             0: ( Param1: LongWord;
  403.                  Param2: LongWord;
  404.                  Result: LongWord);
  405.             1: ( WParam: LongWord;
  406.                  LParam: LongWord;
  407.                  MsgResult: LongWord);
  408.             2: ( Param1Lo: Word;
  409.                  Param1Hi: Word;
  410.                  Param2Lo: Word;
  411.                  Param2Hi: Word;
  412.                  ResultLo: Word;
  413.                  ResultHi: Word);
  414.             3: ( Param1LoByteLo:Byte;
  415.                  Param1LoByteHi:Byte;
  416.                  Param1HiByteLo:Byte;
  417.                  Param1HiByteHi:Byte;
  418.                  Param2LoByteLo:Byte;
  419.                  Param2LoByteHi:Byte;
  420.                  Param2HiByteLo:Byte;
  421.                  Param2HiByteHi:Byte;
  422.                  ResultLoByteLo:Byte;
  423.                  ResultLoByteHi:Byte;
  424.                  ResultHiByteLo:Byte;
  425.                  ResultHiByteHi:Byte);
  426.     End;
  427.  
  428.     HDC=LongWord;
  429.     HPalette=LongWord;
  430.  
  431. {$M+}
  432.     TColor=LongInt;
  433. {$M-}
  434.  
  435.     PPoint=^TPoint;
  436. {$M+}
  437.     TPoint=Record
  438.          X,Y:LongInt;
  439.     End;
  440. {$M-}
  441.  
  442.     PRect=^TRect;
  443. {$M+}
  444.     TRect=Record
  445.          Case LongInt Of
  446.            0: (Left,Bottom,Right,Top:LongInt);
  447.            1: (LeftBottom,RightTop:TPoint);
  448.     End;
  449. {$M-}
  450.  
  451.  
  452.     PSize=^TSize;
  453. {$M+}
  454.     TSize=Record
  455.          CX,CY:LongInt;
  456.     End;
  457.  
  458.     TRGB=Record
  459.          Blue:Byte;
  460.          Green:Byte;
  461.          Red:Byte;
  462.          Fill:Byte;
  463.     End;
  464. {$M-}
  465.  
  466. Const
  467. {$M+}
  468.     {Default RGB color values}
  469.     clBlack                    = TColor($00000000);
  470.     clMaroon                   = TColor($00800000);
  471.     clGreen                    = TColor($00008000);
  472.     clOlive                    = TColor($00808000);
  473.     clNavy                     = TColor($00000080);
  474.     clPurple                   = TColor($00800080);
  475.     clTeal                     = TColor($00008080);
  476.     clGray                     = TColor($00808080);
  477.     clSilver                   = TColor($00C6C6C6);
  478.     clRed                      = TColor($00FF0000);
  479.     clLime                     = TColor($0000FF00);
  480.     clYellow                   = TColor($00FFFF00);
  481.     clBlue                     = TColor($000000FF);
  482.     clFuchsia                  = TColor($00FF00FF);
  483.     clAqua                     = TColor($0000FFFF);
  484.     clLtGray                   = TColor($00CCCCCC);
  485.     clDkGray                   = TColor($00808080);
  486.     clWhite                    = TColor($00FFFFFF);
  487.  
  488.     {System Colors}
  489.     clScrollbar                = TColor(0 Or $80000000);
  490.     clBackGround               = TColor(1 Or $80000000);
  491.     clActiveCaption            = TColor(2 Or $80000000);
  492.     clInactiveCaption          = TColor(3 Or $80000000);
  493.     clMenu                     = TColor(4 Or $80000000);
  494.     clWindow                   = TColor(5 Or $80000000);
  495.     clWindowFrame              = TColor(6 Or $80000000);
  496.     clMenuText                 = TColor(7 Or $80000000);
  497.     clWindowText               = TColor(8 Or $80000000);
  498.     clCaptionText              = TColor(9 Or $80000000);
  499.     clActiveBorder             = TColor(10 Or $80000000);
  500.     clInactiveBorder           = TColor(11 Or $80000000);
  501.     clAppWorkSpace             = TColor(12 Or $80000000);
  502.     clHighlight                = TColor(13 Or $80000000);
  503.     clHighlightText            = TColor(14 Or $80000000);
  504.     clBtnFace                  = TColor(15 Or $80000000);
  505.     clBtnShadow                = TColor(16 Or $80000000);
  506.     clGrayText                 = TColor(17 Or $80000000);
  507.     clBtnText                  = TColor(18 Or $80000000);
  508.     clInactiveCaptionText      = TColor(19 Or $80000000);
  509.     clBtnHighlight             = TColor(20 Or $80000000);
  510.     cl3DDkShadow               = TColor(21 Or $80000000);
  511.     cl3DLight                  = TColor(22 Or $80000000);
  512.     clInfoText                 = TColor(23 Or $80000000);
  513.     clInfo                     = TColor(24 Or $80000000);
  514.     clBtnDefault               = TColor(25 Or $80000000);
  515.     clDlgWindow                = TColor(26 Or $80000000);
  516.     clEntryField               = TColor(27 Or $80000000);
  517.     clStaticText               = TColor(28 Or $80000000);
  518. {$M-}
  519.  
  520.  
  521. Type
  522.     TColorName = Record
  523.          Name: String[20];
  524.          Value: LongInt;
  525.     End;
  526.  
  527. Const
  528.     MaxDefaultColors = 18;
  529.     DefaultColors: Array[1..MaxDefaultColors] Of TColorName = (
  530.          (Name:'clBlack'; Value:clBlack),
  531.          (Name:'clMaroon'; Value:clMaroon),
  532.          (Name:'clGreen'; Value:clGreen),
  533.          (Name:'clOlive'; Value:clOlive),
  534.          (Name:'clNavy'; Value:clNavy),
  535.          (Name:'clPurple'; Value:clPurple),
  536.          (Name:'clTeal'; Value:clTeal),
  537.          (Name:'clGray'; Value:clGray),
  538.          (Name:'clSilver'; Value:clSilver),
  539.          (Name:'clRed'; Value:clRed),
  540.          (Name:'clLime'; Value:clLime),
  541.          (Name:'clYellow'; Value:clYellow),
  542.          (Name:'clBlue'; Value:clBlue),
  543.          (Name:'clFuchsia'; Value:clFuchsia),
  544.          (Name:'clAqua'; Value:clAqua),
  545.          (Name:'clLtGray'; Value:clLtGray),
  546.          (Name:'clDkGray'; Value:clDkGray),
  547.          (Name:'clWhite'; Value:clWhite));
  548.  
  549.     MaxSystemColors = 29;
  550.     SystemColors: Array[1..MaxSystemColors] Of TColorName = (
  551.          (Name:'clScrollbar'; Value:clScrollbar),
  552.          (Name:'clBackGround'; Value:clBackGround),
  553.          (Name:'clActiveCaption'; Value:clActiveCaption),
  554.          (Name:'clInactiveCaption'; Value:clInactiveCaption),
  555.          (Name:'clMenu'; Value:clMenu),
  556.          (Name:'clWindow'; Value:clWindow),
  557.          (Name:'clWindowFrame'; Value:clWindowFrame),
  558.          (Name:'clMenuText'; Value:clMenuText),
  559.          (Name:'clWindowText'; Value:clWindowText),
  560.          (Name:'clCaptionText'; Value:clCaptionText),
  561.          (Name:'clActiveBorder'; Value:clActiveBorder),
  562.          (Name:'clInactiveBorder'; Value:clInactiveBorder),
  563.          (Name:'clAppWorkSpace'; Value:clAppWorkSpace),
  564.          (Name:'clHighLight'; Value:clHighlight),
  565.          (Name:'clHighLightText'; Value:clHighlightText),
  566.          (Name:'clBtnFace'; Value:clBtnFace),
  567.          (Name:'clBtnShadow'; Value:clBtnShadow),
  568.          (Name:'clGrayText'; Value:clGrayText),
  569.          (Name:'clBtnText'; Value:clBtnText),
  570.          (Name:'clInactiveCaptionText'; Value:clInactiveCaptionText),
  571.          (Name:'clBtnHighlight'; Value:clBtnHighlight),
  572.          (Name:'cl3DDkShadow'; Value:cl3DDkShadow),
  573.          (Name:'cl3DLight'; Value:cl3DLight),
  574.          (Name:'clInfoText'; Value:clInfoText),
  575.          (Name:'clInfo'; Value:clInfo),
  576.          (Name:'clBtnDefault'; Value:clBtnDefault),
  577.          (Name:'clDlgWindow'; Value:clDlgWindow),
  578.          (Name:'clEntryField'; Value:clEntryField),
  579.          (Name:'clStaticText'; Value:clStaticText));
  580.  
  581.  
  582. Function ColorName(ColorValue:TColor):String;
  583. Function ColorValue(ColorName:String):TColor;
  584.  
  585.  
  586. Type
  587.     TResourceName=String[32];
  588.  
  589.     TResourceStream=Class(TMemoryStream)
  590.       Private
  591.          FHeaderPos:LongInt;
  592.          FResourceList:TList;
  593.          SCUStream:TStream;
  594.       Public
  595.          Function NewResourceEntry(Const ResName:TResourceName;
  596.                                    Var Data;DataLen:LongInt):Boolean;
  597.          Function WriteResourcesToStream(Stream:TMemoryStream):Boolean;
  598.          Destructor Destroy;Override;
  599.     End;
  600.  
  601.  
  602. {Standard Resource Names For NewResourceEntry}
  603. Const
  604.     rnGlyph         = 'rnGlyph';
  605.     rnBitmap        = 'rnBitmap';
  606.     rnPicture       = 'rnPicture';
  607.     rnPictureLeaf   = 'rnPictureLeaf';
  608.     rnPictureOpen   = 'rnPictureOpen';
  609.     rnPictureClosed = 'rnPictureClosed';
  610.     rnFont          = 'rnFont';
  611.     rnTabFont       = 'rnTabFont';
  612.     rnLines         = 'rnLines';
  613.     rnItems         = 'rnItems';
  614.     rnTabs          = 'rnTabs';
  615.     rnDBServer      = 'rnDBServer';
  616.     rnDBDataBase    = 'rnDBDataBase';
  617.     rnDBTable       = 'rnDBTable';
  618.     rnDBQuery       = 'rnDBQuery';
  619.     rnDBDataField   = 'rnDBDataField';
  620.     rnGridSizes     = 'rnGridSize';
  621.     rnFileName      = 'rnFileName';
  622.     rnIcon          = 'rnIcon';
  623.     rnDBGridCols    = 'rnDBGridCols';
  624.     rnStatusPanels  = 'rnStatusPanels';
  625.     rnHeaders       = 'rnHeaders';
  626.     rnBitmapList    = 'rnBitmapList';
  627.     rnScrollExtents = 'rnScrollExtents';
  628.  
  629. Type
  630.     TComponentState=Set Of (csDesigning,csReading,csWriting,csDestroying,
  631.                             csLoaded,csForm,csDetail,csReferenceControl,
  632.                             csReference,csAcceptsControls,csHandleLinks,
  633.                             csHasMainMenu,csLoading);
  634.  
  635.     TDesignerState=Set Of (dsFormVisible,dsNoRealSizing,
  636.                            dsNoSourceCode,dsStored,dsAutoCreate);
  637.  
  638.     TOperation=(opInsert,opRemove);
  639.  
  640.     TGetChildProc=Procedure(Child:TComponent) Of Object;
  641.  
  642.  
  643.     ESCUError=Class(Exception);
  644.  
  645.     TPersistent=Class(TObject)
  646.        Private
  647.              Procedure AssignError(Source:TPersistent);
  648.        Protected
  649.              Procedure AssignTo(Dest:TPersistent);Virtual;
  650.        Public
  651.              Procedure Assign(Source:TPersistent);Virtual;
  652.     End;
  653.  
  654.     TPersistentClass = class of TPersistent;
  655.  
  656.     TComponent=Class(TPersistent)
  657.       Private
  658.          FLanguages:Pointer;
  659.          FName:PString;
  660.          FUnitName:PString;
  661.          FTypeName:PString;
  662.          FOwner:TComponent;
  663.          FComponentState:TComponentState;
  664.          FDesignerState:TDesignerState;
  665.          FCreateFromSCU:Boolean;
  666.          FComponents:TList;
  667.          FFreeNotifyList:TList;
  668.          FMethods:Pointer;
  669.          FTag:LongInt;
  670.          FWriteComponentCount:LongInt;
  671.          SCUStream:TMemoryStream;
  672.          SCUResStream:TResourceStream;
  673.          SCUWriteError:Boolean;
  674.          FReference:TComponent;
  675.          Function GetComponentCount:LongInt;
  676.          Function GetComponent(AIndex:LongInt):TComponent;
  677.          Function GetComponentIndex:LongInt;
  678.          Procedure SetComponentIndex(Index:LongInt);
  679.          Function GetName:String;
  680.          Procedure SetName(Const NewName:String);
  681.          Function GetUnitName:String;
  682.          Function GetTypeName:String;
  683.          Procedure SetTypeName(NewName:String);
  684.          Function GetDesigned:Boolean;
  685.          Procedure SetupSCU;
  686.          Function ReadPropertiesSCU(COwner:TComponent;Namep,Resourcep:Pointer;Var ClassPointer:Pointer):Boolean;
  687.          Function ReadComponentsSCU(NameTable,ResourceTable:Pointer;Var ClassP:Pointer):Boolean;
  688.          Procedure ReadResourceSCU(ResourceTable:Pointer;Var ClassP:Pointer);
  689.          Procedure WriteComponent(Child:TComponent);
  690.          Procedure ReadSCU(Data:Pointer);
  691.       Protected
  692.          Procedure SetupComponent;Virtual;
  693.          Procedure Loaded;Virtual;
  694.          Procedure LoadedFromSCU(SCUParent:TComponent);Virtual;
  695.          Procedure LoadingFromSCU(SCUParent:TComponent);Virtual;
  696.          Procedure GetChildren(Proc:TGetChildProc);Virtual;
  697.          Function HasParent:Boolean;Virtual;
  698.          Procedure UpdateLinkList(Const PropertyName:String;LinkList:TList);Virtual;  //For Component links
  699.       Public
  700.          Constructor Create(AOwner:TComponent);Virtual;
  701.          Destructor Destroy;Override;
  702.          Procedure InsertComponent(AComponent:TComponent);Virtual;
  703.          Procedure RemoveComponent(AComponent:TComponent);Virtual;
  704.          Function IndexOfComponent(AComponent:TComponent):LongInt;
  705.          Procedure DestroyComponents;
  706.          Function FindComponent(Const AName:String):TComponent;
  707.          Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Virtual;
  708.          Function WriteSCUResource(Stream:TResourceStream):Boolean;Virtual;
  709.          Procedure ReadFromStream(SCUStream:TStream);
  710.          Procedure WriteToStream(SCUStream:TStream);
  711.          Procedure Notification(AComponent:TComponent;Operation:TOperation);Virtual;
  712.          Procedure FreeNotification(AComponent:TComponent);Virtual;
  713.          Procedure SetDesigning(Value:Boolean);Virtual;
  714.          Procedure GetDesignerPopupEvents(AString:TStringList);Virtual;
  715.          Procedure DesignerPopupEvent(Id:LongInt);Virtual;
  716.          Property Owner:TComponent Read FOwner write FOwner;
  717.          Property Components[Index:LongInt]:TComponent Read GetComponent;
  718.          Property ComponentCount:LongInt Read GetComponentCount;
  719.          Property ComponentIndex:LongInt Read GetComponentIndex Write SetComponentIndex;
  720.          Property ComponentState:TComponentState Read FComponentState Write FComponentState;
  721.          Property DesignerState:TDesignerState Read FDesignerState Write FDesignerState; stored;
  722.          Property UnitName:String Read GetUnitName;
  723.          Property TypeName:String Read GetTypeName Write SetTypeName;
  724.          Property Designed:Boolean Read GetDesigned;
  725.          Property FreeNotifyList:TList Read FFreeNotifyList;
  726.          Property Methods:Pointer Read FMethods Write FMethods;      {undocumented}
  727.       Published
  728.          Property Name:String Read GetName Write SetName;
  729.          Property Tag:LongInt Read FTag Write FTag;
  730.     End;
  731.     TComponentClass=Class Of TComponent;
  732.  
  733.     TCollection = Class;
  734.  
  735.     TCollectionItem = Class
  736.       Private
  737.          FCollection:TCollection;
  738.       Private
  739.          Function GetIndex:LongInt;
  740.          Procedure SetCollection(NewValue:TCollection);
  741.       Protected
  742.          Procedure SetIndex(NewIndex:LongInt);Virtual;
  743.          Procedure changed(AllItems:Boolean);
  744.       Public
  745.          Procedure Assign(Source:TCollectionItem);Virtual;Abstract;
  746.          Constructor Create(ACollection: TCollection);Virtual;
  747.          Destructor Destroy;Override;
  748.       Public
  749.          Property collection:TCollection Read FCollection Write SetCollection;
  750.          Property Index:LongInt Read GetIndex Write SetIndex;
  751.     End;
  752.  
  753.     TCollectionItemClass=Class Of TCollectionItem;
  754.  
  755.     TCollection=Class(TComponent)
  756.       Private
  757.          FItemClass:TCollectionItemClass;
  758.          FItems:TList;
  759.          FUpdateCount:LongInt;
  760.       Private
  761.          Function GetCount:LongInt;
  762.          Procedure InsertItem(Item:TCollectionItem);
  763.          Procedure RemoveItem(Item:TCollectionItem);
  764.       Protected
  765.          Procedure changed;
  766.          Function GetItem(Index:LongInt):TCollectionItem;
  767.          Procedure SetItem(Index:LongInt;Value:TCollectionItem);
  768.       Public
  769.          Procedure Update(Item:TCollectionItem);Virtual;
  770.          Procedure SetupComponent;Override;
  771.          Destructor Destroy;Override;
  772.          Function Add:TCollectionItem;
  773.          Procedure Assign(Source:TCollection);Virtual;
  774.          Procedure BeginUpdate;
  775.          Procedure Clear;
  776.          Procedure EndUpdate;
  777.       Public
  778.          Property Count:LongInt Read GetCount;
  779.          Property Items[Index:LongInt]:TCollectionItem Read GetItem Write SetItem;
  780.          Property ItemClass:TCollectionItemClass Read FItemClass Write FItemClass;
  781.     End;
  782.  
  783.  
  784.     TStringSelectList=Class(TComponent)
  785.       Private
  786.          FList:TStringList;
  787.          FSelected:String;
  788.       Protected
  789.          Procedure SetStringItem(NewValue:String);Virtual;
  790.          Procedure SetupComponent;Override;
  791.       Public
  792.          Destructor Destroy;Override;
  793.          Function GetItems:TStringList;Virtual;
  794.          Property SelectedItem:String Read FSelected Write SetStringItem;
  795.          Property Items:TStringList Read GetItems;
  796.     End;
  797.  
  798.  
  799.     {$M+}
  800.     TThreadPriority=(tpIdle,tpLowest,tpLower,tpNormal,tpHigher,tpHighest,tpTimeCritical);
  801.     {$M-}
  802.  
  803.     TThreadMethod=Procedure Of Object;
  804.  
  805.     TThread=Class
  806.       Private
  807.          FOnTerminate:TNotifyEvent;
  808.          FHandle:LongWord;
  809.          FPriority:TThreadPriority;
  810.          FFreeOnTerminate:Boolean;
  811.          FTerminated:Boolean;
  812.          FReturnValue:LongInt;
  813.          FSuspended:Boolean;
  814.          FFinished:Boolean;
  815.          FThreadId:LongWord;
  816.          FParameter:Pointer;
  817.          FMethod:TThreadMethod;
  818.          Procedure SetSuspended(NewValue:Boolean);
  819.          Procedure SetPriority(NewValue:TThreadPriority);
  820.          Procedure SyncTerminate;
  821.          Procedure MsgIdle;
  822.       Protected
  823.          Procedure DoTerminate;Virtual;
  824.          Procedure Execute;Virtual;Abstract;
  825.       Public
  826.          Constructor Create(CreateSuspended:Boolean);
  827.          Constructor ExtCreate(CreateSuspended:Boolean;StackSize:LongWord;
  828.                                Priority:TThreadPriority;Param:Pointer);
  829.          Destructor Destroy;Override;
  830.          Function WaitFor:LongInt;
  831.          Procedure Terminate;
  832.          Procedure Suspend;
  833.          Procedure Resume;
  834.          Procedure Kill;
  835.          Procedure Synchronize(method:TThreadMethod);
  836.          Procedure ProcessMsgs;
  837.          Property Terminated:Boolean Read FTerminated;
  838.          Property ReturnValue:LongInt Read FReturnValue Write FReturnValue;
  839.          Property ThreadId:LongWord Read FThreadId;
  840.          Property Handle:LongWord Read FHandle;
  841.          Property Priority:TThreadPriority Read FPriority Write SetPriority;
  842.          Property Parameter:Pointer Read FParameter Write FParameter;
  843.          Property Suspended:Boolean Read FSuspended Write SetSuspended;
  844.          Property FreeOnTerminate:Boolean Read FFreeOnTerminate Write FFreeOnTerminate;
  845.          Property OnTerminate:TNotifyEvent Read FOnTerminate Write FOnTerminate;
  846.     End;
  847.  
  848.  
  849. Procedure RegisterClasses(Const ComponentClasses: Array Of TComponentClass);
  850. Function SearchClassByName(Const Name:String):TComponentClass;
  851. Function CallReadProp(Objekt:TObject;FuncAddr:Pointer;Typ:Byte;
  852.                       TypLen:LongInt;Value:Pointer):Boolean;
  853. Function CallWriteProp(Objekt:TObject;ProcAddr:Pointer;Typ:Byte;
  854.                        TypLen:LongInt;Value:Pointer):Boolean;
  855.  
  856.  
  857. Type
  858.     PSCUFileFormat=^TSCUFileFormat;
  859.     TSCUFileFormat=Record
  860.          Version:String[5];
  861.          ObjectOffset,ObjectLen:LongInt;
  862.          NameTableOffset,NameTableLen:LongInt;
  863.          ResourceOffset,ResourceLen:LongInt;
  864.          ObjectCount:LongInt;
  865.          UseEntry:LongInt; {used by project management}
  866.          NextEntry:Pointer;
  867.          {auch System ändern (AddSCUData) und Compiler.PAS}
  868.     End;
  869.  
  870.  
  871.     PFormListItem=^TFormListItem;
  872.     TFormListItem=Record
  873.          Form:TComponent;
  874.          FormName:String[64];
  875.          UnitName:String;
  876.          AutoCreate:Boolean;
  877.          SCUPointer:Pointer;
  878.          SCUSize:LongInt;
  879.     End;
  880.  
  881.  
  882. Function WritePropertiesToStream(FormList:TList):TMemoryStream;
  883. Function WritePropertiesToFile(FileName:String;FormList:TList):Boolean;
  884.  
  885.  
  886. Type
  887.     TMsgDlgBtn=(mbYes,mbNo,mbOk,mbCancel,mbAbort,mbRetry,mbIgnore,mbAll,mbHelp);
  888.     TMsgDlgButtons=Set Of TMsgDlgBtn;
  889.     TMsgDlgType=(mtWarning,mtError,mtInformation,mtConfirmation,mtCustom,mtCritical);
  890.     TMsgDlgReturn=LongWord;
  891. Const
  892.     mrBase    = $8000;      //cmBase
  893.     mrOk      = mrBase+50;  //cmOk
  894.     mrCancel  = mrBase+51;  //cmCancel
  895.     mrYes     = mrBase+53;  //cmYes
  896.     mrNo      = mrBase+54;  //cmNo
  897.     mrIgnore  = mrBase+58;  //cmIgnore
  898.     mrRetry   = mrBase+57;  //cmRetry
  899.     mrAbort   = mrBase+56;  //cmAbort
  900.     mrNone    = 0;          //cmNull
  901.     mrAll     = mrBase+59;  //cmAll
  902.  
  903. Const
  904.     mbYesNo=[mbYes,mbNo];
  905.     mbYesNoCancel=[mbYes,mbNo,mbCancel];
  906.     mbOkCancel=[mbOk,mbCancel];
  907.     mbAbortRetryIgnore=[mbAbort,mbRetry,mbIgnore];
  908.  
  909.  
  910. Function MessageBox2(Const Msg:String;Typ:TMsgDlgType;Buttons:TMsgDlgButtons):TMsgDlgReturn;
  911. Function ErrorBox2(Const Msg:String):TMsgDlgReturn;
  912.  
  913. Function GetExperts:TList;  {noch raus?}
  914.  
  915.  
  916. Var RegisteredClasses:TList;
  917.     PropertyEditDialogs:TList;
  918.     LibExperts:TList;
  919.     LibExpertInstances:TList;
  920.  
  921. Type
  922.     TPropertyEditorReturn=(edOk,edCancel,edList,edNoEditor);
  923.  
  924.     TPropertyEditor=Class(TComponent)
  925.        Private
  926.          FPropertyOwner:TComponent;
  927.          FPropertyName:String;
  928.          FList:TStringList;
  929.        Public
  930.          Function Execute(Var Value;ValueLen:LongInt):TPropertyEditorReturn;Virtual;Abstract;
  931.        Public
  932.          Property PropertyOwner:TComponent Read FPropertyOwner;
  933.          Property PropertyName:String Read FPropertyName;
  934.          Property List:TStringList Read FList;
  935.     End;
  936.     TPropertyEditorClass=Class Of TPropertyEditor;
  937.  
  938.     {$HINTS OFF}
  939.     TStringPropertyEditor=Class(TPropertyEditor)
  940.        Public
  941.          Function Execute(Var Value:String;ValueLen:LongInt):TPropertyEditorReturn;Virtual;Abstract;
  942.     End;
  943.  
  944.     TShortIntPropertyEditor=Class(TPropertyEditor)
  945.        Public
  946.          Function Execute(Var Value:ShortInt):TPropertyEditorReturn;Virtual;Abstract;
  947.     End;
  948.  
  949.     TIntegerPropertyEditor=Class(TPropertyEditor)
  950.        Public
  951.          Function Execute(Var Value:Integer):TPropertyEditorReturn;Virtual;Abstract;
  952.     End;
  953.  
  954.     TLongIntPropertyEditor=Class(TPropertyEditor)
  955.        Public
  956.          Function Execute(Var Value:LongInt):TPropertyEditorReturn;Virtual;Abstract;
  957.     End;
  958.  
  959.     TClassPropertyEditorReturn=(peOk,peCancel,peClear,peNoEditor);
  960.  
  961.     TClassPropertyEditor=Class(TPropertyEditor)
  962.       Private
  963.          Property PropertyOwner;
  964.          Property PropertyName;
  965.          Property List;
  966.       Public
  967.          Function Execute(Var ClassToEdit:TObject):TClassPropertyEditorReturn;Virtual;
  968.     End;
  969.     TClassPropertyEditorClass=Class Of TClassPropertyEditor;
  970.     {$HINTS ON}
  971.  
  972.     EClassNotFound=Class(Exception);
  973.  
  974. Procedure RegisterClass(Const ComponentClass:TComponentClass);
  975. Function GetClass(Const ClassName:String):TComponentClass;
  976. Function FindClass(Const ClassName:String):TComponentClass;
  977. Procedure UnRegisterClass(AClass:TComponentClass);
  978. Procedure UnRegisterClasses(Const AClasses:Array of TComponentClass);
  979. Procedure AddPropertyEditor(OwnerClass:TClass;PropertyName:String;PropertyEditor:TPropertyEditorClass);
  980. Function CallPropertyEditor(Owner:TComponent;PropertyName:String;Var Value;ValueLen:LongInt;
  981.                              Var List:TStringList):TPropertyEditorReturn;
  982. Function PropertyEditorAvailable(OwnerClass:TClass;PropertyName:String):Boolean;
  983.  
  984. Procedure AddClassPropertyEditor(ClassToEdit:TClass;PropertyEditor:TClassPropertyEditorClass);
  985. Function CallClassPropertyEditor(Var ClassToEdit:TObject):TClassPropertyEditorReturn;
  986. Function ClassPropertyEditorAvailable(ClassName:String):Boolean;
  987.  
  988. Procedure AddDesignerPopupEvent(AString:TStringList;Caption:String;Id:LongInt);
  989.  
  990. Function GetTempFileName:String;
  991. Function InDesigner:Boolean;
  992.  
  993.  
  994. Implementation
  995.  
  996. //!!!!!!!!!! bei Änderungen auch Language Manager und SIB_DLG ändern!!!!!!!!!!!!!!!!!!!
  997. Type
  998.      PLanguageMessages=^TLanguageMessages;
  999.      TLanguageMessages=Record
  1000.                          Name:PString;  //Language Name
  1001.                          StringTableLen:LongWord;
  1002.                          StringTable:Pointer;
  1003.                          Next:PLanguageMessages;
  1004.      End;
  1005.  
  1006.      PLanguageComponent=^TLanguageComponent;
  1007.      TLanguageComponent=Record
  1008.                          Name:PString;
  1009.                          OriginalInstance:TComponent;
  1010.                          Instance:TComponent;
  1011.                          ValueScope:Byte;
  1012.                          ValueTyp:Byte;
  1013.                          ValueRead:TPropertyReadWriteRecord;
  1014.                          ValueWrite:TPropertyReadWriteRecord;
  1015.                          ValueSize:LongWord;
  1016.                          ValueLen:LongWord;
  1017.                          Value:Pointer;
  1018.                          ControlLeft,ControlBottom:LongInt;
  1019.                          ControlWidth,ControlHeight:LongInt;
  1020.                          OrigControlLeft,OrigControlBottom:LongInt;
  1021.                          OrigControlWidth,OrigControlHeight:LongInt;
  1022.                          Next:PLanguageComponent;
  1023.      End;
  1024.  
  1025.      PLanguageItem=^TLanguageItem;
  1026.      TLanguageItem=Record
  1027.                          Name:PString;
  1028.                          Components:PLanguageComponent;
  1029.                          Menus:PLanguageComponent;
  1030.                          StringTables:PLanguageComponent;
  1031.                          Next:PLanguageItem;
  1032.      End;
  1033. //!!!!!!!!!! bei Änderungen auch Language Manager ändern!!!!!!!!!!!!!!!!!!!
  1034.      PLanguageInfo=^TLanguageInfo;
  1035.      TLanguageInfo=Record
  1036.                          CurrentLanguageName:PString;  //only Copy !!
  1037.                          CurrentLanguageComponents:PLanguageComponent;  //only Copy !
  1038.                          CurrentLanguageMenus:PLanguageComponent; //only Copy !
  1039.                          CurrentLanguageStringTables:PLanguageComponent; //only Copy
  1040.                          Items:PLanguageItem;
  1041.      End;
  1042. //!!!!!!!!!! bei Änderungen auch Language Manager und SIB_DLG ändern!!!!!!!!!!!!!!!!!!!
  1043. //////////////////////////////////////////////////////////////////////////////////////////////////////////
  1044.  
  1045. Var LanguageMessages:PLanguageMessages;
  1046.     AppLanguage:String;
  1047.  
  1048. Procedure DestroyMessages;
  1049. Var dummy:PLanguageMessages;
  1050. Begin
  1051.      While LanguageMessages<>NIL Do
  1052.      Begin
  1053.           dummy:=LanguageMessages^.Next;
  1054.           If LanguageMessages^.Name<>Nil Then
  1055.             FreeMem(LanguageMessages^.Name,length(LanguageMessages^.Name^)+1);
  1056.           If LanguageMessages^.StringTable<>Nil Then
  1057.             FreeMem(LanguageMessages^.StringTable,LanguageMessages^.StringTableLen);
  1058.           Dispose(LanguageMessages);
  1059.           LanguageMessages:=dummy;
  1060.      End;
  1061.      LanguageMessages:=Nil;
  1062.      AppLanguage:='Default';
  1063. End;
  1064.  
  1065. Type TLanguageComponentKinds=(Captions,Menus,StringTables);
  1066.  
  1067.  
  1068. Procedure SetupLanguageComponents(Component:TComponent;Items:PLanguageComponent;Kind:TLanguageComponentKinds);
  1069. Var
  1070.     WriteTyp,ReadTyp:Byte;
  1071.     WriteOffset,ReadOffset:LongWord;
  1072.     ValueTyp:Byte;
  1073.     Info:TPropertyTypeInfo;
  1074.     S,s1:String;
  1075.     T:LongInt;
  1076.     Temp,Temp1:TComponent;
  1077.     p2:^LongWord;
  1078.     B:Byte;
  1079.     C:TObject;
  1080.  
  1081.     Procedure WriteInt(Const Name:String;Value:LongInt);
  1082.     Var Info:TPropertyTypeInfo;
  1083.     Begin
  1084.          If Temp.GetPropertyTypeInfo(Name,Info) Then
  1085.          Begin
  1086.               //Info available
  1087.               Case Info.Write.Kind Of
  1088.                  1:
  1089.                  Begin
  1090.                       p2:=Pointer(Temp);
  1091.                       Inc(p2,Info.Write.VarOffset);
  1092.                       System.Move(Value,p2^,Info.Size);
  1093.                  End;
  1094.                  2,3:
  1095.                  Begin
  1096.                       CallWriteProp(Temp,Pointer(Info.Write.VarOffset),
  1097.                                     Info.Typ,Info.Size,@Value);
  1098.                  End;
  1099.               End; //Case
  1100.          End;
  1101.     End;
  1102.  
  1103. Label skip;
  1104. Begin
  1105.      While Items<>Nil Do //process All Language Components
  1106.      Begin
  1107.           If ((Items^.ValueTyp<>0)And(Items^.ValueWrite.Kind<>0)And(Items^.Instance<>Nil)) Then //Read And Write information are Valid
  1108.           Begin
  1109.                ValueTyp:=Items^.ValueTyp;
  1110.                WriteTyp:=Items^.ValueWrite.Kind;
  1111.                WriteOffset:=Items^.ValueWrite.VarOffset;
  1112.                ReadTyp:=Items^.ValueRead.Kind;
  1113.                ReadOffset:=Items^.ValueRead.VarOffset;
  1114.                Temp:=Items^.Instance;
  1115.           End
  1116.           Else
  1117.           Begin
  1118.                Temp:=Component;
  1119.                S:=Items^.Name^;
  1120.                B:=Pos('.',S);
  1121.                While B<>0 Do
  1122.                Begin
  1123.                     s1:=Copy(S,1,B-1);
  1124.                     Delete(S,1,B);
  1125.  
  1126.                     Temp1:=Nil;
  1127.                     For T:=0 To Temp.ComponentCount-1 Do
  1128.                     Begin
  1129.                         Temp1:=Temp.Components[T];
  1130.                         If Temp1.Name=s1 Then
  1131.                         Begin
  1132.                              Temp:=Temp1;
  1133.                              break; //found !
  1134.                         End;
  1135.                         Temp1:=Nil;
  1136.                     End;
  1137.                     If Temp1=Nil Then Goto skip;  //Not found
  1138.  
  1139.                     B:=Pos('.',S);
  1140.                End;
  1141.  
  1142.                If Not Temp.GetPropertyTypeInfo(S,Info) Then Goto skip;
  1143.  
  1144.                Items^.Instance:=Temp;
  1145.                Items^.ValueRead:=Info.Read;
  1146.                Items^.ValueWrite:=Info.Write;
  1147.                Items^.ValueSize:=Info.Size;
  1148.                Items^.ValueTyp:=Info.Typ;
  1149.                ValueTyp:=Info.Typ;
  1150.                WriteTyp:=Info.Write.Kind;
  1151.                WriteOffset:=Info.Write.VarOffset;
  1152.                ReadTyp:=Info.Read.Kind;
  1153.                ReadOffset:=Info.Read.VarOffset;
  1154.           End;
  1155.  
  1156.           If ((ValueTyp=PropType_Class)And(Kind=StringTables)) Then
  1157.           Begin
  1158.                Case ReadTyp Of
  1159.                  0:Goto skip;
  1160.                  1:
  1161.                  Begin
  1162.                     p2:=Pointer(Temp);
  1163.                     Inc(p2,ReadOffset);
  1164.                     System.Move(p2^,C,4);
  1165.                  End;
  1166.                  2,3:
  1167.                  Begin
  1168.                     CallReadProp(Temp,Pointer(ReadOffset),
  1169.                                  ValueTyp,4,@C);
  1170.                 End;
  1171.                 Else Goto skip;
  1172.                End; //Case
  1173.  
  1174.                If Not (C Is TStrings) Then Goto skip;
  1175.                TStrings(C).SetText(Pointer(Items^.Value));
  1176.                Goto skip;
  1177.           End
  1178.           Else If ((ValueTyp<>PropType_String)And(ValueTyp<>PropType_CString)) Then Goto skip;
  1179.  
  1180.           //Info available
  1181.           Case WriteTyp Of
  1182.              1:
  1183.              Begin
  1184.                  p2:=Pointer(Temp);
  1185.                  Inc(p2,WriteOffset);
  1186.                  System.Move(Items^.Value^,p2^,Items^.ValueLen);
  1187.              End;
  1188.              2,3:
  1189.              Begin
  1190.                  CallWriteProp(Temp,Pointer(WriteOffset),
  1191.                                ValueTyp,
  1192.                                Items^.ValueLen,Items^.Value);
  1193.              End;
  1194.              Else Goto skip;
  1195.           End; //Case
  1196.  
  1197.           If Kind=Captions Then
  1198.             If Not (csForm In Temp.ComponentState) Then
  1199.           Begin
  1200.                //Write Language specific Position
  1201.                WriteInt('Left',Items^.ControlLeft);
  1202.                WriteInt('Bottom',Items^.ControlBottom);
  1203.                WriteInt('Width',Items^.ControlWidth);
  1204.                WriteInt('Height',Items^.ControlHeight);
  1205.           End;
  1206. skip:
  1207.           Items:=Items^.Next;
  1208.      End;
  1209. End;
  1210.  
  1211. Procedure GetLanguage(Component:TComponent;Var Language:String);
  1212. Var Info:PLanguageInfo;
  1213. Begin
  1214.    Info:=PLanguageInfo(Component.FLanguages);
  1215.    If ((Info=Nil)Or(Info^.CurrentLanguageName=Nil)) Then Language:='Default'
  1216.    Else Language:=Info^.CurrentLanguageName^;
  1217. End;
  1218.  
  1219. Procedure UpdateLanguageComponents(Items:PLanguageComponent;Kind:TLanguageComponentKinds);
  1220. Var
  1221.     ReadTyp:Byte;
  1222.     ReadOffset:LongWord;
  1223.     ValueTyp:Byte;
  1224.     Temp:TComponent;
  1225.     p2:^LongWord;
  1226.     C:TObject;
  1227.     P:PChar;
  1228.     S:String;
  1229.  
  1230.     Procedure ReadInt(Const Name:String;Var Value:LongInt);
  1231.     Var Info:TPropertyTypeInfo;
  1232.     Begin
  1233.          If Temp.GetPropertyTypeInfo(Name,Info) Then
  1234.          Begin
  1235.               //Info available
  1236.               Case Info.Read.Kind Of
  1237.                  1:
  1238.                  Begin
  1239.                       p2:=Pointer(Temp);
  1240.                       Inc(p2,Info.Read.VarOffset);
  1241.                       System.Move(p2^,Value,Info.Size);
  1242.                  End;
  1243.                  2,3:
  1244.                  Begin
  1245.                       CallReadProp(Temp,Pointer(Info.Read.VarOffset),
  1246.                                    Info.Typ,Info.Size,@Value);
  1247.                  End;
  1248.               End; //Case
  1249.          End;
  1250.     End;
  1251.  
  1252. Label skip;
  1253. Begin
  1254.      While Items<>Nil Do //process All Language Components
  1255.      Begin
  1256.           If ((Items^.ValueTyp<>0)And(Items^.ValueRead.Kind>0)And(Items^.Instance<>Nil)) Then
  1257.           Begin
  1258.                ValueTyp:=Items^.ValueTyp;
  1259.                ReadTyp:=Items^.ValueWrite.Kind;
  1260.                ReadOffset:=Items^.ValueRead.VarOffset;
  1261.                Temp:=Items^.Instance;
  1262.  
  1263.                If not (Temp Is TComponent) Then continue;
  1264.  
  1265.                Try
  1266.                   If ((ValueTyp=PropType_Class)And(Kind=StringTables)) Then
  1267.                   Begin
  1268.                        Case ReadTyp Of
  1269.                          0:Goto skip;
  1270.                          1:
  1271.                          Begin
  1272.                             p2:=Pointer(Temp);
  1273.                             Inc(p2,ReadOffset);
  1274.                             System.Move(p2^,C,4);
  1275.                          End;
  1276.                          2,3:
  1277.                          Begin
  1278.                             CallReadProp(Temp,Pointer(ReadOffset),
  1279.                                          ValueTyp,4,@C);
  1280.                         End;
  1281.                         Else Goto skip;
  1282.                        End; //Case
  1283.  
  1284.                        If Not (C Is TStrings) Then Goto skip;
  1285.                        P:=TStrings(C).GetText;
  1286.                        If Items^.ValueLen>0 Then FreeMem(Items^.Value,Items^.ValueLen);
  1287.                        If P=Nil Then
  1288.                        Begin
  1289.                             Items^.ValueLen:=0;
  1290.                             Items^.Value:=Nil;
  1291.                        End
  1292.                        Else
  1293.                        Begin
  1294.                             Items^.ValueLen:=Length(P^)+1;
  1295.                             GetMem(Items^.Value,Items^.ValueLen);
  1296.                             Move(P^,Items^.Value^,Items^.ValueLen);
  1297.                             StrDispose(P);
  1298.                        End;
  1299.  
  1300.                        Goto skip;
  1301.                   End
  1302.                   Else If ValueTyp<>PropType_String Then Goto skip;
  1303.  
  1304.                   //Info available
  1305.                   S:='';
  1306.                   Case ReadTyp Of
  1307.                      1:
  1308.                      Begin
  1309.                          p2:=Pointer(Temp);
  1310.                          Inc(p2,ReadOffset);
  1311.                          System.Move(p2^,S,Items^.ValueSize);
  1312.                      End;
  1313.                      2,3:
  1314.                      Begin
  1315.                          CallReadProp(Temp,Pointer(ReadOffset),
  1316.                                       ValueTyp,
  1317.                                       Items^.ValueSize,@S);
  1318.                      End;
  1319.                      Else Goto skip;
  1320.                   End; //Case
  1321.  
  1322.                   If Items^.ValueLen>0 Then FreeMem(Items^.Value,Items^.ValueLen);
  1323.                   Items^.ValueLen:=Length(S)+1;
  1324.                   GetMem(Items^.Value,Items^.ValueLen);
  1325.                   Move(S,Items^.Value^,Items^.ValueLen);
  1326.  
  1327.                   If Kind=Captions Then
  1328.                     If Not (csForm In Temp.ComponentState) Then
  1329.                   Begin
  1330.                        //Write Language specific Position
  1331.                        ReadInt('Left',Items^.ControlLeft);
  1332.                        ReadInt('Bottom',Items^.ControlBottom);
  1333.                        ReadInt('Width',Items^.ControlWidth);
  1334.                        ReadInt('Height',Items^.ControlHeight);
  1335.                   End;
  1336.                Except
  1337.                End;
  1338.           End;
  1339. skip:
  1340.           Items:=Items^.Next;
  1341.      End;
  1342. End;
  1343.  
  1344.  
  1345. Procedure SetLanguage(Component:TComponent;Language:String);
  1346. Var Info:PLanguageInfo;
  1347.     Item:PLanguageItem;
  1348.     S,s1,s2:String;
  1349. Begin
  1350.      Info:=PLanguageInfo(Component.FLanguages);
  1351.      If Info=Nil Then Exit;
  1352.      S:=Language;
  1353.      UpcaseStr(S);
  1354.      If Info^.CurrentLanguageName<>Nil Then
  1355.      Begin
  1356.           s1:=Info^.CurrentLanguageName^;
  1357.           UpcaseStr(s1);
  1358.           If S=s1 Then If S<>'DEFAULT' Then
  1359.           Begin
  1360.                Item:=Info^.Items;
  1361.                While Item<>Nil Do
  1362.                Begin
  1363.                     s1:=Item^.Name^;
  1364.                     UpcaseStr(s1);
  1365.                     If S=s1 Then Exit; //the Item Is present And Set !
  1366.                     Item:=Item^.Next;
  1367.                End;
  1368.  
  1369.                S:='DEFAULT';
  1370.           End;
  1371.  
  1372.           //Update old Language
  1373.           s1:=Info^.CurrentLanguageName^;
  1374.           UpcaseStr(s1);
  1375.           Item:=Info^.Items;
  1376.           While Item<>Nil Do
  1377.           Begin
  1378.                s2:=Item^.Name^;
  1379.                UpcaseStr(s2);
  1380.                If s1=s2 Then
  1381.                Begin
  1382.                     UpdateLanguageComponents(Item^.Components,Captions);
  1383.                     UpdateLanguageComponents(Item^.Menus,Menus);
  1384.                     UpdateLanguageComponents(Item^.StringTables,StringTables);
  1385.                     break;
  1386.                End;
  1387.                Item:=Item^.Next;
  1388.           End;
  1389.      End;
  1390.  
  1391.      Item:=Info^.Items;
  1392.      While Item<>Nil Do
  1393.      Begin
  1394.           s1:=Item^.Name^;
  1395.           UpcaseStr(s1);
  1396.           If S=s1 Then
  1397.           Begin
  1398.                SetupLanguageComponents(Component,Item^.Components,Captions);
  1399.                SetupLanguageComponents(Component,Item^.Menus,Menus);
  1400.                SetupLanguageComponents(Component,Item^.StringTables,StringTables);
  1401.  
  1402.                Info^.CurrentLanguageName:=Item^.Name;
  1403.                Info^.CurrentLanguageComponents:=Item^.Components;
  1404.                Info^.CurrentLanguageMenus:=Item^.Menus;
  1405.                Info^.CurrentLanguageStringTables:=Item^.StringTables;
  1406.  
  1407.                Exit;
  1408.           End;
  1409.           Item:=Item^.Next;
  1410.      End;
  1411. End;
  1412.  
  1413. Procedure GetAppLanguage(Var Language:String);
  1414. Begin
  1415.      Language:=AppLanguage;
  1416. End;
  1417.  
  1418. Procedure SetAppLanguage(Const Language:String);
  1419. Begin
  1420.      AppLanguage:=Language;
  1421. End;
  1422.  
  1423. Const
  1424.     {$IFDEF OS2}
  1425.     SCUVersion:String[5] = 'SCU01';
  1426.     {$ENDIF}
  1427.     {$IFDEF Win95}
  1428.     SCUVersion:String[5] = 'SCW01';
  1429.     {$ENDIF}
  1430.  
  1431. Var
  1432.     InsideCompLib:Boolean;
  1433.     InsideWriteSCU:Boolean;
  1434.     InsideWriteSCUAdr:^Boolean;
  1435.     InsideDesigner:Boolean;
  1436.     InsideLanguageDesigner:Boolean;
  1437.  
  1438. Type
  1439.     PIDE_OwnerList=^TIDE_OwnerList;
  1440.     TIDE_OwnerList=Record
  1441.          PropertyName:PString;
  1442.          Objekt:TComponent;
  1443.     End;
  1444.  
  1445.     PIDE_Methods=^TIDE_Methods;
  1446.     TIDE_Methods=Record
  1447.          Name:PString;
  1448.          Params:PString;
  1449.          Owners:TList;
  1450.          Next:PIDE_Methods;
  1451.     End;
  1452.  
  1453.  
  1454. Function GetTempFileName:String;
  1455. Var  Hour,Minute,Second,Sec100:Word;
  1456.      S,dir:String;
  1457. Begin
  1458.      If GetTime(Hour,Minute,Second,Sec100) = 0 Then
  1459.      Begin
  1460.           S := 'tmp'+ tostr(Minute)+tostr(Second)+tostr(Sec100) +'.tmp';
  1461.      End
  1462.      Else S := 'tmp0001.tmp';
  1463.  
  1464.      dir := GetEnv('TMP');
  1465.      If dir = '' Then dir := GetEnv('TEMP');
  1466.      If dir = '' Then
  1467.      Begin
  1468.           {$I-}
  1469.           GetDir(0,dir);
  1470.           {$I+}
  1471.      End;
  1472.      If dir[Length(dir)] <> '\' Then dir := dir + '\';
  1473.      Result := dir + S;
  1474. End;
  1475.  
  1476.  
  1477. Function InDesigner:Boolean;
  1478. Begin
  1479.      Result:=InsideDesigner;
  1480. End;
  1481.  
  1482.  
  1483. Function ColorName(ColorValue:TColor):String;
  1484. Var  T:LongInt;
  1485. Begin
  1486.      For T := 1 To MaxDefaultColors Do
  1487.      Begin
  1488.           If DefaultColors[T].Value = ColorValue Then
  1489.           Begin
  1490.                Result := DefaultColors[T].Name;
  1491.                Exit;
  1492.           End;
  1493.      End;
  1494.  
  1495.      For T := 1 To MaxSystemColors Do
  1496.      Begin
  1497.           If SystemColors[T].Value = ColorValue Then
  1498.           Begin
  1499.                Result := SystemColors[T].Name;
  1500.                Exit;
  1501.           End;
  1502.      End;
  1503.  
  1504.      Result := tostr(ColorValue);
  1505. End;
  1506.  
  1507.  
  1508. Function ColorValue(ColorName:String):TColor;
  1509. Var  T:LongInt;
  1510.      C:Integer;
  1511.      S:String;
  1512. Begin
  1513.      UpcaseStr(ColorName);
  1514.  
  1515.      For T := 1 To MaxDefaultColors Do
  1516.      Begin
  1517.           S := DefaultColors[T].Name;
  1518.           UpcaseStr(S);
  1519.           If S = ColorName Then
  1520.           Begin
  1521.                Result := DefaultColors[T].Value;
  1522.                Exit;
  1523.           End;
  1524.      End;
  1525.  
  1526.      For T := 1 To MaxSystemColors Do
  1527.      Begin
  1528.           S := SystemColors[T].Name;
  1529.           UpcaseStr(S);
  1530.           If S = ColorName Then
  1531.           Begin
  1532.                Result := SystemColors[T].Value;
  1533.                Exit;
  1534.           End;
  1535.      End;
  1536.  
  1537.      Val(ColorName,Result,C);
  1538.      If C <> 0 Then Result := 0;
  1539. End;
  1540.  
  1541.  
  1542. {
  1543. ╔═══════════════════════════════════════════════════════════════════════════╗
  1544. ║                                                                           ║
  1545. ║ Speed-Pascal/2 Version 2.0                                                ║
  1546. ║                                                                           ║
  1547. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  1548. ║                                                                           ║
  1549. ║ This section: TStream Class Implementation                                ║
  1550. ║                                                                           ║
  1551. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  1552. ║                                                                           ║
  1553. ╚═══════════════════════════════════════════════════════════════════════════╝
  1554. }
  1555.  
  1556. Function TStream.CopyFrom(Source:TStream;Count:LongInt):LongInt;
  1557. Var
  1558.   ActBufSize,T:LongInt;
  1559.   StreamBuffer:Pointer;
  1560. Const
  1561.   MaxBufSize = $FFFF;
  1562. Begin
  1563.   If Count = 0 Then
  1564.   Begin
  1565.     Count := Source.Size;
  1566.     Source.Position := 0;
  1567.   End;
  1568.  
  1569.   Result := Count;
  1570.  
  1571.   If Count > MaxBufSize Then ActBufSize:=MaxBufSize
  1572.   Else ActBufSize := Count;
  1573.  
  1574.   GetMem(StreamBuffer,ActBufSize);
  1575.  
  1576.   Try
  1577.     While Count<>0 Do
  1578.     Begin
  1579.       If Count>ActBufSize Then T:=ActBufSize
  1580.       Else T:=Count;
  1581.  
  1582.       Source.ReadBuffer(StreamBuffer^,T);
  1583.       WriteBuffer(StreamBuffer^,T);
  1584.       Dec(Count,T);
  1585.     End;
  1586.   Finally
  1587.     FreeMem(StreamBuffer, ActBufSize);
  1588.   End;
  1589. End;
  1590.  
  1591. Function TStream.GetSize:LongInt;
  1592. Var
  1593.    OldPos:LongInt;
  1594.    Result:LongInt;
  1595. Begin
  1596.      OldPos:=GetPosition;
  1597.      Result:=Seek(0,Seek_End);
  1598.      SetPosition(OldPos);
  1599.      GetSize:=Result;
  1600. End;
  1601.  
  1602. Function TStream.EndOfData: Boolean;
  1603. Begin
  1604.   Result := (Position >= Size);
  1605. End;
  1606.  
  1607. Function TStream.GetPosition:LongInt;
  1608. Begin
  1609.      GetPosition:=Seek(0,Seek_Current);
  1610. End;
  1611.  
  1612. Procedure TStream.SetPosition(NewPos:LongInt);
  1613. Begin
  1614.      Seek(NewPos,Seek_Begin);
  1615. End;
  1616.  
  1617. Procedure TStream.ReadBuffer(Var Buffer;Count:LongInt);
  1618. Begin
  1619.      If Count=0 Then Exit;  {Nothing To Read}
  1620.      If Read(Buffer,Count)<>Count Then Error(SStreamReadErrorText);
  1621. End;
  1622.  
  1623. Procedure TStream.WriteBuffer(Const Buffer;Count:LongInt);
  1624. Begin
  1625.      If Count=0 Then Exit;
  1626.      If Write(Buffer,Count)<>Count Then Error(SStreamWriteErrorText);
  1627. End;
  1628.  
  1629. Procedure TStream.Error;
  1630. Begin
  1631.      Raise EStreamError.Create(LoadNLSStr(ResourceId));
  1632. End;
  1633.  
  1634. Function TStream.ReadLn: String;
  1635. Var
  1636.   Buffer: cstring[260];
  1637.   OldPos, Count, Temp: LongInt;
  1638. Begin
  1639.   OldPos := Position;
  1640.  
  1641.   Count := Read(Buffer[0], 257);
  1642.   Buffer[Count] := #0;
  1643.  
  1644.   Temp := 0;
  1645.   While Not (Buffer[Temp] In [#10, #13, #26])
  1646.     And (Temp < Count) And (Temp < 255) Do Inc (Temp);
  1647.  
  1648.   Move(Buffer[0], Result[1], Temp);
  1649.   Result[0]:=Chr(Temp);
  1650.   Inc(Temp);
  1651.  
  1652.   If (Buffer[Temp - 1] = #13) And (Buffer[Temp] = #10) Then Inc(Temp);
  1653.  
  1654.   Position := OldPos + Temp;
  1655. End;
  1656.  
  1657. Procedure TStream.WriteLn(Const S: String);
  1658. Var
  1659.   CRLF: Word;
  1660. Begin
  1661.   CRLF := $0A0D;
  1662.   WriteBuffer(S[1], Length(S));
  1663.   WriteBuffer(CRLF, 2);
  1664. End;
  1665.  
  1666. {
  1667. ╔═══════════════════════════════════════════════════════════════════════════╗
  1668. ║                                                                           ║
  1669. ║ Speed-Pascal/2 Version 2.0                                                ║
  1670. ║                                                                           ║
  1671. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  1672. ║                                                                           ║
  1673. ║ This section: THandleStream Class Implementation                          ║
  1674. ║                                                                           ║
  1675. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  1676. ║                                                                           ║
  1677. ╚═══════════════════════════════════════════════════════════════════════════╝
  1678. }
  1679.  
  1680. Constructor THandleStream.Create(AHandle: LongInt);
  1681. Begin
  1682.   FHandle := AHandle;
  1683. End;
  1684.  
  1685. Function THandleStream.Read(Var Buffer; Count: LongInt): LongInt;
  1686. Begin
  1687.   Result := FileRead(Handle, Buffer, Count);
  1688.   If Result = -1 Then Result := 0;
  1689. End;
  1690.  
  1691. Function THandleStream.Write(Const Buffer; Count: LongInt): LongInt;
  1692. Var Temp:^Byte;
  1693. Begin
  1694.   Temp:=@Buffer;
  1695.   Result := FileWrite(Handle, Temp^, Count);
  1696.   If Result = -1 Then Result := 0;
  1697. End;
  1698.  
  1699. Function THandleStream.Seek(Offset: LongInt; Origin: Word): LongInt;
  1700. Begin
  1701.   Result := FileSeek(Handle, Offset, Origin);
  1702.   If Result < 0 Then Error(SStreamSeekErrorText);
  1703. End;
  1704.  
  1705. {
  1706. ╔═══════════════════════════════════════════════════════════════════════════╗
  1707. ║                                                                           ║
  1708. ║ Speed-Pascal/2 Version 2.0                                                ║
  1709. ║                                                                           ║
  1710. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  1711. ║                                                                           ║
  1712. ║ This section: TFileStream Class Implementation                            ║
  1713. ║                                                                           ║
  1714. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  1715. ║                                                                           ║
  1716. ╚═══════════════════════════════════════════════════════════════════════════╝
  1717. }
  1718.  
  1719. Constructor TFileStream.Create(Const FileName:String;Mode:LongWord);
  1720. Var
  1721.   SaveMode: LongWord;
  1722. Begin
  1723.      Inherited Create;
  1724.  
  1725.      SaveMode := FileMode;
  1726.  
  1727.      If Mode = fmCreate Then FileMode := fmOpenReadWrite Or fmShareExclusive
  1728.      Else FileMode := Mode;
  1729.  
  1730.      Try
  1731.         Assign(PStreamFile,FileName);
  1732.         If Mode = fmCreate Then
  1733.         Begin
  1734.             {$I-}
  1735.             Rewrite(PStreamFile,1);
  1736.             {$I+}
  1737.             If InOutRes<>0 Then Raise EFCreateError.Create(LoadNLSStr(SStreamCreateErrorText));
  1738.         End
  1739.         Else
  1740.         Begin
  1741.            {$I-}
  1742.            Reset(PStreamFile,1);
  1743.            {$I+}
  1744.            If InOutRes<>0 Then Raise EFOpenError.Create(LoadNLSStr(SStreamOpenErrorText));
  1745.         End;
  1746.      Finally
  1747.         FileMode := SaveMode;
  1748.      End;
  1749. End;
  1750.  
  1751. Destructor TFileStream.Destroy;
  1752. Begin
  1753.      {$I-}
  1754.      Close(PStreamFile);
  1755.      {$I+}
  1756.      Inherited Destroy;
  1757. End;
  1758.  
  1759. Function TFileStream.Read(Var Buffer;Count:LongInt):LongInt;
  1760. Var
  1761.    Result:LongWord;
  1762. Begin
  1763.      {$I-}
  1764.      BlockRead(PStreamFile,Buffer,Count,Result);
  1765.      {$I+}
  1766.      If InOutRes<>0 Then Error(SStreamReadErrorText);
  1767.      Read:=Result;
  1768. End;
  1769.  
  1770. Function TFileStream.Write(Const Buffer;Count:LongInt):LongInt;
  1771. Var
  1772.    pb:Pointer;
  1773.    Result:LongWord;
  1774. Begin
  1775.      pb:=@Buffer;
  1776.      {$I-}
  1777.      BlockWrite(PStreamFile,pb^,Count,Result);
  1778.      {$I+}
  1779.      If InOutRes<>0 Then Error(SStreamWriteErrorText);
  1780.      Write:=Result;
  1781. End;
  1782.  
  1783. Function TFileStream.Seek(Offset:LongInt;Origin:Word):LongInt;
  1784. Var
  1785.    SaveSeekMode:LongWord;
  1786. Begin
  1787.      SaveSeekMode:=SeekMode;
  1788.      SeekMode:=Origin;
  1789.      {$I-}
  1790.      System.Seek(PStreamFile,Offset);
  1791.      {$I+}
  1792.      If InOutRes<>0 Then Error(SStreamSeekErrorText);
  1793.      SeekMode:=SaveSeekMode;
  1794.      {$I-}
  1795.      Seek:=FilePos(PStreamFile);
  1796.      {$I+}
  1797.      If InOutRes<>0 Then Error(SStreamSeekErrorText);
  1798. End;
  1799.  
  1800. {
  1801. ╔═══════════════════════════════════════════════════════════════════════════╗
  1802. ║                                                                           ║
  1803. ║ Speed-Pascal/2 Version 2.0                                                ║
  1804. ║                                                                           ║
  1805. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  1806. ║                                                                           ║
  1807. ║ This section: TMemoryStream Class Implementation                          ║
  1808. ║                                                                           ║
  1809. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  1810. ║                                                                           ║
  1811. ╚═══════════════════════════════════════════════════════════════════════════╝
  1812. }
  1813.  
  1814. Const
  1815.   MemoryDelta = 8192;
  1816.  
  1817. Destructor TMemoryStream.Destroy;
  1818. Begin
  1819.   Clear;
  1820.   Inherited Destroy;
  1821. End;
  1822.  
  1823. Function TMemoryStream.Read(Var Buffer; Count: LongInt): LongInt;
  1824. Begin
  1825.   If Count > 0 Then
  1826.   Begin
  1827.     Result := FSize - FPosition;
  1828.     If Count < Result Then Result := Count;
  1829.     Move(FBuffer^[FPosition], Buffer, Result);
  1830.     Inc(FPosition, Result);
  1831.   End
  1832.   Else Result := 0;
  1833. End;
  1834.  
  1835. Function TMemoryStream.Write(Const Buffer; Count: LongInt): LongInt;
  1836. Var
  1837.   NewPos, Needed: LongInt;
  1838. Begin
  1839.   If Count > 0 Then
  1840.   Begin
  1841.     NewPos := FPosition + Count;
  1842.     If NewPos > FSize Then
  1843.     Begin
  1844.       FSize := NewPos;
  1845.       If NewPos > FCapacity Then
  1846.       Begin
  1847.         Needed := (NewPos - FCapacity + MemoryDelta - 1) Div MemoryDelta;
  1848.         SetCapacity(FCapacity + Needed * MemoryDelta);
  1849.       End;
  1850.     End;
  1851.     Move(Buffer, FBuffer^[FPosition], Count);
  1852.     FPosition := NewPos;
  1853.   End;
  1854.   Result := Count;
  1855. End;
  1856.  
  1857. Function TMemoryStream.Seek(Offset: LongInt; Origin: Word): LongInt;
  1858. Begin
  1859.   Case Origin Of
  1860.     soFromBeginning: Result := Offset;
  1861.     soFromCurrent:   Result := FPosition + Offset;
  1862.     soFromEnd:       Result := FSize - Offset;
  1863.   End;
  1864.   If (Result < 0) Or (Result > FSize) Then Error(SStreamSeekErrorText)
  1865.   Else FPosition := Result;
  1866. End;
  1867.  
  1868. Procedure TMemoryStream.LoadFromStream(Stream: TStream);
  1869. Var
  1870.   ToDo: LongInt;
  1871. Begin
  1872.   Stream.Position := 0;
  1873.   ToDo := Stream.Size;
  1874.   SetSize(ToDo);
  1875.   If ToDo <> 0 Then Stream.ReadBuffer(FBuffer^[0], ToDo);
  1876. End;
  1877.  
  1878. Procedure TMemoryStream.LoadFromFile(Const FileName:String);
  1879. Var
  1880.   Source: TFileStream;
  1881. Begin
  1882.   Source := TFileStream.Create(FileName, Stream_OpenRead);
  1883.   Try
  1884.     LoadFromStream(Source);
  1885.   Finally
  1886.     Source.Destroy;
  1887.   End;
  1888. End;
  1889.  
  1890. Procedure TMemoryStream.SaveToStream(Stream: TStream);
  1891. Begin
  1892.   If FSize <> 0 Then Stream.WriteBuffer(FBuffer^[0], FSize);
  1893. End;
  1894.  
  1895. Procedure TMemoryStream.SaveToFile(Const FileName:String);
  1896. Var
  1897.   Dest: TFileStream;
  1898. Begin
  1899.   Dest := TFileStream.Create(FileName, Stream_Create);
  1900.   Try
  1901.     SaveToStream(Dest);
  1902.   Finally
  1903.     Dest.Destroy;
  1904.   End;
  1905. End;
  1906.  
  1907. Procedure TMemoryStream.SetCapacity(NewCapacity: LongInt);
  1908. Begin
  1909.   If FCapacity=NewCapacity Then Exit;
  1910.   FBuffer := ReAllocMem(FBuffer, FCapacity, NewCapacity);
  1911.   FCapacity := NewCapacity;
  1912.   If FSize > FCapacity Then FSize := FCapacity;
  1913.   If FPosition > FSize Then FPosition := FSize;
  1914. End;
  1915.  
  1916. Procedure TMemoryStream.SetSize(NewSize: LongInt);
  1917. Begin
  1918.   Clear;
  1919.   SetCapacity(NewSize);
  1920.   FSize := NewSize;
  1921. End;
  1922.  
  1923. Procedure TMemoryStream.Clear;
  1924. Begin
  1925.   SetCapacity(0);
  1926. End;
  1927.  
  1928. {
  1929. ╔═══════════════════════════════════════════════════════════════════════════╗
  1930. ║                                                                           ║
  1931. ║ Speed-Pascal/2 Version 2.0                                                ║
  1932. ║                                                                           ║
  1933. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  1934. ║                                                                           ║
  1935. ║ This section: TList Class Implementation                                  ║
  1936. ║                                                                           ║
  1937. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  1938. ║                                                                           ║
  1939. ╚═══════════════════════════════════════════════════════════════════════════╝
  1940. }
  1941.  
  1942. Procedure TList.Error;
  1943. Begin
  1944.      Raise EListError.Create(LoadNLSStr(SListErrorText));
  1945. End;
  1946.  
  1947.  
  1948. Function TList.Get(Index:LongInt):Pointer;
  1949. Begin
  1950.      Result := Nil;
  1951.      If (Index < 0) Or (Index >= FCount) Then Error
  1952.      Else Result := FList^[Index];
  1953. End;
  1954.  
  1955.  
  1956. Procedure TList.Put(Index:LongInt;Item:Pointer);
  1957. Begin
  1958.      If (Index < 0) Or (Index >= FCount) Then Error
  1959.      Else FList^[Index] := Item;
  1960. End;
  1961.  
  1962.  
  1963. Procedure TList.Grow;
  1964. Var  gr:LongInt;
  1965. Begin
  1966.      If FGrowth <= 0 Then
  1967.      Begin
  1968.           If FCapacity < 128 Then gr := 16
  1969.           Else gr := FCapacity Shr 3;
  1970.      End
  1971.      Else gr := FGrowth;
  1972.      SetCapacity(FCapacity + gr);
  1973. End;
  1974.  
  1975.  
  1976. Procedure TList.SetCapacity(NewCapacity:LongInt);
  1977. Var  NewList:PPointerList;
  1978. Begin
  1979.      If (NewCapacity > MaxListSize) Or (NewCapacity < FCount) Then Error
  1980.      Else
  1981.      If NewCapacity <> FCapacity Then
  1982.      Begin
  1983.           If NewCapacity > 0 Then
  1984.           Begin
  1985.                GetMem(NewList, NewCapacity*SizeOf(Pointer));
  1986.                If FCount > 0 Then System.Move(FList^,NewList^,
  1987.                                               FCount*SizeOf(Pointer));
  1988.           End
  1989.           Else NewList := Nil;
  1990.           If FList<>Nil Then FreeMem(FList, FCapacity*SizeOf(Pointer));
  1991.           FCapacity := NewCapacity;
  1992.           FList := NewList;
  1993.      End;
  1994. End;
  1995.  
  1996.  
  1997. Procedure TList.SetCount(NewCount:LongInt);
  1998. Var  I:LongInt;
  1999. Begin
  2000.      If NewCount=FCount Then Exit;
  2001.      If (NewCount > MaxListSize) Or (NewCount < 0) Then Error
  2002.      Else
  2003.      Begin
  2004.           If NewCount > FCapacity Then SetCapacity(NewCount);
  2005.           If NewCount < FCount Then
  2006.           Begin
  2007.                For I := NewCount To FCount-1 Do FreeItem(FList^[I]);
  2008.           End
  2009.           Else FillChar(FList^[FCount], (NewCount-FCount)*SizeOf(Pointer),0);
  2010.           FCount := NewCount;
  2011.      End;
  2012. End;
  2013.  
  2014.  
  2015. {--- Public part ------------------------------------------------------------}
  2016.  
  2017. (* Clear the whole List And Destroy the List Object *)
  2018. Destructor TList.Destroy;
  2019. Begin
  2020.      Clear;
  2021.      Inherited Destroy;
  2022. End;
  2023.  
  2024.  
  2025. (* Clear the whole List And Release the allocated Memory *)
  2026. Procedure TList.Clear;
  2027. Begin
  2028.      SetCount(0);
  2029.      SetCapacity(0);
  2030. End;
  2031.  
  2032.  
  2033. (*  Append A New Item At the End Of the List And return the New Index *)
  2034. Function TList.Add(Item:Pointer):LongInt;
  2035. Begin
  2036.      If FCount = FCapacity Then Grow;
  2037.      FList^[FCount] := Item;
  2038.      Inc(FCount);
  2039.      Result := FCount-1;
  2040. End;
  2041.  
  2042.  
  2043. (* Delete the Item And decrement the Count Of elements In the List *)
  2044. Procedure TList.Delete(Index:LongInt);
  2045. Begin
  2046.      If (Index < 0) Or (Index >= FCount) Then Error
  2047.      Else
  2048.      Begin
  2049.           FreeItem(FList^[Index]);
  2050.  
  2051.           Dec(FCount);
  2052.           If Index <> FCount Then System.Move(FList^[Index + 1],FList^[Index],
  2053.                                               (FCount-Index)*SizeOf(Pointer));
  2054.      End;
  2055. End;
  2056.  
  2057.  
  2058. (* Remove the Item And decrement the Count Of elements In the List *)
  2059. Function TList.Remove(Item:Pointer):LongInt;
  2060. Begin
  2061.      Result := IndexOf(Item);
  2062.      If Result <> -1 Then Delete(Result);
  2063. End;
  2064.  
  2065.  
  2066. (* Release the Memory allocated by the Item *)
  2067. Procedure TList.FreeItem(Item:Pointer);
  2068. Begin
  2069.      If FOnFreeItem <> Nil Then FOnFreeItem(Self,Item);
  2070. End;
  2071.  
  2072.  
  2073. (* Cut the specified Range out Of the List (including both indices) *)
  2074. Procedure TList.Cut(Index1,Index2:LongInt);
  2075. Var  I,Swap:LongInt;
  2076. Begin
  2077.      If (Index1 < 0) Or (Index1 >= FCount) Or
  2078.         (Index2 < 0) Or (Index2 >= FCount) Then Error
  2079.      Else
  2080.      Begin
  2081.           If Index2 < Index1 Then
  2082.           Begin
  2083.                Swap := Index1;
  2084.                Index1 := Index2;
  2085.                Index2 := Swap;
  2086.           End;
  2087.  
  2088.           For I := Index1 To Index2 Do FreeItem(FList^[I]);
  2089.  
  2090.           If Index2 <> FCount-1 Then System.Move(FList^[Index2+1],FList^[Index1],
  2091.                                                  (FCount-Index2)*SizeOf(Pointer));
  2092.           Dec(FCount,Index2-Index1+1);
  2093.      End;
  2094. End;
  2095.  
  2096.  
  2097. (* Insert A New Item At the specified Position In the List *)
  2098. Procedure TList.Insert(Index:LongInt;Item:Pointer);
  2099. Begin
  2100.      If (Index < 0) Or (Index > FCount) Then Error
  2101.      Else
  2102.      Begin
  2103.           If FCount = FCapacity Then Grow;
  2104.           If Index <> FCount Then System.Move(FList^[Index],FList^[Index+1],
  2105.                                               (FCount-Index)*SizeOf(Pointer));
  2106.           FList^[Index] := Item;
  2107.           Inc(FCount);
  2108.      End;
  2109. End;
  2110.  
  2111.  
  2112. (* Exchange two Items In the List *)
  2113. Procedure TList.Exchange(Index1,Index2:LongInt);
  2114. Var  Item:Pointer;
  2115. Begin
  2116.      Item := Get(Index1);
  2117.      Put(Index1, Get(Index2));
  2118.      Put(Index2, Item);
  2119. End;
  2120.  
  2121.  
  2122. (* Move an Item To A New Position In the List *)
  2123. Procedure TList.Move(CurIndex,NewIndex:LongInt);
  2124. Var  Item:Pointer;
  2125. Begin
  2126.      If (CurIndex < 0) Or (CurIndex >= FCount) Or
  2127.         (NewIndex < 0) Or (NewIndex >= FCount) Then Error
  2128.      Else
  2129.      If CurIndex <> NewIndex Then
  2130.      Begin
  2131.           Item := FList^[CurIndex];
  2132.           If CurIndex < NewIndex
  2133.           Then System.Move(FList^[CurIndex+1], FList^[CurIndex],
  2134.                            (NewIndex-CurIndex)*SizeOf(Pointer))
  2135.           Else System.Move(FList^[NewIndex], FList^[NewIndex+1],
  2136.                            (CurIndex-NewIndex)*SizeOf(Pointer));
  2137.           FList^[NewIndex] := Item;
  2138.      End;
  2139. End;
  2140.  
  2141.  
  2142. (* return the Index Of an Item *)
  2143. Function TList.IndexOf(Item:Pointer):LongInt;
  2144. Begin
  2145.      For Result := 0 To FCount-1 Do
  2146.         If FList^[Result] = Item Then Exit;
  2147.      Result := -1;
  2148. End;
  2149.  
  2150.  
  2151. (* return the First Item In the List *)
  2152. Function TList.First:Pointer;
  2153. Begin
  2154.      Result := Get(0);
  2155. End;
  2156.  
  2157.  
  2158. (* return the Last Item In the List *)
  2159. Function TList.Last:Pointer;
  2160. Begin
  2161.      Result := Get(FCount-1);
  2162. End;
  2163.  
  2164.  
  2165. (* Expand the List If Capacity Is reached *)
  2166. Function TList.Expand:TList;
  2167. Begin
  2168.      If FCount = FCapacity Then Grow;
  2169.      Result := Self;
  2170. End;
  2171.  
  2172.  
  2173. (* Remove All Nil elements In the List *)
  2174. Procedure TList.Pack;
  2175. Var  I:LongInt;
  2176. Begin
  2177.      For I := FCount-1 DownTo 0 Do
  2178.         If FList^[I] = Nil Then Delete(I);
  2179. End;
  2180.  
  2181.  
  2182. Procedure TList.Sort(Compare: TListSortCompare);
  2183.  
  2184.   Procedure Swap(I, K: LongInt);
  2185.   Var
  2186.     Item: Pointer;
  2187.   Begin
  2188.     Item := FList^[I];
  2189.     FList^[I] := FList^[K];
  2190.     FList^[K] := Item;
  2191.   End;
  2192.  
  2193.   Procedure Reheap(I, K: LongInt);
  2194.   Var
  2195.     J: LongInt;
  2196.   Begin
  2197.     J := I;
  2198.     While J Shl 1 < K Do
  2199.     Begin
  2200.       If Compare(FList^[J Shl 1 - 1], FList^[J Shl 1 + 1 - 1]) > 0 Then J := J Shl 1
  2201.       Else J := J Shl 1 + 1;
  2202.     End;
  2203.     If J Shl 1 = K Then J := K;
  2204.  
  2205.     While Compare(FList^[I - 1], FList^[J - 1]) > 0 Do J := J Shr 1;
  2206.  
  2207.     Swap(I - 1, J - 1);
  2208.     J := J Shr 1;
  2209.  
  2210.     While J >= I Do
  2211.     Begin
  2212.       Swap(I - 1, J - 1);
  2213.       J := J Shr 1;
  2214.     End;
  2215.   End;
  2216.  
  2217. Var
  2218.   I, C: LongInt;
  2219. Begin
  2220.   C := Count;
  2221.   For I := C Shr 1 DownTo 1 Do Reheap(I, C);
  2222.   For I := C DownTo 2 Do
  2223.   Begin
  2224.     Swap(0, I - 1);
  2225.     Reheap(1, I - 1);
  2226.   End;
  2227. End;
  2228.  
  2229. {
  2230. ╔═══════════════════════════════════════════════════════════════════════════╗
  2231. ║                                                                           ║
  2232. ║ Speed-Pascal/2 Version 2.0                                                ║
  2233. ║                                                                           ║
  2234. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  2235. ║                                                                           ║
  2236. ║ This section: TChainList Class Implementation                             ║
  2237. ║                                                                           ║
  2238. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  2239. ║                                                                           ║
  2240. ╚═══════════════════════════════════════════════════════════════════════════╝
  2241. }
  2242.  
  2243. Procedure TChainList.Error;
  2244. Begin
  2245.      Raise EListError.Create(LoadNLSStr(SListErrorText));
  2246. End;
  2247.  
  2248.  
  2249. Function TChainList.Index2PLE(Index:LongInt):PChainListItem;
  2250. Var  I:LongInt;
  2251. Begin
  2252.      If (Index < 0) Or (Index >= FCount) Then Result := Nil
  2253.      Else
  2254.      Begin
  2255.           Result := FList;
  2256.           For I := 0 To Index-1 Do Result := Result^.Next;
  2257.           If Result = Nil Then Exit;
  2258.      End;
  2259. End;
  2260.  
  2261.  
  2262. Function TChainList.Item2PLE(Item:Pointer):PChainListItem;
  2263. Begin
  2264.      Result := FList;
  2265.      While Result <> Nil Do
  2266.      Begin
  2267.           If Result^.Item = Item Then Exit;
  2268.           Result := Result^.Next;
  2269.      End;
  2270. End;
  2271.  
  2272.  
  2273. Function TChainList.PLE2Index(ple:PChainListItem):LongInt;
  2274. Var  ple1:PChainListItem;
  2275. Begin
  2276.      Result := -1;
  2277.      ple1 := FList;
  2278.      While ple1 <> Nil Do
  2279.      Begin
  2280.           Inc(Result);
  2281.           If ple1 = ple Then Exit;
  2282.           ple1 := ple1^.Next;
  2283.      End;
  2284.      Result := -1;
  2285. End;
  2286.  
  2287.  
  2288. Function TChainList.Item2Index(Item:Pointer):LongInt;
  2289. Var  ple:PChainListItem;
  2290. Begin
  2291.      Result := -1;
  2292.      ple := FList;
  2293.      While ple <> Nil Do
  2294.      Begin
  2295.           Inc(Result);
  2296.           If ple^.Item = Item Then Exit;
  2297.           ple := ple^.Next;
  2298.      End;
  2299.      Result := -1;
  2300. End;
  2301.  
  2302.  
  2303. Procedure TChainList.Connect(ple1,ple2:PChainListItem);
  2304. Begin
  2305.      If ple1 <> Nil Then ple1^.Next := ple2
  2306.      Else FList := ple2;
  2307.      If ple2 <> Nil Then ple2^.Prev := ple1
  2308.      Else FListEnd := ple1;
  2309. End;
  2310.  
  2311.  
  2312. Function TChainList.Get(Index:LongInt):Pointer;
  2313. Var  ple:PChainListItem;
  2314. Begin
  2315.      ple := Index2PLE(Index);
  2316.      If ple = Nil Then Error;
  2317.      Result := ple^.Item;
  2318. End;
  2319.  
  2320.  
  2321. Procedure TChainList.Put(Index:LongInt;Item:Pointer);
  2322. Var  ple:PChainListItem;
  2323. Begin
  2324.      ple := Index2PLE(Index);
  2325.      If ple = Nil Then Error;
  2326.      ple^.Item := Item;
  2327. End;
  2328.  
  2329.  
  2330.  
  2331. Destructor TChainList.Destroy;
  2332. Begin
  2333.      Clear;
  2334.      Inherited Destroy;
  2335. End;
  2336.  
  2337.  
  2338. Procedure TChainList.Clear;
  2339. Var  I:LongInt;
  2340.      ple,plenext:PChainListItem;
  2341. Begin
  2342.      ple := FList;
  2343.      For I := 0 To FCount-1 Do
  2344.      Begin
  2345.           FreeItem(ple^.Item);
  2346.  
  2347.           plenext := ple^.Next;
  2348.           Dispose(ple);
  2349.           ple := plenext;
  2350.      End;
  2351.      FCount := 0;
  2352.      FList := Nil;
  2353.      FListEnd := Nil;
  2354. End;
  2355.  
  2356.  
  2357. Function TChainList.Add(Item:Pointer):LongInt;
  2358. Var  plenew:PChainListItem;
  2359. Begin
  2360.      New(plenew);
  2361.      plenew^.Item := Item;
  2362.      plenew^.Next := Nil;
  2363.      Connect(FListEnd,plenew);
  2364.      FListEnd := plenew;
  2365.      Result := FCount;
  2366.      Inc(FCount);
  2367. End;
  2368.  
  2369.  
  2370. Function TChainList.Remove(Item:Pointer):LongInt;
  2371. Var  I:LongInt;
  2372.      ple:PChainListItem;
  2373. Begin
  2374.      ple := FList;
  2375.      For I := 0 To FCount-1 Do
  2376.      Begin
  2377.           If ple^.Item = Item Then
  2378.           Begin
  2379.                FreeItem(ple^.Item);
  2380.  
  2381.                Result := I;
  2382.                Connect(ple^.Prev,ple^.Next);
  2383.                Dispose(ple);
  2384.                Dec(FCount);
  2385.                Exit;
  2386.           End;
  2387.           ple := ple^.Next;
  2388.      End;
  2389.      Result := -1;
  2390. End;
  2391.  
  2392.  
  2393. Procedure TChainList.Delete(Index:LongInt);
  2394. Var  ple:PChainListItem;
  2395. Begin
  2396.      ple := Index2PLE(Index);
  2397.      If ple = Nil Then Error;
  2398.  
  2399.      FreeItem(ple^.Item);
  2400.  
  2401.      Connect(ple^.Prev,ple^.Next);
  2402.      Dispose(ple);
  2403.      Dec(FCount);
  2404. End;
  2405.  
  2406.  
  2407. Procedure TChainList.FreeItem(Item:Pointer);
  2408. Begin
  2409.      If FOnFreeItem <> Nil Then FOnFreeItem(Self,Item);
  2410. End;
  2411.  
  2412.  
  2413. Function TChainList.First:Pointer;
  2414. Var  ple:PChainListItem;
  2415. Begin
  2416.      ple := FList;
  2417.      If ple = Nil Then Error;
  2418.      Result := ple^.Item;
  2419. End;
  2420.  
  2421.  
  2422. Function TChainList.Last:Pointer;
  2423. Var  ple:PChainListItem;
  2424. Begin
  2425.      ple := FListEnd;
  2426.      If ple = Nil Then Error;
  2427.      Result := ple^.Item;
  2428. End;
  2429.  
  2430.  
  2431. Function TChainList.IndexOf(Item:Pointer):LongInt;
  2432. Begin
  2433.      Result := Item2Index(Item);
  2434. End;
  2435.  
  2436.  
  2437. Procedure TChainList.Insert(Index:LongInt;Item:Pointer);
  2438. Var  ple,plenew:PChainListItem;
  2439. Begin
  2440.      If Index < 0 Then Error;
  2441.      If Index > FCount Then Error;
  2442.  
  2443.      ple := Index2PLE(Index);
  2444.      If ple <> Nil Then
  2445.      Begin
  2446.           New(plenew);
  2447.           plenew^.Item := Item;
  2448.           Connect(ple^.Prev,plenew);
  2449.           Connect(plenew,ple);
  2450.           Inc(FCount);
  2451.      End
  2452.      Else Add(Item);
  2453. End;
  2454.  
  2455.  
  2456. Procedure TChainList.Move(CurIndex,NewIndex:LongInt);
  2457. Var  TempItem:Pointer;
  2458. Begin
  2459.      If CurIndex < 0 Then Error;
  2460.      If CurIndex >= FCount Then Error;
  2461.      If NewIndex < 0 Then Error;
  2462.      If NewIndex >= FCount Then Error;
  2463.      If CurIndex = NewIndex Then Exit;
  2464.  
  2465.      TempItem := Get(CurIndex);
  2466.      Delete(CurIndex);
  2467.      Insert(NewIndex,TempItem);
  2468. End;
  2469.  
  2470.  
  2471. Procedure TChainList.Exchange(Index1,Index2:LongInt);
  2472. Var  ple1,ple2:PChainListItem;
  2473.      TempItem:Pointer;
  2474. Begin
  2475.      ple1 := Index2PLE(Index1);
  2476.      ple2 := Index2PLE(Index2);
  2477.      If (ple1 = Nil) Or (ple2 = Nil) Then Error;
  2478.  
  2479.      TempItem := ple1^.Item;
  2480.      ple1^.Item := ple2^.Item;
  2481.      ple2^.Item := TempItem;
  2482. End;
  2483.  
  2484.  
  2485. Procedure TChainList.Pack;
  2486. Var  I:LongInt;
  2487.      ple,plenext:PChainListItem;
  2488. Begin
  2489.      ple := FList;
  2490.      For I := 0 To FCount-1 Do
  2491.      Begin
  2492.           plenext := ple^.Next;
  2493.           If ple^.Item = Nil Then
  2494.           Begin
  2495.                Connect(ple^.Prev,ple^.Next);
  2496.                Dispose(ple);
  2497.                Dec(FCount);
  2498.           End;
  2499.           ple := plenext;
  2500.      End;
  2501. End;
  2502.  
  2503.  
  2504. { --- Utility FUNCTIONs For TStrItem --- }
  2505.  
  2506. Function NewStrItem(Const AString: String; AObject: TObject): PStrItem;
  2507. Begin
  2508.   GetMem(Result, SizeOf(TObject) + Length(AString) + 1);
  2509.   Result^.FObject := AObject;
  2510.   Result^.FString := AString;
  2511. End;
  2512.  
  2513. Procedure DisposeStrItem(P: PStrItem);
  2514. Begin
  2515.   FreeMem(P, SizeOf(TObject) + Length(P^.FString) + 1);
  2516. End;
  2517.  
  2518.  
  2519. { --- TStrings --- }
  2520.  
  2521. Procedure TStrings.Append(Const S: String);
  2522. Begin
  2523.   Add(S);
  2524. End;
  2525.  
  2526. Procedure TStrings.Put(Index: LongInt; Const S: String);
  2527. Var  Temp:TObject;
  2528. Begin
  2529.   Temp := GetObject(Index);
  2530.   Delete(Index);
  2531.   InsertObject(Index, S, Temp);
  2532. End;
  2533.  
  2534. {$HINTS OFF}
  2535. Function TStrings.GetObject(Index: LongInt): TObject;
  2536. Begin
  2537.   Result := Nil;
  2538. End;
  2539.  
  2540. Procedure TStrings.PutObject(Index: LongInt; AObject: TObject);
  2541. Begin
  2542. End;
  2543. {$HINTS ON}
  2544.  
  2545. Function TStrings.Add(Const S: String): LongInt;
  2546. Begin
  2547.   Result := Count;
  2548.   Insert(Result, S);
  2549. End;
  2550.  
  2551. Function TStrings.AddObject(Const S: String; AObject: TObject): LongInt;
  2552. Begin
  2553.   Result := Add(S);
  2554.   PutObject(Result, AObject);
  2555. End;
  2556.  
  2557. Procedure TStrings.AddStrings(AStrings: TStrings);
  2558. Var
  2559.   I: LongInt;
  2560. Begin
  2561.   BeginUpdate;
  2562.   Try
  2563.     For I := 0 To AStrings.Count - 1 Do
  2564.        AddObject(AStrings.Get(I), AStrings.GetObject(I));
  2565.   Finally
  2566.     EndUpdate;
  2567.   End;
  2568. End;
  2569.  
  2570. Procedure TStrings.Assign(AStrings: TStrings);
  2571. Begin
  2572.   If AStrings=Self Then Exit;
  2573.   BeginUpdate;
  2574.   Try
  2575.     Clear;
  2576.     If AStrings<>Nil Then AddStrings(AStrings);
  2577.   Finally
  2578.     EndUpdate;
  2579.   End;
  2580. End;
  2581.  
  2582. Procedure TStrings.BeginUpdate;
  2583. Begin
  2584.   If FUpdateSemaphore = 0 Then SetUpdateState(True);
  2585.   Inc(FUpdateSemaphore);
  2586. End;
  2587.  
  2588. Procedure TStrings.EndUpdate;
  2589. Begin
  2590.   Dec(FUpdateSemaphore);
  2591.   If FUpdateSemaphore = 0 Then SetUpdateState(False);
  2592. End;
  2593.  
  2594. Function TStrings.Equals(AStrings: TStrings): Boolean;
  2595. Var
  2596.   N: LongInt;
  2597. Begin
  2598.   Result := False;
  2599.   If Count <> AStrings.Count Then Exit;
  2600.   For N := 0 To Count - 1 Do If Get(N) <> AStrings.Get(N) Then Exit;
  2601.   Result := True;
  2602. End;
  2603.  
  2604. Procedure TStrings.Exchange(Index1, Index2: LongInt);
  2605. Var
  2606.   S: String;
  2607.   O: TObject;
  2608. Begin
  2609.   S := Get(Index1);
  2610.   O := GetObject(Index1);
  2611.   Put(Index1, Get(Index2));
  2612.   PutObject(Index1, GetObject(Index2));
  2613.   Put(Index2, S);
  2614.   PutObject(Index2, O);
  2615. End;
  2616.  
  2617. Function TStrings.GetName(Index: LongInt): String;
  2618. Var
  2619.   P: Integer;
  2620. Begin
  2621.   Result := Get(Index);
  2622.   P := Pos('=', Result);
  2623.   System.Delete(Result, P, Length(Result) - P + 1);
  2624. End;
  2625.  
  2626. Procedure SingleLineToBuffer(Const S: String; Var P: PChar);
  2627. Begin
  2628.   Move(S[1], P[0], Length(S));
  2629.   Inc(P, Length(S));
  2630.   P[0] := #13;
  2631.   P[1] := #10;
  2632.   Inc(P, 2);
  2633. End;
  2634.  
  2635. Function TStrings.GetText: PChar;
  2636. Var
  2637.   N, BufSize: LongInt;
  2638.   BufPtr: PChar;
  2639. Begin
  2640.   BufSize := 1;
  2641.   For N := 0 To Count - 1 Do Inc(BufSize, Length(Get(N)) + 2);
  2642.   Result := StrAlloc(BufSize);
  2643.  
  2644.   BufPtr := Result;
  2645.   For N := 0 To Count - 1 Do SingleLineToBuffer(Get(N), BufPtr);
  2646.   BufPtr[0] := #0;
  2647. End;
  2648.  
  2649. Function TStrings.GetTextStr: AnsiString;
  2650. Var
  2651.   N, BufSize: LongInt;
  2652.   BufPtr: PChar;
  2653. Begin
  2654.   BufSize := 0;
  2655.   For N := 0 To Count - 1 Do Inc(BufSize, Length(Get(N)) + 2);
  2656.   SetLength(Result, BufSize);
  2657.   BufPtr := PChar(Result);
  2658.   For N := 0 To Count - 1 Do SingleLineToBuffer(Get(N), BufPtr);
  2659. End;
  2660.  
  2661. Function TStrings.GetValue(Const Name: String): String;
  2662. Begin
  2663.   FindValue(Name, Result);
  2664. End;
  2665.  
  2666. Function TStrings.FindValue(Const Name: String; Var Value: String): LongInt;
  2667. Var
  2668.   P: Integer;
  2669. Begin
  2670.   For Result := 0 To Count - 1 Do
  2671.   Begin
  2672.     Value := Get(Result);
  2673.     P := Pos('=', Value);
  2674.     If P <> 0 Then
  2675.     Begin
  2676.       If CompareText(Copy(Value, 1, P - 1), Name) = 0 Then
  2677.       Begin
  2678.         System.Delete(Value, 1, P);
  2679.         Exit;
  2680.       End;
  2681.     End;
  2682.   End;
  2683.   Result := -1;
  2684.   Value := '';
  2685. End;
  2686.  
  2687. Function TStrings.IndexOfName(Const Name: String): LongInt;
  2688. Var
  2689.   P: Integer;
  2690.   S: String;
  2691. Begin
  2692.   For Result := 0 To Count - 1 Do
  2693.   Begin
  2694.     S := Get(Result);
  2695.     P := Pos('=', S);
  2696.     If CompareText(Copy(S, 1, P - 1), Name) = 0 Then Exit;
  2697.   End;
  2698.   Result := -1;
  2699. End;
  2700.  
  2701. Function TStrings.IndexOf(Const S: String): LongInt;
  2702. Begin
  2703.   For Result := 0 To Count-1 Do If CompareText(Get(Result), S) = 0 Then Exit;
  2704.   Result := -1;
  2705. End;
  2706.  
  2707. Function TStrings.IndexOfObject(AObject: TObject): LongInt;
  2708. Begin
  2709.   For Result := 0 To Count-1 Do If GetObject(Result) = AObject Then Exit;
  2710.   Result := -1;
  2711. End;
  2712.  
  2713. Procedure TStrings.InsertObject(Index: LongInt; Const S: String; AObject: TObject);
  2714. Begin
  2715.   Insert(Index, S);
  2716.   PutObject(Index, AObject);
  2717. End;
  2718.  
  2719. Procedure TStrings.LoadFromFile(Const FileName: String);
  2720. Var
  2721.   Source: TFileStream;
  2722. Begin
  2723.   Try
  2724.     Source := TFileStream.Create(FileName, Stream_OpenRead);
  2725.   Except
  2726.     Source.Destroy;
  2727.     Raise;
  2728.   End;
  2729.  
  2730.   Try
  2731.     LoadFromStream(Source);
  2732.   Finally
  2733.     Source.Destroy;
  2734.   End;
  2735. End;
  2736.  
  2737. Procedure TStrings.LoadFromStream(Stream: TStream);
  2738. Begin
  2739.   BeginUpdate;
  2740.   Clear;
  2741.   Try
  2742.     While Not Stream.EndOfData Do Add(Stream.ReadLn);
  2743.   Finally
  2744.     EndUpdate;
  2745.   End;
  2746. End;
  2747.  
  2748. Procedure TStrings.Move(CurIndex, NewIndex: LongInt);
  2749. Var
  2750.   O: TObject;
  2751.   S: String;
  2752. Begin
  2753.   If CurIndex = NewIndex Then Exit;
  2754.   S := Get(CurIndex);
  2755.   O := GetObject(CurIndex);
  2756.   FPreventFree := True;
  2757.   Delete(CurIndex);
  2758.   InsertObject(NewIndex, S, O);
  2759.   FPreventFree := False;
  2760. End;
  2761.  
  2762. Procedure TStrings.SaveToFile(Const FileName: String);
  2763. Var
  2764.   Dest: TFileStream;
  2765. Begin
  2766.   Try
  2767.     Dest := TFileStream.Create(FileName, Stream_Create);
  2768.   Except
  2769.     Dest.Destroy;
  2770.     Raise;
  2771.   End;
  2772.  
  2773.   Try
  2774.     SaveToStream(Dest);
  2775.   Finally
  2776.     Dest.Destroy;
  2777.   End;
  2778. End;
  2779.  
  2780. Procedure TStrings.SaveToStream(Stream: TStream);
  2781. Var
  2782.   N: LongInt;
  2783. Begin
  2784.   For N := 0 To Count - 1 Do Stream.WriteLn(Get(N));
  2785. End;
  2786.  
  2787. Procedure TStrings.SetText(Text: PChar);
  2788.  
  2789.   Function SingleLineFromBuffer(Var P: PChar): String;
  2790.   Var
  2791.     I: Integer;
  2792.     Q: PChar;
  2793.   Begin
  2794.     I := 0;
  2795.     Q := P;
  2796.     While Not (Q[0] In [#13, #10, #26, #0]) And (I < 255) Do
  2797.     Begin
  2798.       Inc(Q);
  2799.       Inc(I);
  2800.     End;
  2801.     StrMove(@Result[1], P, I);
  2802.     SetLength(Result, I);
  2803.     P := Q;
  2804.     If P[0] = #13 Then Inc(P);
  2805.     If P[0] = #10 Then Inc(P);
  2806.   End;
  2807.  
  2808. Begin
  2809.   BeginUpdate;
  2810.   Try
  2811.     Clear;
  2812.     If Text<>Nil Then While Not (Text[0] In [#0, #26]) Do
  2813.     Begin
  2814.       Add(SingleLineFromBuffer(Text));
  2815.     End;
  2816.   Finally
  2817.     EndUpdate;
  2818.   End;
  2819. End;
  2820.  
  2821. Procedure TStrings.SetTextStr(Const Value: AnsiString);
  2822. Begin
  2823.     SetText(PChar(Value));
  2824. End;
  2825.  
  2826. {$HINTS OFF}
  2827. Procedure TStrings.SetUpdateState(Updating: Boolean);
  2828. Begin
  2829. End;
  2830. {$HINTS ON}
  2831.  
  2832. Procedure TStrings.SetValue(Const Name, Value: String);
  2833. Var
  2834.   I: LongInt;
  2835.   S: String;
  2836. Begin
  2837.   I := FindValue(Name, S);
  2838.   If I < 0 Then
  2839.   Begin
  2840.     If Length(Value) <> 0 Then Add(Name + '=' + Value)
  2841.   End
  2842.   Else
  2843.   Begin
  2844.     If Length(Value) <> 0 Then Put(I, Name + '=' + Value)
  2845.     Else Delete(I);
  2846.   End;
  2847. End;
  2848.  
  2849. { --- TStringList --- }
  2850.  
  2851. Constructor TStringList.Create;
  2852. Begin
  2853.   Inherited Create;
  2854.   FList := TList.Create;
  2855.   FCaseSensitive := False;
  2856. End;
  2857.  
  2858. Destructor TStringList.Destroy;
  2859. Begin
  2860.   { Die folgenden zwei Zeilen später wieder ändern }
  2861.   Pointer(FOnChanging) := Nil;
  2862.   Pointer(FOnChange) := Nil;
  2863.   Clear;
  2864.   FList.Destroy;
  2865.   FList := Nil;
  2866.   Inherited Destroy;
  2867. End;
  2868.  
  2869. Function TStringList.Add(Const S: String): LongInt;
  2870. Begin
  2871.   If FSorted Then
  2872.   Begin
  2873.     If Find(S, Result) Then
  2874.     Begin
  2875.       Case FDuplicates Of
  2876.         dupIgnore: Exit;
  2877.         dupError: Raise EStringListError.Create(LoadNLSStr(SStringListDupeErrorText));
  2878.       End;
  2879.     End;
  2880.   End
  2881.   Else Result := Count;
  2882.   Changing;
  2883.   FList.Insert(Result, NewStrItem(S, Nil));
  2884.   changed;
  2885. End;
  2886.  
  2887. Procedure TStringList.changed;
  2888. Begin
  2889.   If (FUpdateSemaphore = 0) And (FOnChange <> Nil) Then FOnChange(Self);
  2890. End;
  2891.  
  2892. Procedure TStringList.Changing;
  2893. Begin
  2894.   If (FUpdateSemaphore = 0) And (FOnChanging <> Nil) Then FOnChanging(Self);
  2895. End;
  2896.  
  2897. Procedure TStringList.Clear;
  2898. Var
  2899.   N: LongInt;
  2900. Begin
  2901.   If Count > 0 Then
  2902.   Begin
  2903.     Changing;
  2904.     FLockChange:=True;
  2905.     For N := Count - 1 DownTo 0 Do Delete(N);
  2906.     FLockChange:=False;
  2907.     changed;
  2908.   End;
  2909. End;
  2910.  
  2911. Procedure TStringList.Delete(Index: LongInt);
  2912. Begin
  2913.   If FLockChange Then
  2914.   Begin
  2915.        FreeItem(GetObject(Index));
  2916.        DisposeStrItem(FList.Get(Index));
  2917.        FList.Delete(Index);
  2918.   End
  2919.   Else
  2920.   Begin
  2921.        Changing;
  2922.        If Not FPreventFree Then FreeItem(GetObject(Index));
  2923.        DisposeStrItem(FList.Get(Index));
  2924.        FList.Delete(Index);
  2925.        changed;
  2926.   End;
  2927. End;
  2928.  
  2929. Procedure TStringList.FreeItem(AObject:TObject);
  2930. Begin
  2931.      If FOnFreeItem <> Nil Then FOnFreeItem(Self,AObject);
  2932. End;
  2933.  
  2934. Procedure TStringList.Exchange(Index1, Index2: LongInt);
  2935. Begin
  2936.   Changing;
  2937.   FList.Exchange(Index1, Index2);
  2938.   changed;
  2939. End;
  2940.  
  2941. Function TStringList.Find(Const S: String; Var Index: LongInt): Boolean;
  2942. Var
  2943.   Low, High: LongInt;
  2944.   CMP: Integer;
  2945.   DoCompare: Function(Const S, T: String): Integer;
  2946.  
  2947. Begin
  2948.   If CaseSensitive Then DoCompare := CompareStr
  2949.   Else DoCompare := CompareText;
  2950.  
  2951.   If sorted Then
  2952.   Begin
  2953.     { binary Search }
  2954.     Low := 0;
  2955.     High := GetCount - 1;
  2956.     Index := 0;
  2957.     CMP := -1;
  2958.     While (CMP <> 0) And (Low <= High) Do
  2959.     Begin
  2960.       Index := (Low + High) Div 2;
  2961.       CMP := DoCompare(S, Get(Index));
  2962.       If CMP < 0 Then High := Index -1
  2963.       Else If CMP > 0 Then Low := Index + 1;
  2964.     End;
  2965.     If Low = Index + 1 Then Inc(Index);
  2966.     Result := (CMP = 0);
  2967.   End
  2968.   Else
  2969.   Begin
  2970.     { Linear Search }
  2971.     Index := 0;
  2972.     While (Index < Count) And (DoCompare(Get(Index), S) <> 0) Do Inc(Index);
  2973.     Result := (Index < Count);
  2974.   End;
  2975. End;
  2976.  
  2977. Function TStringList.Get(Index: LongInt): String;
  2978. Begin
  2979.   Result := PStrItem(FList.Get(Index))^.FString;
  2980. End;
  2981.  
  2982. Function TStringList.GetCount: LongInt;
  2983. Begin
  2984.   Result := FList.Count;
  2985. End;
  2986.  
  2987. Function TStringList.GetObject(Index: LongInt): TObject;
  2988. Begin
  2989.   Result := PStrItem(FList.Get(Index))^.FObject;
  2990. End;
  2991.  
  2992. Function TStringList.IndexOf(Const S: String): LongInt;
  2993. Begin
  2994.   If Not Find(S, Result) Then Result := -1;
  2995. End;
  2996.  
  2997. Procedure TStringList.Insert(Index: LongInt; Const S: String);
  2998. Begin
  2999.   Changing;
  3000.   If FSorted Then Raise EListError.Create(LoadNLSStr(SStringListInsertErrorText))
  3001.   Else FList.Insert(Index, NewStrItem(S, Nil));
  3002.   changed;
  3003. End;
  3004.  
  3005. Procedure TStringList.Put(Index: LongInt; Const S: String);
  3006. Var  TempObj:TObject;
  3007.      pstr:PStrItem;
  3008. Begin
  3009.   Changing;
  3010.   pstr := FList.Get(Index);
  3011.   TempObj := pstr^.FObject;
  3012.   DisposeStrItem(pstr);
  3013.   FList.Put(Index, NewStrItem(S, TempObj));
  3014.   changed;
  3015. End;
  3016.  
  3017. Procedure TStringList.PutObject(Index: LongInt; AObject: TObject);
  3018. Var
  3019.   P: PStrItem;
  3020. Begin
  3021.   P := FList.Get(Index);
  3022.   P^.FObject := AObject;
  3023. End;
  3024.  
  3025. Procedure TStringList.BottomUpHeapSort;
  3026. Var
  3027.   DoCompare: Function (Const S, T: String): Integer;
  3028.  
  3029.   Procedure Reheap(I, K: LongInt);
  3030.   Var
  3031.     J: LongInt;
  3032.   Begin
  3033.     J := I;
  3034.     While J Shl 1 < K Do
  3035.     Begin
  3036.       If DoCompare(Get(J Shl 1 - 1), Get(J Shl 1 + 1 - 1)) > 0 Then J := J Shl 1
  3037.       Else J := J Shl 1 + 1;
  3038.     End;
  3039.     If J Shl 1 = K Then J := K;
  3040.  
  3041.     While DoCompare(Get(I - 1), Get(J - 1)) > 0 Do J := J Shr 1;
  3042.  
  3043.     FList.Exchange(I - 1, J - 1);
  3044.     J := J Shr 1;
  3045.  
  3046.     While J >= I Do
  3047.     Begin
  3048.       FList.Exchange(I - 1, J - 1);
  3049.       J := J Shr 1;
  3050.     End;
  3051.   End;
  3052.  
  3053. Var
  3054.   I, C: LongInt;
  3055. Begin
  3056.   If CaseSensitive Then DoCompare := CompareStr
  3057.   Else DoCompare := CompareText;
  3058.  
  3059.   C := Count;
  3060.   For I := C Shr 1 DownTo 1 Do Reheap(I, C);
  3061.   For I := C DownTo 2 Do
  3062.   Begin
  3063.     FList.Exchange(0, I - 1);
  3064.     Reheap(1, I - 1);
  3065.   End;
  3066. End;
  3067.  
  3068. Procedure TStringList.SetCaseSensitive(Value: Boolean);
  3069. Var
  3070.   old: Boolean;
  3071. Begin
  3072.   Changing;
  3073.   old := FCaseSensitive;
  3074.   FCaseSensitive := Value;
  3075.   If FSorted And (FCaseSensitive <> old) Then Sort;
  3076.   changed;
  3077. End;
  3078.  
  3079. Procedure TStringList.SetSorted(Value: Boolean);
  3080. Begin
  3081.   Changing;
  3082.   If (Not FSorted) And Value Then Sort;
  3083.   FSorted := Value;
  3084.   changed;
  3085. End;
  3086.  
  3087. Procedure TStringList.SetUpdateState(Updating: Boolean);
  3088. Begin
  3089.   If Updating Then Changing
  3090.   Else changed;
  3091. End;
  3092.  
  3093. Procedure TStringList.Sort;
  3094. Begin
  3095.   If Count > 1 Then
  3096.   Begin
  3097.     Changing;
  3098.     BottomUpHeapSort;
  3099.     changed;
  3100.   End;
  3101. End;
  3102.  
  3103.  
  3104.  
  3105. {
  3106. ╔═══════════════════════════════════════════════════════════════════════════╗
  3107. ║                                                                           ║
  3108. ║ Speed-Pascal/2 Version 2.0                                                ║
  3109. ║                                                                           ║
  3110. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  3111. ║                                                                           ║
  3112. ║ This section: Some useful FUNCTIONs                                       ║
  3113. ║                                                                           ║
  3114. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  3115. ║                                                                           ║
  3116. ╚═══════════════════════════════════════════════════════════════════════════╝
  3117. }
  3118.  
  3119. Function MessageBox2(Const Msg:String;Typ:TMsgDlgType;Buttons:TMsgDlgButtons):TMsgDlgReturn;
  3120. Var C,Title:cstring;
  3121.     iFlags:LongWord;
  3122.     mresult:LongWord;
  3123. Begin
  3124.      C:=Msg;
  3125.  
  3126.      {$IFDEF OS2}
  3127.      iFlags:=MB_MOVEABLE OR MB_APPLMODAL;
  3128.  
  3129.      If Typ=mtError Then
  3130.      Begin
  3131.           Title:=LoadNLSStr(SError);
  3132.           iFlags:=iFlags Or MB_ERROR;
  3133.      End
  3134.      Else If Typ=mtCritical Then
  3135.      Begin
  3136.           Title:=LoadNLSStr(SCriticalError);
  3137.           iFlags:=iFlags Or MB_CRITICAL;
  3138.      End
  3139.      Else If Typ=mtInformation Then
  3140.      Begin
  3141.           Title:=LoadNLSStr(sInformation);
  3142.           iFlags:=iFlags Or MB_INFORMATION;
  3143.      End
  3144.      Else If Typ=mtWarning Then
  3145.      Begin
  3146.           Title:=LoadNLSStr(SWarning);
  3147.           iFlags:=iFlags Or MB_WARNING;
  3148.      End
  3149.      Else If Typ=mtConfirmation Then
  3150.      Begin
  3151.           Title:=LoadNLSStr(SMessage);
  3152.           iFlags:=iFlags Or MB_ICONQUESTION;
  3153.      End
  3154.      Else
  3155.      Begin
  3156.           Title:=ParamStr(0);
  3157.           iFlags:=iFlags Or MB_NOICON;
  3158.      End;
  3159.  
  3160.      If Buttons*[mbOk]<>[] Then
  3161.      Begin
  3162.           If Buttons*[mbCancel]<>[] Then iFlags:=iFlags Or MB_OKCANCEL
  3163.           Else iFlags:=iFlags Or MB_OK;
  3164.      End
  3165.      Else If Buttons*[mbCancel]<>[] Then
  3166.      Begin
  3167.           If Buttons*mbYesNo<>[] Then iFlags:=iFlags Or MB_YESNOCANCEL
  3168.           Else If Buttons*[mbRetry]<>[] Then iFlags:=iFlags Or MB_RETRYCANCEL
  3169.           Else iFlags:=iFlags Or MB_CANCEL;
  3170.      End
  3171.      Else If Buttons*[mbYes]<>[] Then
  3172.      Begin
  3173.           If Buttons*[mbNo]<>[] Then iFlags:=iFlags Or MB_YESNO
  3174.           Else iFlags:=iFlags Or MB_OK;
  3175.      End;
  3176.  
  3177.      If Buttons*mbAbortRetryIgnore<>[] Then iFlags:=iFlags Or MB_ABORTRETRYIGNORE;
  3178.  
  3179.      InitPM;
  3180.      mresult:=WinMessageBox(HWND_DESKTOP,HWND_DESKTOP,C,Title,0,iFlags);
  3181.  
  3182.      Case mresult Of
  3183.          MBID_OK:Result:=mrOk;
  3184.          MBID_CANCEL:Result:=mrCancel;
  3185.          MBID_YES:Result:=mrYes;
  3186.          MBID_NO:Result:=mrNo;
  3187.          MBID_IGNORE:Result:=mrIgnore;
  3188.          MBID_ABORT:Result:=mrAbort;
  3189.          MBID_RETRY:Result:=mrRetry;
  3190.          Else Result:=mrCancel;
  3191.      End; {Case}
  3192.      {$ENDIF}
  3193.      {$IFDEF Win95}
  3194.      iFlags:=MB_TASKMODAL;
  3195.  
  3196.      If Typ=mtError Then
  3197.      Begin
  3198.           Title:=LoadNLSStr(SError);
  3199.           iFlags:=iFlags Or MB_ICONHAND;
  3200.      End
  3201.      Else If Typ=mtCritical Then
  3202.      Begin
  3203.           Title:=LoadNLSStr(SCriticalError);
  3204.           iFlags:=iFlags Or MB_ICONHAND;
  3205.      End
  3206.      Else If Typ=mtInformation Then
  3207.      Begin
  3208.           Title:=LoadNLSStr(sInformation);
  3209.           iFlags:=iFlags Or MB_ICONEXCLAMATION;
  3210.      End
  3211.      Else If Typ=mtWarning Then
  3212.      Begin
  3213.           Title:=LoadNLSStr(SWarning);
  3214.           iFlags:=iFlags Or MB_ICONEXCLAMATION;
  3215.      End
  3216.      Else If Typ=mtConfirmation Then
  3217.      Begin
  3218.           Title:=LoadNLSStr(SMessage);
  3219.           iFlags:=iFlags Or MB_ICONQUESTION;
  3220.      End
  3221.      Else
  3222.      Begin
  3223.           Title:=ParamStr(0);
  3224.      End;
  3225.  
  3226.      If Buttons*[mbOk]<>[] Then
  3227.      Begin
  3228.           If Buttons*[mbCancel]<>[] Then iFlags:=iFlags Or MB_OKCANCEL
  3229.           Else iFlags:=iFlags Or MB_OK;
  3230.      End
  3231.      Else If Buttons*[mbCancel]<>[] Then
  3232.      Begin
  3233.           If Buttons*mbYesNo<>[] Then iFlags:=iFlags Or MB_YESNOCANCEL
  3234.           Else If Buttons*[mbRetry]<>[] Then iFlags:=iFlags Or MB_RETRYCANCEL
  3235.           Else iFlags:=iFlags Or MB_OK; //MB_CANCEL only Not present
  3236.      End
  3237.      Else If Buttons*[mbYes]<>[] Then
  3238.      Begin
  3239.           If Buttons*[mbNo]<>[] Then iFlags:=iFlags Or MB_YESNO
  3240.           Else iFlags:=iFlags Or MB_OK;
  3241.      End;
  3242.  
  3243.      If Buttons*mbAbortRetryIgnore<>[] Then iFlags:=iFlags Or MB_ABORTRETRYIGNORE;
  3244.  
  3245.      mresult:=WinUser.MessageBox(0,C,Title,iFlags);
  3246.  
  3247.      Case mresult Of
  3248.          IDOK:Result:=mrOk;
  3249.          IDCANCEL:Result:=mrCancel;
  3250.          IDYES:Result:=mrYes;
  3251.          IDNO:Result:=mrNo;
  3252.          IDIGNORE:Result:=mrIgnore;
  3253.          IDABORT:Result:=mrAbort;
  3254.          IDRETRY:Result:=mrRetry;
  3255.          Else Result:=mrCancel;
  3256.      End; {Case}
  3257.      {$ENDIF}
  3258. End;
  3259.  
  3260.  
  3261. Function ErrorBox2(Const Msg:String):TMsgDlgReturn;
  3262. Begin
  3263.      Beep(1000,200);
  3264.      Result:=MessageBox2(Msg,mtError,[mbOk]);
  3265. End;
  3266.  
  3267.  
  3268.  
  3269. {
  3270. ╔═══════════════════════════════════════════════════════════════════════════╗
  3271. ║                                                                           ║
  3272. ║ Speed-Pascal/2 Version 2.0                                                ║
  3273. ║                                                                           ║
  3274. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  3275. ║                                                                           ║
  3276. ║ This section: SCU File format types And records                           ║
  3277. ║                                                                           ║
  3278. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  3279. ║                                                                           ║
  3280. ╚═══════════════════════════════════════════════════════════════════════════╝
  3281. }
  3282.  
  3283. Type
  3284.     PResourceEntry=^TResourceEntry;
  3285.     TResourceEntry=Record
  3286.                          ResName:TResourceName;
  3287.                          DataOffset:LongInt;
  3288.                          DataLen:LongInt;
  3289.                    End;
  3290.  
  3291. Function CompareResMem(Var Buf1,Buf2;Size:LongWord):Boolean;
  3292. Var R:Boolean;
  3293. Begin
  3294.      Asm
  3295.         CLD
  3296.         MOV ESI,Buf1
  3297.         MOV EDI,Buf2
  3298.         MOV ECX,Size
  3299.         CLD
  3300.         REP
  3301.         CMPSB
  3302.         SETE AL
  3303.         MOV R,AL
  3304.      End;
  3305.      Result:=R;
  3306. End;
  3307.  
  3308. {$HINTS OFF}
  3309. Function TResourceStream.NewResourceEntry(Const ResName:TResourceName;
  3310.                                           Var Data;DataLen:LongInt):Boolean;
  3311. Var dummy:PResourceEntry;
  3312.     SavePos,T,HeadPos:LongInt;
  3313.     P:Pointer;
  3314. Label L;
  3315. Begin
  3316.      Result:=False;
  3317.      If DataLen=0 Then Exit;
  3318.  
  3319.      SavePos:=Position;
  3320.      HeadPos:=8;          {Initial Resource Header}
  3321.      If FResourceList<>Nil Then
  3322.      Begin
  3323.           For T:=0 To FResourceList.Count-1 Do
  3324.           Begin
  3325.                dummy:=FResourceList.Items[T];
  3326.                If dummy^.ResName=ResName Then
  3327.                  If dummy^.DataLen=DataLen Then
  3328.                Begin
  3329.                     Position:=dummy^.DataOffset;
  3330.                     P:=Pointer(FBuffer);
  3331.                     Inc(P,Position);
  3332.                     If CompareResMem(P^,Data,DataLen) Then
  3333.                     Begin
  3334.                          Position:=SavePos;
  3335.                          SavePos:=dummy^.DataOffset;
  3336.                          Goto L;
  3337.                     End;
  3338.                End;
  3339.                Inc(HeadPos,SizeOf(TResourceEntry));  {Length Of Info}
  3340.           End;
  3341.      End;
  3342.      Position:=SavePos;
  3343.  
  3344.      If Write(Data,DataLen)=0 Then Exit;
  3345.  
  3346.      //reserve A Header entry
  3347.      HeadPos:=FHeaderPos;
  3348.      Inc(FHeaderPos,SizeOf(TResourceEntry));  {Length Of Info}
  3349.  
  3350.      New(dummy);
  3351.  
  3352.      dummy^.ResName:=ResName;
  3353.      dummy^.DataOffset:=SavePos;
  3354.      dummy^.DataLen:=DataLen;
  3355.  
  3356.      If FResourceList=Nil Then FResourceList.Create;
  3357.      FResourceList.Add(dummy);
  3358. L:
  3359.      //Write Position Of Resource
  3360.      If SCUStream.Write(HeadPos,4)=0 Then Exit;
  3361.  
  3362.      Result:=True;
  3363. End;
  3364. {$HINTS ON}
  3365.  
  3366. Function TResourceStream.WriteResourcesToStream(Stream:TMemoryStream):Boolean;
  3367. Var T,t1:LongInt;
  3368.     PatchOffset,StartPos:LongInt;
  3369.     dummy:PResourceEntry;
  3370.     P:Pointer;
  3371. Begin
  3372.      Result:=False;
  3373.      If FResourceList=Nil Then
  3374.      Begin
  3375.           T:=0;  //no resources
  3376.           If Stream.Write(T,4)=0 Then Exit;
  3377.           Result:=True;
  3378.           Exit;
  3379.      End;
  3380.  
  3381.      StartPos:=Stream.Position;
  3382.  
  3383.      T:=FResourceList.Count;          //Count Of Resource entries
  3384.      If Stream.Write(T,4)=0 Then Exit;
  3385.  
  3386.      PatchOffset:=Stream.Position;
  3387.      T:=0;
  3388.      If Stream.Write(T,4)=0 Then Exit;  // Resource Data Offset patched later
  3389.  
  3390.      For T:=0 To FResourceList.Count-1 Do
  3391.      Begin
  3392.           dummy:=FResourceList.Items[T];
  3393.           If Stream.Write(dummy^,SizeOf(TResourceEntry))=0 Then Exit;
  3394.      End;
  3395.  
  3396.      //patch Offset To Resource Data
  3397.      T:=Stream.Position;
  3398.      Stream.Position:=PatchOffset;
  3399.      t1:=T-StartPos;
  3400.      If Stream.Write(t1,4)=0 Then Exit;
  3401.      Stream.Position:=T;
  3402.  
  3403.      //Write Resource Data
  3404.  
  3405.      P:=Memory;
  3406.      If Stream.Write(P^,Size)=0 Then Exit;
  3407.  
  3408.      Result:=True;
  3409. End;
  3410.  
  3411. Destructor TResourceStream.Destroy;
  3412. Var T:LongInt;
  3413.     dummy:PResourceEntry;
  3414. Begin
  3415.      If FResourceList<>Nil Then
  3416.      Begin
  3417.           For T:=0 To FResourceList.Count-1 Do
  3418.           Begin
  3419.                dummy:=FResourceList.Items[T];
  3420.                Dispose(dummy);
  3421.           End;
  3422.           FResourceList.Destroy;
  3423.           FResourceList := Nil;
  3424.      End;
  3425.  
  3426.      Inherited Destroy;
  3427. End;
  3428.  
  3429. Type
  3430.     TPropertyTyp=(TPropString,TPropSet,TPropLongInt,TPropEnum,
  3431.                   TPropClass);
  3432.  
  3433.     PSCUPropInit=^TSCUPropInit;
  3434.     TSCUPropInit=Record
  3435.                    PropertyName:String;
  3436.                    PropertySize:LongInt;
  3437.                    PropertyTyp:TPropertyTyp;
  3438.                    PropertyValue:Pointer;
  3439.     End;
  3440.  
  3441.     PSCUDesc=^TSCUDesc;
  3442.     TSCUDesc=Record
  3443.                    NextEntryOffset:LongInt;
  3444.                    ClassName:String;      //subclassed Class Name
  3445.                    BaseClassName:String;  //base Class Name For designer
  3446.                    PropertyCount:LongInt; //Count Of properties To initialize
  3447.                    properties:PSCUPropInit;
  3448.     End;
  3449.  
  3450. {
  3451. ╔═══════════════════════════════════════════════════════════════════════════╗
  3452. ║                                                                           ║
  3453. ║ Speed-Pascal/2 Version 2.0                                                ║
  3454. ║                                                                           ║
  3455. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  3456. ║                                                                           ║
  3457. ║ This section: TPersistent Class Implementation                            ║
  3458. ║                                                                           ║
  3459. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  3460. ║                                                                           ║
  3461. ╚═══════════════════════════════════════════════════════════════════════════╝
  3462. }
  3463.  
  3464. Procedure TPersistent.AssignError(Source:TPersistent);
  3465. Var Msg:String;
  3466. Begin
  3467.      If Source=Nil Then Msg:='Nil'
  3468.      Else Msg:=Source.ClassName;
  3469.      Raise EConvertError.Create('Convert '+ClassName+' to '+Msg+'.');
  3470. End;
  3471.  
  3472. Procedure TPersistent.AssignTo(Dest:TPersistent);
  3473. Begin
  3474.      Dest.AssignError(Self);
  3475. End;
  3476.  
  3477. Procedure TPersistent.Assign(Source:TPersistent);
  3478. Begin
  3479.      If Source<>Nil Then Source.AssignTo(Self)
  3480.      Else AssignError(nil);
  3481. End;
  3482.  
  3483.  
  3484. {
  3485. ╔═══════════════════════════════════════════════════════════════════════════╗
  3486. ║                                                                           ║
  3487. ║ Speed-Pascal/2 Version 2.0                                                ║
  3488. ║                                                                           ║
  3489. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  3490. ║                                                                           ║
  3491. ║ This section: TComponent Class Implementation                             ║
  3492. ║                                                                           ║
  3493. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  3494. ║                                                                           ║
  3495. ╚═══════════════════════════════════════════════════════════════════════════╝
  3496. }
  3497.  
  3498. Const //OldStyleFormat:Boolean=False;
  3499.       LastSCUForm:TComponent=Nil;
  3500.  
  3501. Function GetClassNameFromSCU(NameTable:Pointer;Namep:LongWord):String;
  3502. Var ps:^String;
  3503. Begin
  3504.      ps:=NameTable;
  3505.      Inc(ps,Namep);
  3506.      Result:=ps^;
  3507. End;
  3508.  
  3509. Function GetParentSCUFormDesign(Component:TComponent):TComponent;
  3510. Var AOwner:TComponent;
  3511. Begin
  3512.      Result:=Nil;
  3513.      AOwner:=Component;
  3514.  
  3515.      //Search For First parent that has Is A Form And TypeName match
  3516.      While AOwner <> Nil Do
  3517.      Begin
  3518.           //If AOwner.IDESCU_Data<>Nil Then
  3519.           If csForm In AOwner.ComponentState Then
  3520.           Begin
  3521.                Result:=AOwner;
  3522.                Exit;
  3523.           End;
  3524.  
  3525.           AOwner:=AOwner.FOwner;
  3526.      End;
  3527.      Result := Nil;   //Error
  3528. End;
  3529.  
  3530. Function GetParentSCUFormRuntime(Component:TComponent;Name:String):TComponent;
  3531. Var AOwner:TComponent;
  3532.     S:String;
  3533. Begin
  3534.      Result:=Nil;
  3535.      AOwner:=Component;
  3536.      UpcaseStr(Name);
  3537.  
  3538.      //Search For First parent that has TypeName match
  3539.      While AOwner <> Nil Do
  3540.      Begin
  3541.           S:=AOwner.ClassName;
  3542.           UpcaseStr(S);
  3543.           If S=Name Then
  3544.           Begin
  3545.                Result:=AOwner;
  3546.                Exit;
  3547.           End;
  3548.           AOwner:=AOwner.FOwner;
  3549.      End;
  3550.      Result := Nil;   //Error
  3551. End;
  3552.  
  3553. Procedure InsertSCUMethod(AParent,Objekt:TComponent;
  3554.                           ProcName,ProcParams,PropertyName:String);
  3555. Var Methods:PIDE_Methods;
  3556.     S,s2:String[64];
  3557.     s1,s3:String;
  3558.     Own:PIDE_OwnerList;
  3559. Label L;
  3560. Begin
  3561.      S:=ProcName;
  3562.      UpcaseStr(S);
  3563.      s1:=ProcParams;
  3564.      UpcaseStr(s1);
  3565.      s2:=PropertyName;
  3566.      UpcaseStr(s2);
  3567.  
  3568.      //look If method Is still here
  3569.      Methods:=AParent.FMethods;
  3570.      While Methods<>Nil Do
  3571.      Begin
  3572.           s3:=Methods^.Name^;
  3573.           UpcaseStr(s3);
  3574.           If s3=S Then  //ProcNames match
  3575.           Begin
  3576.                s3:=Methods^.Params^;
  3577.                UpcaseStr(s3);
  3578.                If s3=s1 Then  //Parameters match --> only Add To List
  3579.                Begin
  3580.                     Goto L;
  3581.                End;
  3582.           End;
  3583.  
  3584.           Methods:=Methods^.Next;
  3585.      End;
  3586.  
  3587.      //Insert New Item
  3588.      New(Methods);
  3589.      Methods^.Next:=AParent.FMethods;
  3590.      AParent.FMethods:=Methods;
  3591.  
  3592.      AssignStr(Methods^.Name,ProcName);
  3593.      AssignStr(Methods^.Params,ProcParams);
  3594.      Methods^.Owners.Create;
  3595. L:
  3596.      New(Own);
  3597.      AssignStr(Own^.PropertyName,PropertyName);
  3598.      Own^.Objekt:=Objekt;
  3599.      Methods^.Owners.Add(Own);
  3600. End;
  3601.  
  3602. Function GetSCUProcParamsFromName(Objekt:TComponent;PropertyName:String):String;
  3603. Var p1:^LongWord;
  3604.     B:Byte;
  3605.     S,s1:String;
  3606.     ps:^String;
  3607.     pParent:Pointer;
  3608.     Scope:Byte;
  3609.     NameIndex:LongInt;
  3610.     NameTable:^String;
  3611. Label L,ex,again;
  3612. Begin
  3613.      //Search PropertyName
  3614.      UpcaseStr(PropertyName);
  3615.      p1:=Objekt.ClassInfo;
  3616. again:
  3617.      //overread Object Size
  3618.      Inc(p1,4);
  3619.      pParent:=Pointer(p1^);
  3620.      Inc(p1,8);               //onto First Property Name
  3621.      p1:=Pointer(p1^);
  3622.      Inc(p1,4);               //overread End Ptr
  3623.      NameTable:=Pointer(p1^); //Name Table Of Class
  3624.      Inc(p1,4);               //overread Name Table poinzer
  3625.  
  3626.      NameIndex:=p1^ And 255;
  3627.      Inc(p1);
  3628.      While NameIndex<>0 Do
  3629.      Begin
  3630.           s1[0]:=Chr(NameIndex);
  3631.           Move(p1^,s1[1],NameIndex);
  3632.           Inc(p1,NameIndex);
  3633.  
  3634.           Scope:=p1^ And 255;
  3635.           Inc(p1);
  3636.           If Scope And 16=16 Then  //stored ??
  3637.           Begin
  3638.                UpcaseStr(s1);
  3639.                If s1=PropertyName Then  //found
  3640.                Begin
  3641.                    p1:=Pointer(p1^);   //Type information
  3642.  
  3643.                    //overread Property access Info
  3644.                    If p1^ And 255<>0 Then Inc(p1,5)
  3645.                    Else Inc(p1);
  3646.                    If p1^ And 255<>0 Then Inc(p1,5)
  3647.                    Else Inc(p1);
  3648.  
  3649.                    //overread Property Type len
  3650.                    Inc(p1,4);
  3651.  
  3652.                    //Get Property Type
  3653.                    B:=p1^ And 255;
  3654.                    If Not (B In [PropType_ProcVar,PropType_FuncVar]) Then Goto ex;  //Error
  3655.                    Inc(p1);
  3656.                    Goto L;
  3657.                End;
  3658.           End;
  3659.  
  3660.           Inc(p1,4);    //overread Type information Pointer
  3661.           NameIndex:=p1^ And 255;
  3662.           Inc(p1);
  3663.      End;
  3664.  
  3665.      If pParent<>Nil Then
  3666.      Begin
  3667.           p1:=pParent;
  3668.           Inc(p1,4);
  3669.           p1:=Pointer(p1^);  //ClassInfo
  3670.           Goto again;
  3671.      End;
  3672. ex:
  3673.      Result:='?';
  3674.      Exit;  //Not found;
  3675. L:
  3676.      NameIndex:=p1^;
  3677.      Inc(p1,4);
  3678.      S:='';
  3679.      While NameIndex<>0 Do
  3680.      Begin
  3681.           If S<>'' Then S:=S+';';
  3682.           ps:=NameTable+NameIndex;
  3683.           s1:=ps^;
  3684.  
  3685.           B:=p1^ And 255;
  3686.           Inc(p1);
  3687.           Case B Of
  3688.             1:s1:='VAR '+s1;
  3689.             2:;
  3690.             3:s1:='CONST '+s1;
  3691.           End;
  3692.  
  3693.           S:=S+s1;
  3694.           NameIndex:=p1^;  //TypeName
  3695.           Inc(p1,4);
  3696.           If NameIndex<>0 Then
  3697.           Begin
  3698.                ps:=NameTable+NameIndex;
  3699.                s1:=ps^;
  3700.                S:=S+':'+s1;
  3701.           End;
  3702.  
  3703.           NameIndex:=p1^;
  3704.           Inc(p1,4);
  3705.      End; //While
  3706.  
  3707.      If S<>'' Then Result:='('+S+');'
  3708.      Else Result:=S;
  3709. End;
  3710.  
  3711.  
  3712. Type PPropertyLink=^TPropertyLink;
  3713.      TPropertyLink=Record
  3714.                          SelfPtr:TComponent;
  3715.                          Owner:TComponent;
  3716.                          WriteTyp:Byte;
  3717.                          WriteOffset:LongInt;
  3718.                          //WriteName:String[64];
  3719.                          LinkName:String[64];
  3720.                          Next:PPropertyLink;
  3721.      End;
  3722.  
  3723. Const PropertyLinks:PPropertyLink=Nil;
  3724.  
  3725.  
  3726. Function GetPropertyTypeInfo2(Instance:TComponent;PropertyName:String;Var Info:TPropertyTypeInfo):Boolean;
  3727. Var L,C:^LongWord;
  3728.     ps:^String;
  3729.     S:String;
  3730. Label weiter;
  3731. Begin
  3732.      Result:=False;
  3733.      UpcaseStr(PropertyName);
  3734.  
  3735.      L:=Pointer(Instance);
  3736.      L:=Pointer(L^);  //VMT address
  3737.      While L<>Nil Do
  3738.      Begin
  3739.           Inc(L,4);
  3740.           L:=Pointer(L^);  //Class Info
  3741.           C:=L;
  3742.           Inc(L,12);
  3743.           L:=Pointer(L^);  //Property Info
  3744.           Inc(L,4);
  3745.           Info.NameTable:=Pointer(L^);
  3746.           Inc(L,4);        //Start Of properties
  3747.           ps:=Pointer(L);
  3748.           While ps^[0]<>#0 Do
  3749.           Begin
  3750.                If ps^[0]=PropertyName[0] Then  //found !!
  3751.                Begin
  3752.                     S:=ps^;
  3753.                     UpcaseStr(S);
  3754.                     If S=PropertyName Then
  3755.                     Begin
  3756.                          Result:=True;
  3757.                          Inc(L,Ord(ps^[0])+1); //skip Name
  3758.                          Info.Scope:=L^ And 255;
  3759.  
  3760.                          Inc(L);
  3761.                          L:=Pointer(L^);     //Type And access Info
  3762.  
  3763.                          If ((Info.Scope And 24=0)Or(L=Nil)) Then
  3764.                          Begin
  3765.                               L:=Pointer(ps);
  3766.                               Goto weiter;   //Search also parent !
  3767.                          End;
  3768.  
  3769.                          Info.PropInfo:=Pointer(L);
  3770.                          Info.Read.Kind:=L^ And 255;
  3771.                          Inc(L);
  3772.                          If Info.Read.Kind<>0 Then
  3773.                          Begin
  3774.                               Info.Read.VarOffset:=L^;
  3775.                               Inc(L,4);
  3776.                          End;
  3777.                          Info.Write.Kind:=L^ And 255;
  3778.                          Inc(L);
  3779.                          If Info.Write.Kind<>0 Then
  3780.                          Begin
  3781.                               Info.Write.VarOffset:=L^;
  3782.                               Inc(L,4);
  3783.                          End;
  3784.                          Info.Size:=L^;
  3785.                          Inc(L,4);
  3786.                          Info.TypeInfo:=Pointer(L);
  3787.                          Info.Typ:=L^ And 255;
  3788.  
  3789.                          Exit;
  3790.                     End;
  3791.                End;
  3792. weiter:
  3793.                Inc(L,Ord(ps^[0])+6);    //skip This entry
  3794.                ps:=Pointer(L);
  3795.           End;
  3796.  
  3797.           Inc(C,4);
  3798.           L:=Pointer(C^);  //parent VMT Or Nil
  3799.      End;
  3800. End;
  3801.  
  3802.  
  3803. Function GetReference(Owner:TComponent):TComponent;
  3804. Begin
  3805.      Result:=Owner.FReference;
  3806. End;
  3807.  
  3808. Procedure SetReference(Owner,Ref:TComponent);
  3809. Begin
  3810.      Owner.FReference:=Ref;
  3811. End;
  3812.  
  3813.  
  3814. {$HINTS OFF}
  3815. Procedure TComponent.UpdateLinkList(Const PropertyName:String;LinkList:TList);
  3816. Begin
  3817.      //LinkList Is A List Of TComponent Instances that the Inspector
  3818.      //will display For the specified Property, you may only Remove Items !
  3819. End;
  3820. {$HINTS ON}
  3821.  
  3822.  
  3823. Type SCUTypes=(SCUNull,SCUByte,SCUWord,SCULongWord,SCUShortInt,SCUInteger,SCULongInt,SCUSingle,
  3824.                SCUDouble,SCUExtended,SCUByteBool,SCUWordBool,SCULongBool,SCUString,
  3825.                SCUCString,SCURecord,SCUSet4,SCUSet32,SCUEnum,SCUProcVar,SCUFuncVar,SCUClassVar,
  3826.                SCULink,SCUClass,SCUChar,SCUBinary);
  3827.  
  3828.  
  3829. {$HINTS OFF}
  3830. Function TComponent.ReadPropertiesSCU(COwner:TComponent;Namep,Resourcep:Pointer;Var ClassPointer:Pointer):Boolean;
  3831. Var P,p2:^LongInt;
  3832.     B:Byte;
  3833.     tt,TypeLen:LongInt;
  3834.     Typ:Byte;
  3835.     WriteTyp:Byte;
  3836.     WriteOffset,PropNameOffset:LongInt;
  3837.     Value,Temp:Pointer;
  3838.     TypeName,ProcName,PropertyName:String[64];
  3839.     ProcParams:String;
  3840.     ActComponentClass:TComponentClass;
  3841.     Proc:Pointer;
  3842.     AParent:TComponent;
  3843.     dummy:PPropertyLink;
  3844.     Error:Boolean;
  3845.     Info:TPropertyTypeInfo;
  3846.     InheritedComp:TComponent;
  3847.     SectionLen:LongWord;
  3848.     SCUTyp:SCUTypes;
  3849. Label L,err;
  3850. Begin
  3851.      Result:=False;
  3852.      P:=ClassPointer;
  3853.      SectionLen:=P^;
  3854.      Inc(P,4);  //overread Property section len
  3855. L:
  3856.      Error:=False;
  3857.      B:=P^ And 255;  //properties avail ?
  3858.      Inc(P);
  3859.      If ((B=1)Or(B=2)) Then
  3860.      Begin
  3861.           //there follows A Property entry - we are At Name Index
  3862.           PropNameOffset:=P^;
  3863.           Inc(P,4);
  3864.  
  3865.           SCUTyp:=SCUNull;
  3866.           System.Move(P^,SCUTyp,1);
  3867.           Inc(P);
  3868.           If ((SCUTyp=SCURecord)Or(SCUTyp=SCUBinary)) Then
  3869.           Begin
  3870.                System.Move(P^,TypeLen,4);
  3871.                Inc(P,4);
  3872.           End;
  3873.  
  3874.           PropertyName:=GetClassNameFromSCU(Namep,PropNameOffset);
  3875.           If Not GetPropertyTypeInfo2(Self,PropertyName,Info) Then
  3876.           Begin
  3877.                //evtll schon beim Rausschreiben skippen
  3878.                ErrorBox2(FmtLoadNLSStr(SPropertyNotFound,[PropertyName,ClassName])+' !'#13+
  3879.                          LoadNLSStr(SPropertySkipped));
  3880.                Case SCUTyp Of
  3881.                    SCUByte,SCUShortInt,SCUByteBool,SCUChar:Inc(P,1);
  3882.                    SCUWord,SCUInteger,SCUWordBool:Inc(P,2);
  3883.                    SCULongWord,SCULongInt,SCULongBool,SCUSingle:Inc(P,4);
  3884.                    SCUDouble:Inc(P,8);
  3885.                    SCUExtended:Inc(P,10);
  3886.                    SCUString:Inc(P,(P^ And 255)+1);
  3887.                    SCUCString:
  3888.                    Begin
  3889.                         While (P^ And 255)<>0 Do Inc(P);
  3890.                         Inc(P); //skip #0
  3891.                    End;
  3892.                    SCULink:Inc(P,4);  //Name Index
  3893.                    SCURecord,SCUBinary:Inc(P,TypeLen);
  3894.                    SCUSet4:Inc(P,4);
  3895.                    SCUSet32:Inc(P,32);
  3896.                    SCUEnum:Inc(P,4);
  3897.                    SCUProcVar,SCUFuncVar:Inc(P,12); //Owner,method,Property Name Index
  3898.                    {SCUClassVar:Inc(P,4);
  3899.                    SCUClass:Inc(P,4);}
  3900.                    Else Goto err; //Error !
  3901.                End;
  3902.                Goto L;  //Until All properties Read
  3903. err:
  3904.                Inc(ClassPointer,SectionLen);
  3905.                Result:=True;
  3906.                Exit;
  3907.           End;
  3908.  
  3909.           TypeLen:=Info.Size;
  3910.           Typ:=Info.Typ;
  3911.           WriteTyp:=Info.Write.Kind;
  3912.           WriteOffset:=Info.Write.VarOffset;
  3913.  
  3914.           Case WriteTyp Of
  3915.               1,2,3:;
  3916.               Else If Typ<>PropType_Class Then
  3917.               Begin
  3918.                    ErrorBox2(FmtLoadNLSStr(SPropertyReadOnly,[PropertyName])+'. '+
  3919.                              LoadNLSStr(SPropertySkipped)+'.');
  3920.                    Error:=True;
  3921.               End;
  3922.           End; {Case}
  3923.  
  3924.           If B=2 Then //Link
  3925.           Begin
  3926.                Typ:=PropType_Link;
  3927.           End;
  3928.  
  3929.           If Typ=PropType_String Then //String
  3930.           Begin
  3931.                B:=P^ And 255;
  3932.                TypeLen:=B+1;
  3933.           End;
  3934.  
  3935.           Case Typ Of
  3936.             PropType_Class: //Class
  3937.             Begin
  3938.                  //Get Value Of the Property
  3939.                  Case Info.Read.Kind Of
  3940.                    1:
  3941.                    Begin
  3942.                         GetMem(Value,TypeLen);
  3943.                         p2:=Pointer(Self);
  3944.                         Inc(p2,Info.Read.VarOffset);
  3945.                         Move(p2^,Value^,TypeLen);
  3946.                    End;
  3947.                    2,3:
  3948.                    Begin
  3949.                         GetMem(Value,TypeLen);
  3950.                         If Not CallReadProp(Self,Pointer(Info.Read.VarOffset),Typ,TypeLen,Value) Then
  3951.                         Begin
  3952.                             ErrorBox2('SCU Error 3: '+FmtLoadNLSStr(SCouldNotReadFromProperty,[PropertyName])+'.');
  3953.                             FreeMem(Value,TypeLen);
  3954.                             Exit;
  3955.                         End;
  3956.                    End;
  3957.                    Else
  3958.                    Begin
  3959.                         ErrorBox2(FmtLoadNLSStr(SCouldNotReadFromProperty,[PropertyName])+'.');
  3960.                         Goto err;
  3961.                    End;
  3962.                  End;
  3963.  
  3964.                  System.Move(Value^,InheritedComp,4);
  3965.                  If InheritedComp=Nil Then
  3966.                  Begin
  3967.                       ErrorBox2('Property '+Name+'.'+PropertyName+' is NIL');
  3968.                       FreeMem(Value,TypeLen);
  3969.                       Goto err;
  3970.                  End;
  3971.  
  3972.                  If Not InheritedComp.ReadPropertiesSCU(COwner,Namep,Resourcep,P) Then
  3973.                  Begin
  3974.                       ErrorBox2('Property '+Name+'.'+PropertyName+' could not be initialized');
  3975.                       FreeMem(Value,TypeLen);
  3976.                       Goto err;
  3977.                  End;
  3978.                  Error:=True; {!!}
  3979.             End;
  3980.             PropType_ProcVar,PropType_FuncVar:  //ProcVar,FuncVar
  3981.             Begin
  3982.                  tt:=P^;
  3983.                  Inc(P,4);
  3984.                  TypeName:='T'+GetClassNameFromSCU(Namep,tt);
  3985.                  tt:=P^;
  3986.                  Inc(P,4);
  3987.                  ProcName:=GetClassNameFromSCU(Namep,tt);
  3988.                  tt:=P^;
  3989.                  Inc(P,4);
  3990.                  PropertyName:=GetClassNameFromSCU(Namep,tt);
  3991.  
  3992.                  If TypeLen<>8 Then Exit;  //Of Object !!
  3993.  
  3994.                  GetMem(Value,TypeLen);
  3995.  
  3996.                  If ((InsideDesigner)Or(InsideLanguageDesigner)) Then
  3997.                  Begin
  3998.                       //Owner IDESCU_Data suchen !
  3999.                       AParent:=GetParentSCUFormDesign(Self);
  4000.                       If AParent=Nil Then Exit; //Error
  4001.                       //Proc In AParent IDESCU_Data einfügen
  4002.  
  4003.                       ProcParams:=GetSCUProcParamsFromName(Self,PropertyName);
  4004.                       If ProcParams='?' Then
  4005.                       Begin
  4006.                            ErrorBox2(FmtLoadNLSStr(SPropError,[PropertyName]));
  4007.                            Error:=True;
  4008.                       End
  4009.                       Else InsertSCUMethod(AParent,Self,ProcName,ProcParams,PropertyName);
  4010.                       FillChar(Value^,TypeLen,0);  {!!}
  4011.                  End
  4012.                  Else
  4013.                  Begin
  4014.                       //Search For TypeName.ProcName
  4015.                       //dazu In SetupSCU alle Forms mit RegisterClasses registrieren
  4016.                       ActComponentClass:=SearchClassByName(TypeName);
  4017.                       If ActComponentClass=Nil Then
  4018.                       Begin
  4019.                            ErrorBox2('SCU Error 1: '+FmtLoadNLSStr(SComponentNotFound,[TypeName])+'.'#13+
  4020.                                      LoadNLSStr(SUseRegisterClasses));
  4021.                            Error:=True;
  4022.                       End
  4023.                       Else
  4024.                       Begin
  4025.                            //Get Object For that method
  4026.                            AParent:=GetParentSCUFormRuntime(Self,TypeName);
  4027.                            If AParent=Nil Then
  4028.                            Begin
  4029.                                 ErrorBox2(FmtLoadNLSStr(SSCUErrorInClass,[TypeName]));
  4030.                                 Error:=True;
  4031.                            End
  4032.                            Else
  4033.                            Begin
  4034.                                 Proc:=AParent.MethodAddress(ProcName);
  4035.                                 If Proc=Nil Then
  4036.                                 Begin
  4037.                                      ErrorBox2(FmtLoadNLSStr(SMethodNotFound,[ProcName,ClassName]));
  4038.                                      Error:=True;
  4039.                                 End
  4040.                                 Else
  4041.                                 Begin
  4042.                                      //Proc Adresse setzen
  4043.                                      Move(Proc,Value^,4);
  4044.                                      Inc(Value,4);
  4045.                                      //method Object Pointer setzen
  4046.                                      Move(AParent,Value^,4);
  4047.                                      Dec(Value,4);
  4048.                                 End;
  4049.                            End;
  4050.                       End;
  4051.                  End;
  4052.             End;
  4053.             PropType_Link: //Link
  4054.             Begin
  4055.                  If ComponentState*[csForm]<>[] Then
  4056.                    If PropertyName='Menu' Then
  4057.                  Begin
  4058.                      Include(ComponentState,csHasMainMenu);
  4059.                  End;
  4060.  
  4061.                  //Name Of Property To Link
  4062.                  tt:=P^;
  4063.                  Inc(P,4);
  4064.                  PropertyName:=GetClassNameFromSCU(Namep,tt);
  4065.  
  4066.                  If PropertyLinks=Nil Then
  4067.                  Begin
  4068.                       New(PropertyLinks);
  4069.                       dummy:=PropertyLinks;
  4070.                       dummy^.Next:=Nil;
  4071.                  End
  4072.                  Else
  4073.                  Begin
  4074.                       New(dummy);
  4075.                       dummy^.Next:=PropertyLinks;
  4076.                       PropertyLinks:=dummy;
  4077.                  End;
  4078.                  dummy^.SelfPtr:=Self;
  4079.                  dummy^.Owner:=COwner;
  4080.                  dummy^.WriteTyp:=WriteTyp;
  4081.                  dummy^.WriteOffset:=WriteOffset;
  4082.                  dummy^.LinkName:=PropertyName;
  4083.                  Goto L; //dont Write here
  4084.             End;
  4085.             Else
  4086.             Begin
  4087.                  GetMem(Value,TypeLen);
  4088.                  Move(P^,Value^,TypeLen);
  4089.                  Inc(P,TypeLen);
  4090.             End;
  4091.           End; {Case}
  4092.  
  4093.           If Not Error Then
  4094.              Case WriteTyp Of
  4095.                1:
  4096.                Begin
  4097.                     p2:=Pointer(Self);
  4098.                     Inc(p2,WriteOffset);
  4099.                     Move(Value^,p2^,TypeLen);
  4100.                End;
  4101.                2,3:
  4102.                Begin
  4103.                     If Not CallWriteProp(Self,Pointer(WriteOffset),Typ,TypeLen,Value) Then
  4104.                     Begin
  4105.                          ErrorBox2('SCU Error 3: '+FmtLoadNLSStr(SCouldNotWriteToProperty,[PropertyName])+' !');
  4106.                     End;
  4107.                End;
  4108.                Else Goto err;  //Some Error
  4109.              End;
  4110.  
  4111.           FreeMem(Value,TypeLen);
  4112.  
  4113.           Goto L;  //Until All properties Read
  4114.      End
  4115.      Else If B<>0 Then Exit;  //Some Error
  4116.      ClassPointer:=P;
  4117.      Result:=True;
  4118. End;
  4119. {$HINTS ON}
  4120.  
  4121.  
  4122. Procedure TComponent.ReadResourceSCU(ResourceTable:Pointer;Var ClassP:Pointer);
  4123. Var DataOfs:LongWord;
  4124.     P:^LongWord;
  4125.     ps:PString;
  4126.     ResName:TResourceName;
  4127.     Data:Pointer;
  4128.     DataLen:LongInt;
  4129.     pp:^LongWord;
  4130.     DOfs:LongWord;
  4131.     reshead:LongWord;
  4132. Label L;
  4133. Begin
  4134. L:
  4135.      pp:=ClassP;
  4136.      Inc(ClassP,4);
  4137.      reshead:=pp^;
  4138.      If reshead=0 Then Exit; {no resources For This Component}
  4139.  
  4140.      P:=ResourceTable+4;  //onto Resource Data Offset
  4141.      DataOfs:=P^;
  4142.  
  4143.      P:=ResourceTable;
  4144.      Inc(P,reshead);      {Offset To Resource Header}
  4145.  
  4146.      {process Resource Header}
  4147.      ps := PString(P);
  4148.      ResName := TResourceName(ps^);
  4149.      Inc(P,SizeOf(TResourceName));
  4150.      Data:=ResourceTable;
  4151.      DOfs:=P^;
  4152.      Inc(Data,DataOfs+DOfs);  //Start Of Resource information
  4153.      Inc(P,4);
  4154.      DataLen:=P^;
  4155.      Inc(P,4);
  4156.      //Load resources For This Component
  4157.      ReadSCUResource(ResName,Data^,DataLen);
  4158.      Goto L; {Until no more resources For This}
  4159. End;
  4160.  
  4161.  
  4162. Procedure HandlePropertyLinks(Component:TComponent);
  4163. Var dummy,Next:PPropertyLink;
  4164.     P,p2:Pointer;
  4165.     T,t1:LongInt;
  4166.     Comp,Comp1,Comp2:TComponent;
  4167.     S:String;
  4168. Label found,again;
  4169. Begin
  4170.      dummy:=PropertyLinks;
  4171.      While dummy<>Nil Do
  4172.      Begin
  4173.           UpcaseStr(dummy^.LinkName);
  4174.           P:=Nil;
  4175.           Comp1:=Component;
  4176. again:
  4177.           For T:=0 To Comp1.ComponentCount-1 Do
  4178.           Begin
  4179.                Comp:=Comp1.Components[T];
  4180.  
  4181.                If csReferenceControl In Comp.ComponentState Then continue;
  4182.  
  4183.                If Comp Is TComponent Then
  4184.                Begin
  4185.                     S:=Comp.Name;
  4186.                     UpcaseStr(S);
  4187.                     If S=dummy^.LinkName Then
  4188.                     Begin
  4189.                         P:=@Comp;
  4190.                         Goto found;
  4191.                     End;
  4192.                End;
  4193.  
  4194.                For t1:=0 To Comp.ComponentCount-1 Do
  4195.                Begin
  4196.                    Comp2:=Comp.Components[t1];
  4197.  
  4198.                    If csReferenceControl In Comp2.ComponentState Then continue;
  4199.  
  4200.                    If Comp2 Is TComponent Then
  4201.                    Begin
  4202.                         S:=Comp2.Name;
  4203.                         UpcaseStr(S);
  4204.                         If S=dummy^.LinkName Then
  4205.                         Begin
  4206.                             P:=@Comp2;
  4207.                             Goto found;
  4208.                         End;
  4209.                    End;
  4210.                End;
  4211.           End;
  4212.  
  4213.           Comp1:=Comp1.Owner;
  4214.           If Comp1<>Nil Then Goto again;
  4215. found:
  4216.           If P<>Nil Then
  4217.           Begin
  4218.                Case dummy^.WriteTyp Of
  4219.                  1:
  4220.                  Begin
  4221.                      p2:=Pointer(dummy^.SelfPtr);
  4222.                      Inc(p2,dummy^.WriteOffset);
  4223.                      Move(P^,p2^,4);
  4224.                  End;
  4225.                  2,3:  //method call (direct Or VMT)
  4226.                  Begin
  4227.                      If Not CallWriteProp(dummy^.SelfPtr,Pointer(dummy^.WriteOffset),PropType_Unsigned,4,P) Then
  4228.                      Begin
  4229.                      End;
  4230.                  End;
  4231.                End; {Case}
  4232.           End;
  4233.  
  4234.           dummy:=dummy^.Next;
  4235.      End;
  4236.  
  4237.      dummy:=PropertyLinks;
  4238.      While dummy<>Nil Do
  4239.      Begin
  4240.           If dummy^.SelfPtr=Nil Then
  4241.           Begin
  4242.                ErrorBox2('SCU Error: '+FmtLoadNLSStr(SLinkNotFound,[dummy^.LinkName])+' !');
  4243.           End;
  4244.  
  4245.           If ((dummy^.SelfPtr<>Nil)And(dummy^.SelfPtr.FComponentState*[csLoaded]=[])) Then
  4246.           Begin
  4247.                dummy^.SelfPtr.LoadedFromSCU(dummy^.Owner);
  4248.                dummy^.SelfPtr.Loaded;
  4249.           End;
  4250.  
  4251.           Next:=dummy^.Next;
  4252.           Dispose(dummy);
  4253.           dummy:=Next;
  4254.      End;
  4255.  
  4256.      PropertyLinks:=Nil;
  4257. End;
  4258.  
  4259.  
  4260. Function TComponent.ReadComponentsSCU(NameTable,ResourceTable:Pointer;Var ClassP:Pointer):Boolean;
  4261. Var ChildCount,T:LongInt;
  4262.     NameIndex,NameIndex1:LongInt;
  4263.     ComponentClass:TComponentClass;
  4264.     Component:TComponent;
  4265.     S,s1:String[64];
  4266.     ClassPointer:^LongWord;
  4267.     B:Byte;
  4268.     P:Pointer;
  4269.     RemoveReferenceButton:Boolean;
  4270.     ChildIsReferenceButton:Boolean;
  4271.     SavePropertyLinks,dummy:PPropertyLink;
  4272.     idx:LongInt;
  4273.     Ref:TComponent;
  4274.     LastReference:TComponent;
  4275.  
  4276.     Procedure SkipChildComponents;
  4277.     Var t1,Count:LongInt;
  4278.         B:Byte;
  4279.     Begin
  4280.          Count:=ClassPointer^;
  4281.          Inc(ClassPointer,4);
  4282.          For t1:=1 To Count Do //skip All Child Components
  4283.          Begin
  4284.               Inc(ClassPointer,4);  //skip Name Index
  4285.               B:=ClassPointer^ And 255;
  4286.               Inc(ClassPointer);
  4287.               If B=1 Then  {runtime Class Name differs from Inspector Class Name}
  4288.               Begin
  4289.                    Inc(ClassPointer,4);  //skip NameIndex
  4290.               End;
  4291.  
  4292.               {overread Property section}
  4293.               Inc(ClassPointer,ClassPointer^);
  4294.  
  4295.               {overread Components section}
  4296.               SkipChildComponents; //overread All Child Components
  4297.  
  4298.               {overread Resource section}
  4299.               While ClassPointer^<>0 Do Inc(ClassPointer,4);
  4300.               Inc(ClassPointer,4);  {overread 0}
  4301.          End;
  4302.     End;
  4303.  
  4304. Label skip,skipIt;
  4305. Begin
  4306.      Result:=False;
  4307.      SavePropertyLinks:=PropertyLinks;
  4308.      PropertyLinks:=Nil;
  4309.      ClassPointer:=ClassP;
  4310.      ChildCount:=ClassPointer^;
  4311.      Inc(ClassPointer,4);
  4312.      LastReference:=Nil;
  4313.      For T:=1 To ChildCount Do
  4314.      Begin
  4315.           NameIndex:=ClassPointer^;
  4316.           Inc(ClassPointer,4);
  4317.           S:=GetClassNameFromSCU(NameTable,NameIndex); {Of the New Child}
  4318.  
  4319.           RemoveReferenceButton := False;
  4320.           ChildIsReferenceButton := False;
  4321.           If S = 'TReferenceWindow' Then
  4322.           Begin
  4323.                ChildIsReferenceButton := True;
  4324.                If Not InsideDesigner Then RemoveReferenceButton := True;
  4325.           End;
  4326.           s1 := '';
  4327.  
  4328.           {check If runtime Class Name Is avail}
  4329.           B:=ClassPointer^ And 255;
  4330.           Inc(ClassPointer);
  4331.           If B=1 Then  {runtime Class Name differs from Inspector Class Name}
  4332.           Begin
  4333.                NameIndex1:=ClassPointer^;
  4334.                Inc(ClassPointer,4);
  4335.                s1:=GetClassNameFromSCU(NameTable,NameIndex1);
  4336.                {Use runtime Class Name To Create the Class}
  4337.                If Not ((InsideDesigner)Or(InsideLanguageDesigner)) Then
  4338.                  If s1 <> '' Then S := s1; {!!}
  4339.           End;
  4340.  
  4341.           {note: runtime Class Names MUST be registered In Form Unit Or
  4342.                  main Program Of an Application !!}
  4343.  
  4344.           If RemoveReferenceButton Then ComponentClass:=SearchClassByName('TCONTROL')
  4345.           Else ComponentClass:=SearchClassByName(S);
  4346.  
  4347.           If ComponentClass=Nil Then
  4348.           Begin
  4349.                ErrorBox2('SCU Error 2: '+FmtLoadNLSStr(SComponentNotFound,[S])+'.'#13 +
  4350.                          LoadNLSStr(SUseRegisterClasses)+' !');
  4351.                Goto skipIt;
  4352.           End;
  4353.  
  4354.           {C R E A T E  the Child Object}
  4355.           FCreateFromSCU := True;
  4356.           Component := ComponentClass.Create(LastSCUForm);
  4357.           FCreateFromSCU := False;
  4358.  
  4359.           {zur Sicherheit}
  4360.           If ChildIsReferenceButton Then
  4361.             If Not RemoveReferenceButton Then
  4362.           Begin {Predecessor Is the Reference -> Set the flag}
  4363.                idx := LastSCUForm.IndexOfComponent(LastReference);
  4364.                If idx >= 0 Then
  4365.                Begin
  4366.                     Ref := LastSCUForm.Components[idx];
  4367.                     Include(Ref.ComponentState, csReference); {!}
  4368.                End;
  4369.           End;
  4370.  
  4371.           Component.SetDesigning(InsideDesigner Or InsideLanguageDesigner);
  4372.           Component.LoadingFromSCU(Self);
  4373.  
  4374.           If ((InsideDesigner)Or(InsideLanguageDesigner)) Then
  4375.           {Set TypeName And IDESCU_Data}
  4376.             If s1<>'' Then
  4377.             Begin
  4378.                  Component.TypeName:=s1;
  4379.                  Component.FMethods:=Nil; {no Methods defined}
  4380.             End;
  4381.  
  4382.           If RemoveReferenceButton Then
  4383.           Begin
  4384.                Component.Destroy;   {besser gar nicht erst erzeugen}
  4385. skipIt:
  4386.                {overread Property section}
  4387.                Inc(ClassPointer,ClassPointer^);
  4388.  
  4389.                {overread Components section}
  4390.                SkipChildComponents; //overread All Child Components
  4391.  
  4392.                {overread Resource section}
  4393.                While ClassPointer^<>0 Do Inc(ClassPointer,4);
  4394.                Inc(ClassPointer,4);  {overread 0}
  4395.  
  4396.                continue;
  4397.           End
  4398.           Else
  4399.           Begin
  4400.                If Not Component.ReadPropertiesSCU(Self,NameTable,ResourceTable,ClassPointer) Then Exit;
  4401.                If Not Component.ReadComponentsSCU(NameTable,ResourceTable,ClassPointer) Then Exit;
  4402.                Component.ReadResourceSCU(ResourceTable,ClassPointer);
  4403.           End;
  4404.  
  4405.  
  4406.           If Not ((InsideDesigner)Or(InsideLanguageDesigner)) Then
  4407.           Begin
  4408.                {Set Object variable If present}
  4409.                P := LastSCUForm.FieldAddress(Component.Name);
  4410.                If P <> Nil Then Move(Component,P^,4);
  4411.           End;
  4412.  
  4413.           //If This Component expects A Link Then we don't call Loaded unless the
  4414.           //Link Is established
  4415.           dummy:=PropertyLinks;
  4416.           While dummy<>Nil Do
  4417.           Begin
  4418.                If dummy^.SelfPtr=Component Then Goto skip;
  4419.                dummy:=dummy^.Next;
  4420.           End;
  4421.  
  4422.           If Component.FComponentState*[csLoaded]=[] Then
  4423.           Begin
  4424.                If ChildIsReferenceButton Then
  4425.                Begin
  4426.                     //Set the Reference
  4427.                     Component.FReference:=LastReference;
  4428.                     Include(LastReference.ComponentState,csReference);
  4429.                     Component.LoadedFromSCU(Self);
  4430.                End
  4431.                Else Component.LoadedFromSCU(Self);
  4432.                Component.Loaded;
  4433.           End;
  4434. skip:
  4435.           //This Is the Last Reference Window
  4436.           //we have To Store it because it may contain Child Items...
  4437.           LastReference:=Component;
  4438.      End;
  4439.  
  4440.      If PropertyLinks<>Nil Then
  4441.      Begin
  4442.           dummy:=PropertyLinks;
  4443.           While dummy^.Next<>Nil Do dummy:=dummy^.Next;
  4444.           dummy^.Next:=SavePropertyLinks;  {Append}
  4445.      End
  4446.      Else PropertyLinks:=SavePropertyLinks;
  4447.  
  4448.      ClassP:=ClassPointer;
  4449.      Result:=True;
  4450. End;
  4451.  
  4452.  
  4453. Function SearchClassSCU(Data:Pointer;NameToFind:String;ObjectCount:LongInt;ClassUnit:String):Pointer;
  4454. Var dummy:^LongWord;
  4455.     len:LongWord;
  4456.     Count:LongInt;
  4457.     ps:^String;
  4458.     S,D,N,E:String;
  4459. Label L;
  4460. Begin
  4461.      Result:=Nil;
  4462.      Count:=0;
  4463.      UpcaseStr(ClassUnit);
  4464. L:
  4465.      If Count>=ObjectCount Then Exit;
  4466.      dummy:=Data;
  4467.      len:=dummy^;   //len Of This entry
  4468.      Inc(dummy,4);  //onto Inspector Class Name
  4469.      Inc(dummy,(dummy^ And 255)+1); //overread Inspector Name
  4470.      ps:=Pointer(dummy);     //runtime Class Name
  4471.      S:=ps^;
  4472.      UpcaseStr(S);
  4473.      If S=NameToFind Then
  4474.      Begin
  4475.           Inc(ps,Length(S)+1);               //ON Unit Name
  4476.           S:=ps^;
  4477.           UpcaseStr(S);
  4478.           FSplit(S,D,N,E);
  4479.           If N=ClassUnit Then
  4480.           Begin
  4481.                Result:=Data;
  4482.                Exit;
  4483.           End;
  4484.      End;
  4485.  
  4486.      Inc(Data,len); //Next entry
  4487.      Inc(Count);
  4488.      Goto L;
  4489. End;
  4490.  
  4491.  
  4492. Procedure TComponent.SetupSCU;
  4493. Var
  4494.     SaveSCU:Pointer;
  4495.     OldInsideDesigner:Boolean;
  4496. Begin
  4497.      If SCUPointer=Nil Then Exit;
  4498.      If ComponentState * [csForm] = [] Then Exit;
  4499.  
  4500.      OldInsideDesigner:=InsideDesigner;
  4501.      SaveSCU:=SCUPointer;
  4502.      SCUPointer:=Nil; //prevent recursion
  4503.      Try
  4504.         ReadSCU(SaveSCU);
  4505.      Except
  4506.         On E:Exception Do
  4507.           If ((InsideDesigner)Or(InsideLanguageDesigner)) Then ErrorBox2('Illegal SCU format:'+E.Message);
  4508.      End;
  4509.  
  4510.      SCUPointer:=SaveSCU;
  4511.      InsideDesigner:=OldInsideDesigner;
  4512. End;
  4513.  
  4514.  
  4515. {$HINTS OFF}
  4516. Procedure TComponent.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
  4517. Begin
  4518. End;
  4519.  
  4520. Function TComponent.WriteSCUResource(Stream:TResourceStream):Boolean;
  4521. Begin
  4522.      Result:=True;
  4523. End;
  4524.  
  4525. Procedure TComponent.LoadedFromSCU(SCUParent:TComponent);
  4526. Begin
  4527.      Exclude(FComponentState, csReading);
  4528.      Exclude(FComponentState, csLoading);
  4529.      Include(FComponentState, csLoaded);
  4530. End;
  4531.  
  4532. Procedure TComponent.LoadingFromSCU(SCUParent:TComponent);
  4533. Begin
  4534.      Include(FComponentState, csReading);
  4535.      Include(FComponentState, csLoading);
  4536.      Exclude(FComponentState, csLoaded);
  4537. End;
  4538. {$HINTS ON}
  4539.  
  4540. Procedure TComponent.Loaded;
  4541. Begin
  4542. End;
  4543.  
  4544.  
  4545. Procedure TComponent.SetupComponent;
  4546. Begin
  4547.      //Name := 'Component';
  4548.      Name := Copy(ClassName,2,255);
  4549.      Tag := 0;
  4550.      If Designed Then Include(ComponentState,csReference);
  4551. End;
  4552.  
  4553.  
  4554. Constructor TComponent.Create(AOwner:TComponent);
  4555. Begin
  4556.      //Inherited Create;
  4557.  
  4558.      If InsideWriteSCUAdr^ Then Include(ComponentState, csWriting);
  4559.  
  4560.      If AOwner Is TComponent Then AOwner.InsertComponent(Self);
  4561.  
  4562.      SetupComponent;
  4563. End;
  4564.  
  4565.  
  4566. Procedure SetupFormSCU(Form:TComponent);
  4567. Begin
  4568.      If SCUPointer <> Nil Then Form.SetupSCU;
  4569. End;
  4570.  
  4571.  
  4572. Procedure TComponent.Notification(AComponent:TComponent;Operation:TOperation);
  4573. Var  I:LongInt;
  4574. Begin
  4575.      If (FFreeNotifyList <> Nil) And (Operation = opRemove) Then
  4576.      Begin
  4577.           FFreeNotifyList.Remove(AComponent);
  4578.           If FFreeNotifyList.Count = 0 Then
  4579.           Begin
  4580.                FFreeNotifyList.Destroy;
  4581.                FFreeNotifyList := Nil;
  4582.           End;
  4583.      End;
  4584.  
  4585.      For I := 0 To ComponentCount-1 Do
  4586.      Begin
  4587.           Components[I].Notification(AComponent,Operation);
  4588.      End;
  4589. End;
  4590.  
  4591.  
  4592. Procedure TComponent.FreeNotification(AComponent:TComponent);
  4593. Begin
  4594.      If FFreeNotifyList = Nil Then FFreeNotifyList.Create;
  4595.  
  4596.      If FFreeNotifyList.IndexOf(AComponent) < 0 Then
  4597.      Begin
  4598.           FFreeNotifyList.Add(AComponent);
  4599.           AComponent.FreeNotification(Self);
  4600.      End;
  4601. End;
  4602.  
  4603.  
  4604. Function GetLanguages(Component:TComponent):PLanguageInfo;
  4605. Begin
  4606.      Result:=Component.FLanguages;
  4607. End;
  4608.  
  4609. Procedure SetLanguages(Component:TComponent;Info:PLanguageInfo);
  4610. Begin
  4611.      Component.FLanguages:=Info;
  4612. End;
  4613.  
  4614. Procedure FreeLanguage(Var LangComp:PLanguageComponent);
  4615. Var NextLangComp:PLanguageComponent;
  4616. Begin
  4617.      While LangComp<>Nil Do
  4618.      Begin
  4619.           FreeMem(LangComp^.Name,Length(LangComp^.Name^)+1);
  4620.           If LangComp^.ValueLen>0 Then
  4621.            FreeMem(LangComp^.Value,LangComp^.ValueLen);
  4622.  
  4623.           NextLangComp:=LangComp^.Next;
  4624.           Dispose(LangComp);
  4625.           LangComp:=NextLangComp;
  4626.      End;
  4627. End;
  4628.  
  4629. Destructor TComponent.Destroy;
  4630. Var Meth,Last:PIDE_Methods;
  4631.     T:LongInt;
  4632.     Own:PIDE_OwnerList;
  4633.     I:LongInt;
  4634.     LangItem,NextLangItem:PLanguageItem;
  4635. Begin
  4636.      {inform All linked Components}
  4637.      If FFreeNotifyList <> Nil Then
  4638.      Begin
  4639.           For I := 0 To FFreeNotifyList.Count-1 Do
  4640.           Begin
  4641.                TComponent(FFreeNotifyList[I]).Notification(Self,opRemove);
  4642.           End;
  4643.           FFreeNotifyList.Destroy;
  4644.           FFreeNotifyList := Nil;
  4645.      End;
  4646.  
  4647.      Meth:=FMethods;
  4648.      While Meth<>Nil Do
  4649.      Begin
  4650.           DisposeStr(Meth^.Name);
  4651.           DisposeStr(Meth^.Params);
  4652.           If Meth^.Owners<>Nil Then
  4653.           Begin
  4654.                For T:=0 To Meth^.Owners.Count-1 Do
  4655.                Begin
  4656.                     Own:=Meth^.Owners.Items[T];
  4657.                     DisposeStr(Own^.PropertyName);
  4658.                End;
  4659.                Meth^.Owners.Destroy;
  4660.           End;
  4661.  
  4662.           Last:=Meth^.Next;
  4663.           Dispose(Meth);
  4664.           Meth:=Last;
  4665.      End;
  4666.      FMethods := Nil;
  4667.  
  4668.      //Free registered languages
  4669.      If FLanguages<>Nil Then
  4670.      Begin
  4671.           LangItem:=PLanguageInfo(FLanguages)^.Items;
  4672.           FreeMem(FLanguages,SizeOf(TLanguageInfo));
  4673.           FLanguages:=Nil;
  4674.           While LangItem<>Nil Do
  4675.           Begin
  4676.                FreeMem(LangItem^.Name,Length(LangItem^.Name^)+1);
  4677.  
  4678.                FreeLanguage(LangItem^.Components);
  4679.                FreeLanguage(LangItem^.Menus);
  4680.                FreeLanguage(LangItem^.StringTables);
  4681.  
  4682.                NextLangItem:=LangItem^.Next;
  4683.                Dispose(LangItem);
  4684.                LangItem:=NextLangItem;
  4685.           End;
  4686.      End;
  4687.  
  4688.  
  4689.      DestroyComponents;
  4690.  
  4691.      If FOwner <> Nil Then FOwner.RemoveComponent(Self);
  4692.  
  4693.      DisposeStr(FName);
  4694.      FName := Nil;
  4695.      DisposeStr(FUnitName);
  4696.      FUnitName := Nil;
  4697.      DisposeStr(FTypeName);
  4698.      FTypeName := Nil;
  4699.  
  4700.      Inherited Destroy;
  4701. End;
  4702.  
  4703.  
  4704. Procedure TComponent.DestroyComponents;
  4705. Var  I:LongInt;
  4706.      Component:TComponent;
  4707. Begin
  4708.      If FComponents <> Nil Then
  4709.      Begin
  4710.           I := ComponentCount;
  4711.           While I > 0 Do
  4712.           Begin
  4713.                Component := Components[I-1];
  4714.                RemoveComponent(Component);
  4715.                Component.Destroy;
  4716.                I := ComponentCount;
  4717.           End;
  4718.  
  4719.           FComponents.Destroy;
  4720.           FComponents := Nil;
  4721.      End;
  4722. End;
  4723.  
  4724. Function TComponent.GetComponentIndex:LongInt;
  4725. Begin
  4726.      Result := -1;
  4727.      If FOwner = Nil Then Exit;
  4728.      If FOwner.FComponents = Nil Then Exit;
  4729.      Result := FOwner.FComponents.IndexOf(Self);
  4730. End;
  4731.  
  4732. Procedure TComponent.SetComponentIndex(Index:LongInt);
  4733. Var  I:LongInt;
  4734. Begin
  4735.      If FOwner = Nil Then Exit;
  4736.      I := FOwner.IndexOfComponent(Self);
  4737.      If I < 0 Then Exit;
  4738.      If Index = I Then Exit;
  4739.      If Index < 0 Then Index := 0;
  4740.      If Index >= FOwner.FComponents.Count
  4741.      Then Index := FOwner.FComponents.Count -1;
  4742.      FOwner.FComponents.Move(I,Index);
  4743. End;
  4744.  
  4745. Function TComponent.GetComponentCount:LongInt;
  4746. Begin
  4747.      If FComponents=Nil Then Result:=0
  4748.      Else Result:=FComponents.Count;
  4749. End;
  4750.  
  4751. Function TComponent.GetComponent(AIndex:LongInt):TComponent;
  4752. Begin
  4753.      If (FComponents=Nil) Or (AIndex<0) Or (AIndex>=FComponents.Count)
  4754.      Then Result:=Nil
  4755.      Else Result:=FComponents.Items[AIndex];
  4756. End;
  4757.  
  4758. Function TComponent.GetName:String;
  4759. Begin
  4760.      If FName<>Nil Then Result:=FName^
  4761.      Else Result:='';
  4762. End;
  4763.  
  4764. Procedure TComponent.SetName(Const NewName:String);
  4765. Begin
  4766.      AssignStr(FName,NewName);
  4767. End;
  4768.  
  4769. Function TComponent.GetUnitName:String;
  4770. Begin
  4771.      If FUnitName <> Nil Then Result := FUnitName^
  4772.      Else Result := '';
  4773. End;
  4774.  
  4775. Function TComponent.GetTypeName:String;
  4776. Begin
  4777.      If FTypeName <> Nil Then Result := FTypeName^
  4778.      Else Result := '';
  4779. End;
  4780.  
  4781. Procedure TComponent.SetTypeName(NewName:String);
  4782. Begin
  4783.      AssignStr(FTypeName,NewName);
  4784. End;
  4785.  
  4786. Function TComponent.GetDesigned:Boolean;
  4787. Begin
  4788.      Result := FComponentState * [csDesigning] <> [];
  4789. End;
  4790.  
  4791. Procedure TComponent.InsertComponent(AComponent:TComponent);
  4792. Begin
  4793.      If FComponents = Nil Then FComponents.Create;
  4794.      FComponents.Add(AComponent);
  4795.      AComponent.FOwner := Self;
  4796.  
  4797.      AComponent.SetDesigning(Designed);    {!}
  4798.  
  4799.      Notification(AComponent,opInsert);
  4800. End;
  4801.  
  4802. Procedure TComponent.RemoveComponent(AComponent:TComponent);
  4803. Begin
  4804.      Notification(AComponent,opRemove);
  4805.      If FComponents = Nil Then Exit;
  4806.      FComponents.Remove(AComponent);
  4807. End;
  4808.  
  4809. Function TComponent.IndexOfComponent(AComponent:TComponent):LongInt;
  4810. Begin
  4811.      Result := -1;
  4812.      If FComponents = Nil Then Exit;
  4813.      Result := FComponents.IndexOf(AComponent);
  4814. End;
  4815.  
  4816. Function TComponent.FindComponent(Const AName:String):TComponent;
  4817. Var  I:LongInt;
  4818. Begin
  4819.      Result := Nil;
  4820.      For I := 0 To ComponentCount-1 Do
  4821.        If Components[I].Name = AName Then
  4822.        Begin
  4823.             Result := Components[I];
  4824.             break;
  4825.        End;
  4826. End;
  4827.  
  4828.  
  4829. Procedure TComponent.SetDesigning(Value:Boolean);
  4830. Var  I:LongInt;
  4831. Begin
  4832.      If Value Then Include(FComponentState, csDesigning)
  4833.      Else Exclude(FComponentState, csDesigning);
  4834.  
  4835.      For I := 0 To ComponentCount-1 Do Components[I].SetDesigning(Value);
  4836. End;
  4837.  
  4838.  
  4839. Procedure AddDesignerPopupEvent(AString:TStringList;Caption:String;Id:LongInt);
  4840. Begin
  4841.      If AString Is TStringList Then AString.AddObject(Caption, TObject(Id));
  4842. End;
  4843.  
  4844.  
  4845. {event from the designer PopupMenu}
  4846. {$HINTS OFF}
  4847. Procedure TComponent.GetDesignerPopupEvents(AString:TStringList);
  4848. Begin
  4849. End;
  4850.  
  4851. Procedure TComponent.DesignerPopupEvent(Id:LongInt);
  4852. Begin
  4853. End;
  4854. {$HINTS ON}
  4855.  
  4856.  
  4857. {
  4858. ╔═══════════════════════════════════════════════════════════════════════════╗
  4859. ║                                                                           ║
  4860. ║ Speed-Pascal/2 Version 2.0                                                ║
  4861. ║                                                                           ║
  4862. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  4863. ║                                                                           ║
  4864. ║ This section: General FUNCTIONs Implementation                            ║
  4865. ║                                                                           ║
  4866. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  4867. ║                                                                           ║
  4868. ╚═══════════════════════════════════════════════════════════════════════════╝
  4869. }
  4870.  
  4871. Const
  4872.    SearchCompLibComponentByName:Function(Const Name:String):TComponentClass=Nil;
  4873.    CallCompLibClassPropertyEditor:Function(Var ClassToEdit:TObject):TClassPropertyEditorReturn=Nil;
  4874.    CallCompLibPropertyEditor:Function(Owner:TComponent;PropertyName:String;Var Value;ValueLen:LongInt;
  4875.                                       Var List:TStringList):TPropertyEditorReturn=Nil;
  4876.    CallCompLibPropertyEditorAvailable:Function(OwnerClass:TClass;PropertyName:String):Boolean=Nil;
  4877.    CallCompLibClassPropertyEditorAvailable:Function(ClassName:String):Boolean=Nil;
  4878.  
  4879. Var
  4880.     NameTable:TList;
  4881.  
  4882. Function NameTableAdd(P:PString):LongInt;
  4883. Var T:LongInt;
  4884.     Ofs:LongInt;
  4885.     pp:PString;
  4886. Begin
  4887.      Ofs:=0;
  4888.      For T:=0 To NameTable.Count-1 Do
  4889.      Begin
  4890.           pp:=NameTable.Items[T];
  4891.           If pp^=P^ Then
  4892.           Begin
  4893.                Result:=Ofs;
  4894.                Exit;
  4895.           End;
  4896.           Inc(Ofs,Length(pp^)+1);
  4897.      End;
  4898.      NameTable.Add(P);
  4899.      Result:=Ofs;
  4900. End;
  4901.  
  4902.  
  4903. Function SearchClassByName(Const Name:String):TComponentClass;
  4904. Var  T:LongInt;
  4905.      Comp:TComponentClass;
  4906.      S,s1:String;
  4907. Begin
  4908.      Result := Nil;
  4909.      S := Name;
  4910.      UpcaseStr(S);
  4911.      For T := 0 To RegisteredClasses.Count-1 Do
  4912.      Begin
  4913.           Comp := RegisteredClasses.Items[T];
  4914.           s1 := Comp.ClassName;
  4915.           UpcaseStr(s1);
  4916.           If s1 = S Then
  4917.           Begin
  4918.                Result := Comp;
  4919.                Exit;
  4920.           End;
  4921.      End;
  4922.  
  4923.      {Search In registered Components Of the complib}
  4924.      If @SearchCompLibComponentByName<>Nil
  4925.      Then Result := SearchCompLibComponentByName(Name);
  4926. End;
  4927.  
  4928. Procedure RegisterClass(Const ComponentClass:TComponentClass);
  4929. Var Comp:TComponentClass;
  4930.     t1:LongInt;
  4931. Begin
  4932.      For t1:=0 To RegisteredClasses.Count-1 Do
  4933.      Begin
  4934.           Comp:=RegisteredClasses.Items[t1];
  4935.           If Comp.ClassName=ComponentClass.ClassName Then exit;
  4936.      End;
  4937.  
  4938.      RegisteredClasses.Add(ComponentClass);
  4939. End;
  4940.  
  4941. Function GetClass(Const ClassName:String):TComponentClass;
  4942. Begin
  4943.      Result:=SearchClassByName(ClassName);
  4944. End;
  4945.  
  4946. Function FindClass(Const ClassName:String):TComponentClass;
  4947. Begin
  4948.      Result:=GetClass(ClassName);
  4949.      If Result=Nil Then Raise EClassNotFound.Create(ClassName);
  4950. End;
  4951.  
  4952. Procedure UnRegisterClass(AClass:TComponentClass);
  4953. Var t1:LongInt;
  4954.     Comp:TComponentClass;
  4955. Label again;
  4956. Begin
  4957. again:
  4958.      For t1:=0 To RegisteredClasses.Count-1 Do
  4959.      Begin
  4960.           Comp:=RegisteredClasses.Items[t1];
  4961.           If Comp.ClassName=AClass.ClassName Then
  4962.           Begin
  4963.                RegisteredClasses.Remove(Comp);
  4964.                goto again;
  4965.           End;
  4966.      End;
  4967. End;
  4968.  
  4969. Procedure UnRegisterClasses(Const AClasses:Array of TComponentClass);
  4970. Var t:LongInt;
  4971. Begin
  4972.      For t:=0 To High(AClasses) Do UnRegisterClass(AClasses[t]);
  4973. End;
  4974.  
  4975.  
  4976. Procedure RegisterClasses(Const ComponentClasses: Array Of TComponentClass);
  4977. Var T,t1:LongInt;
  4978.     Comp,Comp1:TComponentClass;
  4979. Label l1;
  4980. Begin
  4981.      For T:=0 To High(ComponentClasses) Do
  4982.      Begin
  4983.           Comp1:=ComponentClasses[T];
  4984.           For t1:=0 To RegisteredClasses.Count-1 Do
  4985.           Begin
  4986.                Comp:=RegisteredClasses.Items[t1];
  4987.                If Comp.ClassName=Comp1.ClassName Then Goto l1;
  4988.           End;
  4989.  
  4990.           RegisteredClasses.Add(Comp1);
  4991. l1:
  4992.      End;
  4993. End;
  4994.  
  4995. {copies actual Value Of Property To Value.
  4996.  Value MUST be allocated With At least TypLen Bytes !}
  4997. Function CallReadProp(Objekt:TObject;FuncAddr:Pointer;Typ:Byte;
  4998.                       TypLen:LongInt;Value:Pointer):Boolean;
  4999. Var
  5000.     FResult:LongInt;
  5001.     Func:Function(SelfObj:TObject):LongInt;
  5002.     FuncVar:Function(VarRef:Pointer;SelfObj:TObject):LongInt;
  5003. Begin
  5004.      Result:=False;
  5005.  
  5006.      If FuncAddr=Nil Then Exit;  //method Not found
  5007.  
  5008.      If ((Typ=PropType_Set)And(TypLen=4)) Then Typ:=PropType_Unsigned;
  5009.  
  5010.      If LongWord(FuncAddr)<65535 Then //VMT call
  5011.      Begin
  5012.           Case Typ Of
  5013.              PropType_Unsigned,PropType_Signed,PropType_Class,
  5014.              PropType_Enum,PropType_Boolean,PropType_Char,PropType_ClassVar:
  5015.              Begin
  5016.                   Asm
  5017.                      PUSH DWord Ptr Objekt   //Self
  5018.                      MOV EAX,FuncAddr        //VMT Index
  5019.                      CALLN32 System.!VmtCall
  5020.                      MOV FResult,EAX
  5021.                   End;
  5022.                   Move(FResult,Value^,TypLen);
  5023.              End;
  5024.              PropType_Float,PropType_String,PropType_Set,PropType_CString,
  5025.              PropType_ProcVar,PropType_FuncVar,PropType_Record:
  5026.              Begin
  5027.                   Asm
  5028.                      PUSH DWord Ptr Value    //Var Parameter Of return Value
  5029.                      PUSH DWord Ptr Objekt   //Self
  5030.                      MOV EAX,FuncAddr        //VMT Index
  5031.                      CALLN32 System.!VmtCall
  5032.                   End;
  5033.              End;
  5034.              Else Exit;  //Some Error
  5035.           End; {Case}
  5036.      End
  5037.      Else
  5038.      Begin
  5039.           Case Typ Of
  5040.              PropType_Unsigned,PropType_Signed,PropType_Class,
  5041.              PropType_Enum,PropType_Boolean,PropType_Char,PropType_ClassVar:
  5042.              Begin
  5043.                   Func:=FuncAddr;
  5044.                   FResult:=Func(Objekt);
  5045.                   Move(FResult,Value^,TypLen);
  5046.              End;
  5047.              PropType_Float,PropType_String,PropType_Set,PropType_CString,
  5048.              PropType_ProcVar,PropType_FuncVar,PropType_Record:
  5049.              Begin
  5050.                   FuncVar:=FuncAddr;
  5051.                   FResult:=FuncVar(Value,Objekt);
  5052.              End;
  5053.              Else Exit;  //Some Error
  5054.           End; {Case}
  5055.      End;
  5056.  
  5057.      Result:=True;
  5058. End;
  5059.  
  5060. {copies actual Value Of Value To the Property.
  5061.  Value MUST be allocated With At least TypLen Bytes !}
  5062. Function CallWriteProp(Objekt:TObject;ProcAddr:Pointer;Typ:Byte;
  5063.                        TypLen:LongInt;Value:Pointer):Boolean;
  5064. Var
  5065.     Proc:Procedure(Value:LongWord;SelfObj:TObject);
  5066.     ProcVar:Procedure(Value:Pointer;SelfObj:TObject);
  5067.     pb:^LongWord;
  5068.     pw:^Word;
  5069.     pl:^LongWord;
  5070.     L:LongWord;
  5071. Begin
  5072.      Result:=False;
  5073.  
  5074.      If ProcAddr=Nil Then Exit;  //method Not found
  5075.  
  5076.      If TypLen In [1,2,3,4] Then
  5077.        If Not (Typ In [PropType_String,PropType_CString]) Then Typ:=PropType_Unsigned;
  5078.  
  5079.      If LongWord(ProcAddr)<65535 Then //VMT call
  5080.      Begin
  5081.           Case Typ Of
  5082.              PropType_Unsigned,PropType_Signed,PropType_Class,
  5083.              PropType_Enum,PropType_Boolean,PropType_Char,PropType_ClassVar:
  5084.              Begin
  5085.                   Case TypLen Of
  5086.                     1:
  5087.                     Begin
  5088.                          pb:=Value;
  5089.                          L:=pb^;
  5090.                     End;
  5091.                     2:
  5092.                     Begin
  5093.                          pw:=Value;
  5094.                          L:=pw^;
  5095.                     End;
  5096.                     3:
  5097.                     Begin
  5098.                          L:=0;
  5099.                          Move(pl^,L,3);
  5100.                     End;
  5101.                     4:
  5102.                     Begin
  5103.                          pl:=Value;
  5104.                          L:=pl^;
  5105.                     End;
  5106.                     Else Exit;  //no Valid Type Size For Val
  5107.                   End; {Case}
  5108.  
  5109.                   Asm
  5110.                      PUSH DWord Ptr L        //Value To Set
  5111.                      PUSH DWord Ptr Objekt   //Self
  5112.                      MOV EAX,ProcAddr        //VMT Index
  5113.                      CALLN32 System.!VmtCall
  5114.                   End;
  5115.              End;
  5116.              PropType_Float,PropType_String,PropType_Set,PropType_CString,
  5117.              PropType_ProcVar,PropType_FuncVar,PropType_Record:
  5118.              Begin
  5119.                   Asm
  5120.                      PUSH DWord Ptr Value    //Var Parameter Of Data To Assign
  5121.                      PUSH DWord Ptr Objekt   //Self
  5122.                      MOV EAX,ProcAddr        //VMT Index
  5123.                      CALLN32 System.!VmtCall
  5124.                   End;
  5125.              End;
  5126.              Else Exit;  //Some Error
  5127.           End; {Case}
  5128.      End
  5129.      Else
  5130.      Begin
  5131.           Case Typ Of
  5132.              PropType_Unsigned,PropType_Signed,PropType_Class,
  5133.              PropType_Enum,PropType_Boolean,PropType_Char,PropType_ClassVar:
  5134.              Begin
  5135.                   Proc:=ProcAddr;
  5136.                   Case TypLen Of
  5137.                     1:
  5138.                     Begin
  5139.                          pb:=Value;
  5140.                          L:=pb^;
  5141.                     End;
  5142.                     2:
  5143.                     Begin
  5144.                          pw:=Value;
  5145.                          L:=pw^;
  5146.                     End;
  5147.                     3:
  5148.                     Begin
  5149.                          L:=0;
  5150.                          Move(pl^,L,3);
  5151.                     End;
  5152.                     4:
  5153.                     Begin
  5154.                          pl:=Value;
  5155.                          L:=pl^;
  5156.                     End;
  5157.                     Else Exit;  //no Valid Type Size For Val
  5158.                   End; {Case}
  5159.  
  5160.                   Proc(L,Objekt);
  5161.              End;
  5162.              PropType_Float,PropType_String,PropType_Set,PropType_CString,
  5163.              PropType_ProcVar,PropType_FuncVar,PropType_Record:
  5164.              Begin
  5165.                   ProcVar:=ProcAddr;
  5166.                   ProcVar(Value,Objekt);
  5167.              End;
  5168.              Else Exit;  //Some Error
  5169.           End; {Case}
  5170.      End;
  5171.  
  5172.      Result:=True;
  5173. End;
  5174.  
  5175. Var PropertyNameTable:Pointer;
  5176.  
  5177.  
  5178. Const SCUUnsignedTypes:Array[1..4] Of SCUTypes=(SCUByte,SCUWord,SCUNull,SCULongWord);
  5179.       SCUSignedTypes:Array[1..4] Of SCUTypes=(SCUShortInt,SCUInteger,SCUNull,SCULongInt);
  5180.       SCUFloatTypes:Array[4..10] Of SCUTypes=(SCUSingle,SCUNull,SCUNull,SCUNull,SCUDouble,SCUNull,SCUExtended);
  5181.       SCUBooleanTypes:Array[1..4] Of SCUTypes=(SCUByteBool,SCUWordBool,SCUNull,SCULongBool);
  5182.  
  5183. Function WriteProperties(Stream:TMemoryStream;p1:Pointer;Objekt:TComponent;
  5184.                          pParent:Pointer):Boolean; Forward;
  5185.  
  5186.  
  5187. Function WritePropertyValues(Stream:TMemoryStream;P:Pointer;Objekt:TComponent;
  5188.                              Namep:Pointer;ReferenceObjekt:TComponent):Boolean;
  5189. Var Typep,p1,p2:^LongInt;
  5190.     Typ,B:Byte;
  5191.     tt,TypLen:LongInt;
  5192.     ReadTyp,WriteTyp:Byte;
  5193.     S:String;
  5194.     ps:^String;
  5195.     Value,ReferenceValue:^LongInt;
  5196.     ValueLen:LongInt;
  5197.     ReadOffset,WriteOffset:LongInt;
  5198.     s3:String;
  5199.     ReadAddr,WriteAddr:Pointer;
  5200.     ValidProp:Boolean;
  5201.     AOwner:TComponent;
  5202.     Methods:PIDE_Methods;
  5203.     Own:PIDE_OwnerList;
  5204.     MyComp:TComponent;
  5205.     pParent1:Pointer;
  5206. Label L,lll,lll1,ex,weiter;
  5207. Begin
  5208.      Result:=False;
  5209.      ValidProp:=True;
  5210.      p1:=P;
  5211.      MyComp:=Nil;
  5212.  
  5213.      ReadTyp:=p1^ And 255;
  5214.      Inc(p1);
  5215.      Case ReadTyp Of
  5216.         0:;  //Not avail
  5217.         1:   //Var Offset
  5218.         Begin
  5219.              ReadOffset:=p1^;
  5220.              Inc(p1,4);
  5221.         End;
  5222.         2,3:   //Procedure Or Function (direct Or VMT call)
  5223.         Begin
  5224.              ReadAddr:=Pointer(p1^);
  5225.              Inc(p1,4);
  5226.         End;
  5227.         Else Goto ex;  //Some Error
  5228.      End;
  5229.  
  5230.      WriteTyp:=p1^ And 255;
  5231.      Inc(p1);
  5232.      Case WriteTyp Of
  5233.         0:;  //Not avail
  5234.         1:   //Var Offset
  5235.         Begin
  5236.              WriteOffset:=p1^;
  5237.              Inc(p1,4);
  5238.         End;
  5239.         2,3:   //Procedure Or Function (direct Or VMT call)
  5240.         Begin
  5241.              WriteAddr:=Pointer(p1^);
  5242.              Inc(p1,4);
  5243.         End;
  5244.         Else Goto ex;  //Some Error
  5245.      End;
  5246.  
  5247.      //determine Type Of the Property
  5248.      TypLen:=p1^;
  5249.      ValueLen:=TypLen;
  5250.      GetMem(Value,TypLen);
  5251.      GetMem(ReferenceValue,TypLen);
  5252.      Inc(p1,4);
  5253.      Typ:=p1^ And 255;             //Property Type
  5254.      Typep:=p1;
  5255.  
  5256.      //Write Value Of the Property
  5257.      Case ReadTyp Of
  5258.         0:;  //Not avail
  5259.         1:   //Var Offset
  5260.         Begin
  5261.              p2:=Pointer(Objekt);
  5262.              Inc(p2,ReadOffset);
  5263.              Move(p2^,Value^,TypLen);
  5264.              p2:=Pointer(ReferenceObjekt);
  5265.              Inc(p2,ReadOffset);
  5266.              Move(p2^,ReferenceValue^,TypLen);
  5267.         End;
  5268.         2,3:   //Procedure Or Function (direct Or VMT call)
  5269.         Begin
  5270.              If Not CallReadProp(Objekt,ReadAddr,Typ,TypLen,Value) Then Goto ex;
  5271.              If Not CallReadProp(ReferenceObjekt,ReadAddr,Typ,TypLen,ReferenceValue) Then Goto ex;
  5272.         End;
  5273.         Else Goto ex;  //Some Error
  5274.      End;
  5275.  
  5276.      If ReadTyp In [1,2,3] Then
  5277.      Begin
  5278.           If Typ In [PropType_ProcVar,PropType_FuncVar,
  5279.                      PropType_Class,PropType_ClassVar] Then //ON... properties
  5280.                                                             //ClassVar And
  5281.                                                             //Classes
  5282.           Begin
  5283.                Own:=Nil;
  5284.                If Value^=0 Then
  5285.                Begin
  5286.                     If Typ In [PropType_ProcVar,PropType_FuncVar] Then //ON properties
  5287.                     Begin
  5288.                          //Search Owner
  5289.                          AOwner:=Objekt;
  5290.                          ps:=Namep;
  5291.                          S:=ps^;
  5292.                          UpcaseStr(S);
  5293. lll:
  5294.                          While AOwner<>Nil Do
  5295.                          Begin
  5296.                               Methods:=AOwner.FMethods;
  5297.  
  5298.                               While Methods<>Nil Do
  5299.                               Begin
  5300.                                    For tt:=0 To Methods^.Owners.Count-1 Do
  5301.                                    Begin
  5302.                                        Own:=Methods^.Owners.Items[tt];
  5303.                                        s3:=Own^.PropertyName^;
  5304.                                        UpcaseStr(s3);
  5305.                                        If S=s3 Then
  5306.                                          If Own^.Objekt=TComponent(Objekt) Then
  5307.                                        Begin  //found
  5308.                                             Goto lll1;
  5309.                                        End;
  5310.                                    End;
  5311.  
  5312.                                    Methods:=Methods^.Next;
  5313.                               End;
  5314. weiter:
  5315.                               AOwner:=AOwner.FOwner;
  5316.                               Goto lll;
  5317.                          End;  //While AOwner<>Nil
  5318.  
  5319.                          Goto L;  //Not found --> dont Write
  5320.                     End
  5321.                     Else Goto L; //dont Write
  5322.                End;
  5323.  
  5324.                If Typ=PropType_Class Then {Class}
  5325.                Begin
  5326.                     MyComp:=Pointer(Value^);
  5327.                     If MyComp<>Nil Then
  5328.                       If MyComp Is TComponent Then
  5329.                         If MyComp.Designed Then
  5330.                            If MyComp.ComponentState * [csHandleLinks] <> [] Then
  5331.                            Begin
  5332.                                Typ:=PropType_Link;  //Link
  5333.                                Goto lll1;
  5334.                            End;
  5335.  
  5336.                     If MyComp Is TComponent Then
  5337.                       If MyComp.DesignerState*[dsStored]<>[] Then
  5338.                     Begin
  5339.                          p1:=Pointer(PropertyNameTable);
  5340.  
  5341.                          p2:=Pointer(MyComp);  //Object address
  5342.                          If p2<>Nil Then
  5343.                          Begin
  5344.                               //Write properties Of the Class
  5345.                               B:=1;
  5346.                               If Stream.Write(B,1)=0 Then Goto ex;
  5347.  
  5348.                               tt:=NameTableAdd(Namep);  //Name Of the Property
  5349.                               If Stream.Write(tt,4)=0 Then Goto ex;
  5350.  
  5351.                               {Type Info For the Property}
  5352.                               B:=Ord(SCUClass);
  5353.                               If Stream.Write(B,1)=0 Then Goto ex;
  5354.  
  5355.  
  5356.                               p2:=Pointer(p2^);  //VMT address
  5357.                               Inc(p2,4);
  5358.                               p2:=Pointer(p2^);  //Class Info
  5359.                               Inc(p2,4);
  5360.                               pParent1:=Pointer(p2^); //parent Class VMT Or Nil
  5361.                               Inc(p2,8);
  5362.                               p2:=Pointer(p2^);  //Property Info
  5363.                               If Not WriteProperties(Stream,p2,MyComp,pParent1) Then Goto ex;
  5364.                               PropertyNameTable:=Pointer(p1);
  5365.                          End;
  5366.                     End;
  5367.                End;
  5368.  
  5369.                //dont Write TBitmap here (Extra Data In BitButton Or Picture)
  5370.  
  5371.                Goto L; //don't Write Class/ClassVar
  5372.           End
  5373.           Else
  5374.           Begin
  5375.                //only Write If Value Is different from Default Value
  5376.               If Typ=PropType_String Then ValueLen:=(Value^ And 255)+1;  //String
  5377.               If ValueLen>TypLen Then ValueLen:=TypLen;
  5378.  
  5379.                If CompareResMem(Value^,ReferenceValue^,ValueLen) Then Goto L;
  5380.           End;
  5381. lll1:
  5382.           //the Value differs from the Default Value And MUST be written
  5383.  
  5384.           If Typ=PropType_Link Then B:=2
  5385.           Else B:=1;
  5386.           If Stream.Write(B,1)=0 Then Goto ex;
  5387.  
  5388.           tt:=NameTableAdd(Namep);  //Name Of the Property
  5389.           If Stream.Write(tt,4)=0 Then Goto ex;
  5390.  
  5391.           tt:=0;
  5392.           Case Typ Of
  5393.               PropType_Unsigned:B:=Ord(SCUUnsignedTypes[ValueLen]);
  5394.               PropType_Signed:B:=Ord(SCUSignedTypes[ValueLen]);
  5395.               PropType_Float:B:=Ord(SCUFloatTypes[ValueLen]);
  5396.               PropType_Set:
  5397.               Begin
  5398.                    If ValueLen=4 Then B:=Ord(SCUSet4)
  5399.                    Else B:=Ord(SCUSet32);
  5400.               End;
  5401.               PropType_CString:B:=Ord(SCUCString);
  5402.               PropType_Record:
  5403.               Begin
  5404.                    B:=Ord(SCURecord);
  5405.                    If Stream.Write(B,1)=0 Then Goto ex;
  5406.                    tt:=ValueLen;
  5407.                    If Stream.Write(tt,4)=0 Then Goto ex;
  5408.               End;
  5409.               PropType_Class:B:=Ord(SCUClass);
  5410.               PropType_String:B:=Ord(SCUString);
  5411.               PropType_Enum:B:=Ord(SCUEnum);
  5412.               PropType_Boolean:B:=Ord(SCUBooleanTypes[ValueLen]);
  5413.               PropType_Char:B:=Ord(SCUChar);
  5414.               PropType_ClassVar:B:=Ord(SCUClassVar);
  5415.               PropType_ProcVar:B:=Ord(SCUProcVar);
  5416.               PropType_FuncVar:B:=Ord(SCUFuncVar);
  5417.               PropType_Link:B:=Ord(SCULink);
  5418.               Else
  5419.               Begin
  5420.                    B:=Ord(SCUBinary);
  5421.                    If Stream.Write(B,1)=0 Then Goto ex;
  5422.                    tt:=ValueLen;
  5423.                    If Stream.Write(tt,4)=0 Then Goto ex;
  5424.               End;
  5425.           End;
  5426.  
  5427.           If tt=0 Then If Stream.Write(B,1)=0 Then Goto ex; //Not For records
  5428.  
  5429.           Case Typ Of
  5430.               PropType_ProcVar,PropType_FuncVar: //Events
  5431.               Begin
  5432.                    //Owner Type Name
  5433.                    If AOwner.FName=Nil Then AOwner.Name:=AOwner.ClassName;
  5434.                    tt:=NameTableAdd(AOwner.FName);
  5435.                    If Stream.Write(tt,4)=0 Then Goto ex;
  5436.  
  5437.                    //method Name
  5438.                    tt:=NameTableAdd(Methods^.Name);
  5439.                    If Stream.Write(tt,4)=0 Then Goto ex;
  5440.  
  5441.                    //Property Name
  5442.                    tt:=NameTableAdd(Namep);
  5443.                    If Stream.Write(tt,4)=0 Then Goto ex;
  5444.               End;
  5445.               PropType_Link:  //Link
  5446.               Begin
  5447.                    //Link field Name
  5448.                    If MyComp=Nil Then Goto ex;
  5449.  
  5450.                    If MyComp.FName=Nil Then MyComp.Name:=MyComp.ClassName;
  5451.                    tt:=NameTableAdd(MyComp.FName);
  5452.                    If Stream.Write(tt,4)=0 Then Goto ex;
  5453.               End;
  5454.               Else //others
  5455.               Begin
  5456.                   If Typ=PropType_String Then ValueLen:=(Value^ And 255)+1;  //String
  5457.                   If ValueLen>TypLen Then ValueLen:=TypLen;
  5458.                   If Stream.Write(Value^,ValueLen)=0 Then Goto ex;
  5459.               End;
  5460.           End; {Case}
  5461.      End
  5462.      Else Goto ex; //Some Error
  5463. L:
  5464.      Result:=True;
  5465. ex:
  5466.      FreeMem(Value,TypLen);
  5467.      FreeMem(ReferenceValue,TypLen);
  5468. End;
  5469.  
  5470.  
  5471.  
  5472. Function WriteProperties(Stream:TMemoryStream;p1:Pointer;Objekt:TComponent;
  5473.                          pParent:Pointer):Boolean;
  5474. Var Namep,P,pp,p2:^LongInt;
  5475.     B:Byte;
  5476.     NameLen:LongInt;
  5477.     len,OldPos,EndPos:LongInt;
  5478.     ReferenceObjekt:TComponent;
  5479.     ObjektClass:TComponentClass;
  5480.     Scope:Byte;
  5481. Label L,ex;
  5482. Begin
  5483.      Result:=False;
  5484.      P:=p1;
  5485.  
  5486.      ObjektClass:=Objekt.ClassType;
  5487.      InsideWriteSCUAdr^:=True;
  5488.      ReferenceObjekt:=Nil;
  5489.      Try
  5490.         ReferenceObjekt:=ObjektClass.Create({Objekt.FOwner}Nil);
  5491.         Include(ReferenceObjekt.ComponentState, csWriting);
  5492.         InsideWriteSCUAdr^:=False;
  5493.  
  5494.         OldPos:=Stream.Position;
  5495.         len:=0;                     //patched later
  5496.         If Stream.Write(len,4)=0 Then Goto ex;
  5497.         Inc(P,4);                  //onto Property Name Table
  5498.         PropertyNameTable:=Pointer(P^);
  5499.         Inc(P,4);                  //onto First Name
  5500. L:
  5501.         NameLen:=P^ And 255;
  5502.         Namep:=Pointer(P);
  5503.  
  5504.         If NameLen<>0 Then
  5505.         Begin
  5506.              Inc(P,NameLen+1);  //overread Name
  5507.              Scope:=P^ And 255;
  5508.              Inc(P);
  5509.              If Scope And 16=0 Then  //Not stored
  5510.              Begin
  5511.                   Inc(P,4);
  5512.                   Goto L;
  5513.              End;
  5514.  
  5515.              //Property Is stored, Find out If we need To Write the Value Of it To the SCU Stream
  5516.              p2:=Pointer(P^);   //Property Type And access Info
  5517.              If p2<>Nil Then
  5518.                If Not WritePropertyValues(Stream,p2,Objekt,Namep,ReferenceObjekt) Then Goto ex;  //Some Error
  5519.              Inc(P,4);   //Until All properties written
  5520.              Goto L;
  5521.         End;
  5522.  
  5523.         If pParent<>Nil Then
  5524.         Begin
  5525.              pp:=pParent;            //parent VMT Info
  5526.              Inc(pp,4);
  5527.              pp:=Pointer(pp^);       //ClassInfo
  5528.              Inc(pp,4);
  5529.              pParent:=Pointer(pp^);  //parent Class VMT Or Nil
  5530.              Inc(pp,8);
  5531.              pp:=Pointer(pp^);       //Property Pointer
  5532.              P:=pp;
  5533.              p1:=P;
  5534.              Inc(P,4);               //onto Property Name Table
  5535.              PropertyNameTable:=Pointer(P^);
  5536.              Inc(P,4);               //onto First Name
  5537.              Goto L;                 //Write parent properties
  5538.         End;
  5539.  
  5540.         B:=0;
  5541.         If Stream.Write(B,1)=0 Then Goto ex;
  5542.  
  5543.         EndPos:=Stream.Position;
  5544.         len:=EndPos-OldPos;
  5545.         Stream.Position:=OldPos;
  5546.         If Stream.Write(len,4)=0 Then Goto ex;
  5547.         Stream.Position:=EndPos;
  5548.  
  5549.         Result:=True;
  5550. ex:
  5551.      Finally
  5552.         If ReferenceObjekt<>Nil Then ReferenceObjekt.Destroy;
  5553.         InsideWriteSCUAdr^:=False;
  5554.      End;
  5555. End;
  5556.  
  5557. Function WriteNameTable(Stream:TMemoryStream):Boolean;
  5558. Var T:LongInt;
  5559.     pp:PString;
  5560. Begin
  5561.      Result:=False;
  5562.  
  5563.      For T:=0 To NameTable.Count-1 Do
  5564.      Begin
  5565.           pp:=NameTable.Items[T];
  5566.           If Stream.Write(pp^,Length(pp^)+1)=0 Then Exit;
  5567.      End;
  5568.  
  5569.      NameTable.Destroy; {!!}
  5570.      Result:=True;
  5571. End;
  5572.  
  5573.  
  5574. Function WriteObjectComponents(Stream:TMemoryStream;ResStream:TResourceStream;
  5575.                                Objekt:TComponent):Boolean;
  5576. Var  Count:LongInt;
  5577.      PatchStreamPos:LongInt;
  5578.      CurStreamPos:LongInt;
  5579. Begin
  5580.      Result := False;
  5581.  
  5582.      Objekt.SCUStream := Stream;
  5583.      Objekt.SCUResStream := ResStream;
  5584.      PatchStreamPos := Stream.Position;
  5585.  
  5586.      Count := 0;
  5587.      If Stream.Write(Count,4) = 0 Then Exit; {Write dummy, patch it later}
  5588.      Objekt.FWriteComponentCount := 0;
  5589.      Objekt.GetChildren(Objekt.WriteComponent);
  5590.      Count := Objekt.FWriteComponentCount;
  5591.  
  5592.      Objekt.SCUStream := Nil;
  5593.      Objekt.SCUResStream := Nil;
  5594.  
  5595.      CurStreamPos := Stream.Position;
  5596.      Stream.Position := PatchStreamPos;
  5597.      If Stream.Write(Count,4) = 0 Then Exit;
  5598.      Stream.Position := CurStreamPos;
  5599.  
  5600.      Result := Not Objekt.SCUWriteError;
  5601. End;
  5602.  
  5603.  
  5604. {Write SCU information Of the Child Component}
  5605. Procedure TComponent.WriteComponent(Child:TComponent);
  5606. Const Zero:LongInt=0;
  5607. Var  pp,pp1,pParent1:^LongInt;
  5608.      tt:LongInt;
  5609.      B:Byte;
  5610.      Ok:Boolean;
  5611.      err:String[40];
  5612. Label ex;
  5613. Begin
  5614.      If csReferenceControl In Child.ComponentState Then
  5615.      Begin //Write the referenced Component before Self
  5616.           If Child.FReference <> Nil Then WriteComponent(Child.FReference);
  5617.      End;
  5618.  
  5619.      Ok:=False;
  5620.      err:='Stream write error';
  5621.      Try
  5622.         SCUWriteError := True;
  5623.         If SCUStream = Nil Then Goto ex;
  5624.         If SCUResStream = Nil Then Goto ex;
  5625.  
  5626.         pp:=Pointer(Child);
  5627.         pp:=Pointer(pp^);       //VMT Info
  5628.  
  5629.         Inc(pp,4);
  5630.         pp:=Pointer(pp^);       //ClassInfo
  5631.         pp1:=pp;
  5632.         Inc(pp,4);
  5633.         pParent1:=Pointer(pp^); //parent Class VMT Or Nil
  5634.         Inc(pp,8);
  5635.         pp:=Pointer(pp^);       //Property Pointer
  5636.  
  5637.         //Write Inspector Class Name
  5638.         Inc(pp1,16);   //onto ClassName
  5639.         tt:=NameTableAdd(Pointer(pp1));
  5640.         If SCUStream.Write(tt,4)=0 Then Goto ex;
  5641.  
  5642.         //Write runtime Class Name
  5643.         If Child.FTypeName=Nil Then
  5644.         Begin
  5645.              B:=0;     //runtime And Inspector Type Name are identical
  5646.              If SCUStream.Write(B,1)=0 Then Goto ex;
  5647.         End
  5648.         Else
  5649.         Begin
  5650.              B:=1;     //runtime Name Is different from Inspector Name
  5651.              If SCUStream.Write(B,1)=0 Then Goto ex;
  5652.              tt:=NameTableAdd(Child.FTypeName);
  5653.              If SCUStream.Write(tt,4)=0 Then Goto ex;
  5654.         End;
  5655.  
  5656.         If Not WriteProperties(SCUStream,pp,Child,pParent1) Then
  5657.         Begin
  5658.              err:='WriteProperties error';
  5659.              Goto ex;  //Some Error
  5660.         End;
  5661.  
  5662.         //Write Components that are owned by the Object
  5663.         If Not WriteObjectComponents(SCUStream,SCUResStream,Child) Then
  5664.         Begin
  5665.              err:='WriteObjectComponents error';
  5666.              Goto ex;
  5667.         End;
  5668.  
  5669.         //Write Extra Data For that Component
  5670.         If Not Child.WriteSCUResource(SCUResStream) Then
  5671.         Begin
  5672.              err:='WriteSCUResource error';
  5673.              Goto ex;
  5674.         End;
  5675.         If SCUStream.Write(Zero,4)=0 Then Goto ex; {no more resources}
  5676.  
  5677.         SCUWriteError := False;
  5678.  
  5679.         Inc(FWriteComponentCount);
  5680.  
  5681.         Ok:=True;
  5682.      Except
  5683.         err:=err+' due to exception';
  5684.      End;
  5685. ex:
  5686.      If Not Ok Then
  5687.      Begin
  5688.           Raise ESCUError.Create('SCU write error for '+Child.ClassName+': '+err);
  5689.      End;
  5690. End;
  5691.  
  5692.  
  5693. Procedure TComponent.WriteToStream(SCUStream:TStream);
  5694. Const Zero:LongInt=0;
  5695. Var  Stream:TMemoryStream;
  5696.      ResourceStream:TResourceStream;
  5697.      P,p1,pParent:^LongInt;
  5698.      FileDesc:TSCUFileFormat;
  5699. Begin
  5700.      Stream.Create;
  5701.      Stream.Capacity:=32768;
  5702.  
  5703.      ResourceStream.Create;
  5704.      ResourceStream.Capacity:=32768;
  5705.      ResourceStream.SCUStream:=Stream;
  5706.      ResourceStream.FHeaderPos:=8;    {Initial Resource Header}
  5707.  
  5708.      NameTable.Create; {wo zerstört??}
  5709.  
  5710.      FillChar(FileDesc,SizeOf(TSCUFileFormat),0);
  5711.      FileDesc.Version:=SCUVersion;
  5712.      If Stream.Write(FileDesc,SizeOf(TSCUFileFormat))=0 Then  //SCU Header
  5713.        Raise ESCUError.Create('Stream write error');
  5714.  
  5715.      FileDesc.ObjectOffset:=Stream.Position;
  5716.      FileDesc.ObjectCount:=1;      //Count Of Objects
  5717.  
  5718.      P:=Pointer(Self);
  5719.      P:=Pointer(P^);               //VMT Info
  5720.  
  5721.      Inc(P,4);
  5722.      P:=Pointer(P^);               //ClassInfo
  5723.      p1:=P;
  5724.      Inc(P,4);
  5725.      pParent:=Pointer(P^);         //parent Class VMT Or Nil
  5726.      Inc(P,8);
  5727.      P:=Pointer(P^);               //Property Pointer
  5728.  
  5729.      Inc(p1,16);                   //onto ClassName
  5730.  
  5731.      If Not WriteProperties(Stream,P,Self,pParent) Then
  5732.        Raise ESCUError.Create('WriteProperties failed');
  5733.  
  5734.      //Write Components that are owned by the Object
  5735.      If Not WriteObjectComponents(Stream,ResourceStream,Self) Then
  5736.        Raise ESCUError.Create('WriteObjectComponents failed');
  5737.  
  5738.      If Not WriteSCUResource(ResourceStream) Then
  5739.          Raise ESCUError.Create('WriteSCUResource failed');
  5740.      If Stream.Write(Zero,4)=0 Then
  5741.          Raise ESCUError.Create('Stream Write Error'); {no more resources}
  5742.  
  5743.      FileDesc.ObjectLen:=Stream.Position-FileDesc.ObjectOffset;
  5744.  
  5745.      //patch Name Table
  5746.      FileDesc.NameTableOffset:=Stream.Position;
  5747.      If Not WriteNameTable(Stream) Then
  5748.        Raise ESCUError.Create('Stream write error');
  5749.      FileDesc.NameTableLen:=Stream.Position-FileDesc.NameTableOffset;
  5750.  
  5751.      FileDesc.ResourceOffset:=Stream.Position;
  5752.      {Write Resource information}
  5753.      If Not ResourceStream.WriteResourcesToStream(Stream) Then
  5754.        Raise ESCUError.Create('Stream write error');
  5755.      ResourceStream.Destroy;
  5756.      FileDesc.ResourceLen:=Stream.Position-FileDesc.ResourceOffset;
  5757.  
  5758.      Stream.Position:=0;    //patch Header
  5759.      If Stream.Write(FileDesc,SizeOf(TSCUFileFormat))=0 Then
  5760.        Raise ESCUError.Create('Stream write error');
  5761.  
  5762.      //Copy Stream
  5763.      SCUStream.WriteBuffer(Stream.FBuffer^,Stream.FSize);
  5764.      Stream.Destroy;
  5765. End;
  5766.  
  5767. Procedure TComponent.ReadSCU(Data:Pointer);
  5768. Var
  5769.    ClassPointer,P,p1:^LongWord;
  5770.    dummy:PSCUFileFormat;
  5771.    NameTable:^LongWord;
  5772.    ResourceTable:^LongWord;
  5773.    ActComponentClass:TComponentClass;
  5774.    S,s1:String;
  5775.    ObjectCount:LongInt;
  5776.    ps:^String;
  5777.    OldInsideDesigner:Boolean;
  5778.    LanguageInfo:^LongWord;
  5779.    MessageInfo:^LongWord;
  5780.    Flags:Byte;
  5781.    T:LongInt;
  5782.    CurrentLanguage:String;
  5783.    LangItem:PLanguageItem;
  5784.    Msgs:PLanguageMessages;
  5785.    MsgLen:LongWord;
  5786.  
  5787.    Procedure ReadLanguage(Var Components:PLanguageComponent);
  5788.    Var
  5789.       LangComp:PLanguageComponent;
  5790.       ps:^String;
  5791.    Begin
  5792.         Components:=Nil;
  5793.  
  5794.         While (LanguageInfo^ And 255)<>0 Do //Read All Components entries
  5795.         Begin
  5796.              Inc(LanguageInfo);  //skip 1
  5797.  
  5798.              If Components=Nil Then
  5799.              Begin
  5800.                   New(Components);
  5801.                   LangComp:=Components;
  5802.              End
  5803.              Else
  5804.              Begin
  5805.                   LangComp:=Components;
  5806.                   While LangComp^.Next<>Nil Do LangComp:=LangComp^.Next;
  5807.                   New(LangComp^.Next);
  5808.                   LangComp:=LangComp^.Next;
  5809.              End;
  5810.              LangComp^.Next:=Nil;
  5811.  
  5812.              ps:=Pointer(LanguageInfo);
  5813.              GetMem(LangComp^.Name,Length(ps^)+1);
  5814.              LangComp^.Name^:=ps^;
  5815.              Inc(LanguageInfo,Length(ps^)+1);
  5816.  
  5817.              LangComp^.ValueTyp:=LanguageInfo^ And 255;
  5818.              Inc(LanguageInfo);
  5819.  
  5820.              LangComp^.ValueLen:=LanguageInfo^;
  5821.              Inc(LanguageInfo,4);
  5822.  
  5823.              GetMem(LangComp^.Value,LangComp^.ValueLen);
  5824.              Move(LanguageInfo^,LangComp^.Value^,LangComp^.ValueLen);
  5825.              Inc(LanguageInfo,LangComp^.ValueLen);
  5826.  
  5827.              LangComp^.ControlLeft:=LanguageInfo^;
  5828.              Inc(LanguageInfo,4);
  5829.              LangComp^.ControlBottom:=LanguageInfo^;
  5830.              Inc(LanguageInfo,4);
  5831.              LangComp^.ControlWidth:=LanguageInfo^;
  5832.              Inc(LanguageInfo,4);
  5833.              LangComp^.ControlHeight:=LanguageInfo^;
  5834.              Inc(LanguageInfo,4);
  5835.         End;
  5836.         Inc(LanguageInfo);  //skip 0
  5837.    End;
  5838.  
  5839. Label loadit,Next,skip;
  5840. Begin
  5841.      OldInsideDesigner:=InsideDesigner;
  5842.      dummy:=Data;
  5843.      PropertyLinks:=Nil;
  5844.      MessageInfo:=NIL;
  5845.      LanguageInfo:=NIL;
  5846.  
  5847.      While dummy<>Nil Do
  5848.      Begin
  5849.           NameTable:=Pointer(dummy);
  5850.           Inc(NameTable,dummy^.NameTableOffset);
  5851.           ResourceTable:=Pointer(dummy);
  5852.           Inc(ResourceTable,dummy^.ResourceOffset);
  5853.  
  5854.           P:=Pointer(dummy);
  5855.           Inc(P,dummy^.ObjectOffset);
  5856.  
  5857.           S:=ClassName;
  5858.           UpcaseStr(S);
  5859.           If ((((InsideDesigner)Or(InsideLanguageDesigner)))And(S='TFORMEDITOR')) Then
  5860.           Begin
  5861.                //always Use the Class entry defined by dummy^.UseEntry !
  5862.                p1:=Pointer(dummy);
  5863.                Inc(p1,SizeOf(TSCUFileFormat));
  5864.                ObjectCount:=0;
  5865.                LanguageInfo:=Nil;
  5866.                MessageInfo:=Nil;
  5867.                While ObjectCount<>dummy^.UseEntry+1 Do
  5868.                Begin
  5869.                     Flags:=p1^ And 255;  //1- auto Create, 2- Language Info avail
  5870.                     Inc(p1);                  //skip flag
  5871.                     Inc(p1,(p1^ And 255)+1);  //skip Form Name
  5872.                     Inc(p1,(p1^ And 255)+1);  //skip Form Unit Name
  5873.                     Inc(p1,(p1^ And 255)+1);  //skip Form TypeName
  5874.                     //If Message information Is available For This Form (only For First) remember And skip it !
  5875.                     If (Flags And 8)<>0 Then
  5876.                     Begin
  5877.                          MessageInfo:=Pointer(p1);
  5878.                          Inc(p1,p1^);
  5879.                     End;
  5880.                     //If Language information Is available For This Form, remember And skip
  5881.                     LanguageInfo:=Pointer(p1);
  5882.                     If Flags And 2<>0 Then Inc(p1,p1^);  //skip Language Info
  5883.                     Inc(ObjectCount);
  5884.                End;
  5885.  
  5886.                If (Flags And 2)=0 Then LanguageInfo:=Nil;  //no languages avail
  5887.                If (Flags And 4)<>0 Then LanguageInfo:=Nil; //locked !!
  5888.  
  5889.                ObjectCount:=0;
  5890.                While ObjectCount<>dummy^.UseEntry Do
  5891.                Begin
  5892.                     Inc(P,{4+}P^);        //overread This entry
  5893.                     Inc(ObjectCount);
  5894.                End;
  5895.  
  5896.                ClassPointer:=P;
  5897.                Inc(P,4);              //Set ON Inspector Class Name
  5898.                Inc(P,(P^ And 255)+1); //overread Inspector Name
  5899.                Inc(P,(P^ And 255)+1); //overread runtime Class Name
  5900.                ps:=Pointer(P);        //Unit Name For This Form
  5901.                AssignStr(FUnitName,ps^);
  5902.                Goto loadit;
  5903.           End
  5904.           Else
  5905.           Begin
  5906.               //don't Read any Classes when inside designer !
  5907.               //If (InsideDesigner And (Not InsideCompLib)) Then Exit;
  5908.               If InsideCompLib Then InsideDesigner:=False;
  5909.  
  5910.               //Search For Class named S inside area P With dummy^.ObjectCount
  5911.               //entries And Set ClassPointer To Object Data Start
  5912.               //Use also ClassUnit For Reference
  5913.               ClassPointer:=SearchClassSCU(P,S,dummy^.ObjectCount,ClassUnit);
  5914.               If ClassPointer=Nil Then Goto Next;  //no Class found
  5915.  
  5916.               //look If Language Info Is avail
  5917.               p1:=Pointer(dummy);
  5918.               Inc(p1,SizeOf(TSCUFileFormat));
  5919.               For T:=1 To dummy^.ObjectCount Do
  5920.               Begin
  5921.                    Flags:=p1^ And 255;
  5922.                    Inc(p1);                  //skip flag
  5923.                    Inc(p1,(p1^ And 255)+1);  //skip Form Name
  5924.                    Inc(p1,(p1^ And 255)+1);  //skip Form Unit Name
  5925.                    If (Flags And 2)<>0 Then //Language Info avail ???
  5926.                    Begin
  5927.                         ps:=Pointer(p1);
  5928.                         Inc(p1,(p1^ And 255)+1);  //skip Form Type Name
  5929.  
  5930.                         //If Message information Is available For This Form (only For First) skip it !
  5931.                         If (Flags And 8)<>0 Then Inc(p1,p1^);
  5932.  
  5933.                         s1:=ps^;
  5934.                         UpcaseStr(s1);
  5935.                         If S=s1 Then //found !
  5936.                         Begin
  5937.                              LanguageInfo:=Pointer(p1);
  5938.                              If (Flags And 4)<>0 Then LanguageInfo:=Nil; //locked !!
  5939.                              Goto loadit;
  5940.                         End
  5941.                         Else Inc(p1,p1^); //only skip Info
  5942.                    End
  5943.                    Else
  5944.                    Begin
  5945.                         Inc(p1,(p1^ And 255)+1);  //skip Form Type Name
  5946.                         //If Message information Is available For This Form (only For First) skip it !
  5947.                         If (Flags And 8)<>0 Then Inc(p1,p1^);
  5948.                    End;
  5949.               End;
  5950.               LanguageInfo:=Nil; //Not found
  5951. loadit:
  5952.               Inc(ClassPointer,4);                         //Set ON Inspector Class Name
  5953.               Inc(ClassPointer,(ClassPointer^ And 255)+1); //overread Inspector Name
  5954.               Inc(ClassPointer,(ClassPointer^ And 255)+1); //overread runtime Class Name
  5955.               Inc(ClassPointer,(ClassPointer^ And 255)+1); //overread Unit Name
  5956.  
  5957.               ActComponentClass:=ClassType;
  5958.               RegisterClasses([ActComponentClass]);  //Form registrieren
  5959.               If ((InsideDesigner)Or(InsideLanguageDesigner)) Then
  5960.               Begin
  5961.                    FMethods:=Nil;  //no Methods defined
  5962.               End;
  5963.  
  5964.               LastSCUForm:=Self;
  5965.  
  5966.               LoadingFromSCU(Nil);
  5967.  
  5968.               //Build Message lists
  5969.               If MessageInfo<>Nil Then
  5970.               Begin
  5971.                    Inc(MessageInfo,4);  //skip Size
  5972.  
  5973.                    ps:=Pointer(MessageInfo);
  5974.                    AppLanguage:=ps^;
  5975.                    Inc(MessageInfo,Length(ps^)+1);
  5976.  
  5977.                    ps:=Pointer(MessageInfo);
  5978.                    While Length(ps^)<>0 Do
  5979.                    Begin
  5980.  
  5981.                         //look If the Language Is installed, skip If True
  5982.                         If LanguageMessages=Nil Then
  5983.                         Begin
  5984.                              New(LanguageMessages);
  5985.                              Msgs:=LanguageMessages;
  5986.                         End
  5987.                         Else
  5988.                         Begin
  5989.                              Msgs:=LanguageMessages;
  5990.                              While Msgs^.Next<>Nil Do
  5991.                              Begin
  5992.                                   If Msgs^.Name^=ps^ Then
  5993.                                   Begin
  5994.                                        Inc(MessageInfo,Length(ps^));
  5995.                                        MsgLen:=MessageInfo^;
  5996.                                        Inc(MessageInfo,4);
  5997.                                        Inc(MessageInfo,MsgLen);
  5998.                                        Goto skip;
  5999.                                   End;
  6000.                                   Msgs:=Msgs^.Next;
  6001.                              End;
  6002.                              If Msgs^.Name^=ps^ Then
  6003.                              Begin
  6004.                                   Inc(MessageInfo,Length(ps^)+1);
  6005.                                   MsgLen:=MessageInfo^;
  6006.                                   Inc(MessageInfo,4);
  6007.                                   Inc(MessageInfo,MsgLen);
  6008.                                   Goto skip;
  6009.                              End;
  6010.                              New(Msgs^.Next);
  6011.                              Msgs:=Msgs^.Next;
  6012.                         End;
  6013.  
  6014.                         GetMem(Msgs^.Name,Length(ps^)+1);
  6015.                         Msgs^.Name^:=ps^;
  6016.                         Inc(MessageInfo,Length(ps^)+1);
  6017.                         Msgs^.StringTableLen:=MessageInfo^;
  6018.                         Inc(MessageInfo,4);
  6019.                         GetMem(Msgs^.StringTable,Msgs^.StringTableLen);
  6020.                         Move(MessageInfo^,Msgs^.StringTable^,Msgs^.StringTableLen);
  6021.                         Inc(MessageInfo,Msgs^.StringTableLen);
  6022. skip:
  6023.                         ps:=Pointer(MessageInfo);
  6024.                    End;
  6025.               End;
  6026.  
  6027.               //Build Language lists
  6028.               If LanguageInfo<>Nil Then
  6029.               Begin
  6030.                    Inc(LanguageInfo,4);  //skip Size
  6031.                    GetMem(FLanguages,SizeOf(TLanguageInfo));
  6032.                    ps:=Pointer(LanguageInfo);
  6033.                    CurrentLanguage:=ps^;  //To determine Language !
  6034.                    Inc(LanguageInfo,Length(CurrentLanguage)+1);
  6035.  
  6036.                    While (LanguageInfo^ And 255)<>0 Do //Read All entries
  6037.                    Begin
  6038.                         Inc(LanguageInfo);  //skip 1
  6039.  
  6040.                         If PLanguageInfo(FLanguages)^.Items=Nil Then
  6041.                         Begin
  6042.                              New(LangItem);
  6043.                              PLanguageInfo(FLanguages)^.Items:=LangItem;
  6044.                         End
  6045.                         Else
  6046.                         Begin
  6047.                              LangItem:=PLanguageInfo(FLanguages)^.Items;
  6048.                              While LangItem^.Next<>Nil Do LangItem:=LangItem^.Next;
  6049.                              New(LangItem^.Next);
  6050.                              LangItem:=LangItem^.Next;
  6051.                         End;
  6052.  
  6053.                         LangItem^.Next:=Nil;
  6054.  
  6055.                         ps:=Pointer(LanguageInfo);
  6056.                         GetMem(LangItem^.Name,Length(ps^)+1);
  6057.                         LangItem^.Name^:=ps^;
  6058.                         Inc(LanguageInfo,Length(ps^)+1);
  6059.  
  6060.                         ReadLanguage(LangItem^.Components);
  6061.                         ReadLanguage(LangItem^.Menus);
  6062.                         ReadLanguage(LangItem^.StringTables);
  6063.                    End; //While
  6064.                    Inc(LanguageInfo); //skip 0
  6065.  
  6066.                    If PLanguageInfo(FLanguages)^.Items=Nil Then //no Items
  6067.                    Begin
  6068.                         FreeMem(FLanguages,SizeOf(TLanguageInfo));
  6069.                         FLanguages:=Nil;
  6070.                    End
  6071.                    Else
  6072.                    Begin
  6073.                        //Set Current Language into Form^.LanguageInfo
  6074.                        LangItem:=PLanguageInfo(FLanguages)^.Items;
  6075.                        While LangItem<>Nil Do
  6076.                        Begin
  6077.                             If LangItem^.Name^=CurrentLanguage Then //found
  6078.                             Begin
  6079.                              PLanguageInfo(FLanguages)^.CurrentLanguageName:=LangItem^.Name;
  6080.                              PLanguageInfo(FLanguages)^.CurrentLanguageComponents:=LangItem^.Components;
  6081.                              PLanguageInfo(FLanguages)^.CurrentLanguageMenus:=LangItem^.Menus;
  6082.                              PLanguageInfo(FLanguages)^.CurrentLanguageStringTables:=LangItem^.StringTables;
  6083.                              break;
  6084.                             End;
  6085.                             LangItem:=LangItem^.Next;
  6086.                        End;
  6087.  
  6088.                        If PLanguageInfo(FLanguages)^.CurrentLanguageName=Nil Then
  6089.                        Begin
  6090.                            //Not found - Use First available Language
  6091.                            LangItem:=PLanguageInfo(FLanguages)^.Items;
  6092.                            PLanguageInfo(FLanguages)^.CurrentLanguageName:=LangItem^.Name;
  6093.                            PLanguageInfo(FLanguages)^.CurrentLanguageComponents:=LangItem^.Components;
  6094.                            PLanguageInfo(FLanguages)^.CurrentLanguageMenus:=LangItem^.Menus;
  6095.                            PLanguageInfo(FLanguages)^.CurrentLanguageStringTables:=LangItem^.StringTables;
  6096.                        End;
  6097.                    End;
  6098.               End;
  6099.  
  6100.               If Not ReadPropertiesSCU(Self,NameTable,ResourceTable,ClassPointer) Then
  6101.               Begin
  6102.                    InsideDesigner:=OldInsideDesigner;
  6103.                    Raise ESCUError.Create('ReadPropertiesSCU error');
  6104.               End;
  6105.  
  6106.               SetDesigning(InsideDesigner Or InsideLanguageDesigner);
  6107.  
  6108.               //check For Child Components
  6109.               If Not ReadComponentsSCU(NameTable,ResourceTable,ClassPointer) Then
  6110.               Begin
  6111.                    InsideDesigner:=OldInsideDesigner;
  6112.                    Raise ESCUError.Create('ReadComponentsSCU error');
  6113.               End;
  6114.  
  6115.               //links For the Form
  6116.               HandlePropertyLinks(Self);
  6117.  
  6118.               ReadResourceSCU(ResourceTable,ClassPointer);
  6119.  
  6120.               If FLanguages<>Nil Then
  6121.                 If PLanguageInfo(FLanguages)^.CurrentLanguageName<>Nil Then
  6122.                    SetLanguage(Self,PLanguageInfo(FLanguages)^.CurrentLanguageName^);
  6123.  
  6124.               //If there's only the Default Language Left, Erase it !
  6125.               If FLanguages<>Nil Then
  6126.                 If PLanguageInfo(FLanguages)^.Items<>Nil Then
  6127.                   If PLanguageInfo(FLanguages)^.Items^.Next=Nil Then
  6128.                     If PLanguageInfo(FLanguages)^.Items^.Name^='Default' Then
  6129.               Begin
  6130.                    FreeLanguage(PLanguageInfo(FLanguages)^.Items^.Components);
  6131.                    FreeLanguage(PLanguageInfo(FLanguages)^.Items^.Menus);
  6132.                    FreeLanguage(PLanguageInfo(FLanguages)^.Items^.StringTables);
  6133.                    FreeMem(PLanguageInfo(FLanguages)^.Items^.Name,Length(PLanguageInfo(FLanguages)^.Items^.Name^)+1);
  6134.                    Dispose(PLanguageInfo(FLanguages)^.Items);
  6135.                    FreeMem(FLanguages,SizeOf(TLanguageInfo));
  6136.                    FLanguages:=Nil;
  6137.               End;
  6138.  
  6139.               {For the Form}
  6140.               LoadedFromSCU(Nil);
  6141.               Loaded;
  6142.  
  6143.               InsideDesigner:=OldInsideDesigner;
  6144.               Exit;
  6145.          End;
  6146. Next:
  6147.          dummy:=dummy^.NextEntry;
  6148.      End;
  6149.  
  6150.      InsideDesigner:=OldInsideDesigner;
  6151. End;
  6152.  
  6153.  
  6154. Procedure TComponent.ReadFromStream(SCUStream:TStream);
  6155. Var
  6156.     ClassMem,ClassPointer:^LongWord;
  6157.     OldPos:LongInt;
  6158.     OldInsideDesigner:Boolean;
  6159.     FileDesc:TSCUFileFormat;
  6160.     len:LongInt;
  6161.     NameTable:^LongWord;
  6162.     ResourceTable:^LongWord;
  6163. Begin
  6164.      Try
  6165.        ClassPointer:=Nil;
  6166.        OldInsideDesigner:=InsideDesigner;
  6167.        If InsideCompLib Then InsideDesigner:=False;
  6168.  
  6169.        OldPos:=SCUStream.Position;
  6170.        SCUStream.ReadBuffer(FileDesc,SizeOf(FileDesc));
  6171.        SCUStream.Position:=OldPos;
  6172.  
  6173.        len:=SizeOf(FileDesc)+FileDesc.ObjectLen+FileDesc.NameTableLen+FileDesc.ResourceLen;
  6174.        GetMem(ClassPointer,len);
  6175.        ClassMem:=ClassPointer;
  6176.        SCUStream.ReadBuffer(ClassPointer^,len);
  6177.  
  6178.        NameTable:=Pointer(ClassPointer);
  6179.        Inc(NameTable,FileDesc.NameTableOffset);
  6180.        ResourceTable:=Pointer(ClassPointer);
  6181.        Inc(ResourceTable,FileDesc.ResourceOffset);
  6182.        Inc(ClassPointer,FileDesc.ObjectOffset);
  6183.  
  6184.        LastSCUForm:=Owner;
  6185.        SetDesigning(InsideDesigner Or InsideLanguageDesigner);
  6186.        LoadingFromSCU(LastSCUForm);
  6187.  
  6188.        If Not ReadPropertiesSCU(LastSCUForm,NameTable,ResourceTable,ClassPointer) Then
  6189.          Raise ESCUError.Create('SCU error');
  6190.        If Not ReadComponentsSCU(NameTable,ResourceTable,ClassPointer) Then
  6191.          Raise ESCUError.Create('SCU error');
  6192.        ReadResourceSCU(ResourceTable,ClassPointer);
  6193.  
  6194.        LoadedFromSCU(LastSCUForm);
  6195.      Finally
  6196.        InsideDesigner:=OldInsideDesigner;
  6197.        If ClassMem<>Nil Then FreeMem(ClassMem,len);
  6198.      End;
  6199. End;
  6200.  
  6201.  
  6202. {$HINTS OFF}
  6203. Procedure TComponent.GetChildren(Proc:TGetChildProc);
  6204. Begin
  6205. End;
  6206. {$HINTS ON}
  6207.  
  6208.  
  6209. Function TComponent.HasParent:Boolean;
  6210. Begin
  6211.      Result := False;
  6212. End;
  6213.  
  6214. Function WritePropertiesToStream(FormList:TList):TMemoryStream;
  6215. Const Zero:LongInt=0;
  6216.       bt:Byte=1;
  6217.       bf:Byte=0;
  6218. Var  P,p1:^LongInt;
  6219.      pParent:^LongInt;
  6220.      S:String;
  6221.      tt,tt1,Pos1:LongInt;
  6222.      FormItem:PFormListItem;
  6223.      Stream:TMemoryStream;
  6224.      ResourceStream:TResourceStream;
  6225.      FileDesc:TSCUFileFormat;
  6226.      C:TComponent;
  6227.      D,N,E:String;
  6228.      bb:Byte;
  6229.      LangItem:PLanguageItem;
  6230.      LangPos,LangTemp:LongInt;
  6231.      dummy:PLanguageMessages;
  6232.  
  6233.      Function WriteLanguage(LangComp:PLanguageComponent):Boolean;
  6234.      Var Ende:Byte;
  6235.      Begin
  6236.           Result:=False;
  6237.           While LangComp<>Nil Do
  6238.           Begin
  6239.                If Stream.Write(bt,1)=0 Then Exit; //one more entry
  6240.                If Stream.Write(LangComp^.Name^,Length(LangComp^.Name^)+1)=0 Then Exit;
  6241.                If Stream.Write(LangComp^.ValueTyp,1)=0 Then Exit;
  6242.                If Stream.Write(LangComp^.ValueLen,4)=0 Then Exit;
  6243.                If Stream.Write(LangComp^.Value^,LangComp^.ValueLen)=0 Then Exit;
  6244.  
  6245.                If Stream.Write(LangComp^.ControlLeft,4)=0 Then Exit;
  6246.                If Stream.Write(LangComp^.ControlBottom,4)=0 Then Exit;
  6247.                If Stream.Write(LangComp^.ControlWidth,4)=0 Then Exit;
  6248.                If Stream.Write(LangComp^.ControlHeight,4)=0 Then Exit;
  6249.  
  6250.                LangComp:=LangComp^.Next;
  6251.           End;
  6252.  
  6253.           Ende:=0;
  6254.           If Stream.Write(Ende,1)=0 Then Exit; //no more entries
  6255.           Result:=True;
  6256.      End;
  6257.  
  6258. Label err;
  6259. Begin
  6260.      Result:=Nil;  //Some Error
  6261.  
  6262.      Stream.Create;
  6263.      Stream.Capacity:=32768;
  6264.  
  6265.      ResourceStream.Create;
  6266.      ResourceStream.Capacity:=32768;
  6267.      ResourceStream.SCUStream:=Stream;
  6268.      ResourceStream.FHeaderPos:=8;    {Initial Resource Header}
  6269.  
  6270.      NameTable.Create;
  6271.  
  6272.      FillChar(FileDesc,SizeOf(TSCUFileFormat),0);
  6273.      FileDesc.Version:=SCUVersion;
  6274.      If Stream.Write(FileDesc,SizeOf(TSCUFileFormat))=0 Then  //SCU Header
  6275.      Begin
  6276. err:
  6277.           Stream.Destroy;
  6278.           ResourceStream.Destroy;
  6279.           Result:=Nil;
  6280.           Exit;  //Some Error
  6281.      End;
  6282.  
  6283.      Try
  6284.         For tt:=0 To FormList.Count-1 Do
  6285.         Begin
  6286.              FormItem:=FormList.Items[tt];
  6287.              C:=Pointer(FormItem^.Form);
  6288.              If C = Nil Then Goto err; {need Form}
  6289.  
  6290.              bb:=0;
  6291.  
  6292.              If C.DesignerState*[dsAutoCreate]<>[] Then bb:=bb Or 1; //auto-created Form
  6293.              If C.FLanguages<>Nil Then bb:=bb Or 2;                  //Multi Language
  6294.              //!!!!!!!!!! 4 Is reserved For locking Language !!!!!!!!!!!!!!!!!!!
  6295.  
  6296.              //note: Messages are global To an Application, Not To A Form !!!!
  6297.              If ((tt=0)And(LanguageMessages<>Nil)) Then bb:=bb Or 8; //Messages avail
  6298.  
  6299.              If Stream.Write(bb,1)=0 Then Goto err;
  6300.  
  6301.              S:=FormItem^.FormName+#0;
  6302.              UpcaseStr(S);
  6303.              If Stream.Write(S,Length(S)+1)=0 Then Goto err;
  6304.              S:=FormItem^.UnitName;
  6305.              FSplit(S,D,N,E);
  6306.              N:=N+#0;
  6307.              UpcaseStr(N);
  6308.              If Stream.Write(N,Length(N)+1)=0 Then Goto err;
  6309.              If FormItem^.FormName<>'' Then S:='T'+FormItem^.FormName
  6310.              Else S:=FormItem^.Form.ClassName;
  6311.              If Stream.Write(S,Length(S)+1)=0 Then Goto err; //runtime Class Name
  6312.  
  6313.              //Language Messages are only evaluated by Application.Create by examining the SCU Pointer !!!
  6314.              If ((tt=0)And(LanguageMessages<>Nil)) Then
  6315.              Begin
  6316.                   //Write Language Message information
  6317.                   LangPos:=Stream.Position;  //save Position
  6318.                   If Stream.Write(LangPos,4)=0 Then Goto err; //Size: patched later
  6319.  
  6320.                   If Stream.Write(AppLanguage,Length(AppLanguage)+1)=0 Then Goto err;
  6321.  
  6322.                   dummy:=LanguageMessages;
  6323.                   While dummy<>Nil Do
  6324.                   Begin
  6325.                       If Stream.Write(dummy^.Name^,Length(dummy^.Name^)+1)=0 Then Goto err;
  6326.                       If Stream.Write(dummy^.StringTableLen,4)=0 Then Goto err;
  6327.                       If dummy^.StringTableLen>0 Then
  6328.                         If Stream.Write(dummy^.StringTable^,dummy^.StringTableLen)=0 Then Goto err;
  6329.                       dummy:=dummy^.Next;
  6330.                   End;
  6331.                   If Stream.Write(bf,1)=0 Then Goto err; //no more entries
  6332.                   LangTemp:=Stream.Position;
  6333.                   Stream.Position:=LangPos;  //patch Size
  6334.                   LangPos:=LangTemp-LangPos;
  6335.                   If Stream.Write(LangPos,4)=0 Then Goto err;
  6336.                   Stream.Position:=LangTemp; //restore old Position
  6337.              End;
  6338.  
  6339.              If C.FLanguages<>Nil Then
  6340.              Begin
  6341.                   //Write Language information
  6342.                   LangPos:=Stream.Position;  //save Position
  6343.                   If Stream.Write(LangPos,4)=0 Then Goto err; //Size: patched later
  6344.  
  6345.                   If PLanguageInfo(C.FLanguages)^.CurrentLanguageName<>Nil Then
  6346.                   Begin
  6347.                       If Stream.Write(PLanguageInfo(C.FLanguages)^.CurrentLanguageName^,
  6348.                                       Length(PLanguageInfo(C.FLanguages)^.CurrentLanguageName^)+1)=0 Then Goto err;
  6349.                   End
  6350.                   Else
  6351.                   Begin
  6352.                       S:='Default';
  6353.                       If Stream.Write(S,Length(S)+1)=0 Then Goto err;
  6354.                   End;
  6355.  
  6356.                   LangItem:=PLanguageInfo(C.FLanguages)^.Items;
  6357.  
  6358.                   While LangItem<>Nil Do
  6359.                   Begin
  6360.                        If Stream.Write(bt,1)=0 Then Goto err; //one more entry
  6361.                        If Stream.Write(LangItem^.Name^,Length(LangItem^.Name^)+1)=0 Then Goto err;
  6362.  
  6363.                        If Not WriteLanguage(LangItem^.Components) Then Goto err;
  6364.                        If Not WriteLanguage(LangItem^.Menus) Then Goto err;
  6365.                        If Not WriteLanguage(LangItem^.StringTables) Then Goto err;
  6366.  
  6367.                        LangItem:=LangItem^.Next;
  6368.                   End;
  6369.  
  6370.                   If Stream.Write(bf,1)=0 Then Goto err; //no more entries
  6371.  
  6372.                   LangTemp:=Stream.Position;
  6373.                   Stream.Position:=LangPos;  //patch Size
  6374.                   LangPos:=LangTemp-LangPos;
  6375.                   If Stream.Write(LangPos,4)=0 Then Goto err;
  6376.                   Stream.Position:=LangTemp; //restore old Position
  6377.              End;
  6378.         End;
  6379.  
  6380.         FileDesc.ObjectOffset:=Stream.Position;
  6381.         FileDesc.ObjectCount:=FormList.Count;    //Count Of Objects
  6382.  
  6383.         For tt:=0 To FormList.Count-1 Do
  6384.         Begin
  6385.              Pos1:=Stream.Position;
  6386.  
  6387.              tt1:=0;
  6388.              If Stream.Write(tt1,4)=0 Then Goto err;  //Length Of Object Info
  6389.                                                       //- patched later
  6390.  
  6391.              FormItem:=FormList.Items[tt];
  6392.              P:=Pointer(FormItem^.Form);
  6393.              P:=Pointer(P^);               //VMT Info
  6394.  
  6395.              Inc(P,4);
  6396.              P:=Pointer(P^);               //ClassInfo
  6397.              p1:=P;
  6398.              Inc(P,4);
  6399.              pParent:=Pointer(P^);         //parent Class VMT Or Nil
  6400.              Inc(P,8);
  6401.              P:=Pointer(P^);               //Property Pointer
  6402.  
  6403.              Inc(p1,16);                   //onto ClassName
  6404.              Move(p1^,S,(p1^ And 255)+1);  //Inspector Class Name
  6405.              If Stream.Write(S,Length(S)+1)=0 Then Goto err; //Inspector Class Name
  6406.  
  6407.              If FormItem^.FormName<>'' Then S:='T'+FormItem^.FormName
  6408.              Else S:=FormItem^.Form.ClassName;
  6409.              If Stream.Write(S,Length(S)+1)=0 Then Goto err; //runtime Class Name
  6410.              If Stream.Write(FormItem^.UnitName,Length(FormItem^.UnitName)+1)=0 Then Goto err;
  6411.  
  6412.              If Not WriteProperties(Stream,P,TComponent(FormItem^.Form),pParent) Then Goto err;
  6413.  
  6414.              //Write Components that are owned by the Object
  6415.              If Not WriteObjectComponents(Stream,ResourceStream,TComponent(FormItem^.Form)) Then Goto err;
  6416.  
  6417.              If Not FormItem^.Form.WriteSCUResource(ResourceStream) Then Goto err;
  6418.              If Stream.Write(Zero,4)=0 Then Goto err; {no more resources}
  6419.  
  6420.  
  6421.              tt1:=Stream.Position;
  6422.              Stream.Position:=Pos1;
  6423.              Pos1:=tt1-Pos1;
  6424.              Stream.Write(Pos1,4);  //patch len Of Object Info For This entry
  6425.              Stream.Position:=tt1;
  6426.         End; //For
  6427.  
  6428.         FileDesc.ObjectLen:=Stream.Position-FileDesc.ObjectOffset;
  6429.  
  6430.         //patch Name Table
  6431.         FileDesc.NameTableOffset:=Stream.Position;
  6432.         If Not WriteNameTable(Stream) Then Goto err;
  6433.         FileDesc.NameTableLen:=Stream.Position-FileDesc.NameTableOffset;
  6434.  
  6435.         FileDesc.ResourceOffset:=Stream.Position;
  6436.         {Write Resource information}
  6437.         If Not ResourceStream.WriteResourcesToStream(Stream) Then Goto err;
  6438.         ResourceStream.Destroy;
  6439.         FileDesc.ResourceLen:=Stream.Position-FileDesc.ResourceOffset;
  6440.         {ab hier nichts mehr schreiben, sonst System.AddSCUData ändern}
  6441.  
  6442.         tt:=Stream.Position;   //save Position
  6443.         Stream.Position:=0;    //patch Header
  6444.         If Stream.Write(FileDesc,SizeOf(TSCUFileFormat))=0 Then Goto err;
  6445.         Stream.Position:=tt;   //restore Position
  6446.      Except
  6447.          ON ex:Exception Do
  6448.          Begin
  6449.              ErrorBox2(ex.Message);
  6450.              Stream.Destroy;
  6451.              ResourceStream.Destroy;
  6452.              Stream:=Nil;
  6453.          End;
  6454.      End;
  6455.      Result:=Stream;
  6456. End;
  6457.  
  6458.  
  6459. Function WritePropertiesToFile(FileName:String;FormList:TList):Boolean;
  6460. Var Stream:TMemoryStream;
  6461. Begin
  6462.      Stream:=WritePropertiesToStream(FormList);
  6463.      If Stream=Nil Then
  6464.      Begin
  6465.           Result:=False;
  6466.           Exit;
  6467.      End;
  6468.  
  6469.      Result:=True;
  6470.      Try
  6471.         Stream.SaveToFile(FileName);
  6472.      Except
  6473.         ON ex:Exception Do
  6474.         Begin
  6475.              ErrorBox2(ex.Message);
  6476.              Result:=False;
  6477.         End;
  6478.      End;
  6479.  
  6480.      Stream.Destroy;
  6481. End;
  6482.  
  6483.  
  6484.  
  6485. {
  6486. ╔═══════════════════════════════════════════════════════════════════════════╗
  6487. ║                                                                           ║
  6488. ║ Speed-Pascal/2 Version 2.0                                                ║
  6489. ║                                                                           ║
  6490. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  6491. ║                                                                           ║
  6492. ║ This section: TStringItem Class Implementation                            ║
  6493. ║                                                                           ║
  6494. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  6495. ║                                                                           ║
  6496. ╚═══════════════════════════════════════════════════════════════════════════╝
  6497. }
  6498.  
  6499. Procedure TStringSelectList.SetupComponent;
  6500. Begin
  6501.      Inherited SetupComponent;
  6502.      FList.Create;
  6503.      FList.sorted:=True;
  6504.      Include(ComponentState, csDetail);
  6505. End;
  6506.  
  6507. Procedure TStringSelectList.SetStringItem(NewValue:String);
  6508. Begin
  6509.      FSelected:=NewValue;
  6510. End;
  6511.  
  6512. Destructor TStringSelectList.Destroy;
  6513. Begin
  6514.      FList.Destroy;
  6515.      FList := Nil;
  6516.      Inherited Destroy;
  6517. End;
  6518.  
  6519. Function TStringSelectList.GetItems:TStringList;
  6520. Begin
  6521.      Result:=FList;
  6522. End;
  6523.  
  6524. {
  6525. ╔═══════════════════════════════════════════════════════════════════════════╗
  6526. ║                                                                           ║
  6527. ║ Speed-Pascal/2 Version 2.0                                                ║
  6528. ║                                                                           ║
  6529. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  6530. ║                                                                           ║
  6531. ║ This section: TBits Class Implementation                                  ║
  6532. ║                                                                           ║
  6533. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  6534. ║                                                                           ║
  6535. ╚═══════════════════════════════════════════════════════════════════════════╝
  6536. }
  6537.  
  6538. Destructor TBits.Destroy;
  6539. Begin
  6540.   FreeMem(FBits, (FSize + 31) Shr 5);
  6541.   FBits := Nil;
  6542.   Inherited Destroy;
  6543. End;
  6544.  
  6545. Procedure TBits.Error;
  6546. Begin
  6547.   Raise EBitsError.Create(LoadNLSStr(SEBitsErrorText));
  6548. End;
  6549.  
  6550. Function TBits.GetBit(Index: LongInt): Boolean;
  6551. Var
  6552.   Place: Cardinal;
  6553. Begin
  6554.   If (Index < 0) Or (Index >= FSize) Then Error;
  6555.   Place := 1 Shl (Index And 31);
  6556.   Index := Index Shr 5;
  6557.   Result := (FBits^[Index] And Place) <> 0;
  6558. End;
  6559.  
  6560. Function TBits.OpenBit: LongInt;
  6561. Var
  6562.   I, J, K: LongInt;
  6563.   B: Cardinal;
  6564. Begin
  6565.   I := 0;
  6566.   J := (FSize + 31) Shr 5;
  6567.   While (I < J) And (FBits^[I] = 0) Do Inc(I);
  6568.   If I < J Then
  6569.   Begin
  6570.     K := 1;
  6571.     Result := I Shl 5;
  6572.     B := FBits^[I];
  6573.     While (B And K) = 0 Do
  6574.     Begin
  6575.       K := K Shl 1;
  6576.       Inc(Result);
  6577.     End;
  6578.     If Result >= FSize Then Result := -1;
  6579.   End
  6580.   Else Result := -1;
  6581. End;
  6582.  
  6583. Procedure TBits.SetBit(Index: LongInt; bit: Boolean);
  6584. Var
  6585.   Place: Cardinal;
  6586. Begin
  6587.   If (Index < 0) Or (Index >= FSize) Then Error;
  6588.   Place := 1 Shl (Index And 31);
  6589.   Index := Index Shr 5;
  6590.   If bit Then FBits^[Index] := FBits^[Index] Or Place
  6591.   Else FBits^[Index] := FBits^[Index] And Not Place;
  6592. End;
  6593.  
  6594. Procedure TBits.SetSize(NewSize: LongInt);
  6595. Begin
  6596.   If NewSize < 0 Then Error;
  6597.   If FSize = 0 Then FBits := AllocMem((NewSize + 31) Shr 3)
  6598.   Else FBits := ReAllocMem(FBits, (FSize + 31) Shr 3, (NewSize + 31) Shr 3);
  6599.   FSize := NewSize;
  6600. End;
  6601.  
  6602.  
  6603. {
  6604. ╔═══════════════════════════════════════════════════════════════════════════╗
  6605. ║                                                                           ║
  6606. ║ Speed-Pascal/2 Version 2.0                                                ║
  6607. ║                                                                           ║
  6608. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  6609. ║                                                                           ║
  6610. ║ This section: TPropertyEditClassDialog Class Implementation               ║
  6611. ║                                                                           ║
  6612. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  6613. ║                                                                           ║
  6614. ╚═══════════════════════════════════════════════════════════════════════════╝
  6615. }
  6616.  
  6617. Type
  6618.     PPropertyEditClassItem=^TPropertyEditClassItem;
  6619.     TPropertyEditClassItem=Record
  6620.          ClassToEdit: TClass;                            //Editor Class (Class editors) Or parent Class (others)
  6621.          PropertyName:String[64];                        //Property Name For normal editors
  6622.          ClassPropertyEditor: TClassPropertyEditorClass; //<>Nil For Class Property editors
  6623.          PropertyEditor:TPropertyEditorClass;            //<>Nil For normal Property editors
  6624.     End;
  6625.  
  6626.  
  6627. {$HINTS OFF}
  6628. Function TClassPropertyEditor.Execute(Var ClassToEdit:TObject):TClassPropertyEditorReturn;
  6629. Begin
  6630.      Result:=peCancel;  //Not Handled
  6631. End;
  6632. {$HINTS ON}
  6633.  
  6634. Procedure AddPropertyEditor(OwnerClass:TClass;PropertyName:String;PropertyEditor:TPropertyEditorClass);
  6635. Var T:LongInt;
  6636.     dummy:PPropertyEditClassItem;
  6637. Begin
  6638.      UpcaseStr(PropertyName);
  6639.  
  6640.      For T:=0 To PropertyEditDialogs.Count-1 Do
  6641.      Begin
  6642.           dummy:=PropertyEditDialogs.Items[T];
  6643.  
  6644.           If dummy^.PropertyEditor<>Nil Then //normal Property Editor ??
  6645.             If OwnerClass=dummy^.ClassToEdit Then
  6646.               If dummy^.PropertyName=PropertyName Then
  6647.               Begin
  6648.                   //replace existing
  6649.                   dummy^.PropertyEditor:=PropertyEditor;
  6650.                   Exit;
  6651.               End;
  6652.      End;
  6653.  
  6654.      New(dummy);
  6655.      dummy^.ClassToEdit:=OwnerClass;
  6656.      dummy^.PropertyName:=PropertyName;
  6657.      dummy^.PropertyEditor:=PropertyEditor;
  6658.      PropertyEditDialogs.Add(dummy);
  6659. End;
  6660.  
  6661. Function CallPropertyEditor(Owner:TComponent;PropertyName:String;Var Value;ValueLen:LongInt;
  6662.                             Var List:TStringList):TPropertyEditorReturn;
  6663. Var T:LongInt;
  6664.     dummy:PPropertyEditClassItem;
  6665.     Editor:TPropertyEditor;
  6666.     S:String;
  6667. Label go;
  6668. Begin
  6669.      Result:=edNoEditor;
  6670.      UpcaseStr(PropertyName);
  6671.  
  6672.      For T:=0 To PropertyEditDialogs.Count-1 Do
  6673.      Begin
  6674.           dummy:=PropertyEditDialogs.Items[T];
  6675.  
  6676.           If dummy^.PropertyEditor<>Nil Then //normal Property Editor ??
  6677.             If Owner.ClassType=dummy^.ClassToEdit Then
  6678.               If dummy^.PropertyName=PropertyName Then
  6679.               Begin
  6680. go:
  6681.                    Editor:=dummy^.PropertyEditor.Create(Nil);
  6682.                    Editor.FOwner:=Owner;
  6683.                    Editor.FPropertyName:=PropertyName;
  6684.                    List.Create;
  6685.                    Editor.FList:=List;
  6686.                    Try
  6687.                      If Editor Is TStringPropertyEditor Then
  6688.                      Begin
  6689.                           System.Move(Value,S,ValueLen);
  6690.                           Result:=TStringPropertyEditor(Editor).Execute(S,ValueLen);
  6691.                           System.Move(S,Value,ValueLen);
  6692.                      End
  6693.                      Else If Editor Is TShortIntPropertyEditor Then
  6694.                        Result:=TShortIntPropertyEditor(Editor).Execute(ShortInt(Value))
  6695.                      Else If Editor Is TIntegerPropertyEditor Then
  6696.                        Result:=TIntegerPropertyEditor(Editor).Execute(Integer(Value))
  6697.                      Else If Editor Is TLongIntPropertyEditor Then
  6698.                        Result:=TLongIntPropertyEditor(Editor).Execute(LongInt(Value))
  6699.                      Else Result:=Editor.Execute(Value,ValueLen);
  6700.                      List:=Editor.FList;
  6701.                      Editor.Destroy;
  6702.                    Except
  6703.                      Result:=edNoEditor;
  6704.                    End;
  6705.  
  6706.                    Exit;
  6707.               End;
  6708.      End;
  6709.  
  6710.      For T:=0 To PropertyEditDialogs.Count-1 Do
  6711.      Begin
  6712.           dummy:=PropertyEditDialogs.Items[T];
  6713.  
  6714.           If dummy^.PropertyEditor<>Nil Then //normal Property Editor ??
  6715.             If Owner Is dummy^.ClassToEdit Then
  6716.               If dummy^.PropertyName=PropertyName Then
  6717.               Begin
  6718.                    Goto go;
  6719.               End;
  6720.      End;
  6721.  
  6722.      {Search In registered Property editors Of the complib}
  6723.      If @CallCompLibPropertyEditor<>Nil
  6724.      Then Result := CallCompLibPropertyEditor(Owner,PropertyName,Value,ValueLen,List);
  6725. End;
  6726.  
  6727. Function PropertyEditorAvailable(OwnerClass:TClass;PropertyName:String):Boolean;
  6728. Var T:LongInt;
  6729.     dummy:PPropertyEditClassItem;
  6730. Begin
  6731.      Result:=False;
  6732.      UpcaseStr(PropertyName);
  6733.  
  6734.      For T:=0 To PropertyEditDialogs.Count-1 Do
  6735.      Begin
  6736.           dummy:=PropertyEditDialogs.Items[T];
  6737.  
  6738.           If dummy^.PropertyEditor<>Nil Then //normal Property Editor ??
  6739.             If dummy^.PropertyName=PropertyName Then
  6740.               If OwnerClass Is dummy^.ClassToEdit Then
  6741.               Begin
  6742.                   Result:=True;
  6743.                   Exit;
  6744.               End;
  6745.      End;
  6746.  
  6747.      If @CallCompLibPropertyEditorAvailable<>Nil Then
  6748.         Result:=CallCompLibPropertyEditorAvailable(OwnerClass,PropertyName);
  6749. End;
  6750.  
  6751.  
  6752. Procedure AddClassPropertyEditor(ClassToEdit:TClass;PropertyEditor:TClassPropertyEditorClass);
  6753. Var T:LongInt;
  6754.     dummy:PPropertyEditClassItem;
  6755. Begin
  6756.      For T:=0 To PropertyEditDialogs.Count-1 Do
  6757.      Begin
  6758.           dummy:=PropertyEditDialogs.Items[T];
  6759.  
  6760.           If dummy^.ClassPropertyEditor<>Nil Then //Class Property Editor ??
  6761.             If dummy^.ClassToEdit=ClassToEdit Then
  6762.             Begin
  6763.                  //replace existing
  6764.                  dummy^.ClassPropertyEditor:=PropertyEditor;
  6765.                  Exit;
  6766.             End;
  6767.      End;
  6768.  
  6769.      New(dummy);
  6770.      dummy^.ClassToEdit:=ClassToEdit;
  6771.      dummy^.ClassPropertyEditor:=PropertyEditor;
  6772.      PropertyEditDialogs.Add(dummy);
  6773. End;
  6774.  
  6775. Function ClassPropertyEditorAvailable(ClassName:String):Boolean;
  6776. Var
  6777.     s1:String;
  6778.     AOwner:TClass;
  6779.  
  6780.     Function process(Const s1:String):Boolean;
  6781.     Var T:LongInt;
  6782.         dummy:PPropertyEditClassItem;
  6783.         S:String;
  6784.     Begin
  6785.          Result:=False;
  6786.  
  6787.          For T:=0 To PropertyEditDialogs.Count-1 Do
  6788.          Begin
  6789.               dummy:=PropertyEditDialogs.Items[T];
  6790.  
  6791.               If dummy^.ClassPropertyEditor<>Nil Then //Class Property Editor ???
  6792.               Begin
  6793.                    S:=dummy^.ClassToEdit.ClassName;
  6794.                    UpcaseStr(S);
  6795.                    If S=s1 Then
  6796.                    Begin
  6797.                         Result:=True;
  6798.                         Exit;
  6799.                    End;
  6800.               End;
  6801.          End;
  6802.     End;
  6803.  
  6804. Label L,ex;
  6805. Begin
  6806.      Result:=False;
  6807.      s1:=ClassName;
  6808.      UpcaseStr(s1);
  6809.      If process(s1) Then
  6810.      Begin
  6811.           Result:=True;
  6812.           Exit;
  6813.      End;
  6814.  
  6815.      //check If it Is Some derived Object
  6816.      AOwner:=SearchClassByName(ClassName);
  6817.      If AOwner=Nil Then goto ex;
  6818. L:
  6819.      AOwner:=AOwner.ClassParent;
  6820.  
  6821.      If AOwner<>Nil Then
  6822.      Begin
  6823.           s1:=AOwner.ClassName;
  6824.           UpcaseStr(s1);
  6825.           If process(s1) Then Result:=True
  6826.           Else Goto L;
  6827.      End;
  6828.  
  6829. ex:
  6830.      If @CallComplibClassPropertyEditorAvailable<>Nil Then
  6831.        Result:=Result Or CallCompLibClassPropertyEditorAvailable(ClassName);
  6832. End;
  6833.  
  6834. Function CallClassPropertyEditor(Var ClassToEdit:TObject):TClassPropertyEditorReturn;
  6835. Var
  6836.     s1:String;
  6837.     AOwner:TClass;
  6838.     res:TClassPropertyEditorReturn;
  6839.  
  6840.     Function process(Const s1:String):Boolean;
  6841.     Var T:LongInt;
  6842.         dummy:PPropertyEditClassItem;
  6843.         Editor:TClassPropertyEditor;
  6844.         S:String;
  6845.     Begin
  6846.          Result:=False;
  6847.  
  6848.          For T:=0 To PropertyEditDialogs.Count-1 Do
  6849.          Begin
  6850.               dummy:=PropertyEditDialogs.Items[T];
  6851.  
  6852.               If dummy^.ClassPropertyEditor<>Nil Then //Is it A Class Property Editor ??
  6853.               Begin
  6854.                    S:=dummy^.ClassToEdit.ClassName;
  6855.                    UpcaseStr(S);
  6856.                    If S=s1 Then
  6857.                    Begin
  6858.                        Editor:=dummy^.ClassPropertyEditor.Create(Nil);
  6859.                        res:=Editor.Execute(ClassToEdit);
  6860.                        Editor.Destroy;
  6861.                        Result:=True;
  6862.                        Exit;
  6863.                    End;
  6864.               End;
  6865.          End;
  6866.     End;
  6867. Begin
  6868.      Result:=peNoEditor;
  6869.      s1:=ClassToEdit.ClassName;
  6870.  
  6871.      UpcaseStr(s1);
  6872.      If process(s1) Then
  6873.      Begin
  6874.           Result:=res;
  6875.           Exit;
  6876.      End;
  6877.  
  6878.      {Search In registered Property editors Of the complib}
  6879.      If @CallCompLibClassPropertyEditor<>Nil
  6880.      Then Result := CallCompLibClassPropertyEditor(ClassToEdit);
  6881.      If Result<>peNoEditor Then exit;
  6882.  
  6883.      //check If it Is Some derived Object
  6884.      AOwner := ClassToEdit.ClassType;
  6885.  
  6886.      While AOwner.ClassParent <> Nil Do
  6887.      Begin
  6888.           AOwner:=AOwner.ClassParent;
  6889.  
  6890.           s1:=AOwner.ClassName;
  6891.           UpcaseStr(s1);
  6892.           If process(s1) Then
  6893.           Begin
  6894.                Result:=res;
  6895.                Exit;
  6896.           End;
  6897.      End;
  6898.  
  6899.      Result:=peNoEditor;
  6900. End;
  6901.  
  6902. ///////////////////////////////////////////////////////////////////////////
  6903.  
  6904. Function GetExperts:TList;
  6905. Begin
  6906.      Result:=LibExperts;
  6907. End;
  6908.  
  6909.  
  6910.  
  6911. {
  6912. ╔═══════════════════════════════════════════════════════════════════════════╗
  6913. ║                                                                           ║
  6914. ║ Speed-Pascal/2 Version 2.0                                                ║
  6915. ║                                                                           ║
  6916. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  6917. ║                                                                           ║
  6918. ║ This section: TThread Class Implementation                                ║
  6919. ║                                                                           ║
  6920. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  6921. ║                                                                           ║
  6922. ╚═══════════════════════════════════════════════════════════════════════════╝
  6923. }
  6924.  
  6925. Procedure TThread.SetSuspended(NewValue:Boolean);
  6926. Begin
  6927.      If NewValue Then Suspend
  6928.      Else Resume;
  6929. End;
  6930.  
  6931. Const
  6932.   {$IFDEF OS2}
  6933.   PArray:Array[TThreadPriority] Of LongWord=
  6934.          (PRTYC_IDLETIME,PRTYC_REGULAR,PRTYC_REGULAR,PRTYC_REGULAR,PRTYC_REGULAR,
  6935.           PRTYC_REGULAR,PRTYC_TIMECRITICAL);
  6936.   PDelta:Array[tpIdle..tpTimeCritical] Of LongWord=
  6937.          (0,-31,-16,0,16,31,0);
  6938.   {$ENDIF}
  6939.   {$IFDEF Win95}
  6940.   PArray:Array[TThreadPriority] Of LongWord=
  6941.          (THREAD_PRIORITY_IDLE, THREAD_PRIORITY_LOWEST, THREAD_PRIORITY_BELOW_NORMAL,
  6942.           THREAD_PRIORITY_NORMAL, THREAD_PRIORITY_ABOVE_NORMAL,THREAD_PRIORITY_HIGHEST,
  6943.           THREAD_PRIORITY_TIME_CRITICAL);
  6944.   {$ENDIF}
  6945.  
  6946. Procedure TThread.SetPriority(NewValue:TThreadPriority);
  6947. Begin
  6948.      FPriority:=NewValue;
  6949.      {$IFDEF OS2}
  6950.      If ThreadId<>0 Then DosSetPriority(2,PArray[NewValue],PDelta[NewValue],ThreadId);
  6951.      {$ENDIF}
  6952.      {$IFDEF Win95}
  6953.      SetThreadPriority(FHandle,PArray[NewValue]);
  6954.      {$ENDIF}
  6955. End;
  6956.  
  6957. Procedure TThread.SyncTerminate;
  6958. Begin
  6959.      FOnTerminate(Self);
  6960. End;
  6961.  
  6962. Procedure TThread.DoTerminate;
  6963. Begin
  6964.      If FOnTerminate<>Nil Then Synchronize(SyncTerminate);
  6965. End;
  6966.  
  6967. Function ThreadLayer(Param:TThread):LongInt;
  6968. {$IFDEF OS2}
  6969. Var  PAppHandle:LongWord;
  6970.      PAppQueueHandle:LongWord;
  6971. {$ENDIF}
  6972. Var FreeTerm:Boolean;
  6973. Begin
  6974.      {$IFDEF OS2}
  6975.      Param.FThreadId:=System.GetThreadId;
  6976.      If ApplicationType=1 Then
  6977.      Begin
  6978.           PAppHandle := WinInitializeAPI(0);
  6979.           PAppQueueHandle := WinCreateMsgQueueAPI(PAppHandle,0);
  6980.      End;
  6981.      {$ENDIF}
  6982.  
  6983.      Param.Priority:=Param.FPriority;
  6984.      Param.Execute;
  6985.      Result:=Param.ReturnValue;
  6986.      FreeTerm:=Param.FreeOnTerminate;
  6987.      Param.FFinished:=True;
  6988.      Param.DoTerminate;
  6989.      If FreeTerm Then Param.Destroy;
  6990.  
  6991.      {$IFDEF OS2}
  6992.      If ApplicationType=1 Then
  6993.      Begin
  6994.           WinDestroyMsgQueueAPI(PAppQueueHandle);
  6995.           WinTerminateAPI(PAppHandle);
  6996.      End;
  6997.      {$ENDIF}
  6998.  
  6999.      System.EndThread(Result);
  7000. End;
  7001.  
  7002.  
  7003. Const ThreadWindow:LongWord=0;
  7004.       WM_EXECUTEPROC=WM_USER+1;
  7005.  
  7006. Var ThreadDefWndProc:Function(Win,Msg,para1,para2:LongWord):LongWord;APIENTRY;
  7007.     MsgProc:Procedure;
  7008.     ProcessProc:Procedure;
  7009.  
  7010. Procedure TThread.MsgIdle;
  7011. Begin
  7012.      ProcessProc;
  7013. End;
  7014.  
  7015. Function ThreadWndProc(Win:LongWord;Msg,para1,para2:LongWord):LongWord;APIENTRY;
  7016. Var Thread:TThread;
  7017. Begin
  7018.      If Msg=WM_EXECUTEPROC Then
  7019.      Begin
  7020.           Thread:=TThread(para1);
  7021.           Thread.FMethod;
  7022.           Result:=0;
  7023.      End
  7024.      Else
  7025.      Begin
  7026.           If @ThreadDefWndProc<>Nil Then Result:=ThreadDefWndProc(Win,Msg,para1,para2)
  7027.           Else
  7028.           Begin
  7029.               {$IFDEF OS2}
  7030.               Result:=WinDefWindowProc(Win,Msg,para1,para2);
  7031.               {$ENDIF}
  7032.               {$IFDEF Win95}
  7033.               Result:=DefWindowProc(Win,Msg,para1,para2);
  7034.               {$ENDIF}
  7035.           End;
  7036.      End;
  7037. End;
  7038.  
  7039.  
  7040. Constructor TThread.ExtCreate(CreateSuspended:Boolean;StackSize:LongWord;Priority:TThreadPriority;
  7041.                               Param:Pointer);
  7042. Var Options:LongWord;
  7043. Begin
  7044.      If ((ApplicationType=1)And(ThreadWindow=0)) Then
  7045.      Begin
  7046.           ThreadDefWndProc:=Nil;
  7047.           {$IFDEF OS2}
  7048.           ThreadWindow:=WinCreateWCWindow(HWND_DESKTOP,
  7049.                                           WC_BUTTON,
  7050.                                           '',
  7051.                                           0,               //flStyle
  7052.                                           0,0,             //leave This ON 0 - Set by .Show
  7053.                                           0,0,             //Position And Size
  7054.                                           HWND_DESKTOP,    //parent
  7055.                                           HWND_TOP,        //Insert behind
  7056.                                           1,               //Window Id
  7057.                                           Nil,             //CtlData
  7058.                                           Nil);            //Presparams
  7059.           ThreadDefWndProc:=Pointer(WinSubClassWindow(ThreadWindow,@ThreadWndProc));
  7060.           {$ENDIF}
  7061.           {$IFDEF Win95}
  7062.           ThreadWindow:=CreateWindow('BUTTON',
  7063.                                      '',
  7064.                                      0,
  7065.                                      0,0,
  7066.                                      0,0,
  7067.                                      HWND_DESKTOP,
  7068.                                      1,
  7069.                                      DllModule,
  7070.                                      Nil);
  7071.           ThreadDefWndProc:=Pointer(SetWindowLong(ThreadWindow,GWL_WNDPROC,LongInt(@ThreadWndProc)));
  7072.           {$ENDIF}
  7073.      End;
  7074.  
  7075.      //Inherited Create;
  7076.      FSuspended:=CreateSuspended;
  7077.      Options:=0;
  7078.      If FSuspended Then Options:=Options Or THREAD_SUSPENDED;
  7079.      FPriority:=Priority;
  7080.      FParameter:=Param;
  7081.      FHandle:=BeginThread(Nil,StackSize,@ThreadLayer,Pointer(Self),Options,FThreadId);
  7082. End;
  7083.  
  7084. Constructor TThread.Create(CreateSuspended: Boolean);
  7085. Begin
  7086.      TThread.ExtCreate(CreateSuspended,65535,tpNormal,Nil);
  7087. End;
  7088.  
  7089. Destructor TThread.Destroy;
  7090. Begin
  7091.      If ((Not FFinished)And(Not FSuspended)) Then
  7092.      Begin
  7093.           Terminate;
  7094.           WaitFor;
  7095.      End
  7096.      Else If FSuspended Then
  7097.      Begin
  7098.           FFreeOnTerminate:=False;
  7099.           System.KillThread(FHandle);
  7100.      End;
  7101.      {$IFDEF Win95}
  7102.      If FHandle<>0 Then CloseHandle(FHandle);
  7103.      {$ENDIF}
  7104.      Inherited Destroy;
  7105. End;
  7106.  
  7107. Function TThread.WaitFor:LongInt;
  7108. Var FreeIt:Boolean;
  7109.  
  7110. Begin
  7111.      FreeIt:=FFreeOnTerminate;
  7112.      FFreeOnTerminate:=False;
  7113.      Repeat
  7114.            If ((ApplicationType=1)And(MsgProc<>Nil)) Then MsgProc
  7115.            Else Delay(50);
  7116.      Until FFinished;
  7117.      Result:=ReturnValue;
  7118.      If FreeIt Then Self.Destroy;
  7119. End;
  7120.  
  7121. Procedure TThread.Terminate;
  7122. Begin
  7123.      FTerminated:=True;
  7124. End;
  7125.  
  7126. Procedure TThread.Suspend;
  7127. Begin
  7128.      FSuspended:=True;
  7129.      {$IFDEF OS2}
  7130.      DosSuspendThread(FHandle);
  7131.      {$ENDIF}
  7132.      {$IFDEF Win95}
  7133.      SuspendThread(FHandle);
  7134.      {$ENDIF}
  7135. End;
  7136.  
  7137. Procedure TThread.Resume;
  7138. Begin
  7139.      {$IFDEF OS2}
  7140.      If DosResumeThread(FHandle)=0 Then FSuspended:=False;
  7141.      {$ENDIF}
  7142.      {$IFDEF Win95}
  7143.      If ResumeThread(FHandle) = 1 Then FSuspended:=False;
  7144.      {$ENDIF}
  7145. End;
  7146.  
  7147. //nach Möglichkeit nicht benutzen (statt dessen Terminate !), "abwürgen" des Threads
  7148. //falls keine Möglichkeit zur Abfrage von "Terminated" besteht
  7149. Procedure TThread.Kill;
  7150. Var FreeTerm:Boolean;
  7151. Begin
  7152.      Suspend;
  7153.      System.KillThread(FHandle);
  7154.      FreeTerm:=FreeOnTerminate;
  7155.      FFinished:=True;
  7156.      DoTerminate;
  7157.      If FreeTerm Then Self.Destroy;
  7158. End;
  7159.  
  7160. Procedure TThread.ProcessMsgs;
  7161. Begin
  7162.      If ProcessProc<>Nil Then Synchronize(MsgIdle);
  7163. End;
  7164.  
  7165. Procedure TThread.Synchronize(method:TThreadMethod);
  7166. Begin
  7167.      //If @method<>@MsgIdle Then ProcessMsgs;
  7168.      //MsgIdle;
  7169.      If ThreadWindow<>0 Then
  7170.      Begin
  7171.           FMethod:=method;
  7172.           {$IFDEF OS2}
  7173.           WinSendMsg(ThreadWindow,WM_EXECUTEPROC,LongWord(Self),0);
  7174.           {$ENDIF}
  7175.           {$IFDEF Win95}
  7176.           SendMessage(ThreadWindow,WM_EXECUTEPROC,LongWord(Self),0);
  7177.           {$ENDIF}
  7178.      End
  7179.      Else method;
  7180. End;
  7181.  
  7182. {
  7183. ╔═══════════════════════════════════════════════════════════════════════════╗
  7184. ║                                                                           ║
  7185. ║ Speed-Pascal/2 Version 2.0                                                ║
  7186. ║                                                                           ║
  7187. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  7188. ║                                                                           ║
  7189. ║ This section: TCollectionItem Class Implementation                        ║
  7190. ║                                                                           ║
  7191. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  7192. ║                                                                           ║
  7193. ╚═══════════════════════════════════════════════════════════════════════════╝
  7194. }
  7195.  
  7196. Function TCollectionItem.GetIndex:LongInt;
  7197. Begin
  7198.      If FCollection=Nil Then Result:=-1
  7199.      Else Result:=FCollection.FItems.IndexOf(Self);
  7200. End;
  7201.  
  7202. Procedure TCollectionItem.SetCollection(NewValue:TCollection);
  7203. Begin
  7204.      If NewValue=FCollection Then Exit;
  7205.  
  7206.      If FCollection<>Nil Then FCollection.RemoveItem(Self);
  7207.      If NewValue<>Nil Then NewValue.InsertItem(Self);
  7208. End;
  7209.  
  7210. Procedure TCollectionItem.changed(AllItems:Boolean);
  7211. Begin
  7212.      If FCollection<>Nil Then If FCollection.FUpdateCount=0 Then
  7213.      Begin
  7214.           If AllItems Then FCollection.Update(Nil)
  7215.           Else FCollection.Update(Self);
  7216.      End;
  7217. End;
  7218.  
  7219. Procedure TCollectionItem.SetIndex(NewIndex:LongInt);
  7220. Begin
  7221.      If NewIndex=Index Then Exit
  7222.      Else If Index>=0 Then
  7223.      Begin
  7224.           FCollection.FItems.Move(Index,NewIndex);
  7225.           changed(True);
  7226.      End;
  7227. End;
  7228.  
  7229. Constructor TCollectionItem.Create(ACollection: TCollection);
  7230. Begin
  7231.      Inherited Create;
  7232.      collection:=ACollection;
  7233. End;
  7234.  
  7235. Destructor TCollectionItem.Destroy;
  7236. Begin
  7237.      collection:=Nil;
  7238.      Inherited Destroy;
  7239. End;
  7240.  
  7241. {
  7242. ╔═══════════════════════════════════════════════════════════════════════════╗
  7243. ║                                                                           ║
  7244. ║ Speed-Pascal/2 Version 2.0                                                ║
  7245. ║                                                                           ║
  7246. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  7247. ║                                                                           ║
  7248. ║ This section: TCollection Class Implementation                            ║
  7249. ║                                                                           ║
  7250. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  7251. ║                                                                           ║
  7252. ╚═══════════════════════════════════════════════════════════════════════════╝
  7253. }
  7254.  
  7255.  
  7256. Function TCollection.GetCount:LongInt;
  7257. Begin
  7258.      Result:=FItems.Count;
  7259. End;
  7260.  
  7261. Procedure TCollection.InsertItem(Item:TCollectionItem);
  7262. Begin
  7263.      If Not (Item Is FItemClass) Then Raise EListError.Create(LoadNLSStr(SCollectionErrorText))
  7264.      Else
  7265.      Begin
  7266.           FItems.Add(Item);
  7267.           Item.FCollection:=Self;
  7268.           changed;
  7269.      End;
  7270. End;
  7271.  
  7272. Procedure TCollection.RemoveItem(Item:TCollectionItem);
  7273. Begin
  7274.      FItems.Remove(Item);
  7275.      Item.FCollection:=Nil;
  7276.      changed;
  7277. End;
  7278.  
  7279. Procedure TCollection.changed;
  7280. Begin
  7281.      If FUpdateCount=0 Then Update(Nil);
  7282. End;
  7283.  
  7284. Function TCollection.GetItem(Index:LongInt):TCollectionItem;
  7285. Begin
  7286.      Result:=TCollectionItem(FItems[Index]);
  7287. End;
  7288.  
  7289. Procedure TCollection.SetItem(Index:LongInt;Value:TCollectionItem);
  7290. Var dummy:TCollectionItem;
  7291. Begin
  7292.      dummy:=TCollectionItem(FItems[Index]);
  7293.      dummy.Assign(Value);
  7294. End;
  7295.  
  7296. {$HINTS OFF}
  7297. Procedure TCollection.Update(Item:TCollectionItem);
  7298. Begin
  7299. End;
  7300. {$HINTS ON}
  7301.  
  7302. Procedure TCollection.SetupComponent;
  7303. Begin
  7304.      Inherited SetupComponent;
  7305.  
  7306.      Name:='Collection';
  7307.      FItemClass:=TCollectionItem;
  7308.      FItems.Create;
  7309.      Include(ComponentState,csDetail);
  7310. End;
  7311.  
  7312. Destructor TCollection.Destroy;
  7313. Begin
  7314.      FUpdateCount:=1;
  7315.      Clear;
  7316.      FItems.Destroy;
  7317.  
  7318.      Inherited Destroy;
  7319. End;
  7320.  
  7321. Function TCollection.Add:TCollectionItem;
  7322. Begin
  7323.      Result:=FItemClass.Create(Self);
  7324. End;
  7325.  
  7326. Procedure TCollection.Assign(Source:TCollection);
  7327. Var dummy:TCollectionItem;
  7328.     T:LongInt;
  7329. Begin
  7330.      If ((Source=Nil)Or(Source=Self)) Then Exit;
  7331.  
  7332.      BeginUpdate;
  7333.      Try
  7334.         Clear;
  7335.         For T:=0 To Source.Count-1 Do
  7336.         Begin
  7337.              dummy:=Self.Add;
  7338.              dummy.Assign(Source.Items[T]);
  7339.         End;
  7340.      Finally
  7341.             EndUpdate;
  7342.      End;
  7343. End;
  7344.  
  7345. Procedure TCollection.BeginUpdate;
  7346. Begin
  7347.      Inc(FUpdateCount);
  7348. End;
  7349.  
  7350. Procedure TCollection.EndUpdate;
  7351. Begin
  7352.      Dec(FUpdateCount);
  7353.      changed;
  7354. End;
  7355.  
  7356. Procedure TCollection.Clear;
  7357. Var T:LongInt;
  7358.     dummy:TCollectionItem;
  7359. Begin
  7360.      If FItems.Count=0 Then Exit;
  7361.  
  7362.      BeginUpdate;
  7363.      Try
  7364.         For T:=FItems.Count-1 DownTo 0 Do
  7365.         Begin
  7366.              dummy:=FItems[T];
  7367.              dummy.Destroy;
  7368.         End;
  7369.         FItems.Clear;
  7370.      Finally
  7371.         EndUpdate;
  7372.      End;
  7373. End;
  7374.  
  7375. Begin
  7376.      LanguageMessages:=Nil;
  7377.      AppLanguage:='Default';
  7378.      MsgProc:=Nil;
  7379.      ProcessProc:=Nil;
  7380.      InsideCompLib:=False;
  7381.      InsideWriteSCU:=False;
  7382.      InsideWriteSCUAdr:=@InsideWriteSCU;
  7383.      InsideDesigner:=False;
  7384.      InsideLanguageDesigner:=False;
  7385.  
  7386.      RegisteredClasses.Create;
  7387.      PropertyEditDialogs.Create;
  7388.      LibExperts.Create;
  7389.      LibExpertInstances.Create;
  7390. End.
  7391.  
  7392.