home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / delphi / nastroje / d23456 / PRODEL.ZIP / PROTMAI2.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-05-05  |  4.4 KB  |  194 lines
  1. unit Protmai2;
  2. {$O-}  // Do not remove, Delphi might crash !!!
  3. {$R-}
  4. {$Q-}
  5. {$A+}
  6. interface     
  7.  
  8. uses
  9.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  10.   ExtCtrls, StdCtrls, Procal2;
  11.  
  12. type
  13.   TForm1 = class(TForm)
  14.     Button1: TButton;
  15.     Label1: TLabel;
  16.     Label4: TLabel;
  17.     Label5: TLabel;
  18.     Label6: TLabel;
  19.     Label7: TLabel;
  20.     f0: TLabel;
  21.     f0d: TLabel;
  22.     f100: TLabel;
  23.     f1000: TLabel;
  24.     f100d: TLabel;
  25.     f1000d: TLabel;
  26.     Bevel1: TBevel;
  27.     Label20: TLabel;
  28.     prom: TLabel;
  29.     promd: TLabel;
  30.     Label26: TLabel;
  31.     Bevel2: TBevel;
  32.     Bevel4: TBevel;
  33.     Bevel5: TBevel;
  34.     Bevel6: TBevel;
  35.     Bevel8: TBevel;
  36.     Bevel9: TBevel;
  37.     Bevel10: TBevel;
  38.     Bevel11: TBevel;
  39.     Label8: TLabel;
  40.     tmlf: TLabel;
  41.     tmlfd: TLabel;
  42.     Label9: TLabel;
  43.     Label12: TLabel;
  44.     Label13: TLabel;
  45.     Label15: TLabel;
  46.     Label17: TLabel;
  47.     ResLabel: TLabel;
  48.     Label25: TLabel;
  49.     Label2: TLabel;
  50.     Label18: TLabel;
  51.     Label19: TLabel;
  52.     Label21: TLabel;
  53.     Bevel3: TBevel;
  54.     Label3: TLabel;
  55.     prouse: TLabel;
  56.     proused: TLabel;
  57.     Label14: TLabel;
  58.     Label10: TLabel;
  59.     Label11: TLabel;
  60.     f0s: TLabel;
  61.     f100s: TLabel;
  62.     f1000s: TLabel;
  63.     tmlfs: TLabel;
  64.     f100ds: TLabel;
  65.     f1000ds: TLabel;
  66.     tmlfds: TLabel;
  67.     f0ds: TLabel;
  68.     Warnlab: TLabel;
  69.     procedure StartItAll(Sender: TObject);
  70.   private
  71.     { Private-Deklarationen }
  72.     FUNCTION  MBox : TMyLargeInteger;
  73.     PROCEDURE UserMessage ( VAR Message ); Message WM_USER+5;
  74.   private
  75.     res     : Array[0..5] OF TMyLargeInteger;
  76.     resstr  : Array[0..5] OF String;
  77.     resstr2 : Array[0..5] OF String;
  78.  
  79.   public
  80.     { Public-Deklarationen }
  81.   end;
  82.  
  83. var
  84.   Form1: TForm1;
  85.  
  86. implementation
  87.  
  88. {$R *.dfm}
  89.  
  90. FUNCTION TForm1.MBox : TMyLargeInteger;
  91. BEGIN
  92.   PostMessage(application.mainform.handle, WM_USER+5, 1, 2);
  93.   MessageBox(0, 'Messagebox demo, waiting for click should not be measured',
  94.                 'Protest', MB_OK);
  95. END;
  96.  
  97. PROCEDURE TForm1.UserMessage ( VAR Message );
  98. VAR
  99.   I : Integer;
  100. BEGIN
  101.   i := 0;
  102.   WHILE i < 100000 DO 
  103.     INC(i);
  104. END;
  105.  
  106. PROCEDURE ConvertTime ( VAR wertstr : String; wert : Double; AsCycles : Boolean );
  107. VAR
  108.   einheit : String;
  109. BEGIN
  110.   IF AsCycles = TRUE THEN BEGIN
  111.     Str(wert:0:0, einheit);
  112.     wertstr := '';
  113.     WHILE Length(einheit) > 3 DO BEGIN
  114.       wertstr := ',' + Copy(einheit, Length(einheit)-2, 3) + wertstr;
  115.       einheit := Copy(einheit, 1, Length(einheit)-3);
  116.     END;
  117.     wertstr := einheit + wertstr;
  118.     exit;
  119.   END;
  120.   wertstr := '0.000╡S';
  121. END;
  122.  
  123. procedure TForm1.StartItAll(Sender: TObject);
  124. VAR
  125.   i, x     : Integer;
  126.   xd       : Real;
  127.   ergebnis : Integer;
  128.   resstrs  : Array[0..5] OF String;
  129.   resstr2s : Array[0..5] OF String;
  130. begin
  131.  
  132.   FOR i := 0 TO 5 DO
  133.     res[i].quadpart := 0;
  134.  
  135.   Ergebnis := 0;
  136.   FOR i := 1 TO 200 DO
  137.     res[3].lowpart := res[3].lowpart + TopFunction(Ergebnis).lowpart;
  138.  
  139.   Ergebnis := 0;
  140.   FOR i := 1 TO 200 DO
  141.     res[2].lowpart := res[2].lowpart + FunctionWith1000(Ergebnis).lowpart;
  142.  
  143.   Ergebnis := 0;
  144.   FOR i := 1 TO 200 DO
  145.     res[1].lowpart := res[1].lowpart + FunctionWith100(Ergebnis).lowpart;
  146.  
  147.   FOR i := 1 TO 200 DO
  148.     Empty;
  149.  
  150.   res[4].lowpart := res[4].lowpart + MBox.lowpart;
  151.  
  152.   FOR i := 0 TO 5 DO BEGIN
  153.     x := res[i].lowpart;
  154.     IF x < 4 THEN
  155.       x := x DIV 200;
  156.     ConvertTime(resstr[i], x, TRUE);
  157.     xd := Round(x);
  158.     ConvertTime(resstr2[i], xd, FALSE);
  159.     IF i < 4 THEN BEGIN
  160.       x := res[i].lowpart;
  161.       ConvertTime(resstrs[i], x, TRUE);
  162.       xd := Round(x);
  163.       ConvertTime(resstr2s[i], xd, FALSE);
  164.     END;
  165.   END;
  166.  
  167.   f0.caption     := resstr[0];
  168.   f100.caption   := resstr[1];
  169.   f1000.caption  := resstr[2];
  170.   tmlf.caption   := resstr[3];
  171.   prom.caption   := resstr[4];
  172.   prouse.caption := resstr[5];
  173.  
  174.   f100s.caption  := resstrs[1];
  175.   f1000s.caption := resstrs[2];
  176.   tmlfs.caption  := resstrs[3];
  177.  
  178.   f0d.caption      := resstr2[0];
  179.   f100d.caption    := resstr2[1];
  180.   f1000d.caption   := resstr2[2];
  181.   tmlfd.caption    := resstr2[3];
  182.   promd.caption    := resstr2[4];
  183.   proused.caption  := resstr2[5];
  184.  
  185.   f0ds.caption   := resstr2s[0];
  186.   f100ds.caption := resstr2s[1];
  187.   f1000ds.caption:= resstr2s[2];
  188.   tmlfds.caption := resstr2s[3];
  189.   {$IFDEF      PROFILE } ResLabel.Visible := TRUE;  {$ENDIF }
  190.   {$IFNDEF     PROFILE } WarnLab.visible := TRUE;   {$ENDIF }
  191. end;
  192.  
  193. end.
  194.