home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 September / Chip_2002-09_cd1.bin / zkuste / delphi / kompon / d6 / YPPARSER.ZIP / SpeedTest / MainForm.pas < prev    next >
Pascal/Delphi Source File  |  2002-06-14  |  8KB  |  220 lines
  1. {********************************************************}
  2. {                                                        }
  3. {                    SpeedTest                           }
  4. {             IMPORTANT-READ CAREFULLY:                  }
  5. {                                                        }
  6. {    This End-User License Agreement is a legal          }
  7. {    agreement between you (either an individual         }
  8. {    or a single entity) and Pisarev Yuriy for           }
  9. {    the software product identified above, which        }
  10. {    includes computer software and may include          }
  11. {    associated media, printed materials, and "online"   }
  12. {    or electronic documentation ("SOFTWARE PRODUCT").   }
  13. {    By installing, copying, or otherwise using the      }
  14. {    SOFTWARE PRODUCT, you agree to be bound by the      }
  15. {    terms of this LICENSE AGREEMENT.                    }
  16. {                                                        }
  17. {    If you do not agree to the terms of this            }
  18. {    LICENSE AGREEMENT, do not install or use            }
  19. {    the SOFTWARE PRODUCT.                               }
  20. {                                                        }
  21. {    License conditions                                  }
  22. {                                                        }
  23. {    No part of the software or the manual may be        }
  24. {    multiplied, disseminated or processed in any        }
  25. {    way without the written consent of Pisarev          }
  26. {    Yuriy. Violations of these conditions will be       }
  27. {    prosecuted in every case.                           }
  28. {                                                        }
  29. {    The use of the software is done at your own         }
  30. {    risk. The manufacturer and developer accepts        }
  31. {    no liability for any damages, either as direct      }
  32. {    or indirect consequence of the use of this          }
  33. {    product or software.                                }
  34. {                                                        }
  35. {    Only observance of these conditions allows you      }
  36. {    to use the hardware and software in your computer   }
  37. {    system.                                             }
  38. {                                                        }
  39. {    All rights reserved.                                }
  40. {    Copyright 2002 Pisarev Yuriy                        }
  41. {                                                        }
  42. {                 yuriy_mbox@hotmail.com                 }
  43. {                                                        }
  44. {********************************************************}
  45.  
  46. unit MainForm;
  47.  
  48. interface
  49.  
  50. uses
  51.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  52.   Dialogs, StdCtrls, DataEditor, ComCtrls, Menus, ActnList, ActnMan,
  53.   ImgList, StdActns;
  54.  
  55. type
  56.   TMain = class(TForm)
  57.     gbNumScript: TGroupBox;
  58.     NumScriptBtn: TButton;
  59.     StatusBar: TStatusBar;
  60.     gbBoolScript: TGroupBox;
  61.     BoolScriptBtn: TButton;
  62.     gbRepeatCount: TGroupBox;
  63.     TrackBar: TTrackBar;
  64.     reNumScript: TRichEdit;
  65.     reBoolScript: TRichEdit;
  66.     ActionManager1: TActionManager;
  67.     PopupMenu1: TPopupMenu;
  68.     ImageList1: TImageList;
  69.     RichEdit: TRichEdit;
  70.     laScriptView: TLabel;
  71.     EditCut: TEditCut;
  72.     EditCopy: TEditCopy;
  73.     EditPaste: TEditPaste;
  74.     EditSelectAll: TEditSelectAll;
  75.     EditUndo: TEditUndo;
  76.     EditDelete: TEditDelete;
  77.     Undo1: TMenuItem;
  78.     N1: TMenuItem;
  79.     Cut1: TMenuItem;
  80.     Copy1: TMenuItem;
  81.     Paste1: TMenuItem;
  82.     Delete1: TMenuItem;
  83.     N2: TMenuItem;
  84.     SelectAll1: TMenuItem;
  85.     procedure NumScriptBtnClick(Sender: TObject);
  86.     procedure BoolScriptBtnClick(Sender: TObject);
  87.     procedure TrackBarChange(Sender: TObject);
  88.     procedure FormCreate(Sender: TObject);
  89.     procedure reNumScriptKeyDown(Sender: TObject; var Key: Word;
  90.       Shift: TShiftState);
  91.     procedure reBoolScriptKeyDown(Sender: TObject; var Key: Word;
  92.       Shift: TShiftState);
  93.   private
  94.     FRepeatCount: Integer;
  95.     FDataEditor: TDataEditor;
  96.   public
  97.     procedure Status(ScriptID: Integer; Script: TScript;
  98.       TickCount, Result: Double);
  99.     property DataEditor: TDataEditor read FDataEditor write FDataEditor;
  100.     property RepeatCount: Integer read FRepeatCount write FRepeatCount;
  101.   end;
  102.  
  103. var
  104.   Main: TMain;
  105.  
  106. implementation
  107.  
  108. {$R *.dfm}
  109.  
  110. procedure TMain.FormCreate(Sender: TObject);
  111. begin
  112.   FDataEditor := TDataEditor.Create(Self);
  113.   with FDataEditor.AttrsManager do begin
  114.     Add(reNumScript);
  115.     Add(reBoolScript);
  116.   end;
  117.   TrackBarChange(nil);
  118. end;
  119.  
  120. procedure TMain.NumScriptBtnClick(Sender: TObject);
  121. var
  122.   I: Integer;
  123.   TickCount: Double;
  124. begin
  125.   Screen.Cursor := crHourGlass;
  126.   try
  127.     with FDataEditor do begin
  128.       StringToNumScript(reNumScript.Text);
  129.       with RichEdit.Lines do begin
  130.         Clear;
  131.         Add(Format('Text: "%s"; script length: %d',
  132.           [reNumScript.Text, Length(Script)]));
  133.       end;
  134.       TickCount := GetTickCount;
  135.       for I := 1 to FRepeatCount do ExecuteNum;
  136.       TickCount := GetTickCount - TickCount;
  137.       Status(NumScriptID, Script, TickCount, ExecuteNum);
  138.     end;
  139.   finally
  140.     Screen.Cursor := crDefault;
  141.   end;
  142. end;
  143.  
  144. procedure TMain.reNumScriptKeyDown(Sender: TObject; var Key: Word;
  145.   Shift: TShiftState);
  146. begin
  147.   if Key = VK_RETURN then NumScriptBtnClick(nil);
  148. end;
  149.  
  150. procedure TMain.BoolScriptBtnClick(Sender: TObject);
  151. var
  152.   I: Integer;
  153.   TickCount: Double;
  154. begin
  155.   Screen.Cursor := crHourGlass;
  156.   try
  157.     with FDataEditor do begin
  158.       StringToBoolScript(reBoolScript.Text);
  159.       with RichEdit.Lines do begin
  160.         Clear;
  161.         Add(Format('Text: "%s"; script length: %d',
  162.           [reBoolScript.Text, Length(Script)]));
  163.       end;
  164.       TickCount := GetTickCount;
  165.       for I := 1 to FRepeatCount do ExecuteBool;
  166.       TickCount := GetTickCount - TickCount;
  167.       Status(BoolScriptID, Script, TickCount, Integer(ExecuteBool));
  168.     end;
  169.   finally
  170.     Screen.Cursor := crDefault;
  171.   end;
  172. end;
  173.  
  174. procedure TMain.reBoolScriptKeyDown(Sender: TObject; var Key: Word;
  175.   Shift: TShiftState);
  176. begin
  177.   if Key = VK_RETURN then BoolScriptBtnClick(nil);
  178. end;
  179.  
  180. procedure TMain.Status(ScriptID: Integer; Script: TScript; TickCount, Result: Double);
  181. var
  182.   I: Integer;
  183.   Value, Separator: string;
  184. begin
  185.   Value := '';
  186.   for I := Low(Script) to High(Script) do begin
  187.     if I mod 4 = 0 then Separator := '___' else Separator := '_';
  188.     if I = Low(Script) then Value := IntToStr(Script[I])
  189.     else Value := Value + Separator + IntToStr(Script[I]);
  190.   end;
  191.   with RichEdit.Lines do begin
  192.     Add('');
  193.     Add('Script as array of 1-byte integer numbers: ' + Value);
  194.   end;
  195.   Value := '';
  196.   I := 0;
  197.   while I < Length(Script) do begin
  198.     if I = Low(Script) then Value := IntToStr(PInteger(@Script[I])^)
  199.     else Value := Value + '_' + IntToStr(PInteger(@Script[I])^);
  200.     Inc(I, IntegerSize);
  201.   end;
  202.   with RichEdit.Lines do begin
  203.     Add('');
  204.     Add('Script as array of 4-byte integer numbers: ' + Value);
  205.   end;
  206.   if ScriptID = NumScriptID then StatusBar.Panels[1].Text := Format('Result: %f', [Result])
  207.   else if Result = 0 then StatusBar.Panels[1].Text := 'Result: False'
  208.   else StatusBar.Panels[1].Text := 'Result: True';
  209.   StatusBar.Panels[2].Text := Format('Execution time: %d sec %d msec',
  210.     [Trunc(TickCount / 1000), Trunc(TickCount - Trunc(TickCount / 1000) * 1000)]);
  211. end;
  212.  
  213. procedure TMain.TrackBarChange(Sender: TObject);
  214. begin
  215.   FRepeatCount := TrackBar.Position * 100000;
  216.   StatusBar.Panels[0].Text := Format('Operations amount: %d', [FRepeatCount]);
  217. end;
  218.  
  219. end.
  220.