Delphi的HashMap

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

  1 {*******************************************************}
  2 {                                                       }
  3 {       Delphi HashMap                                  }
  4 {                                                       }
  5 {       版权所有 (C) 2018 hsoft                          }
  6 {                                                       }
  7 {                                                       }
  8 { Author: MarkWu    Email: 77910086@qq.com              }
  9 { Date:   2018-01-02 14:17:00                           }
 10 { Desc:   HashMap                                       }
 11 {*******************************************************}
 12 
 13 unit uHashMap;
 14 
 15 interface
 16 
 17 uses
 18   Windows, SysUtils, StrUtils, Classes, uHashEntry, Variants;
 19 
 20 type
 21   // 实体数组类型
 22   TEntrySet = array of THashEntry;
 23   
 24   // 排序类型
 25   TSortType = (
 26         stKey,      // 按Key排序
 27         stValue,    // 按Value排序
 28         stKeyValue  // Key=Value排序
 29   );
 30 
 31   THashMap = class
 32   private
 33     // 临界值
 34     FThreshold: Integer;
 35 
 36     // 元素个数
 37     FCount: Integer;
 38 
 39     // 扩容次数
 40     FResize: Integer;
 41 
 42     FTable: TEntrySet;
 43 
 44     procedure InitTable();
 45 
 46     // 计算AKey的HashCode
 47     function HashCode(AKey: string): Integer;
 48     function IndexOf(AKey: string; iLen: Integer = 0): Integer;
 49     
 50     procedure Put(AIndex: Integer; AKey: string; AValue: Variant; AIsObj: Boolean = False);
 51     // 加入Key为空
 52     procedure PutNullKey(AValue: Variant);
 53 
 54     procedure Resize(capacity: Integer);
 55 
 56     function ToList: TList;
 57 
 58     //扩容时重新计算各元素的index
 59     procedure Transfer(ANewTable: TEntrySet);
 60     function GetItems(Index: Integer): THashEntry;
 61 
 62   public
 63     constructor Create();
 64     destructor Destroy; override;
 65     // 添加一个元素
 66     procedure Add(AKey: string; AValue: Variant; AIsObj: Boolean = False); overload;
 67     procedure Add(AMap: THashMap); overload;
 68     procedure AddObject(AKey: string; AValue: TObject);
 69 
 70     function Get(AKey: string): Variant;
 71     function GetObject(AKey: string): TObject;
 72     function GetNullKey: Variant;
 73     function GetEntry(AKey: string): THashEntry;
 74     procedure Remove(AKey: string);
 75     function ContainsKey(AKey: string): Boolean;
 76     procedure Clear;
 77 
 78     function GetEntrySet: TEntrySet;
 79 
 80     function ToString: string;
 81 
 82     // 排序
 83     function Sort(ASortType: TSortType = stKeyValue): TEntrySet;
 84 
 85     property Count: Integer read FCount;
 86     property Items[Index: Integer]: THashEntry read GetItems; default;
 87   end;
 88 
 89 implementation
 90 
 91 
 92 const
 93   //默认初始化大小 16, 数组长度一定是2的次幂
 94   DEFAULT_INITIAL_CAPACITY = 16;
 95 
 96   //默认负载因子 0.75
 97   DEFAULT_LOAD_FACTOR = 0.75;
 98 
 99   MAX_SIZE = 1000000;
