home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sp15demo.zip / libsrc.zip / LIBSRC / LISTS.PAS < prev    next >
Pascal/Delphi Source File  |  1996-02-24  |  34KB  |  1,287 lines
  1. UNIT Lists;
  2.  
  3. {
  4. ╔═══════════════════════════════════════════════════════════════════════════╗
  5. ║                                                                           ║
  6. ║ Speed-Pascal/2 Version 2.0                                                ║
  7. ║                                                                           ║
  8. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  9. ║                                                                           ║
  10. ║ This file: Lists class definitions                                        ║
  11. ║                                                                           ║
  12. ║ Last modified: 16.10.1995                                                 ║
  13. ║                                                                           ║
  14. ║ (C) 1995 SpeedSoft. All rights reserved. Disclosure probibited !          ║
  15. ║                                                                           ║
  16. ║ Partially ported by Joerg Pleumann (C) 1996                               ║
  17. ║                                                                           ║
  18. ╚═══════════════════════════════════════════════════════════════════════════╝
  19. }
  20.  
  21. INTERFACE
  22.  
  23. USES Streams,SysUtils;
  24.  
  25. CONST
  26.     EListErrorText = 'List error exception (EListError) occured';
  27.  
  28.     MaxListSize = MaxLongInt DIV SizeOf(Pointer);
  29.  
  30.     { A notify event is a method variable, i.e. a PROCEDURE
  31.     variable for objects. Some classes allow the specification
  32.     of objects to be notified of changes. }
  33.  
  34. type
  35.   TNotifyEvent = PROCEDURE(Sender: TObject) of object;
  36.  
  37.  
  38. TYPE
  39.     EListError = CLASS(Exception);
  40.  
  41.     {TList CLASS}
  42.     PPointerList = ^TPointerList;
  43.     TPointerList = ARRAY[0..MaxListSize-1] OF POINTER;
  44.  
  45.     TList = CLASS
  46.        PROTECTED
  47.              FList:PPointerList;
  48.              FCount:LONGINT;
  49.              FCapacity:LONGINT;
  50.              FGrowth:LONGINT;
  51.        PROTECTED
  52.              PROCEDURE Error; VIRTUAL;
  53.              FUNCTION  Get(Index:LONGINT):POINTER;
  54.              PROCEDURE Put(Index:LONGINT;Item:POINTER);
  55.              PROCEDURE Grow; VIRTUAL;
  56.              PROCEDURE SetCapacity(NewCapacity:LONGINT);
  57.              PROCEDURE SetCount(NewCount:LONGINT);
  58.        PUBLIC
  59.              DESTRUCTOR Destroy; OVERRIDE;
  60.              PROCEDURE Clear; VIRTUAL;
  61.              FUNCTION  Add(Item:POINTER):LONGINT;
  62.              PROCEDURE Delete(Index:LONGINT);
  63.              FUNCTION  Remove(Item:POINTER):LONGINT;
  64.              PROCEDURE Cut(Index1,Index2:LONGINT);
  65.              PROCEDURE Insert(Index:LONGINT;Item:POINTER);
  66.              PROCEDURE Exchange(Index1,Index2:LONGINT);
  67.              PROCEDURE Move(CurIndex,NewIndex:LONGINT);
  68.              FUNCTION  IndexOf(Item:POINTER):LONGINT;
  69.              FUNCTION  First:POINTER;
  70.              FUNCTION  Last:POINTER;
  71.              FUNCTION  Expand:TList;
  72.              PROCEDURE Pack;
  73.        PUBLIC
  74.              PROPERTY  Capacity:LONGINT read FCapacity write SetCapacity;
  75.              PROPERTY  Count:LONGINT read FCount write SetCount;
  76.              PROPERTY  Growth:LONGINT read FGrowth write FGrowth;
  77.              PROPERTY  Items[Index:LONGINT]:POINTER read Get write Put; {default;}
  78.              PROPERTY  List:PPointerList read FList;
  79.     END;
  80.     TListClass=CLASS OF TList;
  81.  
  82.  
  83.     {TChainList CLASS}
  84.     PChainListItem = ^TChainListItem;
  85.     TChainListItem = RECORD
  86.                       prev:PChainListItem;
  87.                       Item:Pointer;
  88.                       next:PChainListItem;
  89.                 END;
  90.  
  91.     TChainList name 'TChainList' = CLASS(TObject)
  92.        PROTECTED
  93.              FList   :PChainListItem;
  94.              FListEnd:PChainListItem;
  95.              FCount  :LongInt;
  96.        PROTECTED
  97.              PROCEDURE Error; VIRTUAL;
  98.              FUNCTION  Index2PLE(Index:LongInt):PChainListItem;
  99.              FUNCTION  Item2PLE(Item:Pointer):PChainListItem;
  100.              FUNCTION  PLE2Index(ple:PChainListItem):LongInt;
  101.              FUNCTION  Item2Index(Item:Pointer):LongInt;
  102.              PROCEDURE Connect(ple1,ple2:PChainListItem);
  103.              FUNCTION  Get(Index:LongInt):Pointer;
  104.              PROCEDURE Put(Index:LongInt;Item:Pointer);
  105.        PUBLIC
  106.              DESTRUCTOR Destroy; OVERRIDE;
  107.              PROCEDURE Clear;
  108.              FUNCTION  Add(Item:Pointer):LongInt;
  109.              FUNCTION  Remove(Item:Pointer):LongInt;
  110.              PROCEDURE Delete(Index:LongInt);
  111.              FUNCTION  First:Pointer;
  112.              FUNCTION  Last:Pointer;
  113.              FUNCTION  IndexOf(Item:Pointer):LongInt;
  114.              PROCEDURE Insert(Index:LongInt;Item:Pointer);
  115.              PROCEDURE Move(CurIndex,NewIndex:LongInt);
  116.              PROCEDURE Exchange(Index1,Index2:LongInt);
  117.              PROCEDURE Pack;
  118.        PUBLIC
  119.              PROPERTY  Count:LongInt read FCount;
  120.              PROPERTY  Items[Index:LongInt]:Pointer read Get write Put; {default;}
  121.     END;
  122.     TChainListClass=CLASS OF TChainList;
  123.  
  124.     { TSTRINGs is an abstract base class for storing a
  125.   number of STRINGs. Every STRING can be associated
  126.   with a value as well as with an object. So, IF you
  127.   want to store simple STRINGs, or collections of
  128.   keys and values, or collection of named objects,
  129.   TSTRINGs is the abstract ancestor you should
  130.   derive your class from. }
  131.  
  132. TYPE
  133.   ESTRINGListError = class(Exception);
  134.  
  135.   TSTRINGs = class(TObject)
  136.   PRIVATE
  137.     FUpdateSemaphore: LongInt;
  138.   PROTECTED
  139.     FUNCTION GetValue(CONST Name: STRING): STRING; VIRTUAL;
  140.     PROCEDURE SetValue(CONST Name, Value: STRING); VIRTUAL;
  141.     FUNCTION FindValue(CONST Name: STRING; VAR Value: STRING): LongInt; VIRTUAL;
  142.     FUNCTION Get(Index: LongInt): STRING; VIRTUAL; abstract;
  143.     FUNCTION GetCount: LongInt; VIRTUAL; abstract;
  144.     FUNCTION GetObject(Index: LongInt): TObject; VIRTUAL; abstract;
  145.     PROCEDURE Put(Index: LongInt; CONST S: STRING); VIRTUAL; abstract;
  146.     PROCEDURE PutObject(Index: LongInt; AObject: TObject); VIRTUAL; abstract;
  147.     PROCEDURE SetUpdateState(Updating: Boolean); VIRTUAL;
  148.   PUBLIC
  149.     FUNCTION Add(CONST S: STRING): LongInt; VIRTUAL;
  150.     FUNCTION AddObject(CONST S: STRING; AObject: TObject): LongInt; VIRTUAL;
  151.     PROCEDURE AddSTRINGs(ASTRINGs: TSTRINGs); VIRTUAL;
  152.     PROCEDURE BEGINUpdate;
  153.     PROCEDURE Clear; VIRTUAL; abstract;
  154.     PROCEDURE Delete(Index: LongInt); VIRTUAL; abstract;
  155.     PROCEDURE EndUpdate;
  156.     FUNCTION Equals(ASTRINGs: TSTRINGs): Boolean;
  157.     PROCEDURE Exchange(Index1, Index2: LongInt); VIRTUAL;
  158.     FUNCTION GetText: PChar; VIRTUAL;
  159.     FUNCTION IndexOf(CONST S: STRING): LongInt; VIRTUAL;
  160.     FUNCTION IndexOfObject(AObject: TObject): Integer;
  161.     PROCEDURE Insert(Index: LongInt; CONST S: STRING); VIRTUAL; abstract;
  162.     PROCEDURE InsertObject(Index: LongInt; CONST S: STRING; AObject: TObject);
  163.     PROCEDURE LoadFromFile(CONST FileName: STRING);
  164.     PROCEDURE LoadFromStream(Stream: TStream); VIRTUAL;
  165.     PROCEDURE Move(CurIndex, NewIndex: LongInt); VIRTUAL;
  166.     PROCEDURE SaveToFile(CONST FileName: STRING);
  167.     PROCEDURE SaveToStream(Stream: TStream); VIRTUAL;
  168.     PROCEDURE SetText(Text: PChar); VIRTUAL;
  169.     PROPERTY Count: LongInt read GetCount;
  170.     PROPERTY Objects[Index: LongInt]: TObject read GetObject write PutObject;
  171.     PROPERTY Values[CONST Name: STRING]: STRING read GetValue write SetValue;
  172.     PROPERTY STRINGs[Index: LongInt]: STRING read Get write Put; default;
  173.   END;
  174.  
  175. { TStringList is a concrete class derived
  176.   from TSTRINGs. TStringList stores its items
  177.   in a PRIVATE field of type TList. It's very
  178.   fast, since it performs binary search for
  179.   retrieving objects by name. You can specify
  180.   whether you want TStringList to be sorted or
  181.   unsorted as well as case-sensitive or not.
  182.   You can also specify the way a TStringList
  183.   object handles duplicate entries.
  184.  
  185.   TStringList is able to notify the user when
  186.   the list's data changes or has been changed.
  187.   Use the properties OnChange and OnChanged. }
  188.  
  189. TYPE
  190.  
  191.   TDuplicates = (dupIgnore, dupAccept, dupError, dupReplace);
  192.     { dupReplace ist neu! }
  193.  
  194. TYPE
  195.  
  196.   TStringList = class(TSTRINGs)
  197.   PRIVATE
  198.     FList: TList;
  199.     FSorted: Boolean;
  200.     FDuplicates: TDuplicates;
  201.     FCaseSensitive: Boolean;
  202.     FOnChange: TNotifyEvent;
  203.     FOnChanging: TNotifyEvent;
  204.     PROCEDURE BottomUpHeapSort;
  205.     PROCEDURE SetSorted(Value: Boolean);
  206.     PROCEDURE SetCaseSensitive(Value: Boolean);
  207.   PROTECTED
  208.     PROCEDURE Changed; VIRTUAL;
  209.     PROCEDURE Changing; VIRTUAL;
  210.     FUNCTION Get(Index: LongInt): STRING; OVERRIDE;
  211.     FUNCTION GetCount: LongInt; OVERRIDE;
  212.     FUNCTION GetObject(Index: LongInt): TObject; OVERRIDE;
  213.     PROCEDURE Put(Index: LongInt; CONST S: STRING); OVERRIDE;
  214.     PROCEDURE PutObject(Index: LongInt; AObject: TObject); OVERRIDE;
  215.     PROCEDURE SetUpdateState(Updating: Boolean); OVERRIDE;
  216.   PUBLIC
  217.     CONSTRUCTOR Create;
  218.     DESTRUCTOR Destroy; OVERRIDE;
  219.     FUNCTION Add(CONST S: STRING): LongInt; OVERRIDE;
  220.     PROCEDURE Clear; OVERRIDE;
  221.     PROCEDURE Delete(Index: LongInt); OVERRIDE;
  222.     PROCEDURE Exchange(Index1, Index2: LongInt); OVERRIDE;
  223.     FUNCTION Find(CONST S: STRING; VAR Index: LongInt): Boolean; VIRTUAL;
  224.     FUNCTION IndexOf(CONST S: STRING): LongInt; OVERRIDE;
  225.     PROCEDURE Insert(Index: LongInt; CONST S: STRING); OVERRIDE;
  226.     PROCEDURE Sort; VIRTUAL;
  227.     PROPERTY Duplicates: TDuplicates read FDuplicates write FDuplicates;
  228.     PROPERTY CaseSensitive: Boolean read FCaseSensitive write SetCaseSensitive;
  229.     PROPERTY Sorted: Boolean read FSorted write SetSorted;
  230.     PROPERTY OnChange: TNotifyEvent read FOnChange write FOnChange;
  231.     PROPERTY OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
  232.   END;
  233.  
  234. { StrItem is a space-efficient way to store an object
  235.   associated with a STRING. It is used inside TStringList. }
  236.  
  237. type
  238.   PStrItem = ^TStrItem;
  239.   TStrItem = record
  240.     FObject: TObject;
  241.     FSTRING: STRING;
  242.   END;
  243.  
  244. FUNCTION NewStrItem(CONST ASTRING: STRING; AObject: TObject): PStrItem;
  245. PROCEDURE DisposeStrItem(P: PStrItem);
  246.  
  247.  
  248. IMPLEMENTATION
  249.  
  250. {
  251. ╔═══════════════════════════════════════════════════════════════════════════╗
  252. ║                                                                           ║
  253. ║ Speed-Pascal/2 Version 2.0                                                ║
  254. ║                                                                           ║
  255. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  256. ║                                                                           ║
  257. ║ This section: TList class implementation                                  ║
  258. ║                                                                           ║
  259. ║ Last modified: 10.01.1996                                                 ║
  260. ║                                                                           ║
  261. ║ (C) 1995 SpeedSoft. All rights reserved. Disclosure probibited !          ║
  262. ║                                                                           ║
  263. ╚═══════════════════════════════════════════════════════════════════════════╝
  264. }
  265.  
  266. PROCEDURE TList.Error;
  267. BEGIN
  268.      RAISE EListError.Create(EListErrorText);
  269. END;
  270.  
  271.  
  272. FUNCTION TList.Get(Index:LONGINT):POINTER;
  273. BEGIN
  274.      Result := NIL;
  275.      IF (Index < 0) OR (Index >= FCount) THEN Error
  276.      ELSE Result := FList^[Index];
  277. END;
  278.  
  279.  
  280. PROCEDURE TList.Put(Index:LONGINT;Item:POINTER);
  281. BEGIN
  282.      IF (Index < 0) OR (Index >= FCount) THEN Error
  283.      ELSE FList^[Index] := Item;
  284. END;
  285.  
  286.  
  287. PROCEDURE TList.Grow;
  288. VAR  gr:LONGINT;
  289. BEGIN
  290.      IF FGrowth <= 0 THEN
  291.      BEGIN
  292.           IF FCapacity < 128 THEN gr := 16
  293.           ELSE gr := FCapacity SHR 3;
  294.      END
  295.      ELSE gr := FGrowth;
  296.      SetCapacity(FCapacity + gr);
  297. END;
  298.  
  299.  
  300. PROCEDURE TList.SetCapacity(NewCapacity:LONGINT);
  301. VAR  newList:PPointerList;
  302. BEGIN
  303.      IF (NewCapacity > MaxListSize) OR (NewCapacity < FCount) THEN Error
  304.      ELSE
  305.      IF NewCapacity <> FCapacity THEN
  306.      BEGIN
  307.           IF NewCapacity > 0 THEN
  308.           BEGIN
  309.                GetMem(newList, NewCapacity*SizeOf(Pointer));
  310.                IF FCount > 0 THEN System.Move(FList^,newList^,
  311.                                               FCount*SizeOf(Pointer));
  312.           END
  313.           ELSE newList := NIL;
  314.           IF FList<>NIL THEN FreeMem(FList, FCapacity*SizeOf(Pointer));
  315.           FCapacity := NewCapacity;
  316.           FList := newList;
  317.      END;
  318. END;
  319.  
  320.  
  321. PROCEDURE TList.SetCount(NewCount:LONGINT);
  322. BEGIN
  323.      IF (NewCount > MaxListSize) OR (NewCount < 0) THEN Error
  324.      ELSE
  325.      BEGIN
  326.           IF NewCount > FCapacity THEN SetCapacity(NewCount);
  327.           IF NewCount > FCount
  328.           THEN FillChar(FList^[FCount], (NewCount-FCount)*SizeOf(Pointer),0);
  329.           FCount := NewCount;
  330.      END;
  331. END;
  332.  
  333.  
  334. {--- PUBLIC part ------------------------------------------------------------}
  335.  
  336. (* Clear the whole list and destroy the list object *)
  337. DESTRUCTOR TList.Destroy;
  338. BEGIN
  339.      Clear;
  340. END;
  341.  
  342.  
  343. (* Clear the whole list and release the allocated memory *)
  344. PROCEDURE TList.Clear;
  345. BEGIN
  346.      SetCount(0);
  347.      SetCapacity(0);
  348. END;
  349.  
  350.  
  351. (*  Append a new item at the end of the list and return the new index *)
  352. FUNCTION TList.Add(Item:POINTER):LONGINT;
  353. BEGIN
  354.      IF FCount = FCapacity THEN Grow;
  355.      FList^[FCount] := Item;
  356.      inc(FCount);
  357.      Result := FCount-1;
  358. END;
  359.  
  360.  
  361. (* Delete the item and decrement the count of elements in the list *)
  362. PROCEDURE TList.Delete(Index:LONGINT);
  363. BEGIN
  364.      IF (Index < 0) OR (Index >= FCount) THEN Error
  365.      ELSE
  366.      BEGIN
  367.           dec(FCount);
  368.           IF Index <> FCount THEN System.Move(FList^[Index + 1],FList^[Index],
  369.                                               (FCount-Index)*SizeOf(Pointer));
  370.      END;
  371. END;
  372.  
  373.  
  374. (* Remove the item and decrement the count of elements in the list *)
  375. FUNCTION TList.Remove(Item:POINTER):LONGINT;
  376. BEGIN
  377.      Result := IndexOf(Item);
  378.      IF Result <> -1 THEN Delete(Result);
  379. END;
  380.  
  381.  
  382. (* Cut the specified range out of the list (including both indices) *)
  383. PROCEDURE TList.Cut(Index1,Index2:LONGINT);
  384. VAR  swap:LONGINT;
  385. BEGIN
  386.      IF (Index1 < 0) OR (Index1 >= FCount) OR
  387.         (Index2 < 0) OR (Index2 >= FCount) THEN Error
  388.      ELSE
  389.      BEGIN
  390.           IF Index2 < Index1 THEN
  391.           BEGIN
  392.                swap := Index1;
  393.                Index1 := Index2;
  394.                Index2 := swap;
  395.           END;
  396.           IF Index2 <> FCount-1 THEN System.Move(FList^[Index2+1],FList^[Index1],
  397.                                                  (FCount-Index2)*SizeOf(Pointer));
  398.           dec(FCount,Index2-Index1+1);
  399.      END;
  400. END;
  401.  
  402.  
  403. (* Insert a new item at the specified position in the list *)
  404. PROCEDURE TList.Insert(Index:LONGINT;Item:POINTER);
  405. BEGIN
  406.      IF (Index < 0) OR (Index > FCount) THEN Error
  407.      ELSE
  408.      BEGIN
  409.           IF FCount = FCapacity THEN Grow;
  410.           IF Index <> FCount THEN System.Move(FList^[Index],FList^[Index+1],
  411.                                               (FCount-Index)*SizeOf(Pointer));
  412.           FList^[Index] := Item;
  413.           inc(FCount);
  414.      END;
  415. END;
  416.  
  417.  
  418. (* Exchange two items in the list *)
  419. PROCEDURE TList.Exchange(Index1,Index2:LONGINT);
  420. VAR  Item:POINTER;
  421. BEGIN
  422.      Item := Get(Index1);
  423.      Put(Index1, Get(Index2));
  424.      Put(Index2, Item);
  425. END;
  426.  
  427.  
  428. (* Move an item to a new position in the list *)
  429. PROCEDURE TList.Move(CurIndex,NewIndex:LONGINT);
  430. VAR  Item:POINTER;
  431. BEGIN
  432.      IF (CurIndex < 0) OR (CurIndex >= FCount) OR
  433.         (NewIndex < 0) OR (NewIndex >= FCount) THEN Error
  434.      ELSE
  435.      IF CurIndex <> NewIndex THEN
  436.      BEGIN
  437.           Item := FList^[CurIndex];
  438.           IF CurIndex < NewIndex
  439.           THEN System.Move(FList^[CurIndex+1], FList^[CurIndex],
  440.                            (NewIndex-CurIndex)*SizeOf(Pointer))
  441.           ELSE System.Move(FList^[NewIndex], FList^[NewIndex+1],
  442.                            (CurIndex-NewIndex)*SizeOf(Pointer));
  443.           FList^[NewIndex] := Item;
  444.      END;
  445. END;
  446.  
  447.  
  448. (* Return the index of an item *)
  449. FUNCTION TList.IndexOf(Item:POINTER):LONGINT;
  450. BEGIN
  451.      FOR Result := 0 TO FCount-1 DO
  452.         IF FList^[Result] = Item THEN exit;
  453.      Result := -1;
  454. END;
  455.  
  456.  
  457. (* Return the first item in the list *)
  458. FUNCTION TList.First:POINTER;
  459. BEGIN
  460.      Result := Get(0);
  461. END;
  462.  
  463.  
  464. (* Return the last item in the list *)
  465. FUNCTION TList.Last:POINTER;
  466. BEGIN
  467.      Result := Get(FCount-1);
  468. END;
  469.  
  470.  
  471. (* Expand the list IF capacity is reached *)
  472. FUNCTION TList.Expand:TList;
  473. BEGIN
  474.      IF FCount = FCapacity THEN Grow;
  475.      Result := SELF;
  476. END;
  477.  
  478.  
  479. (* Remove all NIL elements in the list *)
  480. PROCEDURE TList.Pack;
  481. VAR  i:LONGINT;
  482. BEGIN
  483.      FOR i := FCount-1 DOWNTO 0 DO
  484.         IF FList^[i] = NIL THEN Delete(i);
  485. END;
  486.  
  487.  
  488. {
  489. ╔═══════════════════════════════════════════════════════════════════════════╗
  490. ║                                                                           ║
  491. ║ Speed-Pascal/2 Version 2.0                                                ║
  492. ║                                                                           ║
  493. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  494. ║                                                                           ║
  495. ║ This section: TChainList class implementation                             ║
  496. ║                                                                           ║
  497. ║ Last modified: 16.10.1995                                                 ║
  498. ║                                                                           ║
  499. ║ (C) 1995 SpeedSoft. All rights reserved. Disclosure probibited !          ║
  500. ║                                                                           ║
  501. ╚═══════════════════════════════════════════════════════════════════════════╝
  502. }
  503.  
  504. PROCEDURE TChainList.Error;
  505. BEGIN
  506.      RAISE EListError.Create(EListErrorText);
  507. END;
  508.  
  509.  
  510. FUNCTION TChainList.Index2PLE(Index:LongInt):PChainListItem;
  511. VAR  i:LongInt;
  512. BEGIN
  513.      IF (Index < 0) OR (Index >= FCount) THEN Result := NIL
  514.      ELSE
  515.      BEGIN
  516.           Result := FList;
  517.           FOR i := 0 TO Index-1 DO Result := Result^.next;
  518.           IF Result = NIL THEN exit;
  519.      END;
  520. END;
  521.  
  522.  
  523. FUNCTION TChainList.Item2PLE(Item:Pointer):PChainListItem;
  524. BEGIN
  525.      Result := FList;
  526.      WHILE Result <> NIL DO
  527.      BEGIN
  528.           IF Result^.Item = Item THEN exit;
  529.           Result := Result^.next;
  530.      END;
  531. END;
  532.  
  533.  
  534. FUNCTION TChainList.PLE2Index(ple:PChainListItem):LongInt;
  535. VAR  ple1:PChainListItem;
  536. BEGIN
  537.      Result := -1;
  538.      ple1 := FList;
  539.      WHILE ple1 <> NIL DO
  540.      BEGIN
  541.           inc(Result);
  542.           IF ple1 = ple THEN exit;
  543.           ple1 := ple1^.next;
  544.      END;
  545.      Result := -1;
  546. END;
  547.  
  548.  
  549. FUNCTION TChainList.Item2Index(Item:Pointer):LongInt;
  550. VAR  ple:PChainListItem;
  551. BEGIN
  552.      Result := -1;
  553.      ple := FList;
  554.      WHILE ple <> NIL DO
  555.      BEGIN
  556.           inc(Result);
  557.           IF ple^.Item = Item THEN exit;
  558.           ple := ple^.next;
  559.      END;
  560.      Result := -1;
  561. END;
  562.  
  563.  
  564. PROCEDURE TChainList.Connect(ple1,ple2:PChainListItem);
  565. BEGIN
  566.      IF ple1 <> NIL THEN ple1^.next := ple2
  567.      ELSE FList := ple2;
  568.      IF ple2 <> NIL THEN ple2^.prev := ple1
  569.      ELSE FListEnd := ple1;
  570. END;
  571.  
  572.  
  573. FUNCTION TChainList.Get(Index:LongInt):Pointer;
  574. VAR  ple:PChainListItem;
  575. BEGIN
  576.      ple := Index2PLE(Index);
  577.      IF ple = NIL THEN Error;
  578.      Result := ple^.Item;
  579. END;
  580.  
  581.  
  582. PROCEDURE TChainList.Put(Index:LongInt;Item:Pointer);
  583. VAR  ple:PChainListItem;
  584. BEGIN
  585.      ple := Index2PLE(Index);
  586.      IF ple = NIL THEN Error;
  587.      ple^.Item := Item;
  588. END;
  589.  
  590.  
  591.  
  592. DESTRUCTOR TChainList.Destroy;
  593. BEGIN
  594.      Clear;
  595. END;
  596.  
  597.  
  598. PROCEDURE TChainList.Clear;
  599. VAR  i:LongInt;
  600.      ple,plenext:PChainListItem;
  601. BEGIN
  602.      ple := FList;
  603.      FOR i := 0 TO FCount-1 DO
  604.      BEGIN
  605.           plenext := ple^.next;
  606.           Dispose(ple);
  607.           ple := plenext;
  608.      END;
  609.      FCount := 0;
  610.      FList := NIL;
  611.      FListEnd := NIL;
  612. END;
  613.  
  614.  
  615. FUNCTION TChainList.Add(Item:Pointer):LongInt;
  616. VAR  plenew:PChainListItem;
  617. BEGIN
  618.      New(plenew);
  619.      plenew^.Item := Item;
  620.      plenew^.next := NIL;
  621.      Connect(FListEnd,plenew);
  622.      FListEnd := plenew;
  623.      Result := FCount;
  624.      inc(FCount);
  625. END;
  626.  
  627.  
  628. FUNCTION TChainList.Remove(Item:Pointer):LongInt;
  629. VAR  i:LongInt;
  630.      ple:PChainListItem;
  631. BEGIN
  632.      ple := FList;
  633.      FOR i := 0 TO FCount-1 DO
  634.      BEGIN
  635.           IF ple^.Item = Item THEN
  636.           BEGIN
  637.                Result := i;
  638.                Connect(ple^.prev,ple^.next);
  639.                Dispose(ple);
  640.                dec(FCount);
  641.                exit;
  642.           END;
  643.           ple := ple^.next;
  644.      END;
  645.      Result := -1;
  646. END;
  647.  
  648.  
  649. PROCEDURE TChainList.Delete(Index:LongInt);
  650. VAR  ple:PChainListItem;
  651. BEGIN
  652.      ple := Index2PLE(Index);
  653.      IF ple = NIL THEN Error;
  654.      Connect(ple^.prev,ple^.next);
  655.      Dispose(ple);
  656.      dec(FCount);
  657. END;
  658.  
  659.  
  660. FUNCTION TChainList.First:Pointer;
  661. VAR  ple:PChainListItem;
  662. BEGIN
  663.      ple := FList;
  664.      IF ple = NIL THEN Error;
  665.      Result := ple^.Item;
  666. END;
  667.  
  668.  
  669. FUNCTION TChainList.Last:Pointer;
  670. VAR  ple:PChainListItem;
  671. BEGIN
  672.      ple := FListEND;
  673.      IF ple = NIL THEN Error;
  674.      Result := ple^.Item;
  675. END;
  676.  
  677.  
  678. FUNCTION TChainList.IndexOf(Item:Pointer):LongInt;
  679. BEGIN
  680.      Result := Item2Index(Item);
  681. END;
  682.  
  683.  
  684. PROCEDURE TChainList.Insert(Index:LongInt;Item:Pointer);
  685. VAR  ple,plenew:PChainListItem;
  686. BEGIN
  687.      IF Index < 0 THEN Error;
  688.      IF Index > FCount THEN Error;
  689.  
  690.      ple := Index2PLE(Index);
  691.      IF ple <> NIL THEN
  692.      BEGIN
  693.           New(plenew);
  694.           plenew^.Item := Item;
  695.           Connect(ple^.prev,plenew);
  696.           Connect(plenew,ple);
  697.           inc(FCount);
  698.      END
  699.      ELSE Add(Item);
  700. END;
  701.  
  702.  
  703. PROCEDURE TChainList.Move(CurIndex,NewIndex:LongInt);
  704. VAR  TempItem:Pointer;
  705. BEGIN
  706.      IF CurIndex < 0 THEN Error;
  707.      IF CurIndex >= FCount THEN Error;
  708.      IF NewIndex < 0 THEN Error;
  709.      IF NewIndex >= FCount THEN Error;
  710.      IF CurIndex = NewIndex THEN exit;
  711.  
  712.      TempItem := Get(CurIndex);
  713.      Delete(CurIndex);
  714.      Insert(NewIndex,TempItem);
  715. END;
  716.  
  717.  
  718. PROCEDURE TChainList.Exchange(Index1,Index2:LongInt);
  719. VAR  ple1,ple2:PChainListItem;
  720.      TempItem:Pointer;
  721. BEGIN
  722.      ple1 := Index2PLE(Index1);
  723.      ple2 := Index2PLE(Index2);
  724.      IF (ple1 = NIL) OR (ple2 = NIL) THEN Error;
  725.  
  726.      TempItem := ple1^.Item;
  727.      ple1^.Item := ple2^.Item;
  728.      ple2^.Item := TempItem;
  729. END;
  730.  
  731.  
  732. PROCEDURE TChainList.Pack;
  733. VAR  i:LongInt;
  734.      ple,plenext:PChainListItem;
  735. BEGIN
  736.      ple := FList;
  737.      FOR i := 0 TO FCount-1 DO
  738.      BEGIN
  739.           plenext := ple^.next;
  740.           IF ple^.Item = NIL THEN
  741.           BEGIN
  742.                Connect(ple^.prev,ple^.next);
  743.                Dispose(ple);
  744.                dec(FCount);
  745.           END;
  746.           ple := plenext;
  747.      END;
  748. END;
  749.  
  750. { --- Utility FUNCTIONs for TStrItem --- }
  751.  
  752. FUNCTION NewStrItem(CONST ASTRING: STRING; AObject: TObject): PStrItem;
  753. BEGIN
  754.   GetMem(Result, SizeOf(TObject) + Length(ASTRING) + 1);
  755.   Result^.FObject := AObject;
  756.   Result^.FSTRING := ASTRING;
  757. END;
  758.  
  759. PROCEDURE DisposeStrItem(P: PStrItem);
  760. BEGIN
  761.   FreeMem(P, SizeOf(TObject) + Length(P^.FSTRING) + 1);
  762. END;
  763.  
  764.  
  765. { --- TSTRINGs --- }
  766.  
  767. FUNCTION TSTRINGs.Add(CONST S: STRING): LongInt;
  768. BEGIN
  769.   Result := Count;
  770.   Insert(Result, S);
  771. END;
  772.  
  773. FUNCTION TSTRINGs.AddObject(CONST S: STRING; AObject: TObject): LongInt;
  774. BEGIN
  775.   Result := Add(S);
  776.   PutObject(Result, AObject);
  777. END;
  778.  
  779. PROCEDURE TSTRINGs.AddSTRINGs(ASTRINGs: TSTRINGs);
  780. var
  781.   I: Integer;
  782. BEGIN
  783.   BEGINUpdate;
  784.   try
  785.     for I := 0 to ASTRINGs.Count - 1 do AddObject(ASTRINGs.Get(I), ASTRINGs.GetObject(I));
  786.   finally
  787.     EndUpdate;
  788.   END;
  789. END;
  790.  
  791. PROCEDURE TSTRINGs.BEGINUpdate;
  792. BEGIN
  793.   IF FUpdateSemaphore = 0 THEN SetUpdateState(True);
  794.   Inc(FUpdateSemaphore);
  795. END;
  796.  
  797. PROCEDURE TSTRINGs.EndUpdate;
  798. BEGIN
  799.   Dec(FUpdateSemaphore);
  800.   IF FUpdateSemaphore = 0 THEN SetUpdateState(False);
  801. END;
  802.  
  803. FUNCTION TSTRINGs.Equals(ASTRINGs: TSTRINGs): Boolean;
  804. var
  805.   N: LongInt;
  806. BEGIN
  807.   Result := False;
  808.   IF Count <> ASTRINGs.Count THEN Exit;
  809.   for N := 0 to Count - 1 do IF Get(N) <> ASTRINGs.Get(N) THEN Exit;
  810.   Result := True;
  811. END;
  812.  
  813. PROCEDURE TSTRINGs.Exchange(Index1, Index2: LongInt);
  814. var
  815.   S: STRING;
  816.   O: TObject;
  817. BEGIN
  818.   S := Get(Index1);
  819.   O := GetObject(Index1);
  820.   Put(Index1, Get(Index2));
  821.   PutObject(Index1, GetObject(Index2));
  822.   Put(Index2, S);
  823.   PutObject(Index2, O);
  824. END;
  825.  
  826. FUNCTION TSTRINGs.GetText: PChar;
  827.  
  828.   PROCEDURE SingleLineToBuffer(CONST S: STRING; VAR P: PChar);
  829.   BEGIN
  830.     System.Move(S[1], P[0], Length(S));
  831.     Inc(P, Length(S));
  832.     P[0] := #13;
  833.     P[1] := #10;
  834.     Inc(P, 2);
  835.   END;
  836.  
  837. var
  838.   N, BufSize: LongInt;
  839.   BufPtr: PChar;
  840. BEGIN
  841.   BufSize := 1;
  842.   for N := 0 to Count - 1 do Inc(BufSize, Length(Get(N)) + 2);
  843.   GetMem(Result, BufSize);
  844.  
  845.   WriteLn(LongWord(Result));
  846.   BufPtr := Result;
  847.   for N := 0 to Count - 1 do
  848.   BEGIN
  849.     SingleLineToBuffer(Get(N), BufPtr);
  850.     WriteLn(LongWord(BufPtr));
  851.   END;
  852.   BufPtr[0] := #0;
  853. END;
  854.  
  855. FUNCTION TSTRINGs.GetValue(CONST Name: STRING): STRING;
  856. BEGIN
  857.   FindValue(Name, Result);
  858. END;
  859.  
  860. FUNCTION TSTRINGs.FindValue(CONST Name: STRING; VAR Value: STRING): Integer;
  861. var
  862.   P: Integer;
  863. BEGIN
  864.   for Result := 0 to Count - 1 do
  865.   BEGIN
  866.     Value := Get(Result);
  867.     P := Pos('=', Value);
  868.     IF P <> 0 THEN
  869.     BEGIN
  870.       IF CompareText(Copy(Value, 1, P - 1), Name) = 0 THEN
  871.       BEGIN
  872.         System.Delete(Value, 1, P);
  873.         Exit;
  874.       END;
  875.     END;
  876.   END;
  877.   Result := -1;
  878.   Value := '';
  879. END;
  880.  
  881. FUNCTION TSTRINGs.IndexOf(CONST S: STRING): Integer;
  882. BEGIN
  883.   for Result := 0 to Count do IF CompareText(Get(Result), S) = 0 THEN Exit;
  884.   Result := -1;
  885. END;
  886.  
  887. FUNCTION TSTRINGs.IndexOfObject(AObject: TObject): Integer;
  888. BEGIN
  889.   for Result := 0 to Count do IF GetObject(Result) = AObject THEN Exit;
  890.   Result := -1;
  891. END;
  892.  
  893. PROCEDURE TSTRINGs.InsertObject(Index: LongInt; CONST S: STRING; AObject: TObject);
  894. BEGIN
  895.   Insert(Index, S);
  896.   PutObject(Index, AObject);
  897. END;
  898.  
  899. PROCEDURE TSTRINGs.LoadFromFile(CONST FileName: STRING);
  900. var
  901.   Source: TFileStream;
  902. BEGIN
  903.   try
  904.     Source := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  905.   except
  906.     Source.Destroy;
  907.     raise;
  908.   END;
  909.  
  910.   try
  911.     LoadFromStream(Source);
  912.   finally
  913.     Source.Destroy;
  914.   END;
  915. END;
  916.  
  917. PROCEDURE TSTRINGs.LoadFromStream(Stream: TStream);
  918. BEGIN
  919.   BEGINUpdate;
  920.   try
  921.     while not Stream.EndOfData do Add(Stream.ReadLn);
  922.   finally
  923.     EndUpdate;
  924.   END;
  925. END;
  926.  
  927. PROCEDURE TSTRINGs.Move(CurIndex, NewIndex: LongInt);
  928. var
  929.   O: TObject;
  930.   S: STRING;
  931. BEGIN
  932.   IF CurIndex = NewIndex THEN Exit;
  933.   S := Get(CurIndex);
  934.   O := GetObject(CurIndex);
  935.   Delete(CurIndex);
  936.   InsertObject(NewIndex, S, O);
  937. END;
  938.  
  939. PROCEDURE TSTRINGs.SaveToFile(CONST FileName: STRING);
  940. var
  941.   Dest: TFileStream;
  942. BEGIN
  943.   try
  944.     Dest := TFileStream.Create(FileName, Stream_Create);
  945.   except
  946.     Dest.Destroy;
  947.     raise;
  948.   END;
  949.  
  950.   try
  951.     SaveToStream(Dest);
  952.   finally
  953.     Dest.Destroy;
  954.   END;
  955. END;
  956.  
  957. PROCEDURE TSTRINGs.SaveToStream(Stream: TStream);
  958. var
  959.   N: LongInt;
  960. BEGIN
  961.   for N := 0 to Count - 1 do Stream.WriteLn(Get(N));
  962. END;
  963.  
  964. PROCEDURE TSTRINGs.SetText(Text: PChar);
  965.  
  966.   FUNCTION SingleLineFromBuffer(VAR P: PChar): STRING;
  967.   var
  968.     I: Integer;
  969.     Q: PChar;
  970.   BEGIN
  971.     {
  972.     asm
  973.       mov si, $P;
  974.       mov di, !$FuncResult;
  975.       inc di;
  976.       xor cx, cx;
  977.  
  978.       !SingleLineFromBuffer_1:
  979.  
  980.       lodsb;
  981.       cmp al, ' ';
  982.       jng !SingleLineFromBuffer_2
  983.  
  984.       cmp al, 0;
  985.       je !SingleLineFromBuffer_3
  986.       cmp al, 10;
  987.       je !SingleLineFromBuffer_3
  988.       cmp al, 13;
  989.       je !SingleLineFromBuffer_3
  990.       cmp al, 26;
  991.       je !SingleLineFromBuffer_3
  992.  
  993.       !SingleLineFromBuffer_2:
  994.  
  995.       stosb;
  996.       inc cx;
  997.       cmp cx, 255;
  998.       jne !SingleLineFromBuffer_1
  999.  
  1000.       !SingleLineFromBuffer_3:
  1001.  
  1002.       mov $P, si;
  1003.       mov $Result, cl;
  1004.     END;
  1005.     }
  1006.  
  1007.     I := 0;
  1008.     Q := P;
  1009.     while not (Q[0] in [#13, #10, #26, #0]) and (I < 255) do
  1010.     BEGIN
  1011.       Inc(Q);
  1012.       Inc(I);
  1013.     END;
  1014.     StrMove(@Result[1], P, I);
  1015.     SetLength(Result, I);
  1016.     P := Q;
  1017.     IF P[0] = #13 THEN Inc(P);
  1018.     IF P[0] = #10 THEN Inc(P);
  1019.   END;
  1020.  
  1021. BEGIN
  1022.   BEGINUpdate;
  1023.   try
  1024.     Clear;
  1025.     while not (Text[0] in [#0, #26]) do
  1026.     BEGIN
  1027.       Add(SingleLineFromBuffer(Text));
  1028.     END;
  1029.   finally
  1030.     EndUpdate;
  1031.   END;
  1032. END;
  1033.  
  1034. PROCEDURE TSTRINGs.SetUpdateState(Updating: Boolean);
  1035. BEGIN
  1036. END;
  1037.  
  1038. PROCEDURE TSTRINGs.SetValue(CONST Name, Value: STRING);
  1039. var
  1040.   I: LongInt;
  1041.   S: STRING;
  1042. BEGIN
  1043.   I := FindValue(Name, S);
  1044.   IF I < 0 THEN
  1045.   BEGIN
  1046.     IF Length(Value) <> 0 THEN Add(Name + '=' + Value)
  1047.   end
  1048.   else
  1049.   BEGIN
  1050.     IF Length(Value) <> 0 THEN Put(I, Name + '=' + Value)
  1051.     ELSE Delete(I);
  1052.   END;
  1053. END;
  1054.  
  1055. { --- TStringList --- }
  1056.  
  1057. CONSTRUCTOR TStringList.Create;
  1058. BEGIN
  1059.   INHERITED Create;
  1060.   FList := TList.Create;
  1061.   FCaseSensitive := False;
  1062. END;
  1063.  
  1064. DESTRUCTOR TStringList.Destroy;
  1065. BEGIN
  1066.   { Die folgenden zwei Zeilen später wieder ändern }
  1067.   Pointer(FOnChanging) := NIL;
  1068.   Pointer(FOnChange) := NIL;
  1069.   Clear;
  1070.   FList.Destroy;
  1071. END;
  1072.  
  1073. FUNCTION TStringList.Add(CONST S: STRING): LongInt;
  1074. BEGIN
  1075.   IF FSorted THEN
  1076.   BEGIN
  1077.     IF Find(S, Result) THEN
  1078.     BEGIN
  1079.       case FDuplicates of
  1080.         dupIgnore,
  1081.         dupReplace: Exit;
  1082.         dupError: raise ESTRINGListError.Create('TStringList: Dupe error.');
  1083.       END;
  1084.     END;
  1085.   end
  1086.   ELSE Result := Count;
  1087.   Changing;
  1088.   FList.Insert(Result, NewStrItem(S, nil));
  1089.   Changed;
  1090. END;
  1091.  
  1092. PROCEDURE TStringList.Changed;
  1093. BEGIN
  1094.   IF (FUpdateSemaphore = 0) and (FOnChange <> nil) THEN FOnChange(Self);
  1095. END;
  1096.  
  1097. PROCEDURE TStringList.Changing;
  1098. BEGIN
  1099.   IF (FUpdateSemaphore = 0) and (FOnChanging <> nil) THEN FOnChanging(Self);
  1100. END;
  1101.  
  1102. PROCEDURE TStringList.Clear;
  1103. var
  1104.   N: LongInt;
  1105. BEGIN
  1106.   Changing;
  1107.   for N := Count - 1 downto 0 do Delete(N);
  1108.   Changed;
  1109. END;
  1110.  
  1111. PROCEDURE TStringList.Delete(Index: LongInt);
  1112. BEGIN
  1113.   Changing;
  1114.   DisposeStrItem(FList.Get(Index));
  1115.   FList.Delete(Index);
  1116.   Changed;
  1117. END;
  1118.  
  1119. PROCEDURE TStringList.Exchange(Index1, Index2: LongInt);
  1120. BEGIN
  1121.   Changing;
  1122.   FList.Exchange(Index1, Index2);
  1123.   Changed;
  1124. END;
  1125.  
  1126. FUNCTION TStringList.Find(CONST S: STRING; VAR Index: LongInt): Boolean;
  1127. var
  1128.   Low, High: LongInt;
  1129.   Cmp: Integer;
  1130.   DoCompare: FUNCTION(CONST S, T: STRING): Integer;
  1131.  
  1132. BEGIN
  1133.   IF CaseSensitive THEN DoCompare := CompareStr
  1134.   ELSE DoCompare := CompareText;
  1135.  
  1136.   IF Sorted THEN
  1137.   BEGIN
  1138.     { Binary search }
  1139.     Low := 0;
  1140.     High := GetCount - 1;
  1141.     Index := 0;
  1142.     Cmp := -1;
  1143.     while (Cmp <> 0) and (Low <= High) do
  1144.     BEGIN
  1145.       Index := (Low + High) div 2;
  1146.       Cmp := DoCompare(S, Get(Index));
  1147.       IF Cmp < 0 THEN High := Index -1
  1148.       ELSE IF Cmp > 0 THEN Low := Index + 1;
  1149.     END;
  1150.     IF Low = Index + 1 THEN Inc(Index);
  1151.     Result := (Cmp = 0);
  1152.   end
  1153.   else
  1154.   BEGIN
  1155.     { Linear search }
  1156.     Index := 0;
  1157.     while (Index < Count) and (DoCompare(Get(Index), S) <> 0) do Inc(Index);
  1158.     Result := (Index < Count);
  1159.   END;
  1160. END;
  1161.  
  1162. FUNCTION TStringList.Get(Index: LongInt): STRING;
  1163. BEGIN
  1164.   Result := PStrItem(FList.Get(Index))^.FSTRING;
  1165. END;
  1166.  
  1167. FUNCTION TStringList.GetCount: LongInt;
  1168. BEGIN
  1169.   Result := FList.Count;
  1170. END;
  1171.  
  1172. FUNCTION TStringList.GetObject(Index: LongInt): TObject;
  1173. BEGIN
  1174.   Result := PStrItem(FList.Get(Index))^.FObject;
  1175. END;
  1176.  
  1177. FUNCTION TStringList.IndexOf(CONST S: STRING): LongInt;
  1178. BEGIN
  1179.   IF not Find(S, Result) THEN Result := -1;
  1180. END;
  1181.  
  1182. PROCEDURE TStringList.Insert(Index: LongInt; CONST S: STRING);
  1183. BEGIN
  1184.   Changing;
  1185.   IF FSorted THEN raise EListError.Create('Insertion into sorted list is not allowed.')
  1186.   ELSE FList.Insert(Index, NewStrItem(S, nil));
  1187.   Changed;
  1188. END;
  1189.  
  1190. PROCEDURE TStringList.Put(Index: LongInt; CONST S: STRING);
  1191. BEGIN
  1192.   Changing;
  1193.   DisposeStrItem(FList.Get(Index));
  1194.   FList.Put(Index, NewStrItem(S, nil));
  1195.   Changed;
  1196. END;
  1197.  
  1198. PROCEDURE TStringList.PutObject(Index: LongInt; AObject: TObject);
  1199. var
  1200.   P: PStrItem;
  1201. BEGIN
  1202.   P := FList.Get(Index);
  1203.   P^.FObject := AObject;
  1204. END;
  1205.  
  1206. PROCEDURE TStringList.BottomUpHeapSort;
  1207. var
  1208.   DoCompare: FUNCTION (CONST S, T: STRING): Integer;
  1209.  
  1210.   PROCEDURE Reheap(I, K: LongInt);
  1211.   var
  1212.     J: LongInt;
  1213.   BEGIN
  1214.     J := I;
  1215.     while J shl 1 < K do
  1216.     BEGIN
  1217.       IF DoCompare(Get(J shl 1 - 1), Get(J shl 1 + 1 - 1)) > 0 THEN J := J shl 1
  1218.       ELSE J := J shl 1 + 1;
  1219.     END;
  1220.     IF J shl 1 = K THEN J := K;
  1221.  
  1222.     while DoCompare(Get(I - 1), Get(J - 1)) > 0 do J := J shr 1;
  1223.  
  1224.     FList.Exchange(I - 1, J - 1);
  1225.     J := J shr 1;
  1226.  
  1227.     while J >= I do
  1228.     BEGIN
  1229.       FList.Exchange(I - 1, J - 1);
  1230.       J := J shr 1;
  1231.     END;
  1232.   END;
  1233.  
  1234. var
  1235.   I, C: LongInt;
  1236. BEGIN
  1237.   IF CaseSensitive THEN DoCompare := CompareStr
  1238.   ELSE DoCompare := CompareText;
  1239.  
  1240.   C := Count;
  1241.   for I := C shr 1 downto 1 do Reheap(I, C);
  1242.   for I := C downto 2 do
  1243.   BEGIN
  1244.     FList.Exchange(0, I - 1);
  1245.     Reheap(1, I - 1);
  1246.   END;
  1247. END;
  1248.  
  1249. PROCEDURE TStringList.SetCaseSensitive(Value: Boolean);
  1250. var
  1251.   Old: Boolean;
  1252. BEGIN
  1253.   Changing;
  1254.   Old := FCaseSensitive;
  1255.   FCaseSensitive := Value;
  1256.   IF FSorted and (FCaseSensitive <> Old) THEN Sort;
  1257.   Changed;
  1258. END;
  1259.  
  1260. PROCEDURE TStringList.SetSorted(Value: Boolean);
  1261. BEGIN
  1262.   Changing;
  1263.   IF (not FSorted) and Value THEN Sort;
  1264.   FSorted := Value;
  1265.   Changed;
  1266. END;
  1267.  
  1268. PROCEDURE TStringList.SetUpdateState(Updating: Boolean);
  1269. BEGIN
  1270.   IF Updating THEN Changing
  1271.   ELSE Changed;
  1272. END;
  1273.  
  1274. PROCEDURE TStringList.Sort;
  1275. BEGIN
  1276.   IF Count > 1 THEN
  1277.   BEGIN
  1278.     Changing;
  1279.     BottomUpHeapSort;
  1280.     Changed;
  1281.   END;
  1282. END;
  1283.  
  1284.  
  1285. BEGIN
  1286. END.
  1287.