Delphi泛型动态数组的扩展.

从Delphi支持泛型的第一天起就有了一种新的动态数组类型,泛型化的动态数组–TArray.
虽然这个类型比较方便,但是却没有提供更丰富的操作.因为XE4中提供了对数据类型的Helper扩展,例如StringHelper,企图实现一个TArrayHelper但是发现Helper不支持泛型的类型.
没办法只好包装了一个record,好处是似乎只要支持泛型的Delphi版本都可以支持.使用效果如下.

var
  //声明动态数组
  a, b, c: TArrayEx<Integer>;
  f: TArrayEx<Single>;
  s : TArrayEx<string>;
  //
  i: Integer;
  z: array of Integer;
begin
  // 直接给数组分配内容
  a := [2, 2, 3, 4];
  s := ['haha', 'hello'];
  // 克隆
  b := a.Clone;

  // 给元素赋值
  b[0] := 5;

  // 操作符重载,两个数组相加或给数组加元素
  c := a + b;

  c := 88 + c + 99;
  a.Append([10, 20, 30]);
  a.Insert(2, 1000);
  a.Insert(2, [1000, 45]);

  a[0] := 7;
  // 去重
  c.Unique;
  // 删除
  c.Delete(0, 3);
  // 比较
  if c = z then
    // for in 循环
    for i in c do
      if i = 0 then
      begin
        //
      end;
  //
  f := [1, 2, 3.1415926];
  f.Size := 200;
  if f[0] = 1.0 then
  begin

  end;


end;

这些成员方法和操作符重载都是原来的TArray所不具备的.注重开发效率可以用这个办法封装一些类型,简化操作.
TArrayEx的实现代码在下面.记得必须是支持泛型版本的Delphi哦,也就是至少要Delphi2009版以后的.

unit ArrayEx;

{ ******************************************************************************
  泛型动态数组的扩展.

  wr960204 武稀松

  2013.6.4

http://www.raysoftware.cn/?p=278

  7.10
  感谢TINTIN的完善.
  加入了:排序和搜索两个重要功能

http://hi.baidu.com/tintinsoft/item/ffb1a0981dae2edd1b49df92

  sample:

  var
  a, b, c: TArrayEx<Integer>;
  f: TArrayEx<Single>;
  s : TArrayEx<string>;
  //
  i: Integer;
  z: array of Integer;
  args:TArrayEx<string>;
  begin
  // assign

  a := [2, 2, 3, 4];
  s := ['haha', 'hello'];

  // clone
  b := a.Clone;

  // 给元素赋值
  b[0] := 5;

  // operator +
  c := a + b;

  c := 88 + c + 99;
  a.Append([10, 20, 30]);
  a.Insert(2, 1000);
  a.Insert(2, [1000, 45]);

  a[0] := 7;

  // Unique
  c.Unique;
  // Delete
  c.Delete(0, 3);

  // compare
  if c = z then
  // for in loop
  for i in c do
  if i = 0 then
  begin
  //
  end;

  //

  f := [1, 2, 3.1415926];
  f.Size := 200;
  if f[0] = 1.0 then
  begin
  end;



  args := ['38inch','45inch','XL','XL2','X','38inch','45inch'];
  args.Unique;
  //sort
  args.Sort;
  //search
  if args.BinarySearch('XL',i) then
  ShowMessageFmt('foud index:%d',[i]);



  end;

  ****************************************************************************** }
interface

uses System.Generics.Defaults, System.SysUtils;

