Delphi的HashMap

使用过Java的朋友，应该知道它有个超好用的HashMap容器类，面试必问的，在Delphi10中有TDictionary类，但Delphi7没得用，所以自己动手，使用数组 + 链表写个类似Java的HashMap类，提供给所有坚守Delphi的朋友们，性能还是相当不错的。

{*******************************************************}
{                                                       }
{       Delphi HashMap                                  }
{                                                       }
{       版权所有 (C) 2018 hsoft                          }
{                                                       }
{                                                       }
{ Author: MarkWu    Email: 77910086@qq.com              }
{ Date:   2018-01-02 14:17:00                           }
{ Desc:   HashMap                                       }
{*******************************************************}

unit uHashMap;

interface

uses
  Windows, SysUtils, StrUtils, Classes, uHashEntry, Variants;

type
  // 实体数组类型
  TEntrySet = array of THashEntry;
  
  // 排序类型
  TSortType = (
        stKey,      // 按Key排序
        stValue,    // 按Value排序
        stKeyValue  // Key=Value排序
  );

  THashMap = class
  private
    // 临界值
    FThreshold: Integer;

    // 元素个数
    FCount: Integer;

    // 扩容次数
    FResize: Integer;

    FTable: TEntrySet;

    procedure InitTable();

    // 计算AKey的HashCode
    function HashCode(AKey: string): Integer;
    function IndexOf(AKey: string; iLen: Integer = 0): Integer;
    
    procedure Put(AIndex: Integer; AKey: string; AValue: Variant; AIsObj: Boolean = False);
    // 加入Key为空
    procedure PutNullKey(AValue: Variant);

    procedure Resize(capacity: Integer);

    function ToList: TList;

    //扩容时重新计算各元素的index
    procedure Transfer(ANewTable: TEntrySet);
    function GetItems(Index: Integer): THashEntry;

  public
    constructor Create();
    destructor Destroy; override;
    // 添加一个元素
    procedure Add(AKey: string; AValue: Variant; AIsObj: Boolean = False); overload;
    procedure Add(AMap: THashMap); overload;
    procedure AddObject(AKey: string; AValue: TObject);

    function Get(AKey: string): Variant;
    function GetObject(AKey: string): TObject;
    function GetNullKey: Variant;
    function GetEntry(AKey: string): THashEntry;
    procedure Remove(AKey: string);
    function ContainsKey(AKey: string): Boolean;
    procedure Clear;

    function GetEntrySet: TEntrySet;

    function ToString: string;

    // 排序
    function Sort(ASortType: TSortType = stKeyValue): TEntrySet;

    property Count: Integer read FCount;
    property Items[Index: Integer]: THashEntry read GetItems; default;
  end;

implementation


const
  //默认初始化大小 16, 数组长度一定是2的次幂
  DEFAULT_INITIAL_CAPACITY = 16;

  //默认负载因子 0.75
  DEFAULT_LOAD_FACTOR = 0.75;

  MAX_SIZE = 1000000;

{ THashMap }

constructor THashMap.Create;
begin
  InitTable;
end;

destructor THashMap.Destroy;
begin
  Clear;

  SetLength(FTable, 0);
  FCount := 0;
  inherited;
end;


procedure THashMap.InitTable;
begin
  SetLength(FTable, DEFAULT_INITIAL_CAPACITY);
  FThreshold := Trunc(DEFAULT_INITIAL_CAPACITY * DEFAULT_LOAD_FACTOR);
  FCount := 0;
end;

// 计算AKey的HashCode
function THashMap.HashCode(AKey: string): Integer;
var
  I: Integer;
begin                                       
  Result := 0;
  if (Result = 0) and (Length(AKey) > 0) then
  begin
    for I := 1 to Length(AKey) do
    begin
      Result := 31 * Result + Ord(AKey[I]);
    end;
  end;
end;

function THashMap.IndexOf(AKey: string; iLen: Integer): Integer;
begin
  if iLen = 0 then iLen := Length(FTable);
  // 根据key的hashcode和table长度取模计算key在table中的位置
  Result := HashCode(AKey) and (iLen - 1);
end;

procedure THashMap.Add(AKey: string; AValue: Variant; AIsObj: Boolean);
var
  index: Integer;
  entry: THashEntry;