100 
101 { THashMap }
102 
103 constructor THashMap.Create;
104 begin
105   InitTable;
106 end;
107 
108 destructor THashMap.Destroy;
109 begin
110   Clear;
111 
112   SetLength(FTable, 0);
113   FCount := 0;
114   inherited;
115 end;
116 
117 
118 procedure THashMap.InitTable;
119 begin
120   SetLength(FTable, DEFAULT_INITIAL_CAPACITY);
121   FThreshold := Trunc(DEFAULT_INITIAL_CAPACITY * DEFAULT_LOAD_FACTOR);
122   FCount := 0;
123 end;
124 
125 // 计算AKey的HashCode
126 function THashMap.HashCode(AKey: string): Integer;
127 var
128   I: Integer;
129 begin                                       
130   Result := 0;
131   if (Result = 0) and (Length(AKey) > 0) then
132   begin
133     for I := 1 to Length(AKey) do
134     begin
135       Result := 31 * Result + Ord(AKey[I]);
136     end;
137   end;
138 end;
139 
140 function THashMap.IndexOf(AKey: string; iLen: Integer): Integer;
141 begin
142   if iLen = 0 then iLen := Length(FTable);
143   // 根据key的hashcode和table长度取模计算key在table中的位置
144   Result := HashCode(AKey) and (iLen - 1);
145 end;
146 
147 procedure THashMap.Add(AKey: string; AValue: Variant; AIsObj: Boolean);
148 var
149   index: Integer;
150   entry: THashEntry;
151 begin
152   // key为''时,需要特殊处理
153   if AKey = '' then
154   begin
155     PutNullKey(AValue);
156     Exit;
157   end;
158 
159   if Length(FTable) = 0 then
160     InitTable;
161 
162   index := IndexOf(AKey);
163   // 遍历index位置的Entry, 若找到重复key,则更新对应entry的值,再返回
164   entry := FTable[index];
165   while entry <> nil do
166   begin
167     if (HashCode(entry.Key) = HashCode(AKey)) and (SameText(entry.Key, AKey)) then
168     begin
169       //entry.Value := Unassigned;
170       entry.Value := AValue;
171       Exit;
172     end;
173     entry := entry.Next;
174   end;
175   // 如果index位置没有找到或者未找到重复的Key, 则将新Key添加到table的index位置
176   Put(index, AKey, AValue, AIsObj);
177 end;
178 
179 procedure THashMap.PutNullKey(AValue: Variant);
180 var
181   entry: THashEntry;
182 begin
183   entry := FTable[0];
184   while entry <> nil do
185   begin
186     // 如果找到Key为空的对象时,则覆盖它
187     if entry.Key = '' then
188     begin
189       entry.Value := AValue;
190       Exit;
191     end;
192 
193     entry := entry.Next;
194   end;
195   Put(0, '', AValue);
196 end;
197 
198 procedure THashMap.Put(AIndex: Integer; AKey: string; AValue: Variant; AIsObj: Boolean = False);
199 var
200   entry: THashEntry;
201 begin
202   // 将新的entry放到table的index位置第一个, 如果原来有值则以链表存放
203   entry := THashEntry.Create(AKey, AValue, FTable[AIndex], AIsObj);
204   FTable[AIndex] := entry;
205   // 若达到临界值, 则进行扩容,将table的capacity翻倍
206   Inc(FCount);
207 
208   if FThreshold >= MAX_SIZE then
209   begin
210     FThreshold := MAX_SIZE;
211     Exit;
212   end;
213 
214   if FCount >= FThreshold then
215   begin
216     Resize(Length(FTable) * 2);
217   end;
218 end;
219 
220 procedure THashMap.Resize(capacity: Integer);
221 var
222   I, index: Integer;
223   newTable: TEntrySet;
224 begin
225   if capacity <= Length(FTable) then Exit;
226 
227 
228   SetLength(newTable, capacity);
229 
230   Transfer(newTable);
231   FTable := nil;
232   FTable := newTable;
233 
234   //修改临界值
235   FThreshold := Trunc(Length(FTable) * DEFAULT_LOAD_FACTOR);
236   Inc(FResize);
237 end;
238 
239 //重新计算index
240 procedure THashMap.Transfer(ANewTable: TEntrySet);
241 var
242   I, newIndex: Integer;
243   iNewCapacity: Integer;
244   e, tmpNext: THashEntry;
245 begin
246   iNewCapacity := Length(ANewTable);
247   // 循环Table,重新计算各元素索引位置, 再把旧数组数据Copy到新数组中
248   for I := Low(FTable) to High(FTable) do
249   begin
250     e := FTable[I];
251     while e <> nil do
252     begin
253       tmpNext := e.Next;
254       // 计算出新的索引
255       newIndex := IndexOf(e.Key, iNewCapacity);
256       // 把当前旧entry.next链指向新的索引位置,ANewTable[newIndex]可能为nil, 也可能是entry链,
257       // 如果是entry链,就直接在链表头插入
258       e.Next := ANewTable[newIndex];
259       ANewTable[newIndex] := e;
260 
261       e := tmpNext;
262     end;
263   end;
264 end;
265 
266 function THashMap.Get(AKey: string): Variant;
267 var
268   entry: THashEntry;
269 begin
270   Result := NULL;
271   if (AKey = '') then
272   begin
273     Result := GetNullKey;
274     Exit;
275   end;
276 
277   entry := GetEntry(AKey);
278   if entry = nil then
279     Result := NULL
280   else
281     Result := entry.Value;
282 end;
283 
284 function THashMap.GetNullKey: Variant;
285 var
286   e: THashEntry;
287 begin
288   if FCount = 0 then
289   begin
290     Result := Null;
291     Exit;
292   end;
293 
294   //在FTable[0]的链表上查找key为''的键值对,因为''默认是存在FTable[0]的桶里
295   e := FTable[0];
296   while e <> nil do
297   begin
298     if e.Key = '' then
299     begin
300       Result := e.Value;
301       Break;
302     end;
303     e := e.Next;
304   end;
305 end;
306 
307 
308 function THashMap.GetEntry(AKey: string): THashEntry;
309 var
310   entry: THashEntry;
311 begin
312   entry := FTable[IndexOf(AKey)];
313   try
314     while (entry <> nil) do
315     begin
316       if (HashCode(entry.Key) = HashCode(AKey)) and SameText(entry.Key, AKey) then
317       begin
318         Result := entry;
319         Exit;
320       end;
321       entry := entry.Next;
322     end;
323     Result := entry;
324   except
325     Result := nil;
326   end;
327 end;
328 
329 procedure THashMap.Remove(AKey: string);
330 var
331   index: Integer;
332   pre, entry: THashEntry;
333 begin
334   if AKey = '' then Exit;
335 
336   index := IndexOf(AKey);
337   pre := nil;
338   entry := FTable[index];
339   while entry <> nil do
340   begin
341     if (HashCode(entry.Key) = HashCode(AKey)) and SameText(entry.Key, AKey) then
342     begin
343       if pre = nil then
344         FTable[index] := entry.Next
345       else
346         pre.Next := entry.Next;
347 
348       Dec(FCount);
349       Exit;
350     end;
351     pre := entry;
352     entry := entry.Next;
353   end;
354 end;
355 
356 
357 function THashMap.ContainsKey(AKey: string): Boolean;
358 begin
359   Result := False;
360   if AKey = '' then Exit;
361   Result := GetEntry(aKey) <> nil;
362 end;
363 
364 procedure THashMap.Clear;
365 var
366   I: Integer;
367   firstEntry, pre, Entry: THashEntry;
368 begin
369   for I := 0 to Length(FTable) - 1 do
370   begin
371     firstEntry := FTable[I];
372     if firstEntry <> nil then
373     begin
374       // 有链表
375       pre := nil;
376       entry := firstEntry.Next;
377       while entry <> nil do
378       begin
379         pre := Entry;
380         Entry := pre.Next;
381         pre.Next := nil;
382         FreeAndNil(pre);
383       end;
384       FreeAndNil(firstEntry);
385       FTable[I] := nil;
386     end;
387   end;
388 
389   SetLength(FTable, 0);
390   FCount := 0;
391 end;
392 
393 function THashMap.ToString(): string;
394 var
395   I, iPadLeft: Integer;
396   entry: THashEntry;
397   sValue: string;
398 begin                     
399   if not Assigned(FTable) then Exit;
400   Result := Format('Size: %d, capacity: %d, Resize: %d;'#10#13, [FCount, Length(FTable), FResize]);
401   Result := Result + #13#10;
402   for I := 0 to Length(FTable) - 1 do
403   begin
404     entry := FTable[I];
405     if entry = nil then
406       Result := Result + Format('a[%d] = nil'#13#10, [I])
407     else
408       Result := Result + Format('a[%d]  ', [I]);
409 
410     iPadLeft := Length(Format('a[%d]  ', [I])) + 1;
411     while entry <> nil do
412     begin
413       case TVarData(entry.Value).VType of
414         varString: sValue := '''' + entry.Value + '''';
415       else
416         sValue := VarToStrDef(entry.Value, '');
417       end;
418 
419 
420       if entry <> FTable[I] then
421         Result := Result + DupeString(' ', iPadLeft) + ' -> ' + entry.Key + ' = ' +  sValue
422       else
423         Result := Result + entry.Key + ' = ' + sValue;
424 
425       entry := entry.Next;
426       Result := Result + #13#10;
427     end;
428   end;
429 end;
430 
431 function THashMap.ToList: TList;
432 var
433   I: Integer;
434   e: THashEntry;
435 begin
436   Result := nil;
437   if Length(FTable) = 0 then
438   begin
439     Exit;
440   end;
441 
442   Result := TList.Create;
443   for I := Low(FTable) to High(FTable) do
444   begin
445     e := FTable[I];
446     while e <> nil do
447     begin
448       Result.Add(e);
449       e := e.Next;
450     end;
451   end;
452 end;
453 
454 function THashMap.GetEntrySet: TEntrySet;
455 var
456   I: Integer;
457   e: THashEntry;
458   aList: TList;
459 begin
460   Result := nil;
461   if Length(FTable) = 0 then
462   begin
463     Exit;
464   end;
465 
466   try
467     // 1、先获取到数组和链表中所有Entry对象
468     aList := ToList;
469     // 2、把得到的Entry对象加入到TEntrySet中
470     SetLength(Result, aList.Count);
471     for I := 0 to aList.Count - 1 do
472     begin
473       Result[I] := aList[I];
474     end;
475   finally
476     FreeAndNil(aList);
477   end;
478 end;
479 
480 procedure THashMap.Add(AMap: THashMap);
481 var
482   I: Integer;
483   e: THashEntry;
484   aSet: TEntrySet;
485 begin
486   aSet := AMap.GetEntrySet;
487   for I := 0 to Length(aSet) - 1 do
488   begin
489     Add(aSet[I].Key, aSet[I].Value);
490   end;
491 end;
492 
493 // 插入对象
494 procedure THashMap.AddObject(AKey: string; AValue: TObject);
495 begin
496   Add(AKey, Integer(AValue), True);
497 end;
498 
499 function THashMap.GetObject(AKey: string): TObject;
500 begin
501   Result := TObject(Integer(Get(AKey)));
502 end;
503 
504 
505 // key排序
506 function SortCompareByKey(Item1, Item2: Pointer): Integer;
507 begin
508   Result := AnsiCompareStr(THashEntry(item1).Key, THashEntry(Item2).Key);
509 end;
510 
511 // Value排序
512 function SortCompareByValue(Item1, Item2: Pointer): Integer;
513 begin
514   Result := AnsiCompareStr(THashEntry(item1).Value, THashEntry(Item2).Value);
515 end;
516 
517 // KeyValue排序
518 function SortCompareByKeyValue(Item1, Item2: Pointer): Integer;
519 begin
520   Result := AnsiCompareStr(THashEntry(item1).Key + VarToStrDef(THashEntry(item1).Value, '')
521     , THashEntry(item2).Key + VarToStrDef(THashEntry(Item2).Value, ''));
522 end;
523 
524 function THashMap.Sort(ASortType: TSortType): TEntrySet;
525 var
526   I: Integer;
527   aSortCompare: TListSortCompare;
528   aList: TList;
529 begin
530   aList := ToList;
531   try
532     case ASortType of
533       stKey:
534         aSortCompare := SortCompareByKey;
535       stValue:
536         aSortCompare := SortCompareByValue;
537     else
538       aSortCompare := SortCompareByKeyValue;
539     end;
540     aList.Sort(aSortCompare);
541 
542     SetLength(Result, aList.Count);
543     for I := 0 to aList.Count - 1 do
544     begin
545       Result[I] := aList[I];
546     end;
547   finally
548     FreeAndNil(aList);
549   end;
550 end;
551 
552 
553 
554 function THashMap.GetItems(Index: Integer): THashEntry;
555 begin
556   if (Index < 0) or (Index >= FCount) then
557   begin
558     Result := nil;
559     Exit;
560   end;
561   Result := FTable[Index];  
562 end;
563 
564 end.

 

 1 {*******************************************************}
 2 {                                                       }
 3 {       Delphi HashMap                                  }
 4 {                                                       }
 5 {       版权所有 (C) 2018 hsoft                          }
 6 {                                                       }
 7 {                                                       }
 8 { Author: MarkWu    Email: 77910086@qq.com              }
 9 { Date:   2018-01-02 14:17:00                           }
10 { Desc:   HashMap                                       }
11 {*******************************************************}
12 
13 unit uHashEntry;
14 
15 interface
16 
17 uses
18   Variants;
19 
20 type
21   THashEntry = class
22   private
23     FKey: string;
24     FValue: Variant;
25     FNext: THashEntry;
26     FIsObj: Boolean;
27     procedure SetValue(const Value: Variant);
28     function GetValue: Variant;
29   public
30     constructor Create(AKey: string; AValue: Variant; ANext: THashEntry; AIsObj: Boolean = False);
31 
32     function ToString(): string;
33     function HashCode: Integer;
34 
35     property Key: string read FKey write FKey;
36     property Value: Variant read GetValue write SetValue;
37     property Next: THashEntry read FNext write FNext;
38     property IsObj: Boolean read FIsObj;
39   end;
40 
41 implementation
42 
43 { THashEntry }
44 
45 constructor THashEntry.Create(AKey: string; AValue: Variant; ANext: THashEntry; AIsObj: Boolean);
46 begin
47   FKey := AKey;
48   FValue := AValue;
49   FIsObj := AIsObj;
50   FNext  := ANext;
51 end;
52 
53 function THashEntry.HashCode: Integer;
54 begin
55   Result := Integer(Self);
56 end;
57 
58 function THashEntry.GetValue: Variant;
59 begin
60   Result := FValue;
61 end;
62 
63 procedure THashEntry.SetValue(const Value: Variant);
64 begin
65   FValue := Value;
66 end;
67 
68 function THashEntry.ToString: string;
69 begin
70   Result := FKey + '=' + VarToStrDef(FValue, '');
71 end;
72 
73 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.

 

posted on 2020-09-02 12:45  markwu  阅读(989)  评论(5编辑  收藏  举报

导航