Changeset 425 for Generics/NativeGenerics/Units/GenericList.pas
- Timestamp:
- Sep 21, 2012, 9:19:58 AM (12 years ago)
- File:
-
- 1 edited
-
Generics/NativeGenerics/Units/GenericList.pas (modified) (34 diffs)
Legend:
- Unmodified
- Added
- Removed
-
Generics/NativeGenerics/Units/GenericList.pas
r424 r425 13 13 14 14 TGAbstractList<TItem> = class 15 private 16 FOnUpdate: TNotifyEvent; 17 FUpdateCount: NativeInt; 15 18 public 16 19 type 17 20 TIndex = NativeInt; 21 PItem = ^TItem; 18 22 TSortCompare = function(Item1, Item2: TItem): Integer of object; 19 23 TToStringConverter = function(Item: TItem): string; … … 29 33 function Get(Index: TIndex): TItem; virtual; abstract; 30 34 procedure Put(Index: TIndex; const AValue: TItem); virtual; abstract; 35 function GetInternal(Index: TIndex): TItem; virtual; abstract; 36 procedure PutInternal(Index: TIndex; const AValue: TItem); virtual; abstract; 31 37 procedure QuickSort(L, R : TIndex; Compare: TSortCompare); 38 property ItemsInternal[Index: TIndex]: TItem read GetInternal 39 write PutInternal; 32 40 public 33 41 function Add(const Item: TItem): TIndex; virtual; … … 36 44 procedure AddListPart(List: TGAbstractList<TItem>; ItemIndex, ItemCount: TIndex); 37 45 procedure Assign(Source: TGAbstractList<TItem>); virtual; 46 procedure BeginUpdate; 47 procedure EndUpdate; 48 procedure Update; 38 49 constructor Create; virtual; 39 50 procedure Clear; virtual; … … 46 57 procedure Explode(Text, Separator: string; Converter: TFromStringConverter; SlicesCount: Integer = -1); 47 58 function Extract(Item: TItem): TItem; virtual; 48 procedure Fill(Start, Count: TIndex; Value: TItem); virtual;59 procedure Fill(Start, ACount: TIndex; Value: TItem); virtual; 49 60 function GetArray(Index, ACount: TIndex): TItemArray; virtual; 50 61 procedure GetList(List: TGAbstractList<TItem>; Index, ACount: TIndex); virtual; 62 procedure GetBuffer(Index: TIndex; var Buffer; ACount: TIndex); virtual; 51 63 function IndexOfList(List: TGAbstractList<TItem>; Start: TIndex = 0): TIndex; virtual; 52 64 procedure Insert(const Index: TIndex; Item: TItem); virtual; … … 62 74 procedure ReplaceListPart(const Index: TIndex; Source: TGAbstractList<TItem>; 63 75 SourceIndex, SourceCount: TIndex); virtual; 76 procedure ReplaceBuffer(const Index: TIndex; var Buffer; ACount: TIndex); 64 77 function Remove(const Item: TItem): TIndex; 65 78 procedure Reverse; … … 70 83 property First: TItem read GetFirst write SetFirst; 71 84 property Last: TItem read GetLast write SetLast; 85 property OnUpdate: TNotifyEvent read FOnUpdate write FOnUpdate; 72 86 end; 73 87 … … 80 94 protected 81 95 function Get(Index: TIndex): TItem; override; 96 function GetInternal(Index: TIndex): TItem; override; 82 97 function GetCapacity: TIndex; 83 98 function GetCount: TIndex; override; … … 86 101 procedure SetCount(const AValue: TIndex); override; 87 102 procedure Put(Index: TIndex; const AValue: TItem); override; 103 procedure PutInternal(Index: TIndex; const AValue: TItem); override; 88 104 public 89 105 procedure Fill(Start, Count: TIndex; Value: TItem); override; … … 95 111 end; 96 112 113 { TGObjectList } 114 97 115 TGObjectList<TItem> = class(TGList<TItem>) 98 116 protected … … 100 118 public 101 119 OwnsObjects: Boolean; 120 procedure SetCount(const AValue: TIndex); override; 121 function AddNew(NewObject: TItem = nil): TItem; 102 122 procedure Delete(const Index: Integer); override; 103 123 procedure Clear; override; … … 110 130 private 111 131 public 112 procedure Delete( Index: Integer); override;132 procedure Delete(const Index: Integer); override; 113 133 procedure Clear; override; 114 134 procedure Assign(Source: TGAbstractList<TItem>); override; … … 136 156 end; 137 157 158 { TListByte } 159 160 TListByte = class(TGList<Byte>) 161 procedure WriteToStream(Stream: TStream); 162 procedure WriteToStreamPart(Stream: TStream; ItemIndex, ItemCount: TIndex); 163 procedure ReplaceStream(Stream: TStream); 164 procedure ReplaceStreamPart(Stream: TStream; ItemIndex, ItemCount: TIndex); 165 procedure AddStream(Stream: TStream); 166 procedure AddStreamPart(Stream: TStream; ItemCount: TIndex); 167 procedure WriteBuffer(var Buffer; Count: Integer); 168 procedure ReadBuffer(var Buffer; Count: Integer); 169 end; 170 TListInteger = TGList<Integer>; 171 TListString = TGStringList<string>; 172 TListObject = TGObjectList<TObject>; 173 174 { TListNotifyEvent } 175 176 TListNotifyEvent = class(TGList<TNotifyEvent>) 177 procedure CallAll(Sender: TObject); 178 end; 179 TBaseEvent = procedure of object; 180 181 { TListSimpleEvent } 182 183 TListSimpleEvent = class(TGList<TBaseEvent>) 184 procedure CallAll; 185 end; 186 TListBoolean = TGList<Boolean>; 187 TListDouble = TGList<Double>; 188 189 function StrToStr(Value: string): string; 190 191 138 192 139 193 resourcestring … … 145 199 146 200 { TGList<TItem> } 201 202 function TGList<TItem>.Get(Index: TIndex): TItem; 203 begin 204 if (Index < 0) or (Index >= Count) then 205 raise EListError.CreateFmt(SListIndexError, [Index]); 206 Result := ItemsInternal[Index]; 207 end; 208 209 function TGList<TItem>.GetInternal(Index: TIndex): TItem; 210 begin 211 Result := FItems[Index]; 212 end; 147 213 148 214 function TGList<TItem>.GetCapacity: TIndex; … … 182 248 end; 183 249 184 function TGList<TItem>.Get(Index: TIndex): TItem;250 procedure TGList<TItem>.Put(Index: TIndex; const AValue: TItem); 185 251 begin 186 252 if (Index < 0) or (Index >= Count) then 187 253 raise EListError.CreateFmt(SListIndexError, [Index]); 188 Result := FItems[Index]; 189 end; 190 191 procedure TGList<TItem>.Put(Index: TIndex; const AValue: TItem); 192 begin 193 if (Index < 0) or (Index >= Count) then 194 raise EListError.CreateFmt(SListIndexError, [Index]); 254 ItemsInternal[Index] := AValue; 255 end; 256 257 procedure TGList<TItem>.PutInternal(Index: TIndex; const AValue: TItem); 258 begin 195 259 FItems[Index] := AValue; 196 260 end; … … 214 278 ); 215 279 begin 216 if Source is TGList<TItem>then begin217 System.Move( TGList<TItem>(Source).FItems[0], FItems[Index], Source.Count * SizeOf(TItem));280 if (Source.Count > 0) and (Source is TGList<TItem>) then begin 281 System.Move(PByte(TGList<TItem>(Source).FItems)^, FItems[Index], Source.Count * SizeOf(TItem)); 218 282 end else inherited; 219 283 end; … … 224 288 raise EListError.CreateFmt(SListCountError, [AValue]); 225 289 if AValue > Capacity then SetCapacityOptimized(AValue); // Before FCount change 290 291 if AValue > FCount then // Clear allocated space 292 FillChar(FItems[FCount], (AValue - FCount) * SizeOf(TItem), 0); 226 293 FCount := AValue; 227 294 if AValue < Capacity then SetCapacityOptimized(AValue); // After FCount change … … 230 297 function TGList<TItem>.CompareItem(const Item1, Item2: TItem): Boolean; 231 298 begin 232 Result := Compare Mem(Addr(Item1), Addr(Item2), SizeOf(TItem));299 Result := CompareByte(Item1, Item2, SizeOf(TItem)) = 0; 233 300 end; 234 301 … … 240 307 procedure TGList<TItem>.CopyItems(CurIndex, NewIndex, ACount: TIndex); 241 308 begin 242 System.Move(FItems[CurIndex], FItems[NewIndex], ACount * SizeOf(TItem)); 309 if ACount > 0 then 310 System.Move(FItems[CurIndex], FItems[NewIndex], ACount * SizeOf(TItem)); 243 311 end; 244 312 … … 254 322 procedure TGObjectList<TItem>.Put(Index: Integer; const AValue: TItem); 255 323 begin 256 if OwnsObjects then FItems[Index].Free;324 if OwnsObjects and Assigned(FItems[Index]) then FItems[Index].Free; 257 325 inherited Put(Index, AValue); 258 326 end; 259 327 328 procedure TGObjectList<TItem>.SetCount(const AValue: TIndex); 329 begin 330 if AValue < FCount then 331 Fill(AValue, FCount - AValue, nil); 332 inherited SetCount(AValue); 333 end; 334 335 function TGObjectList<TItem>.AddNew(NewObject: TItem): TItem; 336 begin 337 if Assigned(NewObject) then Result := NewObject 338 else Result := TItem.Create; 339 Add(Result); 340 end; 341 260 342 procedure TGObjectList<TItem>.Delete(const Index: Integer); 261 343 begin 262 if OwnsObjects then FItems[Index].Free; 344 (*if OwnsObjects then begin 345 FItems[Index].Free; 346 FItems[Index] := nil; 347 end;*) 263 348 inherited Delete(Index); 264 349 end; 265 350 266 351 procedure TGObjectList<TItem>.Clear; 267 var 268 I: Integer; 269 begin 270 if OwnsObjects then begin 271 I := 0; 272 while I < Count do begin 273 FItems[I].Free; 274 I := I + 1; 275 end; 276 end; 352 begin 353 Fill(0, Count, nil); 277 354 inherited Clear; 278 355 end; … … 287 364 begin 288 365 Clear; 289 inherited Destroy;366 inherited; 290 367 end; 291 368 … … 298 375 end; 299 376 300 procedure TGStringList<TItem>.Delete( Index: Integer);377 procedure TGStringList<TItem>.Delete(const Index: Integer); 301 378 begin 302 379 FItems[Index] := ''; … … 366 443 P, Q: TItem; 367 444 begin 368 repeat369 I := L;370 J := R;371 P := Items[(L + R) div 2];372 repeat373 while Compare(P, Items[I]) > 0 do374 I := I + 1;375 while Compare(P, Items[J]) < 0 do376 J := J - 1;377 if I <= J then378 begin379 Q := Items[I];380 Items[I] := Items[J];381 Items[J] := Q;382 I := I + 1;383 J := J - 1;384 end;385 until I > J;386 if L < J then387 QuickSort(L, J, Compare);388 L := I;445 repeat 446 I := L; 447 J := R; 448 P := ItemsInternal[(L + R) div 2]; 449 repeat 450 while Compare(P, ItemsInternal[I]) > 0 do 451 I := I + 1; 452 while Compare(P, ItemsInternal[J]) < 0 do 453 J := J - 1; 454 if I <= J then 455 begin 456 Q := ItemsInternal[I]; 457 ItemsInternal[I] := ItemsInternal[J]; 458 ItemsInternal[J] := Q; 459 I := I + 1; 460 J := J - 1; 461 end; 462 until I > J; 463 if L < J then 464 QuickSort(L, J, Compare); 465 L := I; 389 466 until I >= R; 390 467 end; … … 406 483 procedure TGAbstractList<TItem>.DeleteItems(const Index, ACount: TIndex); 407 484 begin 408 if (Index < 0) or (Index >= (Count - ACount)) then485 if (Index < 0) or (Index >= Count) then 409 486 raise EListError.CreateFmt(SListIndexError, [Index]); 410 CopyItems(Index + ACount, Index, Count - Index - ACount);487 MoveItems(Index + ACount, Index, Count - Index - ACount); 411 488 //SetCapacityOptimized(Capacity - ACount); 489 412 490 Count := Count - ACount; 413 491 end; … … 438 516 if ((Index2 >= Count) or (Index2 < 0)) then 439 517 raise EListError.CreateFmt(SListIndexError, [Index2]); 440 Temp := Items [Index1];441 Items [Index1] := Items[Index2];442 Items [Index2] := Temp;518 Temp := ItemsInternal[Index1]; 519 ItemsInternal[Index1] := ItemsInternal[Index2]; 520 ItemsInternal[Index2] := Temp; 443 521 end; 444 522 … … 467 545 end; 468 546 469 procedure TGAbstractList<TItem>.Fill(Start, Count: TIndex; Value: TItem);547 procedure TGAbstractList<TItem>.Fill(Start, ACount: TIndex; Value: TItem); 470 548 var 471 549 I: TIndex; 472 550 begin 473 551 I := Start; 474 while I < Countdo begin552 while I < (Start + ACount) do begin 475 553 Items[I] := Value; 476 554 I := I + 1; … … 494 572 List.Clear; 495 573 List.AddListPart(Self, Index, ACount); 574 end; 575 576 procedure TGAbstractList<TItem>.GetBuffer(Index: TIndex; var Buffer; 577 ACount: TIndex); 578 var 579 P: PItem; 580 I: TIndex; 581 begin 582 if (Index + ACount) > Count then 583 raise EListError.CreateFmt(SListIndexError, [Index + ACount]); 584 P := PItem(@Buffer); 585 I := 0; 586 while I < ACount do begin 587 P^ := Items[Index + I]; 588 Inc(P, 1); 589 I := I + 1; 590 end; 496 591 end; 497 592 … … 529 624 raise EListError.CreateFmt(SListIndexError, [Index]); 530 625 InsertCount(Index, 1); 531 Items [Index] := Item;626 ItemsInternal[Index] := Item; 532 627 end; 533 628 … … 579 674 I := 0; 580 675 while I < ACount do begin 581 Items [NewIndex] := Items[CurIndex];676 ItemsInternal[NewIndex] := ItemsInternal[CurIndex]; 582 677 CurIndex := CurIndex + 1; 583 678 NewIndex := NewIndex + 1; … … 589 684 CurIndex := CurIndex + ACount - 1; 590 685 while I >= 0 do begin 591 Items [NewIndex] := Items[CurIndex];686 ItemsInternal[NewIndex] := ItemsInternal[CurIndex]; 592 687 NewIndex := NewIndex - 1; 593 688 CurIndex := CurIndex - 1; … … 605 700 ACount: TIndex); 606 701 var 607 I: Integer;702 // I: Integer; 608 703 Temp: TGList<TItem>; 609 704 begin 705 if (ACount > 0) and (NewIndex <> CurIndex) then 610 706 try 611 707 Temp := TGList<TItem>.Create; 612 Temp.AddListPart(Self, NewIndex, ACount); 613 CopyItems(CurIndex, NewIndex, ACount); 614 ReplaceList(CurIndex, Temp); 708 if NewIndex > CurIndex then begin 709 Temp.AddListPart(Self, CurIndex, ACount); 710 CopyItems(CurIndex + ACount, CurIndex, NewIndex - CurIndex); 711 ReplaceList(NewIndex, Temp); 712 end else 713 if NewIndex < CurIndex then begin 714 Temp.AddListPart(Self, CurIndex, ACount); 715 CopyItems(NewIndex, NewIndex + ACount, CurIndex - NewIndex); 716 ReplaceList(NewIndex, Temp); 717 end; 615 718 finally 616 719 Temp.Free; … … 650 753 while I < SourceCount do begin 651 754 Items[Index + I] := Source[SourceIndex + I]; 755 I := I + 1; 756 end; 757 end; 758 759 procedure TGAbstractList<TItem>.ReplaceBuffer(const Index: TIndex; var Buffer; 760 ACount: TIndex); 761 var 762 P: PItem; 763 I: TIndex; 764 begin 765 if (Index + ACount) > Count then 766 raise EListError.CreateFmt(SListIndexError, [Index + ACount]); 767 P := PItem(@Buffer); 768 I := 0; 769 while I < ACount do begin 770 Items[Index + I] := P^; 771 Inc(P, 1); 652 772 I := I + 1; 653 773 end; … … 694 814 Count := Count + 1; 695 815 Result := Count - 1; 696 Items [Result] := Item;816 ItemsInternal[Result] := Item; 697 817 end; 698 818 … … 724 844 begin 725 845 Count := Source.Count; 726 ReplaceList(0, Source); 846 if Count > 0 then ReplaceList(0, Source); 847 end; 848 849 procedure TGAbstractList<TItem>.BeginUpdate; 850 begin 851 Inc(FUpdateCount); 852 end; 853 854 procedure TGAbstractList<TItem>.EndUpdate; 855 begin 856 Dec(FUpdateCount); 857 Update; 858 end; 859 860 procedure TGAbstractList<TItem>.Update; 861 begin 862 if Assigned(FOnUpdate) and (FUpdateCount = 0) then FOnUpdate(Self); 727 863 end; 728 864 … … 788 924 end; 789 925 926 function StrToStr(Value: string): string; 927 begin 928 Result := Value; 929 end; 930 931 { TListSimpleEvent } 932 933 procedure TListSimpleEvent.CallAll; 934 var 935 I: TIndex; 936 begin 937 I := 0; 938 while (I < Count) do begin 939 Items[I](); 940 I := I + 1; 941 end; 942 end; 943 944 { TListNotifyEvent } 945 946 procedure TListNotifyEvent.CallAll(Sender: TObject); 947 var 948 I: TIndex; 949 begin 950 I := 0; 951 while (I < Count) do begin 952 Items[I](Sender); 953 I := I + 1; 954 end; 955 end; 956 957 { TListByte } 958 959 procedure TListByte.WriteToStream(Stream: TStream); 960 var 961 I: Integer; 962 begin 963 Stream.Position := 0; 964 I := 0; 965 while I < Count do begin 966 Stream.WriteByte(Items[I]); 967 I := I + 1; 968 end; 969 end; 970 971 procedure TListByte.WriteToStreamPart(Stream: TStream; ItemIndex, ItemCount: TIndex); 972 var 973 I: Integer; 974 begin 975 I := ItemIndex; 976 while I < ItemCount do begin 977 Stream.WriteByte(Items[I]); 978 I := I + 1; 979 end; 980 end; 981 982 procedure TListByte.ReplaceStream(Stream: TStream); 983 var 984 I: Integer; 985 begin 986 Stream.Position := 0; 987 I := 0; 988 while I < Count do begin 989 Items[I] := Stream.ReadByte; 990 I := I + 1; 991 end; 992 end; 993 994 procedure TListByte.ReplaceStreamPart(Stream: TStream; ItemIndex, 995 ItemCount: TIndex); 996 var 997 I: Integer; 998 begin 999 I := ItemIndex; 1000 while I < ItemCount do begin 1001 Items[I] := Stream.ReadByte; 1002 I := I + 1; 1003 end; 1004 end; 1005 1006 procedure TListByte.AddStream(Stream: TStream); 1007 var 1008 I: Integer; 1009 begin 1010 Stream.Position := 0; 1011 I := Count; 1012 Count := Count + Stream.Size; 1013 while I < Count do begin 1014 Items[I] := Stream.ReadByte; 1015 I := I + 1; 1016 end; 1017 end; 1018 1019 procedure TListByte.AddStreamPart(Stream: TStream; ItemCount: TIndex); 1020 var 1021 I: Integer; 1022 begin 1023 I := Count; 1024 Count := Count + ItemCount; 1025 while I < Count do begin 1026 Items[I] := Stream.ReadByte; 1027 I := I + 1; 1028 end; 1029 end; 1030 1031 procedure TListByte.WriteBuffer(var Buffer; Count: Integer); 1032 begin 1033 1034 end; 1035 1036 procedure TListByte.ReadBuffer(var Buffer; Count: Integer); 1037 begin 1038 1039 end; 1040 790 1041 end.
Note:
See TracChangeset
for help on using the changeset viewer.