begin
  // key为''时，需要特殊处理
  if AKey = '' then
  begin
    PutNullKey(AValue);
    Exit;
  end;

  if Length(FTable) = 0 then
    InitTable;

  index := IndexOf(AKey);
  // 遍历index位置的Entry, 若找到重复key，则更新对应entry的值,再返回
  entry := FTable[index];
  while entry <> nil do
  begin
    if (HashCode(entry.Key) = HashCode(AKey)) and (SameText(entry.Key, AKey)) then
    begin
      //entry.Value := Unassigned;
      entry.Value := AValue;
      Exit;
    end;
    entry := entry.Next;
  end;
  // 如果index位置没有找到或者未找到重复的Key, 则将新Key添加到table的index位置
  Put(index, AKey, AValue, AIsObj);
end;

procedure THashMap.PutNullKey(AValue: Variant);
var
  entry: THashEntry;
begin
  entry := FTable[0];
  while entry <> nil do
  begin
    // 如果找到Key为空的对象时，则覆盖它
    if entry.Key = '' then
    begin
      entry.Value := AValue;
      Exit;
    end;

    entry := entry.Next;
  end;
  Put(0, '', AValue);
end;

procedure THashMap.Put(AIndex: Integer; AKey: string; AValue: Variant; AIsObj: Boolean = False);
var
  entry: THashEntry;
begin
  // 将新的entry放到table的index位置第一个, 如果原来有值则以链表存放
  entry := THashEntry.Create(AKey, AValue, FTable[AIndex], AIsObj);
  FTable[AIndex] := entry;
  // 若达到临界值, 则进行扩容，将table的capacity翻倍
  Inc(FCount);

  if FThreshold >= MAX_SIZE then
  begin
    FThreshold := MAX_SIZE;
    Exit;
  end;

  if FCount >= FThreshold then
  begin
    Resize(Length(FTable) * 2);
  end;
end;

procedure THashMap.Resize(capacity: Integer);
var
  I, index: Integer;
  newTable: TEntrySet;
begin
  if capacity <= Length(FTable) then Exit;


  SetLength(newTable, capacity);

  Transfer(newTable);
  FTable := nil;
  FTable := newTable;

  //修改临界值
  FThreshold := Trunc(Length(FTable) * DEFAULT_LOAD_FACTOR);
  Inc(FResize);
end;

//重新计算index
procedure THashMap.Transfer(ANewTable: TEntrySet);
var
  I, newIndex: Integer;
  iNewCapacity: Integer;
  e, tmpNext: THashEntry;
begin
  iNewCapacity := Length(ANewTable);
  // 循环Table，重新计算各元素索引位置, 再把旧数组数据Copy到新数组中
  for I := Low(FTable) to High(FTable) do
  begin
    e := FTable[I];
    while e <> nil do
    begin
      tmpNext := e.Next;
      // 计算出新的索引
      newIndex := IndexOf(e.Key, iNewCapacity);
      // 把当前旧entry.next链指向新的索引位置，ANewTable[newIndex]可能为nil, 也可能是entry链，
      // 如果是entry链，就直接在链表头插入
      e.Next := ANewTable[newIndex];
      ANewTable[newIndex] := e;

      e := tmpNext;
    end;
  end;
end;

function THashMap.Get(AKey: string): Variant;
var
  entry: THashEntry;
begin
  Result := NULL;
  if (AKey = '') then
  begin
    Result := GetNullKey;
    Exit;
  end;

  entry := GetEntry(AKey);
  if entry = nil then
    Result := NULL
  else
    Result := entry.Value;
end;

function THashMap.GetNullKey: Variant;
var
  e: THashEntry;
begin
  if FCount = 0 then
  begin
    Result := Null;
    Exit;
  end;

  //在FTable[0]的链表上查找key为''的键值对，因为''默认是存在FTable[0]的桶里
  e := FTable[0];
  while e <> nil do
  begin
    if e.Key = '' then
    begin
      Result := e.Value;
      Break;
    end;
    e := e.Next;
  end;
end;


function THashMap.GetEntry(AKey: string): THashEntry;
var
  entry: THashEntry;
begin
  entry := FTable[IndexOf(AKey)];
  try
    while (entry <> nil) do
    begin
      if (HashCode(entry.Key) = HashCode(AKey)) and SameText(entry.Key, AKey) then
      begin
        Result := entry;
        Exit;
      end;
      entry := entry.Next;
    end;
    Result := entry;
  except
    Result := nil;
  end;
