stringl.inc 19 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077
  1. {
  2. $Id$
  3. This file is part of the Free Component Library (FCL)
  4. Copyright (c) 1999-2000 by the Free Pascal development team
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. {****************************************************************************}
  12. {* TStrings *}
  13. {****************************************************************************}
  14. // Function to quote text. Should move maybe to sysutils !!
  15. // Also, it is not clear at this point what exactly should be done.
  16. { //!! is used to mark unsupported things. }
  17. Function QuoteString (Const S : String; Quote : String) : String;
  18. Var
  19. I,J : Integer;
  20. begin
  21. J:=0;
  22. Result:=S;
  23. for i:=1to length(s) do
  24. begin
  25. inc(j);
  26. if S[i]=Quote then
  27. begin
  28. System.Insert(Quote,Result,J);
  29. inc(j);
  30. end;
  31. end;
  32. Result:=Quote+Result+Quote;
  33. end;
  34. function TStrings.GetCommaText: string;
  35. Var
  36. I : integer;
  37. p : pchar;
  38. begin
  39. result:='';
  40. For i:=0 to count-1 do
  41. begin
  42. p:=pchar(strings[i]);
  43. while not(p^ in [#0..' ','"',',']) do
  44. inc(p);
  45. if p^<>#0 then
  46. Result:=Result+QuoteString (Strings[I],'"')
  47. else
  48. result:=result+strings[i];
  49. if I<Count-1 then Result:=Result+',';
  50. end;
  51. If Length(Result)=0 then
  52. Result:='""';
  53. end;
  54. function TStrings.GetName(Index: Integer): string;
  55. Var L : longint;
  56. begin
  57. Result:=Strings[Index];
  58. L:=Pos('=',Result);
  59. If L<>0 then
  60. Result:=Copy(Result,1,L-1)
  61. else
  62. Result:='';
  63. end;
  64. Function TStrings.GetValue(const Name: string): string;
  65. Var L : longint;
  66. begin
  67. Result:='';
  68. L:=IndexOfName(Name);
  69. If L<>-1 then
  70. begin
  71. Result:=Strings[L];
  72. L:=Pos('=',Result);
  73. System.Delete (Result,1,L);
  74. end;
  75. end;
  76. procedure TStrings.ReadData(Reader: TReader);
  77. begin
  78. Reader.ReadListBegin;
  79. BeginUpdate;
  80. try
  81. Clear;
  82. while not Reader.EndOfList do
  83. Add(Reader.ReadString);
  84. finally
  85. EndUpdate;
  86. end;
  87. Reader.ReadListEnd;
  88. end;
  89. Function GetQuotedString (Var P : Pchar) : AnsiString;
  90. Var P1,L : Pchar;
  91. ReplaceQuotes : boolean;
  92. begin
  93. Result:='';
  94. ReplaceQuotes := False;
  95. P1:=P+1;
  96. While P1^<>#0 do
  97. begin
  98. If (P1^='"') then
  99. begin
  100. if (P1[1]<>'"') then
  101. break;
  102. inc(p1);
  103. ReplaceQuotes := True;
  104. end;
  105. inc(p1);
  106. end;
  107. // P1 points to last quote, or to #0;
  108. P:=P+1;
  109. If P1-P>0 then
  110. begin
  111. SetLength(Result,(P1-P));
  112. L:=Pointer(Result);
  113. Move (P^,L^,P1-P);
  114. P:=P1+1;
  115. end;
  116. if ReplaceQuotes then
  117. result := StringReplace (result, '""', '"', [rfReplaceAll]);
  118. end;
  119. Function GetNextQuotedChar (var P : PChar; Var S : String): Boolean;
  120. Var PS,L : PChar;
  121. begin
  122. Result:=False;
  123. S:='';
  124. While (p^<>#0) and (byte(p^)<=byte(' ')) do
  125. inc(p);
  126. If P^=#0 then exit;
  127. PS:=P;
  128. If P^='"' then
  129. begin
  130. S:=GetQuotedString(P);
  131. While (p^<>#0) and (byte(p^)<=byte(' ')) do
  132. inc(p);
  133. end
  134. else
  135. begin
  136. While (p^>' ') and (P^<>',') do
  137. inc(p);
  138. Setlength (S,P-PS);
  139. L:=Pointer(S);
  140. Move (PS^,L^,P-PS);
  141. end;
  142. if p^=',' then
  143. inc(p);
  144. Result:=True;
  145. end;
  146. Procedure TStrings.SetCommaText(const Value: string);
  147. Var
  148. P : PChar;
  149. S : String;
  150. begin
  151. BeginUpdate;
  152. try
  153. Clear;
  154. P:=PChar(Value);
  155. if assigned(p) then
  156. begin
  157. While GetNextQuotedChar (P,S) do
  158. Add (S);
  159. end;
  160. finally
  161. EndUpdate;
  162. end;
  163. end;
  164. Procedure TStrings.SetStringsAdapter(const Value: IStringsAdapter);
  165. begin
  166. end;
  167. Procedure TStrings.SetValue(const Name, Value: string);
  168. Var L : longint;
  169. begin
  170. L:=IndexOfName(Name);
  171. if L=-1 then
  172. Add (Name+'='+Value)
  173. else
  174. Strings[L]:=Name+'='+value;
  175. end;
  176. procedure TStrings.WriteData(Writer: TWriter);
  177. var
  178. i: Integer;
  179. begin
  180. Writer.WriteListBegin;
  181. for i := 0 to Count - 1 do
  182. Writer.WriteString(Strings[i]);
  183. Writer.WriteListEnd;
  184. end;
  185. procedure TStrings.DefineProperties(Filer: TFiler);
  186. var
  187. HasData: Boolean;
  188. begin
  189. if Assigned(Filer.Ancestor) then
  190. // Only serialize if string list is different from ancestor
  191. if Filer.Ancestor.InheritsFrom(TStrings) then
  192. HasData := not Equals(TStrings(Filer.Ancestor))
  193. else
  194. HasData := True
  195. else
  196. HasData := Count > 0;
  197. Filer.DefineProperty('Strings', @ReadData, @WriteData, HasData);
  198. end;
  199. Procedure TStrings.Error(const Msg: string; Data: Integer);
  200. begin
  201. {$ifdef VER1_0}
  202. Raise EStringListError.CreateFmt(Msg,[Data]) at longint(get_caller_addr(get_frame));
  203. {$else VER1_0}
  204. Raise EStringListError.CreateFmt(Msg,[Data]) at get_caller_addr(get_frame);
  205. {$endif VER1_0}
  206. end;
  207. Function TStrings.GetCapacity: Integer;
  208. begin
  209. Result:=Count;
  210. end;
  211. Function TStrings.GetObject(Index: Integer): TObject;
  212. begin
  213. Result:=Nil;
  214. end;
  215. Function TStrings.GetTextStr: string;
  216. Const
  217. {$ifdef Unix}
  218. NewLineSize=1;
  219. {$else}
  220. NewLineSize=2;
  221. {$endif}
  222. Var P : Pchar;
  223. I,L : Longint;
  224. S : String;
  225. begin
  226. // Determine needed place
  227. L:=0;
  228. For I:=0 to count-1 do
  229. L:=L+Length(Strings[I])+NewLineSize;
  230. Setlength(Result,L);
  231. P:=Pointer(Result);
  232. For i:=0 To count-1 do
  233. begin
  234. S:=Strings[I];
  235. L:=Length(S);
  236. if L<>0 then
  237. System.Move(Pointer(S)^,P^,L);
  238. P:=P+L;
  239. {$ifndef Unix}
  240. p[0]:=#13;
  241. p[1]:=#10;
  242. {$else}
  243. p[0]:=#10;
  244. {$endif}
  245. P:=P+NewLineSize;
  246. end;
  247. end;
  248. Procedure TStrings.Put(Index: Integer; const S: string);
  249. Var Obj : TObject;
  250. begin
  251. Obj:=Objects[Index];
  252. Delete(Index);
  253. InsertObject(Index,S,Obj);
  254. end;
  255. Procedure TStrings.PutObject(Index: Integer; AObject: TObject);
  256. begin
  257. // Empty.
  258. end;
  259. Procedure TStrings.SetCapacity(NewCapacity: Integer);
  260. begin
  261. // Empty.
  262. end;
  263. Procedure TStrings.SetTextStr(const Value: string);
  264. begin
  265. SetText(PChar(Value));
  266. end;
  267. Procedure TStrings.SetUpdateState(Updating: Boolean);
  268. begin
  269. end;
  270. destructor TSTrings.Destroy;
  271. begin
  272. inherited destroy;
  273. end;
  274. Function TStrings.Add(const S: string): Integer;
  275. begin
  276. Result:=Count;
  277. Insert (Count,S);
  278. end;
  279. Function TStrings.AddObject(const S: string; AObject: TObject): Integer;
  280. begin
  281. Result:=Add(S);
  282. Objects[result]:=AObject;
  283. end;
  284. Procedure TStrings.Append(const S: string);
  285. begin
  286. Add (S);
  287. end;
  288. Procedure TStrings.AddStrings(TheStrings: TStrings);
  289. Var Runner : longint;
  290. begin
  291. try
  292. beginupdate;
  293. For Runner:=0 to TheStrings.Count-1 do
  294. self.AddObject (Thestrings[Runner],TheStrings.Objects[Runner]);
  295. finally
  296. EndUpdate;
  297. end;
  298. end;
  299. Procedure TStrings.Assign(Source: TPersistent);
  300. begin
  301. Try
  302. BeginUpdate;
  303. If Source is TStrings then
  304. begin
  305. clear;
  306. AddStrings(TStrings(Source));
  307. exit;
  308. end;
  309. Inherited Assign(Source);
  310. finally
  311. EndUpdate;
  312. end;
  313. end;
  314. Procedure TStrings.BeginUpdate;
  315. begin
  316. inc(FUpdateCount);
  317. if FUpdateCount = 1 then SetUpdateState(true);
  318. end;
  319. Procedure TStrings.EndUpdate;
  320. begin
  321. If FUpdateCount>0 then
  322. Dec(FUpdateCount);
  323. if FUpdateCount=0 then
  324. SetUpdateState(False);
  325. end;
  326. Function TStrings.Equals(TheStrings: TStrings): Boolean;
  327. Var Runner,Nr : Longint;
  328. begin
  329. Result:=False;
  330. Nr:=Self.Count;
  331. if Nr<>TheStrings.Count then exit;
  332. For Runner:=0 to Nr-1 do
  333. If Strings[Runner]<>TheStrings[Runner] then exit;
  334. Result:=True;
  335. end;
  336. Procedure TStrings.Exchange(Index1, Index2: Integer);
  337. Var
  338. Obj : TObject;
  339. Str : String;
  340. begin
  341. Try
  342. beginUpdate;
  343. Obj:=Objects[Index1];
  344. Str:=Strings[Index1];
  345. Objects[Index1]:=Objects[Index2];
  346. Strings[Index1]:=Strings[Index2];
  347. Objects[Index2]:=Obj;
  348. Strings[Index2]:=Str;
  349. finally
  350. EndUpdate;
  351. end;
  352. end;
  353. Function TStrings.GetText: PChar;
  354. begin
  355. Result:=StrNew(Pchar(Self.Text));
  356. end;
  357. Function TStrings.IndexOf(const S: string): Integer;
  358. begin
  359. Result:=0;
  360. While (Result<Count) and (CompareText(Strings[Result],S)<>0) do Result:=Result+1;
  361. if Result=Count then Result:=-1;
  362. end;
  363. Function TStrings.IndexOfName(const Name: string): Integer;
  364. Var
  365. len : longint;
  366. S : String;
  367. begin
  368. Result:=0;
  369. while (Result<Count) do
  370. begin
  371. S:=Strings[Result];
  372. len:=pos('=',S)-1;
  373. if (len>0) and (CompareText(Name,Copy(S,1,Len))=0) then
  374. exit;
  375. inc(result);
  376. end;
  377. result:=-1;
  378. end;
  379. Function TStrings.IndexOfObject(AObject: TObject): Integer;
  380. begin
  381. Result:=0;
  382. While (Result<count) and (Objects[Result]<>AObject) do Result:=Result+1;
  383. If Result=Count then Result:=-1;
  384. end;
  385. Procedure TStrings.InsertObject(Index: Integer; const S: string;
  386. AObject: TObject);
  387. begin
  388. Insert (Index,S);
  389. Objects[Index]:=AObject;
  390. end;
  391. Procedure TStrings.LoadFromFile(const FileName: string);
  392. Var TheStream : TFileStream;
  393. begin
  394. TheStream:=TFileStream.Create(FileName,fmOpenRead);
  395. LoadFromStream(TheStream);
  396. TheStream.Free;
  397. end;
  398. Procedure TStrings.LoadFromStream(Stream: TStream);
  399. {
  400. Borlands method is no good, since a pipe for
  401. instance doesn't have a size.
  402. So we must do it the hard way.
  403. }
  404. Const
  405. BufSize = 1024;
  406. Var
  407. Buffer : Pointer;
  408. BytesRead,
  409. BufLen : Longint;
  410. begin
  411. // reread into a buffer
  412. try
  413. beginupdate;
  414. Buffer:=Nil;
  415. BufLen:=0;
  416. Repeat
  417. ReAllocMem(Buffer,BufLen+BufSize);
  418. BytesRead:=Stream.Read((Buffer+BufLen)^,BufSize);
  419. inc(BufLen,BufSize);
  420. Until BytesRead<>BufSize;
  421. // Null-terminate !!
  422. Pchar(Buffer)[BufLen-BufSize+BytesRead]:=#0;
  423. Text:=PChar(Buffer);
  424. FreeMem(Buffer);
  425. finally
  426. EndUpdate;
  427. end;
  428. end;
  429. Procedure TStrings.Move(CurIndex, NewIndex: Integer);
  430. Var
  431. Obj : TObject;
  432. Str : String;
  433. begin
  434. BeginUpdate;
  435. Obj:=Objects[CurIndex];
  436. Str:=Strings[CurIndex];
  437. Delete(Curindex);
  438. InsertObject(NewIndex,Str,Obj);
  439. EndUpdate;
  440. end;
  441. Procedure TStrings.SaveToFile(const FileName: string);
  442. Var TheStream : TFileStream;
  443. begin
  444. TheStream:=TFileStream.Create(FileName,fmCreate);
  445. SaveToStream(TheStream);
  446. TheStream.Free;
  447. end;
  448. Procedure TStrings.SaveToStream(Stream: TStream);
  449. Var
  450. S : String;
  451. begin
  452. S:=Text;
  453. Stream.Write(Pointer(S)^,Length(S));
  454. end;
  455. Function GetNextLine (Var P : Pchar; Var S : String) : Boolean;
  456. Var PS : PChar;
  457. begin
  458. S:='';
  459. Result:=False;
  460. If P^=#0 then exit;
  461. PS:=P;
  462. While not (P^ in [#0,#10,#13]) do P:=P+1;
  463. SetLength (S,P-PS);
  464. System.Move (PS^,Pointer(S)^,P-PS);
  465. If P^=#13 then P:=P+1;
  466. If P^=#10 then
  467. P:=P+1; // Point to character after #10(#13)
  468. Result:=True;
  469. end;
  470. Procedure TStrings.SetText(TheText: PChar);
  471. Var S : String;
  472. begin
  473. Try
  474. beginUpdate;
  475. Clear;
  476. While GetNextLine (TheText,S) do
  477. Add(S);
  478. finally
  479. EndUpdate;
  480. end;
  481. end;
  482. {****************************************************************************}
  483. {* TStringList *}
  484. {****************************************************************************}
  485. Procedure TStringList.ExchangeItems(Index1, Index2: Integer);
  486. Var P1,P2 : Pointer;
  487. begin
  488. P1:=Pointer(Flist^[Index1].FString);
  489. P2:=Pointer(Flist^[Index1].FObject);
  490. Pointer(Flist^[Index1].Fstring):=Pointer(Flist^[Index2].Fstring);
  491. Pointer(Flist^[Index1].FObject):=Pointer(Flist^[Index2].FObject);
  492. Pointer(Flist^[Index2].Fstring):=P1;
  493. Pointer(Flist^[Index2].FObject):=P2;
  494. end;
  495. Procedure TStringList.Grow;
  496. Var Extra : Longint;
  497. begin
  498. If FCapacity>64 then
  499. Extra:=FCapacity Div 4
  500. Else If FCapacity>8 Then
  501. Extra:=16
  502. Else
  503. Extra:=4;
  504. SetCapacity(FCapacity+Extra);
  505. end;
  506. Procedure TStringList.QuickSort(L, R: Integer; CompareFn: TStringListSortCompare);
  507. Var I,J, Pivot : Longint;
  508. begin
  509. Repeat
  510. I:=L;
  511. J:=R;
  512. Pivot:=(L+R) div 2;
  513. Repeat
  514. While CompareFn(Self, I, Pivot)<0 do Inc(I);
  515. While CompareFn(Self, J, Pivot)>0 do Dec(J);
  516. If I<=J then
  517. begin
  518. ExchangeItems(I,J); // No check, indices are correct.
  519. if Pivot=I then
  520. Pivot:=J
  521. else if Pivot=J then
  522. Pivot := I;
  523. Inc(I);
  524. Dec(j);
  525. end;
  526. until I>J;
  527. If L<J then QuickSort(L,J, CompareFn);
  528. L:=I;
  529. Until I>=R;
  530. end;
  531. Procedure TStringList.InsertItem(Index: Integer; const S: string);
  532. begin
  533. Changing;
  534. If FCount=Fcapacity then Grow;
  535. If Index<FCount then
  536. System.Move (FList^[Index],FList^[Index+1],
  537. (FCount-Index)*SizeOf(TStringItem));
  538. Pointer(Flist^[Index].Fstring):=Nil; // Needed to initialize...
  539. Flist^[Index].FString:=S;
  540. Flist^[Index].Fobject:=Nil;
  541. Inc(FCount);
  542. Changed;
  543. end;
  544. Procedure TStringList.SetSorted(Value: Boolean);
  545. begin
  546. If FSorted<>Value then
  547. begin
  548. If Value then sort;
  549. FSorted:=VAlue
  550. end;
  551. end;
  552. Procedure TStringList.Changed;
  553. begin
  554. If (FUpdateCount=0) Then
  555. If Assigned(FOnChange) then
  556. FOnchange(Self);
  557. end;
  558. Procedure TStringList.Changing;
  559. begin
  560. If FUpdateCount=0 then
  561. if Assigned(FOnChanging) then
  562. FOnchanging(Self);
  563. end;
  564. Function TStringList.Get(Index: Integer): string;
  565. begin
  566. If (Index<0) or (INdex>=Fcount) then
  567. Error (SListIndexError,Index);
  568. Result:=Flist^[Index].FString;
  569. end;
  570. Function TStringList.GetCapacity: Integer;
  571. begin
  572. Result:=FCapacity;
  573. end;
  574. Function TStringList.GetCount: Integer;
  575. begin
  576. Result:=FCount;
  577. end;
  578. Function TStringList.GetObject(Index: Integer): TObject;
  579. begin
  580. If (Index<0) or (INdex>=Fcount) then
  581. Error (SListIndexError,Index);
  582. Result:=Flist^[Index].FObject;
  583. end;
  584. Procedure TStringList.Put(Index: Integer; const S: string);
  585. begin
  586. If Sorted then
  587. Error(SSortedListError,0);
  588. If (Index<0) or (INdex>=Fcount) then
  589. Error (SListIndexError,Index);
  590. Changing;
  591. Flist^[Index].FString:=S;
  592. Changed;
  593. end;
  594. Procedure TStringList.PutObject(Index: Integer; AObject: TObject);
  595. begin
  596. If (Index<0) or (INdex>=Fcount) then
  597. Error (SListIndexError,Index);
  598. Changing;
  599. Flist^[Index].FObject:=AObject;
  600. Changed;
  601. end;
  602. Procedure TStringList.SetCapacity(NewCapacity: Integer);
  603. Var NewList : Pointer;
  604. MSize : Longint;
  605. begin
  606. If (NewCapacity<0) then
  607. Error (SListCapacityError,NewCapacity);
  608. If NewCapacity>FCapacity then
  609. begin
  610. GetMem (NewList,NewCapacity*SizeOf(TStringItem));
  611. If NewList=Nil then
  612. Error (SListCapacityError,NewCapacity);
  613. If Assigned(FList) then
  614. begin
  615. MSize:=FCapacity*Sizeof(TStringItem);
  616. System.Move (FList^,NewList^,MSize);
  617. FillWord (Pchar(NewList)[MSize],(NewCapacity-FCapacity)*WordRatio, 0);
  618. FreeMem (Flist,MSize);
  619. end;
  620. Flist:=NewList;
  621. FCapacity:=NewCapacity;
  622. end
  623. else if NewCapacity<FCapacity then
  624. begin
  625. if NewCapacity = 0 then
  626. begin
  627. FreeMem(FList);
  628. FList := nil;
  629. end else
  630. begin
  631. GetMem(NewList, NewCapacity * SizeOf(TStringItem));
  632. System.Move(FList^, NewList^, NewCapacity * SizeOf(TStringItem));
  633. FreeMem(FList);
  634. FList := NewList;
  635. end;
  636. FCapacity:=NewCapacity;
  637. end;
  638. end;
  639. Procedure TStringList.SetUpdateState(Updating: Boolean);
  640. begin
  641. If Updating then
  642. Changing
  643. else
  644. Changed
  645. end;
  646. destructor TStringList.Destroy;
  647. Var I : Longint;
  648. begin
  649. FOnChange:=Nil;
  650. FOnChanging:=Nil;
  651. // This will force a dereference. Can be done better...
  652. For I:=0 to FCount-1 do
  653. FList^[I].FString:='';
  654. FCount:=0;
  655. SetCapacity(0);
  656. Inherited destroy;
  657. end;
  658. Function TStringList.Add(const S: string): Integer;
  659. begin
  660. If Not Sorted then
  661. Result:=FCount
  662. else
  663. If Find (S,Result) then
  664. Case DUplicates of
  665. DupIgnore : Exit;
  666. DupError : Error(SDuplicateString,0)
  667. end;
  668. InsertItem (Result,S);
  669. end;
  670. Procedure TStringList.Clear;
  671. Var I : longint;
  672. begin
  673. if FCount = 0 then Exit;
  674. Changing;
  675. For I:=0 to FCount-1 do
  676. Flist^[I].FString:='';
  677. FCount:=0;
  678. SetCapacity(0);
  679. Changed;
  680. end;
  681. Procedure TStringList.Delete(Index: Integer);
  682. begin
  683. If (Index<0) or (Index>=FCount) then
  684. Error(SlistINdexError,Index);
  685. Changing;
  686. Flist^[Index].FString:='';
  687. Dec(FCount);
  688. If Index<FCount then
  689. System.Move(Flist^[Index+1],
  690. Flist^[Index],
  691. (Fcount-Index)*SizeOf(TStringItem));
  692. Changed;
  693. end;
  694. Procedure TStringList.Exchange(Index1, Index2: Integer);
  695. begin
  696. If (Index1<0) or (Index1>=FCount) then
  697. Error(SListIndexError,Index1);
  698. If (Index2<0) or (Index2>=FCount) then
  699. Error(SListIndexError,Index2);
  700. Changing;
  701. ExchangeItems(Index1,Index2);
  702. changed;
  703. end;
  704. Function TStringList.Find(const S: string; var Index: Integer): Boolean;
  705. { Searches for the first string <= S, returns True if exact match,
  706. sets index to the index f the found string. }
  707. Var I,L,R,Temp : Longint;
  708. begin
  709. Result:=False;
  710. // Use binary search.
  711. L:=0;
  712. R:=FCount-1;
  713. While L<=R do
  714. begin
  715. I:=(L+R) div 2;
  716. Temp:=AnsiCompareText(FList^ [I].FString,S);
  717. If Temp<0 then
  718. L:=I+1
  719. else
  720. begin
  721. R:=I-1;
  722. If Temp=0 then
  723. begin
  724. Result:=True;
  725. If Duplicates<>DupAccept then L:=I;
  726. end;
  727. end;
  728. end;
  729. Index:=L;
  730. end;
  731. Function TStringList.IndexOf(const S: string): Integer;
  732. begin
  733. If Not Sorted then
  734. Result:=Inherited indexOf(S)
  735. else
  736. // faster using binary search...
  737. If Not Find (S,Result) then
  738. Result:=-1;
  739. end;
  740. Procedure TStringList.Insert(Index: Integer; const S: string);
  741. begin
  742. If Sorted then
  743. Error (SSortedListError,0)
  744. else
  745. If (Index<0) or (Index>FCount) then
  746. Error (SListIndexError,Index)
  747. else
  748. InsertItem (Index,S);
  749. end;
  750. Procedure TStringList.CustomSort(CompareFn: TStringListSortCompare);
  751. begin
  752. If Not Sorted and (FCount>1) then
  753. begin
  754. Changing;
  755. QuickSort(0,FCount-1, CompareFn);
  756. Changed;
  757. end;
  758. end;
  759. function StringListAnsiCompare(List: TStringList; Index1, Index: Integer): Integer;
  760. begin
  761. Result := AnsiCompareText(List.FList^[Index1].FString,
  762. List.FList^[Index].FString);
  763. end;
  764. Procedure TStringList.Sort;
  765. begin
  766. CustomSort(@StringListAnsiCompare);
  767. end;
  768. {
  769. $Log$
  770. Revision 1.2 2004-04-18 19:38:56 michael
  771. + Patch from Colin Western
  772. Revision 1.1 2003/10/06 20:33:58 peter
  773. * classes moved to rtl for 1.1
  774. * classes .inc and classes.pp files moved to fcl/classes for
  775. backwards 1.0.x compatiblity to have it in the fcl
  776. Revision 1.15 2003/05/29 23:13:57 michael
  777. fixed case insensitivity of TStrings.IndexOf
  778. Revision 1.14 2002/12/10 21:05:44 michael
  779. + IndexOfName is case insensitive
  780. Revision 1.13 2002/10/10 12:50:40 michael
  781. + Fix for handling of double quotes in getquotedstring from Luk Vandelaer ([email protected])
  782. Revision 1.12 2002/09/07 15:15:25 peter
  783. * old logs removed and tabs fixed
  784. Revision 1.11 2002/07/17 11:52:01 florian
  785. * at and frame addresses in raise statements changed to pointer; fixed
  786. }