Delphi的HashMap

为摊代言 發表於 2020-9-2 12:45:00

使用过Java的朋友，应该知道它有个超好用的HashMap容器类，面试必问的，在Delphi10中有TDictionary类，但Delphi7没得用，所以自己动手，使用数组 + 链表写个类似Java的HashMap类，提供给所有坚守Delphi的朋友们，性能还是相当不错的。
<div class="cnblogs_code">
<pre>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: 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);
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;
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, AIsObj);
204 FTable := 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;
251 while e <> nil do
252 begin
253 tmpNext := e.Next;
254 // 计算出新的索引
255 newIndex := IndexOf(e.Key, iNewCapacity);
256 // 把当前旧entry.next链指向新的索引位置，ANewTable可能为nil, 也可能是entry链，
257 // 如果是entry链，就直接在链表头插入
258 e.Next := ANewTable;
259 ANewTable := 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的链表上查找key为''的键值对，因为''默认是存在FTable的桶里
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;
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;
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 := 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;
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 := 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, );
401 Result := Result + #13#10;
402 for I := 0 to Length(FTable) - 1 do
403 begin
404 entry := FTable;
405 if entry = nil then
406 Result := Result + Format('a[%d] = nil'#13#10, )
407 else
408 Result := Result + Format('a[%d]', );
409
410 iPadLeft := Length(Format('a[%d]', )) + 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 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;
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 := aList;
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.Key, aSet.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 := aList;
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;
562 end;
563
564 end.</pre>
</div>
 
<div class="cnblogs_code">
<pre> 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.</pre>
</div>
测试效果图
 <img src="https://img2020.cnblogs.com/blog/40151/202009/40151-20200902123001174-620424926.png" alt="" loading="lazy">
 
 HashMap, StringList, HashedStringList的性能比较， HashMap的性能比较稳定，保持O(1)，而HashedStringList第1次查找时很慢，后面就稳定了，不知啥原因，没有去跟踪它代码。
<img src="https://img2020.cnblogs.com/blog/40151/202009/40151-20200902123100451-1357733111.png" alt="" loading="lazy">
 
测试程序源码：
<div class="cnblogs_code">
<pre>object Form1: TForm1
Left = 263
Top = 169
Width = 787
Height = 518
Caption = 'HashMap Demo -- Author: MarkWuQQ: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</pre>
</div>
 
<div class="cnblogs_code">
<pre>{*******************************************************}
{ }
{ 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());

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.Key + '=' + VarToStrDef(aSet.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.Key + '=' + VarToStrDef(aSet.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.Key + '=' + VarToStrDef(aSet.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.Key + '=' + VarToStrDef(aSet.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--------------------', ));
Memo2.Lines.Add(Format('HashMap 增加%d条, 总共花了%d ms', ));
//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--------------------', ));
//Memo2.Lines.Add(btnStringList10000.Caption + ' 总共花了' + Inttostr(iEnd));
Memo2.Lines.Add(Format('StringList 增加%d条, 总共花了%d ms', ));

{
str := '';
for I := 0 to aList.Count - 1 do
begin
str := str + #13#10 + aList;
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; //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--------------------', ));
//Memo2.Lines.Add(btnStringList10000.Caption + ' 总共花了' + Inttostr(iEnd));
Memo2.Lines.Add(Format('HashStringList 增加%d条, 总共花了%d ms', ));

{
str := '';
for I := 0 to aList.Count - 1 do
begin
str := str + #13#10 + aList;
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;
//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.</pre>
</div>
  
来源：https://www.cnblogs.com/markwu/p/13601095.html

頁: [1]

琼殿技术论坛's Archiver

Delphi的HashMap