type
  TArrayEx<T> = record
  strict private
  type
    TEnumerator = class
    private
      FValue: TArray<T>;
      FIndex: NativeInt;
      function GetCurrent: T;
    public
      constructor Create(const AValue: TArray<T>);
      function MoveNext: Boolean;
      property Current: T read GetCurrent;
    end;
  public
    function GetEnumerator(): TEnumerator;
  strict private
    FData: TArray<T>;
    function GetRawData: TArray<T>;
    function GetElements(Index: Integer): T;
    procedure SetElements(Index: Integer; const Value: T);
  private
    class function EqualArray(A, B: TArray<T>): Boolean; static;
    class function CompareT(const A, B: T): Boolean; static;
    class procedure CopyArray(var FromArray, ToArray: TArray<T>;
      FromIndex: NativeInt = 0; ToIndex: NativeInt = 0;
      Count: NativeInt = -1); static;
    class procedure MoveArray(var AArray: array of T;
      FromIndex, ToIndex, Count: Integer); static;
    class function DynArrayToTArray(const Value: array of T): TArray<T>; static;
    class function Min(A, B: NativeInt): NativeInt; static;
    procedure QuickSort(const Comparer: IComparer<T>; L, R: Integer);
  public // operators
    class operator Implicit(Value: TArray<T>): TArrayEx<T>; overload;
    class operator Implicit(Value: array of T): TArrayEx<T>; overload;
    (*
      这个无解,Delphi不允许array of T作为返回值.也就是这个转换是被废了.只好用AssignTo
      class operator Implicit(Value:  TArrayEx<T>):array of T; overload;
    *)
    class operator Implicit(Value: TArrayEx<T>): TArray<T>; overload;
    class operator Explicit(Value: TArrayEx<T>): TArray<T>; overload;
    class operator Explicit(Value: array of T): TArrayEx<T>; overload;

    class operator Add(A, B: TArrayEx<T>): TArrayEx<T>; overload;
    class operator Add(A: TArrayEx<T>; const B: T): TArrayEx<T>; overload;
    class operator Add(const A: T; B: TArrayEx<T>): TArrayEx<T>; overload;
    class operator Add(A: TArrayEx<T>; B: array of T): TArrayEx<T>; overload;
    class operator Add(A: array of T; B: TArrayEx<T>): TArrayEx<T>; overload;
    class operator In (A: T; B: TArrayEx<T>): Boolean; overload;
    //
    class operator Equal(A, B: TArrayEx<T>): Boolean; overload;
    class operator Equal(A: TArrayEx<T>; B: TArray<T>): Boolean; overload;
    class operator Equal(A: TArray<T>; B: TArrayEx<T>): Boolean; overload;
    class operator Equal(A: array of T; B: TArrayEx<T>): Boolean; overload;
    class operator Equal(A: TArrayEx<T>; B: array of T): Boolean; overload;

  public
    procedure SetLen(Value: NativeInt); inline;
    function GetLen: NativeInt; inline;
    function ByteLen: NativeInt; inline;
    class function Create(Value: array of T): TArrayEx<T>; overload; static;
    class function Create(Value: TArrayEx<T>): TArrayEx<T>; overload; static;
    class function Create(const Value: T): TArrayEx<T>; overload; static;
    function Clone(): TArrayEx<T>;
    procedure SetValue(Value: array of T);
    function ToArray(): TArray<T>;
    function SubArray(AFrom, ACount: NativeInt): TArrayEx<T>;
    procedure Delete(AFrom, ACount: NativeInt); overload;
    procedure Delete(AIndex: NativeInt); overload;
    procedure Append(Values: TArrayEx<T>); overload;
    procedure Append(const Value: T); overload;
    procedure Append(Values: array of T); overload;
    procedure Append(Values: TArray<T>); overload;
    function Insert(AIndex: NativeInt; const Value: T): NativeInt; overload;
    function Insert(AIndex: NativeInt; const Values: array of T)
      : NativeInt; overload;
    function Insert(AIndex: NativeInt; const Values: TArray<T>)
      : NativeInt; overload;
    function Insert(AIndex: NativeInt; const Values: TArrayEx<T>)
      : NativeInt; overload;
    procedure Unique();
    // 排序
    procedure Sort(); overload;
    procedure Sort(const Comparer: IComparer<T>); overload;
    procedure Sort(const Comparer: IComparer<T>;
      Index, Count: Integer); overload;
    // 搜索
    function BinarySearch(const Item: T; out FoundIndex: Integer;
      const Comparer: IComparer<T>; Index, Count: Integer): Boolean; overload;
    function BinarySearch(const Item: T; out FoundIndex: Integer;
      const Comparer: IComparer<T>): Boolean; overload;
    function BinarySearch(const Item: T; out FoundIndex: Integer)
      : Boolean; overload;

    property Size: NativeInt read GetLen write SetLen;
    property Len: NativeInt read GetLen write SetLen;
    property RawData: TArray<T> read GetRawData;
    property Elements[Index: Integer]: T read GetElements
      write SetElements; default;
  end;

