Ignore:
Timestamp:
Feb 25, 2012, 7:41:42 PM (13 years ago)
Author:
chronos
Message:
  • Modified: Reorganized docked forms. Target code is now accessible through main PageControl tab.
  • Added: Store right and bottom panels size.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/Demos/Generics/List.pas

    r21 r39  
    44
    55type
    6   TGList<TGListIndex, TGListItem> = class
    7   private
    8     FItems: array of TGListItem;
    9     FCount: TGListIndex;
    10     function Get(Index: TGListIndex): TGListItem;
    11     function GetCapacity: TGListIndex;
    12     function GetLast: TGListItem;
    13     function GetFirst: TGListItem;
    14     procedure SetCapacity(const AValue: TGListIndex);
    15     procedure SetLast(AValue: TGListItem);
    16     procedure SetFirst(AValue: TGListItem);
    17     procedure Put(Index: TGListIndex; const AValue: TGListItem); virtual;
    18     procedure SetCount(const AValue: TGListIndex);
    19     procedure QuickSort(L, R : TGListIndex; Compare: TGListSortCompare);
     6  TList<TItem, TIndex = NativeInt> = class
    207  public
    218    type
    22       TGListSortCompare = function(const Item1, Item2: TGListItem): Integer of object;
    23       TGListStringConverter = function(Item: TGListItem): string;
    24     function Add(Item: TGListItem): TGListIndex;
    25     procedure AddArray(Values: array of TGListItem);
    26     procedure AddList(List: TGList);
    27     procedure Assign(List: TGList);
     9      TSortCompare = function(const Item1, Item2: TItem): Integer of object;
     10      TStringConverter = function(Item: TItem): string;
     11  private
     12    FItems: array of TItem;
     13    FCount: TIndex;
     14    function Get(Index: TIndex): TItem;
     15    function GetCapacity: TIndex;
     16    function GetLast: TItem;
     17    function GetFirst: TItem;
     18    procedure SetCapacity(const AValue: TIndex);
     19    procedure SetLast(AValue: TItem);
     20    procedure SetFirst(AValue: TItem);
     21    procedure Put(Index: TIndex; const AValue: TItem); virtual;
     22    procedure SetCount(const AValue: TIndex);
     23    procedure QuickSort(L, R : TIndex; Compare: TSortCompare);
     24  public
     25    function Add(Item: TItem): TIndex;
     26    procedure AddArray(Values: array of TItem);
     27    procedure AddList(List: TList);
     28    procedure Assign(List: TList);
    2829    procedure Clear; virtual;
    2930    procedure Contract;
    30     procedure Delete(Index: TGListIndex); virtual;
    31     procedure DeleteItems(Index, Count: TGListIndex);
    32     function Equals(List: TGList): Boolean;
     31    procedure Delete(Index: TIndex); virtual;
     32    procedure DeleteItems(Index, Count: TIndex);
     33    function Equals(List: TList): Boolean;
    3334    procedure Expand;
    34     function Extract(Item: TGListItem): TGListItem;
    35     procedure Exchange(Index1, Index2: TGListIndex);
    36     property First: TGListItem read GetFirst write SetFirst;
    37     procedure Fill(Start, Count: TGListIndex; Value: TGListItem);
    38     function Implode(Separator: string; Converter: TGListStringConverter): string;
    39     function IndexOf(Item: TGListItem; Start: TGListIndex = 0): TGListIndex;
    40     function IndexOfList(List: TGList; Start: TGListIndex = 0): TGListIndex;
    41     procedure Insert(Index: TGListIndex; Item: TGListItem);
    42     procedure InsertList(Index: TGListIndex; List: TGList);
    43     procedure InsertArray(Index: TGListIndex; Values: array of TGListItem);
    44     procedure Move(CurIndex, NewIndex: TGListIndex);
    45     procedure MoveItems(CurIndex, NewIndex, Count: TGListIndex);
    46     function Remove(Item: TGListItem): TGListIndex;
     35    function Extract(Item: TItem): TItem;
     36    procedure Exchange(Index1, Index2: TIndex);
     37    property First: TItem read GetFirst write SetFirst;
     38    procedure Fill(Start, Count: TIndex; Value: TItem);
     39    function Implode(Separator: string; Converter: TStringConverter): string;
     40    function IndexOf(Item: TItem; Start: TIndex = 0): TIndex;
     41    function IndexOfList(List: TList; Start: TIndex = 0): TIndex;
     42    procedure Insert(Index: TIndex; Item: TItem);
     43    procedure InsertList(Index: TIndex; List: TList);
     44    procedure InsertArray(Index: TIndex; Values: array of TItem);
     45    procedure Move(CurIndex, NewIndex: TIndex);
     46    procedure MoveItems(CurIndex, NewIndex, Count: TIndex);
     47    function Remove(Item: TItem): TIndex;
    4748    procedure Reverse;
    48     procedure Sort(Compare: TGListSortCompare);
    49     procedure SetArray(Values: array of TGListItem);
    50     property Count: TGListIndex read FCount write SetCount;
    51     property Capacity: TGListIndex read GetCapacity write SetCapacity;
    52     property Items[Index: TGListIndex]: TGListItem read Get write Put; default;
    53     property Last: TGListItem read GetLast write SetLast;
     49    procedure Sort(Compare: TSortCompare);
     50    procedure SetArray(Values: array of TItem);
     51    property Count: TIndex read FCount write SetCount;
     52    property Capacity: TIndex read GetCapacity write SetCapacity;
     53    property Items[Index: TIndex]: TItem read Get write Put; default;
     54    property Last: TItem read GetLast write SetLast;
    5455  end;
    5556 
    5657implementation
    5758
    58 function TGList.GetCapacity: TGListIndex;
     59function TList.GetCapacity: TIndex;
    5960begin
    6061  Result := Length(FItems);
    6162end;
    6263
    63 procedure TGList.SetCapacity(const AValue: TGListIndex);
     64procedure TList.SetCapacity(const AValue: TIndex);
    6465begin
    6566  SetLength(FItems, AValue);
    6667end;
    6768
    68 function TGList.Get(Index: TGListIndex): TGListItem;
     69function TList.Get(Index: TIndex): TItem;
    6970begin
    7071  Result := FItems[Index];
    7172end;
    7273
    73 procedure TGList.Put(Index: TGListIndex; const AValue: TGListItem);
     74procedure TList.Put(Index: TIndex; const AValue: TItem);
    7475begin
    7576  FItems[Index] := AValue;
    7677end;
    7778
    78 procedure TGList.SetCount(const AValue: TGListIndex);
     79procedure TList.SetCount(const AValue: TIndex);
    7980begin
    8081  SetLength(FItems, AValue);
    … …  
    8283end;
    8384
    84 procedure TGList.QuickSort(L, R: TGListIndex; Compare: TGListSortCompare);
    85 var
    86   I, J: TGListIndex;
    87   P, Q: TGListItem;
     85procedure TList.QuickSort(L, R: TIndex; Compare: TSortCompare);
     86var
     87  I, J: TIndex;
     88  P, Q: TItem;
    8889begin
    8990 repeat
    … …  
    111112end;
    112113
    113 procedure TGList.Assign(List: TGList);
     114procedure TList.Assign(List: TList);
    114115var
    115116  I: Integer;
    … …  
    123124end;
    124125
    125 procedure TGList.Expand;
    126 var
    127   IncSize: TGListIndex;
     126procedure TList.Expand;
     127var
     128  IncSize: TIndex;
    128129begin
    129130  if FCount = Capacity then begin
    … …  
    136137end;
    137138
    138 procedure TGList.Contract;
     139procedure TList.Contract;
    139140begin
    140141  if (Capacity > 256) and (FCount < Capacity shr 2) then
    … …  
    144145end;
    145146
    146 function TGList.Extract(Item: TGListItem): TGListItem;
    147 var
    148   I: TGListIndex;
     147function TList.Extract(Item: TItem): TItem;
     148var
     149  I: TIndex;
    149150begin
    150151  I := IndexOf(Item);
    … …  
    156157end;
    157158
    158 function TGList.IndexOf(Item: TGListItem; Start: TGListIndex): TGListIndex;
     159function TList.IndexOf(Item: TItem; Start: TIndex): TIndex;
    159160begin
    160161  Result := Start;
    161162  while (Result < FCount) and
    162   not CompareMem(Addr(FItems[Result]), Addr(Item), SizeOf(TGListItem)) do
     163  not CompareMem(Addr(FItems[Result]), Addr(Item), SizeOf(TItem)) do
    163164    Result := Result + 1;
    164165  if Result = FCount then Result := -1;
    165166end;
    166167
    167 procedure TGList.Insert(Index: TGListIndex; Item: TGListItem);
     168procedure TList.Insert(Index: TIndex; Item: TItem);
    168169begin
    169170  if (Index < 0) or (Index > FCount ) then
    … …  
    171172  if FCount = Capacity then Expand;
    172173  if Index < FCount then
    173     System.Move(FItems[Index], FItems[Index + 1], (FCount - Index) * SizeOf(TGListItem));
     174    System.Move(FItems[Index], FItems[Index + 1], (FCount - Index) * SizeOf(TItem));
    174175  FItems[Index] := Item;
    175176  FCount := FCount + 1;
    176177end;
    177178
    178 procedure TGList.InsertList(Index: TGListIndex; List: TGList);
    179 var
    180   I: TGListIndex;
     179procedure TList.InsertList(Index: TIndex; List: TList);
     180var
     181  I: TIndex;
    181182begin
    182183  I := 0;
    … …  
    187188end;
    188189
    189 function TGList.IndexOfList(List: TGList; Start: TGListIndex): TGListIndex;
    190 var
    191   I: TGListIndex;
     190function TList.IndexOfList(List: TList; Start: TIndex): TIndex;
     191var
     192  I: TIndex;
    192193begin
    193194  if List.Count > 0 then begin
    … …  
    196197      I := 1;
    197198      while I < List.Count do begin
    198         if not CompareMem(Addr(FItems[Result + I]), Addr(List.FItems[I]), SizeOf(TGListItem)) then begin
     199        if not CompareMem(Addr(FItems[Result + I]), Addr(List.FItems[I]), SizeOf(TItem)) then begin
    199200          Result := -1;
    200201          Break;
    … …  
    206207end;
    207208
    208 function TGList.GetLast: TGListItem;
     209function TList.GetLast: TItem;
    209210begin
    210211  if FCount = 0 then
    … …  
    214215end;
    215216
    216 procedure TGList.SetLast(AValue: TGListItem);
     217procedure TList.SetLast(AValue: TItem);
    217218begin
    218219  if FCount = 0 then
    … …  
    222223end;
    223224
    224 function TGList.GetFirst: TGListItem;
     225function TList.GetFirst: TItem;
    225226begin
    226227  if FCount = 0 then
    … …  
    230231end;
    231232
    232 procedure TGList.SetFirst(AValue: TGListItem);
     233procedure TList.SetFirst(AValue: TItem);
    233234begin
    234235  if FCount = 0 then
    … …  
    238239end;
    239240
    240 procedure TGList.Move(CurIndex, NewIndex: TGListIndex);
    241 var
    242   Temp: TGListItem;
     241procedure TList.Move(CurIndex, NewIndex: TIndex);
     242var
     243  Temp: TItem;
    243244begin
    244245  if ((CurIndex < 0) or (CurIndex > Count - 1)) then
    … …  
    248249  Temp := FItems[CurIndex];
    249250  if NewIndex > CurIndex then begin
    250     System.Move(FItems[CurIndex + 1], FItems[CurIndex], (NewIndex - CurIndex) * SizeOf(TGListItem));
     251    System.Move(FItems[CurIndex + 1], FItems[CurIndex], (NewIndex - CurIndex) * SizeOf(TItem));
    251252  end else
    252253  if NewIndex < CurIndex then begin
    253     System.Move(FItems[NewIndex], FItems[NewIndex + 1], (CurIndex - NewIndex) * SizeOf(TGListItem));
     254    System.Move(FItems[NewIndex], FItems[NewIndex + 1], (CurIndex - NewIndex) * SizeOf(TItem));
    254255  end;
    255256  FItems[NewIndex] := Temp;
    … …  
    258259end;
    259260
    260 procedure TGList.MoveItems(CurIndex, NewIndex, Count: TGListIndex);
     261procedure TList.MoveItems(CurIndex, NewIndex, Count: TIndex);
    261262var
    262263  S: Integer;
    … …  
    283284end;
    284285
    285 function TGList.Remove(Item: TGListItem): TGListIndex;
     286function TList.Remove(Item: TItem): TIndex;
    286287begin
    287288  Result := IndexOf(Item);
    … …  
    290291end;
    291292
    292 function TGList.Equals(List: TGList): Boolean;
    293 var
    294   I: TGListIndex;
     293function TList.Equals(List: TList): Boolean;
     294var
     295  I: TIndex;
    295296begin
    296297  Result := Count = List.Count;
    … …  
    298299    I := 0;
    299300    while I < Count do begin
    300       if not CompareMem(Addr(FItems[I]), Addr(List.FItems[I]), SizeOf(TGListItem)) then begin
     301      if not CompareMem(Addr(FItems[I]), Addr(List.FItems[I]), SizeOf(TItem)) then begin
    301302        Result := False;
    302303        Break;
    … …  
    307308end;
    308309
    309 procedure TGList.Reverse;
    310 var
    311   I: TGListIndex;
     310procedure TList.Reverse;
     311var
     312  I: TIndex;
    312313begin
    313314  I := 0;
    … …  
    318319end;
    319320
    320 procedure TGList.Sort(Compare: TGListSortCompare);
     321procedure TList.Sort(Compare: TSortCompare);
    321322begin
    322323  if FCount > 1 then
    … …  
    324325end;
    325326
    326 procedure TGList.AddArray(Values: array of TGListItem);
    327 var
    328   I: TGListIndex;
     327procedure TList.AddArray(Values: array of TItem);
     328var
     329  I: TIndex;
    329330begin
    330331  I := 0;
    … …  
    335336end;
    336337
    337 procedure TGList.SetArray(Values: array of TGListItem);
    338 var
    339   I: TGListIndex;
     338procedure TList.SetArray(Values: array of TItem);
     339var
     340  I: TIndex;
    340341begin
    341342  Clear;
    … …  
    347348end;
    348349
    349 procedure TGList.InsertArray(Index: TGListIndex; Values: array of TGListItem);
    350 var
    351   I: TGListIndex;
     350procedure TList.InsertArray(Index: TIndex; Values: array of TItem);
     351var
     352  I: TIndex;
    352353begin
    353354  I := 0;
    … …  
    358359end;
    359360
    360 function TGList.Implode(Separator: string; Converter: TGListStringConverter): string;
    361 var
    362   I: TGListIndex;
     361function TList.Implode(Separator: string; Converter: TStringConverter): string;
     362var
     363  I: TIndex;
    363364begin
    364365  Result := '';
    … …  
    372373end;
    373374
    374 function TGList.Add(Item: TGListItem): TGListIndex;
     375function TList.Add(Item: TItem): TIndex;
    375376begin
    376377  if FCount = Capacity then
    … …  
    381382end;
    382383
    383 procedure TGList.AddList(List: TGList);
    384 var
    385   I: TGListIndex;
     384procedure TList.AddList(List: TList);
     385var
     386  I: TIndex;
    386387begin
    387388  I := 0;
    … …  
    392393end;
    393394
    394 procedure TGList.Clear;
     395procedure TList.Clear;
    395396begin
    396397  Count := 0;
    … …  
    398399end;
    399400
    400 procedure TGList.Delete(Index: TGListIndex);
     401procedure TList.Delete(Index: TIndex);
    401402begin
    402403  if (Index < 0) or (Index >= FCount) then
    403404    raise EListError.CreateFmt(SListIndexError, [Index]);
    404405  FCount := FCount - 1;
    405   System.Move(FItems[Index + 1], FItems[Index], (FCount - Index) * SizeOf(TGListItem));
     406  System.Move(FItems[Index + 1], FItems[Index], (FCount - Index) * SizeOf(TItem));
    406407  Contract;
    407408end;
    408409
    409 procedure TGList.DeleteItems(Index, Count: TGListIndex);
    410 var
    411   I: TGListIndex;
     410procedure TList.DeleteItems(Index, Count: TIndex);
     411var
     412  I: TIndex;
    412413begin
    413414  I := Index;
    … …  
    418419end;
    419420
    420 procedure TGList.Fill(Start, Count: TGListIndex; Value: TGListItem);
     421procedure TList.Fill(Start, Count: TIndex; Value: TItem);
    421422begin
    422423  while Count > 0 do begin
    … …  
    427428end;
    428429
    429 procedure TGList.Exchange(Index1, Index2: TGListIndex);
    430 var
    431   Temp: TGListItem;
     430procedure TList.Exchange(Index1, Index2: TIndex);
     431var
     432  Temp: TItem;
    432433begin
    433434  if ((Index1 >= FCount) or (Index1 < 0)) then
Note: See TracChangeset for help on using the changeset viewer.