end;

procedure THashMap.Remove(AKey: string);
var
  index: Integer;
  pre, entry: THashEntry;
begin
  if AKey = '' then Exit;

  index := IndexOf(AKey);
  pre := nil;
  entry := FTable[index];
  while entry <> nil do
  begin
    if (HashCode(entry.Key) = HashCode(AKey)) and SameText(entry.Key, AKey) then
    begin
      if pre = nil then
        FTable[index] := entry.Next
      else
        pre.Next := entry.Next;

      Dec(FCount);
      Exit;
    end;
    pre := entry;
    entry := entry.Next;
  end;
end;


function THashMap.ContainsKey(AKey: string): Boolean;
begin
  Result := False;
  if AKey = '' then Exit;
  Result := GetEntry(aKey) <> nil;
end;

procedure THashMap.Clear;
var
  I: Integer;
  firstEntry, pre, Entry: THashEntry;
begin
  for I := 0 to Length(FTable) - 1 do
  begin
    firstEntry := FTable[I];
    if firstEntry <> nil then
    begin
      // 有链表
      pre := nil;
      entry := firstEntry.Next;
      while entry <> nil do
      begin
        pre := Entry;
        Entry := pre.Next;
        pre.Next := nil;
        FreeAndNil(pre);
      end;
      FreeAndNil(firstEntry);
      FTable[I] := nil;
    end;
  end;

  SetLength(FTable, 0);
  FCount := 0;
end;

function THashMap.ToString(): string;
var
  I, iPadLeft: Integer;
  entry: THashEntry;
  sValue: string;