implementation

uses System.RTLConsts;

class operator TArrayEx<T>.Add(A, B: TArrayEx<T>): TArrayEx<T>;
begin
  Result := A.Clone;
  Result.Append(B);
end;

class operator TArrayEx<T>.Add(A: TArrayEx<T>; const B: T): TArrayEx<T>;
begin
  Result := A.Clone;
  Result.Append(B);
end;

class operator TArrayEx<T>.Add(const A: T; B: TArrayEx<T>): TArrayEx<T>;
begin
  Result.SetValue([A]);
  Result.Append(B);
end;

class operator TArrayEx<T>.Add(A: TArrayEx<T>; B: array of T): TArrayEx<T>;
begin
  Result := A.Clone;
  Result.Append(B);
end;

class operator TArrayEx<T>.Add(A: array of T; B: TArrayEx<T>): TArrayEx<T>;
begin
  Result.FData := DynArrayToTArray(A);
  Result.Append(B);
end;

class operator TArrayEx<T>.In(A: T; B: TArrayEx<T>): Boolean;
var
  Tmp: T;
begin
  Result := False;
  for Tmp in B.FData do
    if CompareT(A, Tmp) then
    begin
      Result := True;
      Break;
    end;
end;

class operator TArrayEx<T>.Equal(A, B: TArrayEx<T>): Boolean;
begin
  Result := EqualArray(A.FData, B.FData);
end;

class operator TArrayEx<T>.Equal(A: TArrayEx<T>; B: TArray<T>): Boolean;
begin
  Result := EqualArray(A.FData, B);
end;

class operator TArrayEx<T>.Equal(A: TArray<T>; B: TArrayEx<T>): Boolean;
begin
  Result := EqualArray(A, B.FData);
end;

class operator TArrayEx<T>.Equal(A: array of T; B: TArrayEx<T>): Boolean;
begin
  Result := EqualArray(DynArrayToTArray(A), B.FData);
end;

class operator TArrayEx<T>.Equal(A: TArrayEx<T>; B: array of T): Boolean;
begin
  Result := EqualArray(A.FData, DynArrayToTArray(B));
end;

function TArrayEx<T>.BinarySearch(const Item: T; out FoundIndex: Integer;
  const Comparer: IComparer<T>; Index, Count: Integer): Boolean;
var
  L, H: Integer;
  mid, cmp: Integer;
begin
  if (Index < Low(FData)) or ((Index > High(FData)) and (Count > 0)) or
    (Index + Count - 1 > High(FData)) or (Count < 0) or (Index + Count < 0) then
    raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
  if Count = 0 then
  begin
    FoundIndex := Index;
    Exit(False);
  end;

  Result := False;
  L := Index;
  H := Index + Count - 1;
  while L <= H do
  begin
    mid := L + (H - L) shr 1;
    cmp := Comparer.Compare(FData[mid], Item);
    if cmp < 0 then
      L := mid + 1
    else
    begin
      H := mid - 1;
      if cmp = 0 then
        Result := True;
    end;
  end;
  FoundIndex := L;
end;

function TArrayEx<T>.BinarySearch(const Item: T; out FoundIndex: Integer;
  const Comparer: IComparer<T>): Boolean;
begin
  Result := BinarySearch(Item, FoundIndex, Comparer, Low(FData), Length(FData));
end;

function TArrayEx<T>.BinarySearch(const Item: T;
  out FoundIndex: Integer): Boolean;
begin
  Result := BinarySearch(Item, FoundIndex, TComparer<T>.Default, Low(FData),
    Length(FData));
end;

function TArrayEx<T>.ByteLen: NativeInt;
begin
  Result := Length(FData) * Sizeof(T);
end;

class function TArrayEx<T>.Min(A, B: NativeInt): NativeInt;
begin
  Result := A;
  if Result > B then
    Result := B;
end;

class procedure TArrayEx<T>.CopyArray(var FromArray, ToArray: TArray<T>;
  FromIndex, ToIndex, Count: NativeInt);
var
  i: Integer;
