source: Generics/TemplateGenerics/Demo/FormMain.pas

Last change on this file was 574, checked in by chronos, 18 months ago
  • Modified: Removed U prefix from unit names.
File size: 22.5 KB
Line 
1unit FormMain;
2
3interface
4
5uses
6 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
7 ComCtrls, SpecializedList, SpecializedDictionary, SpecializedQueue,
8 DateUtils, SpecializedMatrix, SpecializedStream;
9
10type
11
12 { TFormMain }
13
14 TFormMain = class(TForm)
15 ButtonStreamByte: TButton;
16 ButtonBenchmarkDictionary: TButton;
17 ButtonBenchmarkListPointer: TButton;
18 ButtonListObject: TButton;
19 ButtonBenchmarkListString: TButton;
20 ButtonCharList: TButton;
21 ButtonMatrixInteger: TButton;
22 ButtonQueueInteger: TButton;
23 ButtonDictionaryString: TButton;
24 ButtonIntegerList: TButton;
25 ButtonStringList: TButton;
26 Label1: TLabel;
27 LabelTestName: TLabel;
28 ListViewOutput: TListView;
29 procedure ButtonBenchmarkDictionaryClick(Sender: TObject);
30 procedure ButtonBenchmarkListPointerClick(Sender: TObject);
31 procedure ButtonBenchmarkListStringClick(Sender: TObject);
32 procedure ButtonCharListClick(Sender: TObject);
33 procedure ButtonDictionaryStringClick(Sender: TObject);
34 procedure ButtonIntegerListClick(Sender: TObject);
35 procedure ButtonMatrixIntegerClick(Sender: TObject);
36 procedure ButtonListObjectClick(Sender: TObject);
37 procedure ButtonQueueIntegerClick(Sender: TObject);
38 procedure ButtonStringListClick(Sender: TObject);
39 procedure ButtonStreamByteClick(Sender: TObject);
40 procedure FormCreate(Sender: TObject);
41 procedure FormDestroy(Sender: TObject);
42 public
43 MeasureDuration: TDateTime;
44 Bitmap: TBitmap;
45 procedure UpdateButtonState(Enabled: Boolean);
46 procedure WriteOutput(Text1: string = ''; Text2: string = '');
47 end;
48
49var
50 FormMain: TFormMain;
51
52
53implementation
54
55{$R *.lfm}
56
57{ TFormMain }
58
59procedure TFormMain.FormCreate(Sender: TObject);
60begin
61 MeasureDuration := 100 * OneMillisecond;
62end;
63
64procedure TFormMain.ButtonIntegerListClick(Sender: TObject);
65var
66 List: TListInteger;
67 List2: TListInteger;
68 I: Integer;
69begin
70 ListViewOutput.Clear;
71 LabelTestName.Caption := 'TListInteger test';
72 List := TListInteger.Create;
73 List2 := TListInteger.Create;
74 with List do try
75 AddArray([10, 20, 30, 40]);
76 WriteOutput('AddArray([10, 20, 30, 40])', Implode(',', IntToStr));
77 Clear;
78 WriteOutput('Clear', Implode(',', IntToStr));
79 for I := 0 to 10 do Add(I);
80 WriteOutput('for I := 0 to 10 do Add(I)', Implode(',', IntToStr));
81 WriteOutput('Count', IntToStr(Count));
82 Reverse;
83 WriteOutput('Reverse', Implode(',', IntToStr));
84 WriteOutput('First', IntToStr(First));
85 WriteOutput('Last', IntToStr(Last));
86 MoveItems(3, 2, 3);
87 WriteOutput('MoveItems(3, 2, 3)', Implode(',', IntToStr));
88 Insert(5, 11);
89 WriteOutput('Insert(5, 11)', Implode(',', IntToStr));
90 DeleteItems(0, 10);
91 WriteOutput('Delete(0, 10)', Implode(',', IntToStr));
92 List2.SetArray([1, 0]);
93 WriteOutput('EqualTo([6, 11])', BoolToStr(EqualTo(List2)));
94 List2.SetArray([2, 0]);
95 WriteOutput('EqualTo([7, 11])', BoolToStr(EqualTo(List2)));
96 InsertCount(0, 3);
97 WriteOutput('InsertCount(0, 3)', Implode(',', IntToStr));
98 Fill(0, 3, 9);
99 WriteOutput('Fill(0, 3, 9)', Implode(',', IntToStr));
100 finally
101 Free;
102 List2.Free;
103 end;
104end;
105
106procedure TFormMain.ButtonMatrixIntegerClick(Sender: TObject);
107var
108 Matrix: TMatrixInteger;
109 I: Integer;
110begin
111 ListViewOutput.Clear;
112 LabelTestName.Caption := 'TMatrixInteger test';
113 Matrix := TMatrixInteger.Create;
114 with Matrix do try
115 Count := CreateIndex(2, 2);
116 WriteOutput('Count := CreateIndex(2, 2)', '[' + Implode('; ', ', ', IntToStr) + ']');
117 Fill(CreateIndex(0, 0), Count, 1);
118 WriteOutput('Fill(1)', '[' + Implode('; ', ', ', IntToStr) + ']');
119 Count := CreateIndex(3, 3);
120 WriteOutput('Count := CreateIndex(3, 3)', '[' + Implode('; ', ', ', IntToStr) + ']');
121 WriteOutput('Count [Y, X]', IntToStr(Count.Y) + ', ' + IntToStr(Count.X));
122 Clear;
123 WriteOutput('Clear', '[' + Implode('; ', ', ', IntToStr) + ']');
124 WriteOutput('Count [Y, X]', IntToStr(Count.Y) + ', ' + IntToStr(Count.X));
125 finally
126 Free;
127 end;
128end;
129
130procedure TFormMain.ButtonStreamByteClick(Sender: TObject);
131var
132 Stream: TMemoryStreamByte;
133 I: Integer;
134 ByteArray: array of Byte;
135 ByteArrayText: string;
136begin
137 ListViewOutput.Clear;
138 LabelTestName.Caption := 'TStreamByte test';
139 Stream := TMemoryStreamByte.Create;
140 with Stream do try
141 WriteOutput('Size := ', IntToStr(Stream.Size));
142 Write(1);
143 WriteOutput('Write(1)', '');
144 WriteOutput('Size, Position', IntToStr(Stream.Size) + ', ' + IntToStr(Stream.Position));
145 WriteArray([2, 3, 4]);
146 WriteOutput('WriteArray([2, 3, 4])', '');
147 WriteOutput('Size, Position', IntToStr(Stream.Size) + ', ' + IntToStr(Stream.Position));
148 Position := 1;
149 WriteOutput('Position := 1', '');
150 WriteOutput('Size, Position', IntToStr(Stream.Size) + ', ' + IntToStr(Stream.Position));
151 WriteOutput('Read', IntToStr(Read));
152 WriteOutput('Size, Position', IntToStr(Stream.Size) + ', ' + IntToStr(Stream.Position));
153 ByteArray := ReadArray(2);
154 ByteArrayText := '[';
155 for I := 0 to Length(ByteArray) - 1 do begin
156 ByteArrayText := ByteArrayText + IntToStr(ByteArray[I]);
157 if I < Length(ByteArray) - 1 then ByteArrayText := ByteArrayText + ', ';
158 end;
159 ByteArrayText := ByteArrayText + ']';
160 WriteOutput('ReadArray', ByteArrayText);
161 WriteOutput('Size, Position', IntToStr(Stream.Size) + ', ' + IntToStr(Stream.Position));
162 finally
163 Free;
164 end;
165end;
166
167function ObjectToStr(Obj: TObject): string;
168begin
169 Result := Obj.ClassName;
170end;
171
172procedure TFormMain.ButtonListObjectClick(Sender: TObject);
173var
174 List: TListObject;
175 I: Integer;
176begin
177 ListViewOutput.Clear;
178 LabelTestName.Caption := 'TListObject test';
179 List := TListObject.Create;
180 with List do try
181 AddArray([TObject.Create, TObject.Create, TObject.Create, TObject.Create]);
182 WriteOutput('AddArray([TObject.Create, TObject.Create, TObject.Create, TObject.Create])', Implode(',', ObjectToStr));
183 Clear;
184 WriteOutput('Clear', Implode(',', ObjectToStr));
185 for I := 0 to 10 do Add(TObject.Create);
186 WriteOutput('for I := 0 to 10 do Add(TObject.Create)', Implode(',', ObjectToStr));
187 WriteOutput('Count', IntToStr(Count));
188 Reverse;
189 WriteOutput('Reverse', Implode(',', ObjectToStr));
190 MoveItems(3, 2, 3);
191 WriteOutput('MoveItems(3, 2, 3)', Implode(',', ObjectToStr));
192 finally
193 Free;
194 end;
195end;
196
197procedure TFormMain.ButtonQueueIntegerClick(Sender: TObject);
198var
199 Queue: TQueueInteger;
200 I: Integer;
201begin
202 ListViewOutput.Clear;
203 LabelTestName.Caption := 'TQueueInteger test';
204 Queue := TQueueInteger.Create;
205 with Queue do try
206 Enqueue(1);
207 Enqueue(2);
208 Enqueue(3);
209 WriteOutput('Enqueue(1),Enqueue(2),Enqueue(3) ', List.Implode(',', IntToStr));
210 Enqueue(4);
211 WriteOutput('Enqueue(4)', List.Implode(',', IntToStr));
212 WriteOutput('Dequeued item', IntToStr(Dequeue));
213 WriteOutput('Dequeue', List.Implode(',', IntToStr));
214 finally
215 Free;
216 end;
217end;
218
219function StringPairToStr(Pair: TPairStringString): string;
220begin
221 Result := Pair.Key + ':' + Pair.Value;
222end;
223
224procedure TFormMain.ButtonDictionaryStringClick(Sender: TObject);
225var
226 Dictionary: TDictionaryStringString;
227begin
228 ListViewOutput.Clear;
229 LabelTestName.Caption := 'TDictionaryString test';
230 Dictionary := TDictionaryStringString.Create;
231 with Dictionary do try
232 Add('Key1', 'Value1');
233 Add('Key2', 'Value2');
234 Add('Key3', 'Value3');
235 WriteOutput('Add(''Key1'', ''Value1''),Add(''Key1'', ''Value1''),Add(''Key1'', ''Value1'')', Implode(',', StringPairToStr));
236 WriteOutput('Values[Key2]', Values['Key2']);
237 WriteOutput('Values[Key2] = None');
238 Values['Key2'] := 'None';
239 WriteOutput('Values[Key2]', Values['Key2']);
240 WriteOutput('Values[Key0]', Values['Key0']);
241 WriteOutput('Keys[2]', Keys[2]);
242 finally
243 Free;
244 end;
245end;
246
247function CharToStr(Value: Char): string;
248begin
249 Result := Value;
250end;
251
252procedure TFormMain.ButtonCharListClick(Sender: TObject);
253var
254 List: TListChar;
255 List2: TListChar;
256begin
257 ListViewOutput.Clear;
258 LabelTestName.Caption := 'TListChar test';
259 List := TListChar.Create;
260 List2 := TListChar.Create;
261 with List do try
262 AddArray([' ', ' ', 'A', 'b', 'c', 'd', ' ']);
263 WriteOutput('AddArray(['' '', '' '', ''A'', ''b'', ''c'', ''d'', '' ''])',
264 '''' + Implode('', CharToStr) + '''');
265 Reverse;
266 WriteOutput('Reverse', '''' + Implode('', CharToStr) + '''');
267 TrimLeft;
268 WriteOutput('TrimLeft', '''' + Implode('', CharToStr) + '''');
269 TrimRight;
270 WriteOutput('TrimRight', '''' + Implode('', CharToStr) + '''');
271 UpperCase;
272 WriteOutput('UpperCase', '''' + Implode('', CharToStr) + '''');
273 LowerCase;
274 WriteOutput('LowerCase', '''' + Implode('', CharToStr) + '''');
275 WriteOutput('IndexOf(''c'')', IntToStr(IndexOf('c')));
276 List2.AddArray(['c', 'b']);
277 WriteOutput('IndexOfList(''cb'')', IntToStr(IndexOfList(List2)));
278 finally
279 List2.Free;
280 Free;
281 end;
282end;
283
284procedure TFormMain.ButtonBenchmarkListStringClick(Sender: TObject);
285var
286 List: TListString;
287 List2: TStringList;
288 StartTime: TDateTime;
289 I: Integer;
290const
291 SampleText: string = 'text';
292 SampleCount: Integer = 100000;
293begin
294 LabelTestName.Caption := 'Generic specialized TListString vs. classic non-generic TStringList benchmark';
295 ListViewOutput.Clear;
296 try
297 UpdateButtonState(False);
298 List := TListString.Create;
299 List2 := TStringList.Create;
300
301 StartTime := Now;
302 repeat
303 List.Add(SampleText);
304 until (Now - StartTime) > MeasureDuration;
305 WriteOutput('TListString.Add', IntToStr(List.Count) + ' ops');
306 List.Clear;
307 Application.ProcessMessages;
308
309 StartTime := Now;
310 repeat
311 List2.Add(SampleText);
312 until (Now - StartTime) > MeasureDuration;
313 WriteOutput('TStringList.Add', IntToStr(List2.Count) + ' ops');
314 List2.Clear;
315 Application.ProcessMessages;
316
317 StartTime := Now;
318 repeat
319 List.Insert(0, SampleText);
320 until (Now - StartTime) > MeasureDuration;
321 WriteOutput('TListString.Insert', IntToStr(List.Count) + ' ops');
322 List.Clear;
323 Application.ProcessMessages;
324
325 StartTime := Now;
326 repeat
327 List2.Insert(0, SampleText);
328 until (Now - StartTime) > MeasureDuration;
329 WriteOutput('TStringList.Insert', IntToStr(List2.Count) + ' ops');
330 List2.Clear;
331 Application.ProcessMessages;
332
333 for I := 0 to SampleCount - 1 do
334 List.Add(SampleText);
335 StartTime := Now;
336 I := 0;
337 repeat
338 List.Delete(0);
339 Inc(I);
340 until (Now - StartTime) > MeasureDuration;
341 WriteOutput('TListString.Delete', IntToStr(I) + ' ops');
342 List.Clear;
343 Application.ProcessMessages;
344
345 for I := 0 to SampleCount - 1 do
346 List2.Add(SampleText);
347 StartTime := Now;
348 I := 0;
349 repeat
350 List2.Delete(0);
351 Inc(I);
352 until (Now - StartTime) > MeasureDuration;
353 WriteOutput('TStringList.Delete', IntToStr(I) + ' ops');
354 Application.ProcessMessages;
355
356 for I := 0 to SampleCount - 1 do
357 List.Add(SampleText);
358 StartTime := Now;
359 I := 0;
360 repeat
361 List.Move(Round(SampleCount * 0.3), Round(SampleCount * 0.7));
362 Inc(I);
363 until (Now - StartTime) > MeasureDuration;
364 WriteOutput('TListString.Move', IntToStr(I) + ' ops');
365 List.Clear;
366 Application.ProcessMessages;
367
368 for I := 0 to SampleCount - 1 do
369 List2.Add(SampleText);
370 StartTime := Now;
371 I := 0;
372 repeat
373 List2.Move(Round(SampleCount * 0.3), Round(SampleCount * 0.7));
374 Inc(I);
375 until (Now - StartTime) > MeasureDuration;
376 WriteOutput('TStringList.Move', IntToStr(I) + ' ops');
377 Application.ProcessMessages;
378
379 for I := 0 to SampleCount - 1 do
380 List.Add(SampleText);
381 StartTime := Now;
382 I := 0;
383 repeat
384 List.Exchange(Round(SampleCount * 0.3), Round(SampleCount * 0.7));
385 Inc(I);
386 until (Now - StartTime) > MeasureDuration;
387 WriteOutput('TListString.Exchange', IntToStr(I) + ' ops');
388 List.Clear;
389 Application.ProcessMessages;
390
391 for I := 0 to SampleCount - 1 do
392 List2.Add(SampleText);
393 StartTime := Now;
394 I := 0;
395 repeat
396 List2.Exchange(Round(SampleCount * 0.3), Round(SampleCount * 0.7));
397 Inc(I);
398 until (Now - StartTime) > MeasureDuration;
399 WriteOutput('TStringList.Exchange', IntToStr(I) + ' ops');
400 Application.ProcessMessages;
401
402 for I := 0 to SampleCount - 1 do
403 List.Add(SampleText + IntToStr(I));
404 StartTime := Now;
405 I := 0;
406 repeat
407 List.IndexOf(SampleText + IntToStr(I mod List.Count));
408 Inc(I);
409 until (Now - StartTime) > MeasureDuration;
410 WriteOutput('TListString.IndexOf', IntToStr(I) + ' ops');
411 List.Clear;
412 Application.ProcessMessages;
413
414 for I := 0 to SampleCount - 1 do
415 List2.Add(SampleText + IntToStr(I));
416 StartTime := Now;
417 I := 0;
418 repeat
419 List2.IndexOf(SampleText + IntToStr(I mod List2.Count));
420 Inc(I);
421 until (Now - StartTime) > MeasureDuration;
422 WriteOutput('TStringList.IndexOf', IntToStr(I) + ' ops');
423 Application.ProcessMessages;
424
425 finally
426 UpdateButtonState(True);
427 List.Free;
428 List2.Free;
429 end;
430end;
431
432procedure TFormMain.ButtonBenchmarkDictionaryClick(Sender: TObject);
433var
434 Dictionary: TDictionaryStringString;
435 Dictionary2: TStringList;
436 StartTime: TDateTime;
437 I: Integer;
438 R: string;
439begin
440 LabelTestName.Caption := 'Generic specialized TDictionaryStringString vs. classic non-generic TStringList benchmark';
441 ListViewOutput.Clear;
442 try
443 UpdateButtonState(False);
444 Dictionary := TDictionaryStringString.Create;
445 Dictionary2 := TStringList.Create;
446 Dictionary2.NameValueSeparator := '|';
447
448 I := 0;
449 StartTime := Now;
450 repeat
451 Dictionary.Add(IntToStr(I), IntToStr(I));
452 I := I + 1;
453 until (Now - StartTime) > MeasureDuration;
454 WriteOutput('TDictionaryStringString.Add', IntToStr(Dictionary.Count) + ' ops');
455 Application.ProcessMessages;
456
457 I := 0;
458 StartTime := Now;
459 repeat
460 Dictionary2.Add(IntToStr(I) + Dictionary2.NameValueSeparator + IntToStr(I));
461 I := I + 1;
462 until (Now - StartTime) > MeasureDuration;
463 WriteOutput('TStringList.Add', IntToStr(Dictionary2.Count) + ' ops');
464 Application.ProcessMessages;
465
466 I := 0;
467 StartTime := Now;
468 repeat
469 R := Dictionary.Values[IntToStr(I mod Dictionary.Count)];
470 I := I + 1;
471 until (Now - StartTime) > MeasureDuration;
472 WriteOutput('TDictionaryStringString.Values', IntToStr(I) + ' ops');
473 Application.ProcessMessages;
474
475 I := 0;
476 StartTime := Now;
477 repeat
478 R := Dictionary2.Values[IntToStr(I mod Dictionary2.Count)];
479 I := I + 1;
480 until (Now - StartTime) > MeasureDuration;
481 WriteOutput('TStringList.Values', IntToStr(I) + ' ops');
482 Application.ProcessMessages;
483
484 I := 0;
485 StartTime := Now;
486 repeat
487 R := Dictionary.Keys[I mod Dictionary.Count];
488 I := I + 1;
489 until (Now - StartTime) > MeasureDuration;
490 WriteOutput('TDictionaryStringString.Keys', IntToStr(I) + ' ops');
491 Application.ProcessMessages;
492
493 I := 0;
494 StartTime := Now;
495 repeat
496 R := Dictionary2.Names[I mod Dictionary2.Count];
497 I := I + 1;
498 until (Now - StartTime) > MeasureDuration;
499 WriteOutput('TStringList.Keys(Names)', IntToStr(I) + ' ops');
500 Application.ProcessMessages;
501
502 I := 0;
503 StartTime := Now;
504 repeat
505 R := Dictionary.Items[I mod Dictionary.Count].Value;
506 I := I + 1;
507 until (Now - StartTime) > MeasureDuration;
508 WriteOutput('TDictionaryStringString.Items', IntToStr(I) + ' ops');
509 Application.ProcessMessages;
510
511 I := 0;
512 StartTime := Now;
513 repeat
514 R := Dictionary2.ValueFromIndex[I mod Dictionary2.Count];
515 I := I + 1;
516 until (Now - StartTime) > MeasureDuration;
517 WriteOutput('TStringList.Items(ValueFromIndex)', IntToStr(I) + ' ops');
518 Application.ProcessMessages;
519
520 finally
521 UpdateButtonState(True);
522 Dictionary.Free;
523 Dictionary2.Free;
524 end;
525end;
526
527procedure TFormMain.ButtonBenchmarkListPointerClick(Sender: TObject);
528var
529 List: TListPointer;
530 List2: TFPList;
531 StartTime: TDateTime;
532 I: Integer;
533const
534 SampleCount: Integer = 100000;
535begin
536 LabelTestName.Caption := 'Generic specialized TListObject vs. classic non-generic TFPList benchmark';
537 ListViewOutput.Clear;
538 try
539 UpdateButtonState(False);
540 List := TListPointer.Create;
541 List2 := TFPList.Create;
542
543 WriteOutput('TListPointer.InstanceSize', IntToStr(TListPointer.InstanceSize) + ' bytes');
544 WriteOutput('TFPList.InstanceSize', IntToStr(TFPList.InstanceSize) + ' bytes');
545
546 StartTime := Now;
547 repeat
548 List.Add(Pointer(1));
549 until (Now - StartTime) > MeasureDuration;
550 WriteOutput('TListPointer.Add', IntToStr(List.Count) + ' ops');
551 List.Clear;
552 Application.ProcessMessages;
553
554 StartTime := Now;
555 repeat
556 List2.Add(Pointer(1));
557 until (Now - StartTime) > MeasureDuration;
558 WriteOutput('TFPList.Add', IntToStr(List2.Count) + ' ops');
559 List2.Clear;
560 Application.ProcessMessages;
561
562 StartTime := Now;
563 repeat
564 List.Insert(0, Pointer(1));
565 until (Now - StartTime) > MeasureDuration;
566 WriteOutput('TListPointer.Insert', IntToStr(List.Count) + ' ops');
567 List.Clear;
568 Application.ProcessMessages;
569
570 StartTime := Now;
571 repeat
572 List2.Insert(0, Pointer(1));
573 until (Now - StartTime) > MeasureDuration;
574 WriteOutput('TFPList.Insert', IntToStr(List2.Count) + ' ops');
575 List2.Clear;
576 Application.ProcessMessages;
577
578 for I := 0 to SampleCount - 1 do
579 List.Add(Pointer(1));
580 StartTime := Now;
581 I := 0;
582 repeat
583 List.Delete(0);
584 Inc(I);
585 until (Now - StartTime) > MeasureDuration;
586 WriteOutput('TListPointer.Delete', IntToStr(I) + ' ops');
587 List.Clear;
588 Application.ProcessMessages;
589
590 for I := 0 to SampleCount - 1 do
591 List2.Add(Pointer(1));
592 StartTime := Now;
593 I := 0;
594 repeat
595 List2.Delete(0);
596 Inc(I);
597 until (Now - StartTime) > MeasureDuration;
598 WriteOutput('TFPList.Delete', IntToStr(I) + ' ops');
599 Application.ProcessMessages;
600
601 for I := 0 to SampleCount - 1 do
602 List.Add(Pointer(1));
603 StartTime := Now;
604 I := 0;
605 repeat
606 List.Move(Round(SampleCount * 0.3), Round(SampleCount * 0.7));
607 Inc(I);
608 until (Now - StartTime) > MeasureDuration;
609 WriteOutput('TListPointer.Move', IntToStr(I) + ' ops');
610 List.Clear;
611 Application.ProcessMessages;
612
613 for I := 0 to SampleCount - 1 do
614 List2.Add(Pointer(1));
615 StartTime := Now;
616 I := 0;
617 repeat
618 List2.Move(Round(SampleCount * 0.3), Round(SampleCount * 0.7));
619 Inc(I);
620 until (Now - StartTime) > MeasureDuration;
621 WriteOutput('TFPList.Move', IntToStr(I) + ' ops');
622 Application.ProcessMessages;
623
624 for I := 0 to SampleCount - 1 do
625 List.Add(Pointer(1));
626 StartTime := Now;
627 I := 0;
628 repeat
629 List.Exchange(Round(SampleCount * 0.3), Round(SampleCount * 0.7));
630 Inc(I);
631 until (Now - StartTime) > MeasureDuration;
632 WriteOutput('TListPointer.Exchange', IntToStr(I) + ' ops');
633 List.Clear;
634 Application.ProcessMessages;
635
636 for I := 0 to SampleCount - 1 do
637 List2.Add(Pointer(1));
638 StartTime := Now;
639 I := 0;
640 repeat
641 List2.Exchange(Round(SampleCount * 0.3), Round(SampleCount * 0.7));
642 Inc(I);
643 until (Now - StartTime) > MeasureDuration;
644 WriteOutput('TFPList.Exchange', IntToStr(I) + ' ops');
645 Application.ProcessMessages;
646
647 for I := 0 to SampleCount - 1 do
648 List.Add(Pointer(1));
649 StartTime := Now;
650 I := 0;
651 repeat
652 List.IndexOf(Pointer(I mod List.Count));
653 Inc(I);
654 until (Now - StartTime) > MeasureDuration;
655 WriteOutput('TListPointer.IndexOf', IntToStr(I) + ' ops');
656 List.Clear;
657 Application.ProcessMessages;
658
659 for I := 0 to SampleCount - 1 do
660 List2.Add(Pointer(1));
661 StartTime := Now;
662 I := 0;
663 repeat
664 List2.IndexOf(Pointer(I mod List2.Count));
665 Inc(I);
666 until (Now - StartTime) > MeasureDuration;
667 WriteOutput('TFPList.IndexOf', IntToStr(I) + ' ops');
668 Application.ProcessMessages;
669
670 for I := 0 to SampleCount - 1 do
671 List.Add(Pointer(1));
672 StartTime := Now;
673 I := 0;
674 repeat
675 List[I mod List.Count] := Pointer(1);
676 Inc(I);
677 until (Now - StartTime) > MeasureDuration;
678 WriteOutput('TListPointer[I] write', IntToStr(I) + ' ops');
679 List.Clear;
680 Application.ProcessMessages;
681
682 for I := 0 to SampleCount - 1 do
683 List2.Add(Pointer(1));
684 StartTime := Now;
685 I := 0;
686 repeat
687 List2[I mod List2.Count] := Pointer(1);
688 Inc(I);
689 until (Now - StartTime) > MeasureDuration;
690 WriteOutput('TFPList[I] write', IntToStr(I) + ' ops');
691 Application.ProcessMessages;
692
693 for I := 0 to SampleCount - 1 do
694 List.Add(Pointer(1));
695 StartTime := Now;
696 I := 0;
697 repeat
698 List[I mod List.Count];
699 Inc(I);
700 until (Now - StartTime) > MeasureDuration;
701 WriteOutput('TListPointer[I] read', IntToStr(I) + ' ops');
702 List.Clear;
703 Application.ProcessMessages;
704
705 for I := 0 to SampleCount - 1 do
706 List2.Add(Pointer(1));
707 StartTime := Now;
708 I := 0;
709 repeat
710 List2[I mod List2.Count];
711 Inc(I);
712 until (Now - StartTime) > MeasureDuration;
713 WriteOutput('TFPList[I] read', IntToStr(I) + ' ops');
714 Application.ProcessMessages;
715 finally
716 UpdateButtonState(True);
717 List.Free;
718 List2.Free;
719 end;
720end;
721
722function StrToStr(Value: string): string;
723begin
724 Result := Value;
725end;
726
727procedure TFormMain.ButtonStringListClick(Sender: TObject);
728var
729 List: TListString;
730begin
731 ListViewOutput.Clear;
732 WriteOutput('TListString test');
733 List := TListString.Create;
734 with List do try
735 AddArray(['One', 'Two', 'Three', 'Four', 'Five', 'Six', 'Seven']);
736 WriteOutput('Count', IntToStr(Count));
737 WriteOutput('Implode', Implode(',', StrToStr));
738 WriteOutput('Reverse');
739 Reverse;
740 WriteOutput('Implode', Implode(',', StrToStr));
741 WriteOutput('First', First);
742 WriteOutput('Last', Last);
743 MoveItems(2, 3, 3);
744 WriteOutput('Implode', Implode(',', StrToStr));
745 InsertCount(0, 3);
746 WriteOutput('InsertCount(0, 3)', Implode(',', StrToStr));
747 Fill(0, 3, 'Zero');
748 WriteOutput('Fill(0, 3, ''Zero'')', Implode(',', StrToStr));
749 finally
750 Free;
751 end;
752end;
753
754procedure TFormMain.FormDestroy(Sender: TObject);
755begin
756end;
757
758procedure TFormMain.UpdateButtonState(Enabled: Boolean);
759begin
760 ButtonBenchmarkDictionary.Enabled := Enabled;
761 ButtonBenchmarkListString.Enabled := Enabled;
762 ButtonCharList.Enabled := Enabled;
763 ButtonDictionaryString.Enabled := Enabled;
764 ButtonIntegerList.Enabled := Enabled;
765 ButtonListObject.Enabled := Enabled;
766 ButtonMatrixInteger.Enabled := Enabled;
767 ButtonQueueInteger.Enabled := Enabled;
768 ButtonStringList.Enabled := Enabled;
769end;
770
771procedure TFormMain.WriteOutput(Text1: string = ''; Text2: string = '');
772var
773 NewItem: TListItem;
774begin
775 NewItem := ListViewOutput.Items.Add;
776 NewItem.Caption := Text1;
777 NewItem.SubItems.Add(Text2);
778end;
779
780end.
781
Note: See TracBrowser for help on using the repository browser.