begin                     
  if not Assigned(FTable) then Exit;
  Result := Format('Size: %d, capacity: %d, Resize: %d;'#10#13, [FCount, Length(FTable), FResize]);
  Result := Result + #13#10;
  for I := 0 to Length(FTable) - 1 do
  begin
    entry := FTable[I];
    if entry = nil then
      Result := Result + Format('a[%d] = nil'#13#10, [I])
    else
      Result := Result + Format('a[%d]  ', [I]);

    iPadLeft := Length(Format('a[%d]  ', [I])) + 1;
    while entry <> nil do
    begin
      case TVarData(entry.Value).VType of
        varString: sValue := '''' + entry.Value + '''';
      else
        sValue := VarToStrDef(entry.Value, '');
      end;


      if entry <> FTable[I] then
        Result := Result + DupeString(' ', iPadLeft) + ' -> ' + entry.Key + ' = ' +  sValue
      else
        Result := Result + entry.Key + ' = ' + sValue;

      entry := entry.Next;
      Result := Result + #13#10;
    end;
  end;
end;

function THashMap.ToList: TList;
var
  I: Integer;
  e: THashEntry;
begin
  Result := nil;
  if Length(FTable) = 0 then
  begin
    Exit;
  end;

  Result := TList.Create;
  for I := Low(FTable) to High(FTable) do
  begin
    e := FTable[I];
    while e <> nil do
    begin
      Result.Add(e);
      e := e.Next;
    end;
  end;
end;

function THashMap.GetEntrySet: TEntrySet;
var
  I: Integer;
  e: THashEntry;
  aList: TList;
begin
  Result := nil;
  if Length(FTable) = 0 then
  begin
    Exit;
  end;

  try
    // 1、先获取到数组和链表中所有Entry对象
    aList := ToList;
    // 2、把得到的Entry对象加入到TEntrySet中
    SetLength(Result, aList.Count);
    for I := 0 to aList.Count - 1 do
    begin
      Result[I] := aList[I];
    end;
  finally
    FreeAndNil(aList);
  end;
end;

procedure THashMap.Add(AMap: THashMap);
var
  I: Integer;
  e: THashEntry;
  aSet: TEntrySet;
begin
  aSet := AMap.GetEntrySet;
  for I := 0 to Length(aSet) - 1 do
  begin
    Add(aSet[I].Key, aSet[I].Value);
  end;
end;

// 插入对象
procedure THashMap.AddObject(AKey: string; AValue: TObject);
begin
  Add(AKey, Integer(AValue), True);
end;

function THashMap.GetObject(AKey: string): TObject;
begin
  Result := TObject(Integer(Get(AKey)));
end;


// key排序
function SortCompareByKey(Item1, Item2: Pointer): Integer;
begin
  Result := AnsiCompareStr(THashEntry(item1).Key, THashEntry(Item2).Key);
end;

// Value排序
function SortCompareByValue(Item1, Item2: Pointer): Integer;
begin
  Result := AnsiCompareStr(THashEntry(item1).Value, THashEntry(Item2).Value);
end;

// KeyValue排序
function SortCompareByKeyValue(Item1, Item2: Pointer): Integer;
begin
  Result := AnsiCompareStr(THashEntry(item1).Key + VarToStrDef(THashEntry(item1).Value, '')
    , THashEntry(item2).Key + VarToStrDef(THashEntry(Item2).Value, ''));
end;

function THashMap.Sort(ASortType: TSortType): TEntrySet;
var
  I: Integer;
  aSortCompare: TListSortCompare;
  aList: TList;
begin
  aList := ToList;
  try
    case ASortType of
      stKey:
        aSortCompare := SortCompareByKey;
      stValue:
        aSortCompare := SortCompareByValue;
    else
      aSortCompare := SortCompareByKeyValue;
    end;
    aList.Sort(aSortCompare);

    SetLength(Result, aList.Count);
    for I := 0 to aList.Count - 1 do
    begin
      Result[I] := aList[I];
    end;
  finally
    FreeAndNil(aList);
  end;
end;



function THashMap.GetItems(Index: Integer): THashEntry;
begin
  if (Index < 0) or (Index >= FCount) then
  begin
    Result := nil;
    Exit;
  end;
  Result := FTable[Index];  
end;

end.

{*******************************************************}
{                                                       }
{       Delphi HashMap                                  }
{                                                       }
{       版权所有 (C) 2018 hsoft                          }
{                                                       }
{                                                       }
{ Author: MarkWu    Email: 77910086@qq.com              }
{ Date:   2018-01-02 14:17:00                           }
{ Desc:   HashMap                                       }
{*******************************************************}

unit uHashEntry;

interface

uses
  Variants;

type
  THashEntry = class
  private
    FKey: string;
    FValue: Variant;
    FNext: THashEntry;
    FIsObj: Boolean;
    procedure SetValue(const Value: Variant);
    function GetValue: Variant;
  public
    constructor Create(AKey: string; AValue: Variant; ANext: THashEntry; AIsObj: Boolean = False);

    function ToString(): string;
    function HashCode: Integer;

    property Key: string read FKey write FKey;
    property Value: Variant read GetValue write SetValue;
    property Next: THashEntry read FNext write FNext;
    property IsObj: Boolean read FIsObj;
  end;

implementation

{ THashEntry }

constructor THashEntry.Create(AKey: string; AValue: Variant; ANext: THashEntry; AIsObj: Boolean);
begin
  FKey := AKey;
  FValue := AValue;
  FIsObj := AIsObj;
  FNext  := ANext;
end;

function THashEntry.HashCode: Integer;
begin
  Result := Integer(Self);
end;

function THashEntry.GetValue: Variant;
begin
  Result := FValue;
end;

procedure THashEntry.SetValue(const Value: Variant);
begin
  FValue := Value;
end;

function THashEntry.ToString: string;
begin
  Result := FKey + '=' + VarToStrDef(FValue, '');
end;

end.

测试效果图

 

 HashMap, StringList, HashedStringList的性能比较， HashMap的性能比较稳定，保持O(1)， 而HashedStringList第1次查找时很慢，后面就稳定了，不知啥原因，没有去跟踪它代码。

测试程序源码：

object Form1: TForm1
  Left = 263
  Top = 169
  Width = 787
  Height = 518
  Caption = 'HashMap Demo -- Author: MarkWu  QQ:77910086'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 237
    Top = 90
    Width = 18
    Height = 13
    Caption = 'Key'
  end
  object Label2: TLabel
    Left = 237
    Top = 119
    Width = 27
    Height = 13
    Caption = 'Value'
  end
  object Label3: TLabel
    Left = 231
    Top = 168
    Width = 34
    Height = 13
    Caption = 'Serach'
  end
  object Label4: TLabel
    Left = 240
    Top = 348
    Width = 14
    Height = 13
    Caption = 'N: '
  end
  object Label5: TLabel
    Left = 365
    Top = 347
    Width = 17
    Height = 13
    Caption = 'Get'
  end
  object Button1: TButton
    Left = 257
    Top = 11
    Width = 75
    Height = 25
    Caption = #21021#22987#21270'Map'
    TabOrder = 2
    OnClick = Button1Click
  end
  object Memo1: TMemo
    Left = 0
    Top = 0
    Width = 225
    Height = 480
    Align = alLeft
    ScrollBars = ssVertical
    TabOrder = 0
  end
  object Button2: TButton
    Left = 364
    Top = 163
    Width = 75
    Height = 25
    Caption = 'Get'
    TabOrder = 8
    OnClick = Button2Click
  end
  object Edit1: TEdit
    Left = 268
    Top = 164
    Width = 85
    Height = 21
    TabOrder = 9
  end
  object Button3: TButton
    Left = 364
    Top = 97
    Width = 75
    Height = 25
    Caption = 'Put'
    TabOrder = 6
    OnClick = Button3Click
  end
  object edt_key: TEdit
    Left = 268
    Top = 85
    Width = 85
    Height = 21
    TabOrder = 5
  end
  object edt_value: TEdit
    Left = 268
    Top = 117
    Width = 85
    Height = 21
    TabOrder = 7
  end
  object Button4: TButton
    Left = 364
    Top = 11
    Width = 75
    Height = 25
    Caption = 'Destory Map'
    TabOrder = 3
    OnClick = Button4Click
  end
  object btnSortKey: TButton
    Left = 241
    Top = 236
    Width = 97
    Height = 25
    Caption = 'Sort Key'
    TabOrder = 12
    OnClick = btnSortKeyClick
  end
  object PutMap: TButton
    Left = 241
    Top = 203
    Width = 97
    Height = 25
    Caption = 'PutMap'
    TabOrder = 10
    OnClick = PutMapClick
  end
  object Button5: TButton
    Left = 257
    Top = 51
    Width = 184
    Height = 25
    Caption = #25171#21360'Map'#20869#23481
    TabOrder = 4
    OnClick = Button5Click
  end
  object btnSortValue: TButton
    Left = 241
    Top = 270
    Width = 97
    Height = 25
    Caption = 'Sort Value'
    TabOrder = 13
    OnClick = btnSortValueClick
  end
  object btnSortKeyValue: TButton
    Left = 241
    Top = 303
    Width = 97
    Height = 25
    Caption = 'Sort KeyValue'
    TabOrder = 14
    OnClick = btnSortKeyValueClick
  end
  object btnHashMap10000: TButton
    Left = 241
    Top = 379
    Width = 122
    Height = 25
    Caption = 'HashMap '#22686#21152'N'#26465
    TabOrder = 17
    OnClick = btnHashMap10000Click
  end
  object btnStringList10000: TButton
    Left = 241
    Top = 408
    Width = 122
    Height = 25
    Caption = 'StringList '#22686#21152'N'#26465
    TabOrder = 19
    OnClick = btnStringList10000Click
  end
  object edt_N: TEdit
    Left = 259
    Top = 345
    Width = 104
    Height = 21
    TabOrder = 15
    Text = '10000'
  end
  object btn_hashMap_get: TButton
    Left = 373
    Top = 379
    Width = 100
    Height = 25
    Caption = 'hashMap_get'
    TabOrder = 18
    OnClick = btn_hashMap_getClick
  end
  object btn_stringList_get: TButton
    Left = 373
    Top = 408
    Width = 100
    Height = 25
    Caption = 'stringList_get'
    TabOrder = 20
    OnClick = btn_stringList_getClick
  end
  object edt_Get: TEdit
    Left = 387
    Top = 345
    Width = 104
    Height = 21
    TabOrder = 16
  end
  object Button6: TButton
    Left = 364
    Top = 203
    Width = 75
    Height = 25
    Caption = 'AddObject'
    TabOrder = 11
    OnClick = Button6Click
  end
  object Panel1: TPanel
    Left = 504
    Top = 0
    Width = 267
    Height = 480
    Align = alRight
    BevelOuter = bvNone
    TabOrder = 1
    object Label6: TLabel
      Left = 0
      Top = 0
      Width = 267
      Height = 16
      Align = alTop
      Caption = 'HashMap'#20869#23384#20998#24067
    end
    object Memo2: TMemo
      Left = 0
      Top = 16
      Width = 267
      Height = 464
      Align = alClient
      ScrollBars = ssVertical
      TabOrder = 0
    end
  end
  object btn_HashStringList1000: TButton
    Left = 241
    Top = 439
    Width = 122
    Height = 25
    Caption = 'HashStringList '#22686#21152'N'#26465
    TabOrder = 21
    OnClick = btn_HashStringList1000Click
  end
  object btn_HashStringList_get: TButton
    Left = 373
    Top = 439
    Width = 100
    Height = 25
    Caption = 'HashStringList_Get'
    TabOrder = 22
    OnClick = btn_HashStringList_getClick
  end
end

{*******************************************************}
{                                                       }
{       Delphi HashMap test                             }
{                                                       }
{       版权所有 (C) 2018 hsoft                        }
{                                                        }
{                                                       }
{ Author: MarkWu    Email: 77910086@qq.com                }
{ Date:   2018-01-02 14:17:00                           }
{ Desc:   HashMap                                       }
{*******************************************************}

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, uHashMap, StdCtrls, StrUtils, ExtCtrls, IniFiles;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    Edit1: TEdit;
    Button3: TButton;
    edt_key: TEdit;
    edt_value: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Button4: TButton;
    btnSortKey: TButton;
    PutMap: TButton;
    Button5: TButton;
    btnSortValue: TButton;
    btnSortKeyValue: TButton;
    btnHashMap10000: TButton;
    btnStringList10000: TButton;
    Label4: TLabel;
    edt_N: TEdit;
    btn_hashMap_get: TButton;
    btn_stringList_get: TButton;
    Label5: TLabel;
    edt_Get: TEdit;
    Button6: TButton;
    Panel1: TPanel;
    Label6: TLabel;
    Memo2: TMemo;
    btn_HashStringList1000: TButton;
    btn_HashStringList_get: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure btnSortKeyClick(Sender: TObject);
    procedure PutMapClick(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure btnSortValueClick(Sender: TObject);
    procedure btnSortKeyValueClick(Sender: TObject);
    procedure btnHashMap10000Click(Sender: TObject);
    procedure btnStringList10000Click(Sender: TObject);
    procedure btn_hashMap_getClick(Sender: TObject);
    procedure btn_stringList_getClick(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure btn_HashStringList1000Click(Sender: TObject);
    procedure btn_HashStringList_getClick(Sender: TObject);

  private
    { Private declarations }
    aHashMap: THashMap;

    FMap: THashMap;
    FList: TStringList;
    FHashList: THashedStringList;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses uHashEntry;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  aHashMap := THashMap.Create;

  FMap := THashMap.Create;
  FList := TStringList.Create;
  FHashList := THashedStringList.Create;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  //caption :=  IntToStr(aHashMap.HashCode('123'));
  //caption :=  IntToStr(5 mod 3);
  aHashMap.Add('中国', '中华人民共和国');
  aHashMap.Add('中國', '中華人民共和國');
  aHashMap.Add('吴wu', 'MarkWu');
  aHashMap.Add('b', 2);
  aHashMap.Add('c', 3);
  aHashMap.Add('d', 'dd');
  aHashMap.Add('e', 'ee');
  aHashMap.Add('f', 'ff');
  aHashMap.Add('g', 'ggg');
  aHashMap.Add('h', 11.1);
  aHashMap.Add('i', 22.2);
  aHashMap.Add('j', 33.3);
  aHashMap.Add('k', 44.4);
  aHashMap.Add('l', True);

  aHashMap.Add('aa', 'a1');
  aHashMap.Add('ca', 'c2');

  aHashMap.Add('', '0000000000');
  aHashMap.Add('', '1111111111');
 // aHashMap.Put('m', VarArrayOf([1, 2, 'a', 'b']));

  Memo1.Lines.Add(aHashMap.ToString);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  I: Integer;
  aMap: THashMap;
  aSet: TEntrySet;
begin
{  aMap := THashMap.Create;
  aMap.Put('h1', 'h1');
  aMap.Put('h2', 2);
  aMap.Put('h3', 33);
  aMap.Put('中1', 81);
  aMap.Put('中2', 82);
  aMap.Put('中2', 83);

  aMap.Put(aHashMap);
}
  //Memo2.Lines.Add(aMap.ToString);
  Memo2.Lines.Add('---------------Get-----------------');
  Memo2.Lines.Add(VarToStrDef( aHashMap.Get(Edit1.Text), ''));

  //aMap.Free;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  aHashMap.Add(edt_key.Text, edt_value.Text);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  FreeAndNil(aHashMap);
end;

procedure TForm1.btnSortKeyClick(Sender: TObject);
var
  I: Integer;
  aSet: TEntrySet;
begin
  Memo2.Lines.Add('---------------Sort Key-----------------');
  aSet := aHashMap.Sort(stKey);
  for I := 0 to Length(aSet) - 1 do
  begin
    Memo2.Lines.Add(aSet[I].Key + '=' + VarToStrDef(aSet[I].Value, 'NULL') );
  end;
end;

procedure TForm1.btnSortValueClick(Sender: TObject);
var
  I: Integer;
  aSet: TEntrySet;
begin
  Memo2.Lines.Add('---------------Sort Value-----------------');
  aSet := aHashMap.Sort(stValue);
  for I := 0 to Length(aSet) - 1 do
  begin
    Memo2.Lines.Add(aSet[I].Key + '=' + VarToStrDef(aSet[I].Value, 'NULL') );
  end;
end;

procedure TForm1.btnSortKeyValueClick(Sender: TObject);
var
  I: Integer;
  aSet: TEntrySet;
begin
  Memo2.Lines.Add('---------------Sort KeyValue-----------------');
  aSet := aHashMap.Sort(stKeyValue);
  for I := 0 to Length(aSet) - 1 do
  begin
    Memo2.Lines.Add(aSet[I].Key + '=' + VarToStrDef(aSet[I].Value, 'NULL') );
  end;
end;


procedure TForm1.PutMapClick(Sender: TObject);
var
  I: Integer;
  aMap: THashMap;
  aSet: TEntrySet;
begin
  aMap := THashMap.Create;
  aMap.Add('h1', 'h1');
  aMap.Add('h2', 2);
  aMap.Add('h3', 33);
  aMap.Add('中1', 81);
  aMap.Add('中2', 82);
  aMap.Add('中2', 83);
  //aMap.Put(aHashMap);
  aHashMap.Add(aMap);

  //Memo2.Lines.Add(aMap.ToString);

   Memo2.Lines.Add('-------------------PutMap-------------------');
  aSet := aHashMap.GetEntrySet;
  for I := 0 to Length(aSet) - 1 do
  begin
    Memo2.Lines.Add(aSet[I].Key + '=' + VarToStrDef(aSet[I].Value, '') );
  end;
  aMap.Free;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  Memo2.Lines.Add('------------------ToString----------------------');
  Memo2.Lines.Add(aHashMap.ToString);
end;



procedure TForm1.btnHashMap10000Click(Sender: TObject);
var
  I: Integer;
  iBegin, iEnd: Cardinal;
  map: THashMap;
begin
  FMap.Clear;
  iBegin := GetTickCount;
  map := FMap;
  for I := 0 to StrToInt(edt_N.Text) - 1 do
  begin
    map.Add( IntToStr(I), I);   //'m' +
  end;
  iEnd := (GetTickCount - iBegin);

  Memo2.Lines.Add(Format('-------------------- %s ToString--------------------', [btnHashMap10000.Caption]));
  Memo2.Lines.Add(Format('HashMap 增加%d条, 总共花了%d ms', [StrToIntDef(edt_N.Text, 1), iEnd]));
  //Memo2.Lines.Add(map.ToString);
end;

procedure TForm1.btnStringList10000Click(Sender: TObject);
var
  I: Integer;
  iBegin, iEnd: Cardinal;
  str: string;
  aList: TStringList;
begin
  FList.Clear;
  iBegin := GetTickCount;
  aList := FList; //TStringList.Create;
  for I := 0 to StrToInt(edt_N.Text) -1 do
  begin
    aList.Add( IntToStr(I) + '=' + IntToStr(I));
  end;
  iEnd := GetTickCount - iBegin;

  Memo2.Lines.Add(Format('-------------------- %s ToString--------------------', [btnStringList10000.Caption]));
  //Memo2.Lines.Add(btnStringList10000.Caption + ' 总共花了' + Inttostr(iEnd));
  Memo2.Lines.Add(Format('StringList 增加%d条, 总共花了%d ms', [StrToIntDef(edt_N.Text, 1), iEnd]));

  {
  str := '';
  for I := 0 to aList.Count - 1 do
  begin
    str := str + #13#10 + aList[I];
  end;
  Memo2.Lines.Add(str);
  }
end;

procedure TForm1.btn_hashMap_getClick(Sender: TObject);
var
  iBegin, iEnd: Cardinal;
  sValue: string;
begin
  try
    if Trim(edt_Get.Text) = '' then
    begin
      if edt_Get.CanFocus then edt_Get.SetFocus;
      ShowMessage('请输入要查询的key');
      Abort;
    end;
    iBegin := GetTickCount;
    sValue := FMap.Get(edt_Get.Text);
    iEnd := GetTickCount - iBegin;
    Memo2.Lines.Add('------------------hashMap Get-----------------');
    Memo2.Lines.Add(sValue + '--->' + IntToStr(iEnd) + 'ms');
  except

  end;
end;

procedure TForm1.btn_stringList_getClick(Sender: TObject);
var
  iBegin, iEnd: Cardinal;
  sValue: string;
begin
  try
    if Trim(edt_Get.Text) = '' then
    begin
      if edt_Get.CanFocus then edt_Get.SetFocus;
      ShowMessage('请输入要查询的key');
      Abort;
    end;
    iBegin := GetTickCount;
    sValue := FList.Values[edt_Get.Text]; //FList.ValueFromIndex(Flist.);
    iEnd := GetTickCount - iBegin;
    Memo2.Lines.Add('------------------StringList Get-----------------');
    Memo2.Lines.Add(sValue + '--->' + IntToStr(iEnd) + 'ms');
  except

  end;
end;

procedure TForm1.Button6Click(Sender: TObject);
var
  v: Variant;
  map: THashMap;
begin
  //map := THashMap.Create;
  map := aHashMap;
  try
    v := Integer(Self);
    map.AddObject('form1', Self);
    //ShowMessage(map.Get('form1').Value);

    ShowMessage(TForm1(map.GetObject('form1')).Caption);
  finally
    //FreeAndNil(map);
  end;
end;

procedure TForm1.btn_HashStringList1000Click(Sender: TObject);
var
  I: Integer;
  iBegin, iEnd: Cardinal;
  str: string;
  aList: THashedStringList;
begin
  FHashList.Clear;
  iBegin := GetTickCount;
  aList := FHashList; //TStringList.Create;
  for I := 0 to StrToInt(edt_N.Text) -1 do
  begin
    aList.Add(IntToStr(I) + '=' + IntToStr(I));
  end;
  iEnd := GetTickCount - iBegin;

  Memo2.Lines.Add(Format('-------------------- %s ToString--------------------', [btn_HashStringList1000.Caption]));
  //Memo2.Lines.Add(btnStringList10000.Caption + ' 总共花了' + Inttostr(iEnd));
  Memo2.Lines.Add(Format('HashStringList 增加%d条, 总共花了%d ms', [StrToIntDef(edt_N.Text, 1), iEnd]));

  {
  str := '';
  for I := 0 to aList.Count - 1 do
  begin
    str := str + #13#10 + aList[I];
  end;
  Memo2.Lines.Add(str);
  }
end;

procedure TForm1.btn_HashStringList_getClick(Sender: TObject);
var
  iBegin, iEnd: Cardinal;
  sValue: string;
begin
  try
    if Trim(edt_Get.Text) = '' then
    begin
      if edt_Get.CanFocus then edt_Get.SetFocus;
      ShowMessage('请输入要查询的key');
      Abort;
    end;
    iBegin := GetTickCount;
    sValue := FHashList.Values[edt_Get.Text];
    //sValue := FHashList.ValueFromIndex[ FHashList.IndexOfName(edt_Get.Text) ];
    iEnd := GetTickCount - iBegin;
    Memo2.Lines.Add('------------------HashedStringList Get-----------------');
    Memo2.Lines.Add(sValue + '--->' + IntToStr(iEnd) + 'ms');
  except

  end;
end;

end.