begin
  if Count = 0 then
    Exit;
  if Count < 0 then
    Count := Min(Length(FromArray), Length(ToArray));
  if Length(FromArray) < (FromIndex + Count) then
    Count := Length(FromArray) - FromIndex;
  if Length(ToArray) < (ToIndex + Count) then
    Count := Length(ToArray) - ToIndex;

  if Count > 0 then
    for i := 0 to Count - 1 do
      ToArray[ToIndex + i] := FromArray[FromIndex + i];
end;

class procedure TArrayEx<T>.MoveArray(var AArray: array of T;
  FromIndex, ToIndex, Count: Integer);
var
  i: Integer;
begin
  if Count > 0 then
  begin
    if FromIndex < ToIndex then
      for i := Count - 1 downto 0 do
        AArray[ToIndex + i] := AArray[FromIndex + i]
    else if FromIndex > ToIndex then
      for i := 0 to Count - 1 do
        AArray[ToIndex + i] := AArray[FromIndex + i];
  end;
end;

procedure TArrayEx<T>.QuickSort(const Comparer: IComparer<T>; L, R: Integer);
var
  i, J: Integer;
  pivot, temp: T;
begin
  if (Length(FData) = 0) or ((R - L) <= 0) then
    Exit;
  repeat
    i := L;
    J := R;
    pivot := FData[L + (R - L) shr 1];
    repeat
      while Comparer.Compare(FData[i], pivot) < 0 do
        Inc(i);
      while Comparer.Compare(FData[J], pivot) > 0 do
        Dec(J);
      if i <= J then
      begin
        if i <> J then
        begin
          temp := FData[i];
          FData[i] := FData[J];
          FData[J] := temp;
        end;
        Inc(i);
        Dec(J);
      end;
    until i > J;
    if L < J then
      QuickSort(Comparer, L, J);
    L := i;
  until i >= R;
end;

class function TArrayEx<T>.DynArrayToTArray(const Value: array of T): TArray<T>;
var
  i: Integer;
begin
  SetLength(Result, Length(Value));
  for i := Low(Value) to High(Value) do
    Result[i] := Value[i];
end;

class function TArrayEx<T>.EqualArray(A, B: TArray<T>): Boolean;
var
  i: Integer;
begin
  Result := True;
  if A = B then
    Exit;
  if Length(A) <> Length(B) then
  begin
    Result := False;
  end
  else
  begin
    for i := Low(A) to High(A) do
      if not CompareT(A[i], B[i]) then
      begin
        Result := False;
        Break;
      end;
  end;
end;

class function TArrayEx<T>.CompareT(const A, B: T): Boolean;
var
  Compare: IComparer<T>;
begin
  Compare := TComparer<T>.Default;
  Result := Compare.Compare(A, B) = 0;
end;
// class function TArrayEx<T>.CompareT(const A, B: T): Boolean;
// var
// p1, p2: PByte;
// i: Integer;
// begin
// Result := True;
// p1 := PByte(@A);
// p2 := PByte(@B);
// for i := 0 to Sizeof(T) - 1 do
// begin
// //
// if p1^ <> p2^ then
// begin
// Result := False;
// Exit;
// end;
// Inc(p1);
// Inc(p2);
// end;
// end;

function TArrayEx<T>.GetElements(Index: Integer): T;
begin
  Result := FData[Index];
end;

function TArrayEx<T>.GetEnumerator: TEnumerator;
begin
  Result := TEnumerator.Create(FData);
end;

function TArrayEx<T>.GetLen: NativeInt;
begin
  Result := Length(FData);
end;

function TArrayEx<T>.GetRawData: TArray<T>;
begin
  Result := FData;
end;

class operator TArrayEx<T>.Implicit(Value: TArrayEx<T>): TArray<T>;
begin
  SetLength(Result, Length(Value.FData));
  CopyArray(Value.FData, Result, 0, 0, Length(Value.FData));
end;

class operator TArrayEx<T>.Explicit(Value: array of T): TArrayEx<T>;
begin
  Result.SetValue(Value);
end;

class operator TArrayEx<T>.Implicit(Value: array of T): TArrayEx<T>;
begin
  Result.SetValue(Value);
end;

