Changeset 425


Ignore:
Timestamp:
Sep 21, 2012, 9:19:58 AM (12 years ago)
Author:
chronos
Message:
Location:
Generics/NativeGenerics
Files:
4 added
6 edited

Legend:

Unmodified
Added
Removed

  • Generics/NativeGenerics/Demo/Demo.lpi

    r424 r425  
    3838      </Item2>
    3939    </RequiredPackages>
    40     <Units Count="74">
     40    <Units Count="75">
    4141      <Unit0>
    4242        <Filename Value="Demo.lpr"/>
    … …  
    4545        <WindowIndex Value="0"/>
    4646        <TopLine Value="1"/>
    47         <CursorPos X="26" Y="8"/>
     47        <CursorPos X="27" Y="16"/>
    4848        <UsageCount Value="233"/>
    4949        <DefaultSyntaxHighlighter Value="Delphi"/>
    … …  
    5959        <WindowIndex Value="0"/>
    6060        <TopLine Value="652"/>
    61         <CursorPos X="15" Y="33"/>
     61        <CursorPos X="11" Y="657"/>
    6262        <UsageCount Value="233"/>
    6363        <Bookmarks Count="1">
    … …  
    348348        <EditorIndex Value="5"/>
    349349        <WindowIndex Value="0"/>
    350         <TopLine Value="190"/>
    351         <CursorPos X="56" Y="205"/>
    352         <UsageCount Value="63"/>
     350        <TopLine Value="31"/>
     351        <CursorPos X="28" Y="44"/>
     352        <UsageCount Value="64"/>
    353353        <Loaded Value="True"/>
    354354      </Unit35>
    … …  
    360360        <TopLine Value="127"/>
    361361        <CursorPos X="51" Y="143"/>
    362         <UsageCount Value="39"/>
     362        <UsageCount Value="40"/>
    363363        <Loaded Value="True"/>
    364364      </Unit36>
    … …  
    550550        <EditorIndex Value="8"/>
    551551        <WindowIndex Value="0"/>
    552         <TopLine Value="576"/>
    553         <CursorPos X="28" Y="587"/>
    554         <UsageCount Value="11"/>
     552        <TopLine Value="582"/>
     553        <CursorPos X="11" Y="595"/>
     554        <UsageCount Value="12"/>
    555555        <Loaded Value="True"/>
    556556      </Unit61>
    … …  
    602602        <EditorIndex Value="6"/>
    603603        <WindowIndex Value="0"/>
    604         <TopLine Value="71"/>
     604        <TopLine Value="72"/>
    605605        <CursorPos X="10" Y="84"/>
    606         <UsageCount Value="10"/>
     606        <UsageCount Value="11"/>
    607607        <Loaded Value="True"/>
    608608      </Unit68>
    … …  
    613613        <TopLine Value="257"/>
    614614        <CursorPos X="14" Y="270"/>
    615         <UsageCount Value="10"/>
     615        <UsageCount Value="11"/>
    616616        <Loaded Value="True"/>
    617617      </Unit69>
    … …  
    622622        <TopLine Value="736"/>
    623623        <CursorPos X="3" Y="738"/>
    624         <UsageCount Value="10"/>
     624        <UsageCount Value="11"/>
    625625        <Loaded Value="True"/>
    626626      </Unit70>
    … …  
    631631        <TopLine Value="199"/>
    632632        <CursorPos X="3" Y="205"/>
    633         <UsageCount Value="10"/>
     633        <UsageCount Value="11"/>
    634634        <Loaded Value="True"/>
    635635      </Unit71>
    … …  
    638638        <EditorIndex Value="7"/>
    639639        <WindowIndex Value="0"/>
    640         <TopLine Value="167"/>
    641         <CursorPos X="3" Y="169"/>
    642         <UsageCount Value="10"/>
     640        <TopLine Value="181"/>
     641        <CursorPos X="3" Y="187"/>
     642        <UsageCount Value="11"/>
    643643        <Loaded Value="True"/>
    644644      </Unit72>
    645645      <Unit73>
    646646        <Filename Value="../../../../../Lazarus/1.1_2.7.1/fpc/2.7.1/source/rtl/i386/i386.inc"/>
     647        <EditorIndex Value="10"/>
     648        <WindowIndex Value="0"/>
     649        <TopLine Value="503"/>
     650        <CursorPos X="9" Y="503"/>
     651        <UsageCount Value="11"/>
     652        <Loaded Value="True"/>
     653      </Unit73>
     654      <Unit74>
     655        <Filename Value="../../../../../Lazarus/1.1_2.7.1/fpc/2.7.1/source/rtl/inc/system.inc"/>
    647656        <EditorIndex Value="9"/>
    648657        <WindowIndex Value="0"/>
    649         <TopLine Value="224"/>
    650         <CursorPos X="11" Y="213"/>
    651         <UsageCount Value="10"/>
    652         <Loaded Value="True"/>
    653       </Unit73>
     658        <TopLine Value="277"/>
     659        <CursorPos X="14" Y="285"/>
     660        <UsageCount Value="11"/>
     661        <Loaded Value="True"/>
     662      </Unit74>
    654663    </Units>
    655664    <JumpHistory Count="30" HistoryIndex="29">
    656665      <Position1>
    657         <Filename Value="../Units/GenericList.pas"/>
    658         <Caret Line="601" Column="1" TopLine="588"/>
     666        <Filename Value="UMainForm.pas"/>
     667        <Caret Line="657" Column="1" TopLine="652"/>
    659668      </Position1>
    660669      <Position2>
    661670        <Filename Value="../Units/GenericList.pas"/>
    662         <Caret Line="188" Column="1" TopLine="175"/>
     671        <Caret Line="237" Column="1" TopLine="229"/>
    663672      </Position2>
    664673      <Position3>
    665         <Filename Value="UMainForm.pas"/>
    666         <Caret Line="611" Column="1" TopLine="599"/>
     674        <Filename Value="../Units/GenericList.pas"/>
     675        <Caret Line="239" Column="1" TopLine="229"/>
    667676      </Position3>
    668677      <Position4>
    669         <Filename Value="../Units/GenericList.pas"/>
    670         <Caret Line="602" Column="1" TopLine="589"/>
     678        <Filename Value="UMainForm.pas"/>
     679        <Caret Line="658" Column="1" TopLine="652"/>
    671680      </Position4>
    672681      <Position5>
    673         <Filename Value="../Units/GenericList.pas"/>
    674         <Caret Line="611" Column="1" TopLine="590"/>
     682        <Filename Value="UMainForm.pas"/>
     683        <Caret Line="657" Column="1" TopLine="652"/>
    675684      </Position5>
    676685      <Position6>
    677686        <Filename Value="../Units/GenericList.pas"/>
    678         <Caret Line="612" Column="1" TopLine="591"/>
     687        <Caret Line="238" Column="1" TopLine="229"/>
    679688      </Position6>
    680689      <Position7>
    681690        <Filename Value="../Units/GenericList.pas"/>
    682         <Caret Line="394" Column="1" TopLine="381"/>
     691        <Caret Line="239" Column="1" TopLine="229"/>
    683692      </Position7>
    684693      <Position8>
    685694        <Filename Value="../Units/GenericList.pas"/>
    686         <Caret Line="395" Column="1" TopLine="381"/>
     695        <Caret Line="521" Column="1" TopLine="508"/>
    687696      </Position8>
    688697      <Position9>
    689698        <Filename Value="../Units/GenericList.pas"/>
    690         <Caret Line="613" Column="1" TopLine="600"/>
     699        <Caret Line="522" Column="1" TopLine="508"/>
    691700      </Position9>
    692701      <Position10>
    … …  
    700709      <Position12>
    701710        <Filename Value="../Units/GenericList.pas"/>
    702         <Caret Line="720" Column="1" TopLine="707"/>
     711        <Caret Line="187" Column="1" TopLine="174"/>
    703712      </Position12>
    704713      <Position13>
    705714        <Filename Value="../Units/GenericList.pas"/>
    706         <Caret Line="617" Column="35" TopLine="600"/>
     715        <Caret Line="238" Column="1" TopLine="225"/>
    707716      </Position13>
    708717      <Position14>
    709         <Filename Value="UMainForm.pas"/>
    710         <Caret Line="611" Column="1" TopLine="599"/>
     718        <Filename Value="../Units/GenericList.pas"/>
     719        <Caret Line="239" Column="1" TopLine="225"/>
    711720      </Position14>
    712721      <Position15>
    713722        <Filename Value="../Units/GenericList.pas"/>
    714         <Caret Line="602" Column="1" TopLine="597"/>
     723        <Caret Line="189" Column="1" TopLine="176"/>
    715724      </Position15>
    716725      <Position16>
    717726        <Filename Value="../Units/GenericList.pas"/>
    718         <Caret Line="611" Column="1" TopLine="597"/>
     727        <Caret Line="190" Column="1" TopLine="176"/>
    719728      </Position16>
    720729      <Position17>
    721730        <Filename Value="../Units/GenericList.pas"/>
    722         <Caret Line="612" Column="1" TopLine="597"/>
     731        <Caret Line="233" Column="1" TopLine="220"/>
    723732      </Position17>
    724733      <Position18>
    725734        <Filename Value="../Units/GenericList.pas"/>
    726         <Caret Line="613" Column="1" TopLine="597"/>
     735        <Caret Line="234" Column="1" TopLine="220"/>
    727736      </Position18>
    728737      <Position19>
    729738        <Filename Value="../Units/GenericList.pas"/>
    730         <Caret Line="720" Column="1" TopLine="707"/>
     739        <Caret Line="238" Column="1" TopLine="220"/>
    731740      </Position19>
    732741      <Position20>
    733742        <Filename Value="../Units/GenericList.pas"/>
    734         <Caret Line="721" Column="1" TopLine="707"/>
     743        <Caret Line="239" Column="1" TopLine="220"/>
    735744      </Position20>
    736745      <Position21>
    737746        <Filename Value="../Units/GenericList.pas"/>
    738         <Caret Line="722" Column="1" TopLine="707"/>
     747        <Caret Line="187" Column="1" TopLine="174"/>
    739748      </Position21>
    740749      <Position22>
    741750        <Filename Value="../Units/GenericList.pas"/>
    742         <Caret Line="614" Column="1" TopLine="601"/>
     751        <Caret Line="238" Column="1" TopLine="225"/>
    743752      </Position22>
    744753      <Position23>
    745754        <Filename Value="../Units/GenericList.pas"/>
    746         <Caret Line="615" Column="1" TopLine="601"/>
     755        <Caret Line="239" Column="1" TopLine="225"/>
    747756      </Position23>
    748757      <Position24>
    749         <Filename Value="UMainForm.pas"/>
    750         <Caret Line="33" Column="15" TopLine="403"/>
     758        <Filename Value="../Units/GenericList.pas"/>
     759        <Caret Line="189" Column="1" TopLine="176"/>
    751760      </Position24>
    752761      <Position25>
    753         <Filename Value="../../../../../Lazarus/1.1_2.7.1/fpc/2.7.1/source/rtl/objpas/classes/stringl.inc"/>
    754         <Caret Line="1285" Column="3" TopLine="1282"/>
     762        <Filename Value="../Units/GenericList.pas"/>
     763        <Caret Line="190" Column="1" TopLine="176"/>
    755764      </Position25>
    756765      <Position26>
    757         <Filename Value="UMainForm.pas"/>
    758         <Caret Line="33" Column="15" TopLine="652"/>
     766        <Filename Value="../Units/GenericList.pas"/>
     767        <Caret Line="233" Column="1" TopLine="220"/>
    759768      </Position26>
    760769      <Position27>
    761770        <Filename Value="../Units/GenericList.pas"/>
    762         <Caret Line="232" Column="3" TopLine="229"/>
     771        <Caret Line="234" Column="1" TopLine="220"/>
    763772      </Position27>
    764773      <Position28>
    765         <Filename Value="../../../../../Lazarus/1.1_2.7.1/fpc/2.7.1/source/rtl/objpas/sysutils/sysstr.inc"/>
    766         <Caret Line="169" Column="3" TopLine="167"/>
     774        <Filename Value="../Units/GenericList.pas"/>
     775        <Caret Line="238" Column="1" TopLine="220"/>
    767776      </Position28>
    768777      <Position29>
    769778        <Filename Value="../Units/GenericList.pas"/>
    770         <Caret Line="200" Column="10" TopLine="197"/>
     779        <Caret Line="239" Column="1" TopLine="220"/>
    771780      </Position29>
    772781      <Position30>
    773         <Filename Value="../Units/GenericList.pas"/>
    774         <Caret Line="203" Column="42" TopLine="190"/>
     782        <Filename Value="UMainForm.pas"/>
     783        <Caret Line="657" Column="11" TopLine="652"/>
    775784      </Position30>
    776785    </JumpHistory>
    … …  
    821830  </CompilerOptions>
    822831  <Debugging>
    823     <BreakPoints Count="1">
     832    <BreakPoints Count="2">
    824833      <Item1>
    825834        <Kind Value="bpkSource"/>
    … …  
    829838        <Line Value="206"/>
    830839      </Item1>
     840      <Item2>
     841        <Kind Value="bpkSource"/>
     842        <WatchScope Value="wpsLocal"/>
     843        <WatchKind Value="wpkWrite"/>
     844        <Source Value="UMainForm.pas"/>
     845        <Line Value="657"/>
     846      </Item2>
    831847    </BreakPoints>
    832848    <Exceptions Count="3">

  • Generics/NativeGenerics/NativeGenerics.lpk

    r324 r425  
    55    <Name Value="NativeGenerics"/>
    66    <AddToProjectUsesSection Value="True"/>
    7     <Author Value="Chronos"/>
     7    <Author Value="Chronos (robie@centrum.cz)"/>
    88    <CompilerOptions>
    99      <Version Value="11"/>
    1010      <PathDelim Value="\"/>
    1111      <SearchPaths>
    12         <OtherUnitFiles Value="Units"/>
     12        <OtherUnitFiles Value="Units;Additional"/>
    1313        <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
    1414      </SearchPaths>
    … …  
    2525      </Other>
    2626    </CompilerOptions>
    27     <Description Value="Native generics library."/>
     27    <Description Value="Native generics library.
     28Require FPC 2.7.1"/>
    2829    <License Value="GNU/GPL"/>
    29     <Version Minor="1"/>
    30     <Files Count="12">
     30    <Version Minor="2"/>
     31    <Files Count="15">
    3132      <Item1>
    3233        <Filename Value="ReadMe.txt"/>
    … …  
    7778        <UnitName Value="GenericBitmap"/>
    7879      </Item12>
     80      <Item13>
     81        <Filename Value="Units\GenericRectangle.pas"/>
     82        <UnitName Value="GenericRectangle"/>
     83      </Item13>
     84      <Item14>
     85        <Filename Value="Units\GenericPoint.pas"/>
     86        <UnitName Value="GenericPoint"/>
     87      </Item14>
     88      <Item15>
     89        <Filename Value="Additional\UBinarySerializer.pas"/>
     90        <UnitName Value="UBinarySerializer"/>
     91      </Item15>
    7992    </Files>
    8093    <Type Value="RunAndDesignTime"/>

  • Generics/NativeGenerics/NativeGenerics.pas

    r324 r425  
    1010  GenericList, GenericTree, GenericDictionary, GenericQueue, GenericRange,
    1111  GenericSet, GenericStack, GenericStream, GenericMatrix, GenericString,
    12   GenericBitmap, LazarusPackageIntf;
     12  GenericBitmap, GenericRectangle, GenericPoint, UBinarySerializer,
     13  LazarusPackageIntf;
    1314
    1415implementation

  • Generics/NativeGenerics/Units/GenericList.pas

    r424 r425  
    1313
    1414  TGAbstractList<TItem> = class
     15  private
     16    FOnUpdate: TNotifyEvent;
     17    FUpdateCount: NativeInt;
    1518  public
    1619  type
    1720    TIndex = NativeInt;
     21    PItem = ^TItem;
    1822    TSortCompare = function(Item1, Item2: TItem): Integer of object;
    1923    TToStringConverter = function(Item: TItem): string;
    … …  
    2933    function Get(Index: TIndex): TItem; virtual; abstract;
    3034    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;
    3137    procedure QuickSort(L, R : TIndex; Compare: TSortCompare);
     38    property ItemsInternal[Index: TIndex]: TItem read GetInternal
     39      write PutInternal;
    3240  public
    3341    function Add(const Item: TItem): TIndex; virtual;
    … …  
    3644    procedure AddListPart(List: TGAbstractList<TItem>; ItemIndex, ItemCount: TIndex);
    3745    procedure Assign(Source: TGAbstractList<TItem>); virtual;
     46    procedure BeginUpdate;
     47    procedure EndUpdate;
     48    procedure Update;
    3849    constructor Create; virtual;
    3950    procedure Clear; virtual;
    … …  
    4657    procedure Explode(Text, Separator: string; Converter: TFromStringConverter; SlicesCount: Integer = -1);
    4758    function Extract(Item: TItem): TItem; virtual;
    48     procedure Fill(Start, Count: TIndex; Value: TItem); virtual;
     59    procedure Fill(Start, ACount: TIndex; Value: TItem); virtual;
    4960    function GetArray(Index, ACount: TIndex): TItemArray; virtual;
    5061    procedure GetList(List: TGAbstractList<TItem>; Index, ACount: TIndex); virtual;
     62    procedure GetBuffer(Index: TIndex; var Buffer; ACount: TIndex); virtual;
    5163    function IndexOfList(List: TGAbstractList<TItem>; Start: TIndex = 0): TIndex; virtual;
    5264    procedure Insert(const Index: TIndex; Item: TItem); virtual;
    … …  
    6274    procedure ReplaceListPart(const Index: TIndex; Source: TGAbstractList<TItem>;
    6375      SourceIndex, SourceCount: TIndex); virtual;
     76    procedure ReplaceBuffer(const Index: TIndex; var Buffer; ACount: TIndex);
    6477    function Remove(const Item: TItem): TIndex;
    6578    procedure Reverse;
    … …  
    7083    property First: TItem read GetFirst write SetFirst;
    7184    property Last: TItem read GetLast write SetLast;
     85    property OnUpdate: TNotifyEvent read FOnUpdate write FOnUpdate;
    7286  end;
    7387
    … …  
    8094  protected
    8195    function Get(Index: TIndex): TItem; override;
     96    function GetInternal(Index: TIndex): TItem; override;
    8297    function GetCapacity: TIndex;
    8398    function GetCount: TIndex; override;
    … …  
    86101    procedure SetCount(const AValue: TIndex); override;
    87102    procedure Put(Index: TIndex; const AValue: TItem); override;
     103    procedure PutInternal(Index: TIndex; const AValue: TItem); override;
    88104  public
    89105    procedure Fill(Start, Count: TIndex; Value: TItem); override;
    … …  
    95111  end;
    96112
     113  { TGObjectList }
     114
    97115  TGObjectList<TItem> = class(TGList<TItem>)
    98116  protected
    … …  
    100118  public
    101119    OwnsObjects: Boolean;
     120    procedure SetCount(const AValue: TIndex); override;
     121    function AddNew(NewObject: TItem = nil): TItem;
    102122    procedure Delete(const Index: Integer); override;
    103123    procedure Clear; override;
    … …  
    110130  private
    111131  public
    112     procedure Delete(Index: Integer); override;
     132    procedure Delete(const Index: Integer); override;
    113133    procedure Clear; override;
    114134    procedure Assign(Source: TGAbstractList<TItem>); override;
    … …  
    136156  end;
    137157
     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
     189function StrToStr(Value: string): string;
     190
     191
    138192
    139193resourcestring
    … …  
    145199
    146200{ TGList<TItem> }
     201
     202function TGList<TItem>.Get(Index: TIndex): TItem;
     203begin
     204  if (Index < 0) or (Index >= Count) then
     205    raise EListError.CreateFmt(SListIndexError, [Index]);
     206  Result := ItemsInternal[Index];
     207end;
     208
     209function TGList<TItem>.GetInternal(Index: TIndex): TItem;
     210begin
     211  Result := FItems[Index];
     212end;
    147213
    148214function TGList<TItem>.GetCapacity: TIndex;
    … …  
    182248end;
    183249
    184 function TGList<TItem>.Get(Index: TIndex): TItem;
     250procedure TGList<TItem>.Put(Index: TIndex; const AValue: TItem);
    185251begin
    186252  if (Index < 0) or (Index >= Count) then
    187253    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;
     255end;
     256
     257procedure TGList<TItem>.PutInternal(Index: TIndex; const AValue: TItem);
     258begin
    195259  FItems[Index] := AValue;
    196260end;
    … …  
    214278  );
    215279begin
    216   if Source is TGList<TItem> then begin
    217     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));
    218282  end else inherited;
    219283end;
    … …  
    224288    raise EListError.CreateFmt(SListCountError, [AValue]);
    225289  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);
    226293  FCount := AValue;
    227294  if AValue < Capacity then SetCapacityOptimized(AValue); // After FCount change
    … …  
    230297function TGList<TItem>.CompareItem(const Item1, Item2: TItem): Boolean;
    231298begin
    232   Result := CompareMem(Addr(Item1), Addr(Item2), SizeOf(TItem));
     299  Result := CompareByte(Item1, Item2, SizeOf(TItem)) = 0;
    233300end;
    234301
    … …  
    240307procedure TGList<TItem>.CopyItems(CurIndex, NewIndex, ACount: TIndex);
    241308begin
    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));
    243311end;
    244312
    … …  
    254322procedure TGObjectList<TItem>.Put(Index: Integer; const AValue: TItem);
    255323begin
    256   if OwnsObjects then FItems[Index].Free;
     324  if OwnsObjects and Assigned(FItems[Index]) then FItems[Index].Free;
    257325  inherited Put(Index, AValue);
    258326end;
    259327
     328procedure TGObjectList<TItem>.SetCount(const AValue: TIndex);
     329begin
     330  if AValue < FCount then
     331    Fill(AValue, FCount - AValue, nil);
     332  inherited SetCount(AValue);
     333end;
     334
     335function TGObjectList<TItem>.AddNew(NewObject: TItem): TItem;
     336begin
     337  if Assigned(NewObject) then Result := NewObject
     338    else Result := TItem.Create;
     339  Add(Result);
     340end;
     341
    260342procedure TGObjectList<TItem>.Delete(const Index: Integer);
    261343begin
    262   if OwnsObjects then FItems[Index].Free;
     344  (*if OwnsObjects then begin
     345    FItems[Index].Free;
     346    FItems[Index] := nil;
     347  end;*)
    263348  inherited Delete(Index);
    264349end;
    265350
    266351procedure 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;
     352begin
     353  Fill(0, Count, nil);
    277354  inherited Clear;
    278355end;
    … …  
    287364begin
    288365  Clear;
    289   inherited Destroy;
     366  inherited;
    290367end;
    291368
    … …  
    298375end;
    299376
    300 procedure TGStringList<TItem>.Delete(Index: Integer);
     377procedure TGStringList<TItem>.Delete(const Index: Integer);
    301378begin
    302379  FItems[Index] := '';
    … …  
    366443  P, Q: TItem;
    367444begin
    368  repeat
    369    I := L;
    370    J := R;
    371    P := Items[(L + R) div 2];
    372    repeat
    373      while Compare(P, Items[I]) > 0 do
    374        I := I + 1;
    375      while Compare(P, Items[J]) < 0 do
    376        J := J - 1;
    377      if I <= J then
    378      begin
    379        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 then
    387      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;
    389466  until I >= R;
    390467end;
    … …  
    406483procedure TGAbstractList<TItem>.DeleteItems(const Index, ACount: TIndex);
    407484begin
    408   if (Index < 0) or (Index >= (Count - ACount)) then
     485  if (Index < 0) or (Index >= Count) then
    409486    raise EListError.CreateFmt(SListIndexError, [Index]);
    410   CopyItems(Index + ACount, Index, Count - Index - ACount);
     487  MoveItems(Index + ACount, Index, Count - Index - ACount);
    411488  //SetCapacityOptimized(Capacity - ACount);
     489
    412490  Count := Count - ACount;
    413491end;
    … …  
    438516  if ((Index2 >= Count) or (Index2 < 0)) then
    439517    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;
    443521end;
    444522
    … …  
    467545end;
    468546
    469 procedure TGAbstractList<TItem>.Fill(Start, Count: TIndex; Value: TItem);
     547procedure TGAbstractList<TItem>.Fill(Start, ACount: TIndex; Value: TItem);
    470548var
    471549  I: TIndex;
    472550begin
    473551  I := Start;
    474   while I < Count do begin
     552  while I < (Start + ACount) do begin
    475553    Items[I] := Value;
    476554    I := I + 1;
    … …  
    494572  List.Clear;
    495573  List.AddListPart(Self, Index, ACount);
     574end;
     575
     576procedure TGAbstractList<TItem>.GetBuffer(Index: TIndex; var Buffer;
     577  ACount: TIndex);
     578var
     579  P: PItem;
     580  I: TIndex;
     581begin
     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;
    496591end;
    497592
    … …  
    529624    raise EListError.CreateFmt(SListIndexError, [Index]);
    530625  InsertCount(Index, 1);
    531   Items[Index] := Item;
     626  ItemsInternal[Index] := Item;
    532627end;
    533628
    … …  
    579674    I := 0;
    580675    while I < ACount do begin
    581       Items[NewIndex] := Items[CurIndex];
     676      ItemsInternal[NewIndex] := ItemsInternal[CurIndex];
    582677      CurIndex := CurIndex + 1;
    583678      NewIndex := NewIndex + 1;
    … …  
    589684    CurIndex := CurIndex + ACount - 1;
    590685    while I >= 0 do begin
    591       Items[NewIndex] := Items[CurIndex];
     686      ItemsInternal[NewIndex] := ItemsInternal[CurIndex];
    592687      NewIndex := NewIndex - 1;
    593688      CurIndex := CurIndex - 1;
    … …  
    605700  ACount: TIndex);
    606701var
    607   I: Integer;
     702//  I: Integer;
    608703  Temp: TGList<TItem>;
    609704begin
     705  if (ACount > 0) and (NewIndex <> CurIndex) then
    610706  try
    611707    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;
    615718  finally
    616719    Temp.Free;
    … …  
    650753  while I < SourceCount do begin
    651754    Items[Index + I] := Source[SourceIndex + I];
     755    I := I + 1;
     756  end;
     757end;
     758
     759procedure TGAbstractList<TItem>.ReplaceBuffer(const Index: TIndex; var Buffer;
     760  ACount: TIndex);
     761var
     762  P: PItem;
     763  I: TIndex;
     764begin
     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);
    652772    I := I + 1;
    653773  end;
    … …  
    694814  Count := Count + 1;
    695815  Result := Count - 1;
    696   Items[Result] := Item;
     816  ItemsInternal[Result] := Item;
    697817end;
    698818
    … …  
    724844begin
    725845  Count := Source.Count;
    726   ReplaceList(0, Source);
     846  if Count > 0 then ReplaceList(0, Source);
     847end;
     848
     849procedure TGAbstractList<TItem>.BeginUpdate;
     850begin
     851  Inc(FUpdateCount);
     852end;
     853
     854procedure TGAbstractList<TItem>.EndUpdate;
     855begin
     856  Dec(FUpdateCount);
     857  Update;
     858end;
     859
     860procedure TGAbstractList<TItem>.Update;
     861begin
     862  if Assigned(FOnUpdate) and (FUpdateCount = 0) then FOnUpdate(Self);
    727863end;
    728864
    … …  
    788924end;
    789925
     926function StrToStr(Value: string): string;
     927begin
     928  Result := Value;
     929end;
     930
     931{ TListSimpleEvent }
     932
     933procedure TListSimpleEvent.CallAll;
     934var
     935  I: TIndex;
     936begin
     937  I := 0;
     938  while (I < Count) do begin
     939    Items[I]();
     940    I := I + 1;
     941  end;
     942end;
     943
     944{ TListNotifyEvent }
     945
     946procedure TListNotifyEvent.CallAll(Sender: TObject);
     947var
     948  I: TIndex;
     949begin
     950  I := 0;
     951  while (I < Count) do begin
     952    Items[I](Sender);
     953    I := I + 1;
     954  end;
     955end;
     956
     957{ TListByte }
     958
     959procedure TListByte.WriteToStream(Stream: TStream);
     960var
     961  I: Integer;
     962begin
     963  Stream.Position := 0;
     964  I := 0;
     965  while I < Count do begin
     966    Stream.WriteByte(Items[I]);
     967    I := I + 1;
     968  end;
     969end;
     970
     971procedure TListByte.WriteToStreamPart(Stream: TStream; ItemIndex, ItemCount: TIndex);
     972var
     973  I: Integer;
     974begin
     975  I := ItemIndex;
     976  while I < ItemCount do begin
     977    Stream.WriteByte(Items[I]);
     978    I := I + 1;
     979  end;
     980end;
     981
     982procedure TListByte.ReplaceStream(Stream: TStream);
     983var
     984  I: Integer;
     985begin
     986  Stream.Position := 0;
     987  I := 0;
     988  while I < Count do begin
     989    Items[I] := Stream.ReadByte;
     990    I := I + 1;
     991  end;
     992end;
     993
     994procedure TListByte.ReplaceStreamPart(Stream: TStream; ItemIndex,
     995  ItemCount: TIndex);
     996var
     997  I: Integer;
     998begin
     999  I := ItemIndex;
     1000  while I < ItemCount do begin
     1001    Items[I] := Stream.ReadByte;
     1002    I := I + 1;
     1003  end;
     1004end;
     1005
     1006procedure TListByte.AddStream(Stream: TStream);
     1007var
     1008  I: Integer;
     1009begin
     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;
     1017end;
     1018
     1019procedure TListByte.AddStreamPart(Stream: TStream; ItemCount: TIndex);
     1020var
     1021  I: Integer;
     1022begin
     1023  I := Count;
     1024  Count := Count + ItemCount;
     1025  while I < Count do begin
     1026    Items[I] := Stream.ReadByte;
     1027    I := I + 1;
     1028  end;
     1029end;
     1030
     1031procedure TListByte.WriteBuffer(var Buffer; Count: Integer);
     1032begin
     1033
     1034end;
     1035
     1036procedure TListByte.ReadBuffer(var Buffer; Count: Integer);
     1037begin
     1038
     1039end;
     1040
    7901041end.

  • Generics/NativeGenerics/Units/GenericMatrix.pas

    r423 r425  
    123123  SMatrixIndexError = 'Matrix index error [X: %d, Y: %d]';
    124124
     125
    125126implementation
    126 
    127 uses
    128   RtlConsts;
    129 
    130127
    131128{ TGRawMatrix }

  • Generics/NativeGenerics/Units/GenericStream.pas

    r323 r425  
    2121    function GetPosition: TIndex;
    2222  public
    23     procedure Assign(Source: TGAbstractStream<TItem>); virtual;
     23    procedure Assign(Source: TGAbstractStream<TItem>); virtual; abstract;
    2424    procedure Write(Item: TItem); virtual; abstract;
    2525    procedure WriteArray(Item: array of TItem); virtual; abstract;
    … …  
    2727    function Read: TItem; virtual; abstract;
    2828    function ReadArray(Count: TIndex): TItemArray; virtual; abstract;
     29    function ReadBuffer(var Buffer; Count: Integer): Integer; virtual; abstract;
    2930    function Insert(Count: TIndex): TIndex; virtual; abstract;
    3031    function Remove(Count: TIndex): TIndex; virtual; abstract;
    … …  
    4142    FPosition: TIndex;
    4243  public
     44    type
     45      PItem = ^TItem;
    4346    procedure Assign(Source: TGAbstractStream<TItem>); override;
    4447    procedure Write(Item: TItem); override;
    … …  
    4851    function ReadArray(Count: TIndex): TItemArray; override;
    4952    function ReadList(List: TGList<TItem>; Count: TIndex): TIndex;
     53    function ReadBuffer(var Buffer; Count: Integer): Integer; override;
    5054    function Insert(Count: TIndex): Integer; override;
    5155    function Remove(Count: TIndex): Integer; override;
    … …  
    5660  end;
    5761
     62    TStreamByte = TGStream<Byte>;
     63
    5864
    5965implementation
    … …  
    6167
    6268{ TGStream }
    63 
    64 procedure TGAbstractStream<TItem>.Assign(Source: TGAbstractStream<TItem>);
    65 begin
    66 end;
    6769
    6870procedure TGAbstractStream<TItem>.SetPosition(AValue: TIndex);
    … …  
    112114procedure TGStream<TItem>.Assign(Source: TGAbstractStream<TItem>);
    113115begin
    114   inherited;
    115116  if Source is TGStream<TItem> then begin
    116117    FList.Assign(TGStream<TItem>(Source).FList);
    … …  
    196197end;
    197198
     199function TGStream<TItem>.ReadBuffer(var Buffer; Count: Integer): Integer;
     200begin
     201  List.GetBuffer(Position, Buffer, Count);
     202end;
     203
    198204
    199205end.
Note: See TracChangeset for help on using the changeset viewer.