class operator TArrayEx<T>.Implicit(Value: TArray<T>): TArrayEx<T>;
begin
  SetLength(Result.FData, Length(Value));
  CopyArray(Value, Result.FData, 0, 0, Length(Value));
end;

class operator TArrayEx<T>.Explicit(Value: TArrayEx<T>): TArray<T>;
begin
  SetLength(Result, Length(Value.FData));
  CopyArray(Value.FData, Result, 0, 0, Length(Value.FData));
end;

procedure TArrayEx<T>.SetElements(Index: Integer; const Value: T);
begin
  FData[Index] := Value;
end;

procedure TArrayEx<T>.SetLen(Value: NativeInt);
begin
  SetLength(FData, Value);
end;

procedure TArrayEx<T>.SetValue(Value: array of T);
begin
  FData := DynArrayToTArray(Value);
end;

procedure TArrayEx<T>.Sort;
begin
  QuickSort(TComparer<T>.Default, Low(FData), High(FData));
end;

procedure TArrayEx<T>.Sort(const Comparer: IComparer<T>; Index, Count: Integer);
begin
  if (Index < Low(FData)) or ((Index > High(FData)) and (Count > 0)) or
    (Index + Count - 1 > High(FData)) or (Count < 0) or (Index + Count < 0) then
    raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
  if Count <= 1 then
    Exit;
  QuickSort(Comparer, Index, Index + Count - 1);
end;

procedure TArrayEx<T>.Sort(const Comparer: IComparer<T>);
begin
  QuickSort(Comparer, Low(FData), High(FData));
end;

function TArrayEx<T>.ToArray(): TArray<T>;
begin
  SetLength(Result, Length(FData));
  CopyArray(FData, Result, 0, 0, Length(FData));
end;

class function TArrayEx<T>.Create(Value: array of T): TArrayEx<T>;
begin
  Result.SetValue(Value);
end;

class function TArrayEx<T>.Create(Value: TArrayEx<T>): TArrayEx<T>;
begin
  Result := Value.Clone;
end;

class function TArrayEx<T>.Create(const Value: T): TArrayEx<T>;
begin
  Result.SetValue([Value]);
end;

function TArrayEx<T>.Clone(): TArrayEx<T>;
begin
  Result := SubArray(0, Length(FData));
end;

function TArrayEx<T>.SubArray(AFrom, ACount: NativeInt): TArrayEx<T>;
begin
  SetLength(Result.FData, ACount);
  CopyArray(FData, Result.FData, AFrom, 0, ACount);
end;

procedure TArrayEx<T>.Delete(AFrom, ACount: NativeInt);
begin
  if AFrom >= Length(FData) then
    Exit;
  if (AFrom + ACount) > Length(FData) then
    ACount := Length(FData) - AFrom;

  MoveArray(FData, AFrom + ACount, AFrom, Length(FData) - (AFrom + ACount));
  SetLength(FData, Length(FData) - ACount);
end;

procedure TArrayEx<T>.Delete(AIndex: NativeInt);
begin
  Delete(AIndex, 1);
end;

procedure TArrayEx<T>.Append(Values: TArrayEx<T>);
begin
  Insert(Length(FData), Values);
end;

procedure TArrayEx<T>.Append(Values: TArray<T>);
begin
  Insert(Length(FData), Values);
end;

procedure TArrayEx<T>.Append(const Value: T);
begin
  SetLength(FData, Length(FData) + 1);
  FData[High(FData)] := Value;
end;

procedure TArrayEx<T>.Append(Values: array of T);
begin
  Insert(Length(FData), Values);
end;

function TArrayEx<T>.Insert(AIndex: NativeInt; const Value: T): NativeInt;
var
  i: Integer;
begin
  Result := -1;
  if (AIndex > Length(FData)) or (AIndex < 0) then
    Exit;
  SetLength(FData, Length(FData) + 1);
  MoveArray(FData, AIndex, AIndex + 1, Length(FData) - AIndex);
  FData[AIndex] := Value;
  Result := AIndex;
end;

function TArrayEx<T>.Insert(AIndex: NativeInt; const Values: array of T)
  : NativeInt;
var
  i: Integer;
begin
  SetLength(FData, Length(Values));
  MoveArray(FData, AIndex, AIndex + Length(Values), Length(FData) - AIndex);
  for i := 0 to Length(Values) - 1 do
    FData[AIndex + i] := Values[i];
  Result := AIndex;
end;

function TArrayEx<T>.Insert(AIndex: NativeInt; const Values: TArray<T>)
  : NativeInt;
var
  i: Integer;
begin
  SetLength(FData, Length(FData) + Length(Values));
  MoveArray(FData, AIndex, AIndex + Length(Values), Length(FData) - AIndex);
  for i := 0 to Length(Values) - 1 do
    FData[AIndex + i] := Values[i];
  Result := AIndex;
end;

function TArrayEx<T>.Insert(AIndex: NativeInt; const Values: TArrayEx<T>)
  : NativeInt;
begin
  Result := Insert(AIndex, Values.ToArray);
end;

procedure TArrayEx<T>.Unique();
var
  i, J: Integer;
  Tmp: TArrayEx<T>;
  Flag: Boolean;
begin

  for i := High(FData) downto Low(FData) do
  begin
    Flag := False;
    for J := High(Tmp.FData) downto Low(Tmp.FData) do
    begin
      if CompareT(FData[i], Tmp[J]) then
      begin
        Flag := True;
        Break;
      end;
    end;
    if not Flag then
      Tmp.Append(FData[i]);
  end;
  FData := Tmp.FData;
end;

{ TArrayEx<T>.TEnumerator }

constructor TArrayEx<T>.TEnumerator.Create(const AValue: TArray<T>);
begin
  FValue := AValue;
  FIndex := -1;
end;

function TArrayEx<T>.TEnumerator.GetCurrent: T;
begin
  Result := FValue[FIndex];
end;

function TArrayEx<T>.TEnumerator.MoveNext: Boolean;
begin
  Result := False;
  if (FIndex >= Length(FValue)) then
    Exit;

  Inc(FIndex);
  Result := FIndex < Length(FValue);
end;

end.
此条目发表在Delphi, 未分类分类目录。将固定链接加入收藏夹。

Delphi泛型动态数组的扩展.》有 12 条评论

  1. TINTIN说:

    很好的东西,以前也做了一个简单的封装,但没有武稀松封装的那么完美!

  2. pccppc说:

    博主对delphi和win api研究颇深,鄙人拙劣,诚向博主学习。
    另博主如果不介意,把博客搬到我的服务器上吧,免费提供php空间。
    想和楼主多学习delphi和win api

  3. TINTIN说:

    直接复制你的源码,有很多红色波浪线的字符集错误,导致关键字 strict 也失灵,估计是HTML编码问题!武兄你不如贴单元源码。

  4. TINTIN说:

    抱歉,我可能因打字太快表达错误,我意思是这HTML着色贴的源码,有很多非法字符,尤其是需要换掉回车换行,最好是你上传单元附件,当然,我已经逐行换掉回车换行。再次感谢!

  5. TINTIN说:

    泛型数组里简单排序和自定义排序 Sort功能,比如 TArray.Sort(arr);
    武兄能否集成在 TArrayEx 里边。
    另有1疑问,
    a := [2, 2, 3, 4];
    a.Append([10, 20, 30]); //xe4环境

    a的结果为:[2,2,3],按理来说数组尾部应该追加另一数组,结果不是我所想象。
    可能是我理解有误,请赐教!

  6. TINTIN说:

    procedure TForm3.btn1Click(Sender: TObject);
    var
    args:TArrayEx;
    begin
    //
    args := ['38寸','45寸','XL','XL2','X','38寸','45寸'];
    args.Unique;
    end;

    //貌似CompareT不能比较,导致不能去掉重复,如果您有改动,能否上传一个新版?

    • admin说:

      确实有这个问题,因为原来我是为了不引入System.Generics.Default单元二比较内存的,而String实际是引用类型,相当比较指针,肯定都不同.
      现在改成了System.Generics.Default中的默认比较器.

  7. 匿名说:

    [dcc32 Warning] QBE3ArrayEx.pas(56): W1025 Unsupported language feature: ‘operator explicit’

发表评论

电子邮件地址不会被公开。

您可以使用这些HTML标签和属性: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <strike> <strong>

你必须启用JavaScript