home *** CD-ROM | disk | FTP | other *** search
/ PC Pro 2 / PcPro-2a.iso / Demos / ProDelph / PROTMAI2.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-01-05  |  6.4 KB  |  302 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;
  11.  
  12. TYPE
  13. {$IFDEF VER120 }
  14.   TMyComp  = Int64;
  15. {$ELSE }
  16.   {$IFDEF VER130 }
  17.     TMyComp  = Int64;
  18.   {$ELSE }
  19.     TMyComp  = Comp;
  20.   {$ENDIF }
  21. {$ENDIF }
  22.   TMyLargeInteger = RECORD
  23.                     CASE Byte OF
  24.                      0 : ( LowPart  : DWORD; HighPart : LongInt );
  25.                      1 : ( QuadPart : TMyComp );
  26.                   END;
  27.  
  28. type
  29.   TForm1 = class(TForm)
  30.     Button1: TButton;
  31.     Label1: TLabel;
  32.     Label2: TLabel;
  33.     Label3: TLabel;
  34.     Label4: TLabel;
  35.     Label5: TLabel;
  36.     Label6: TLabel;
  37.     Label7: TLabel;
  38.     f0: TLabel;
  39.     f0d: TLabel;
  40.     f10: TLabel;
  41.     f10d: TLabel;
  42.     f100: TLabel;
  43.     f1000: TLabel;
  44.     f10000: TLabel;
  45.     f100d: TLabel;
  46.     f1000d: TLabel;
  47.     f10000d: TLabel;
  48.     Bevel1: TBevel;
  49.     Label18: TLabel;
  50.     Label19: TLabel;
  51.     Label20: TLabel;
  52.     pmam: TLabel;
  53.     prom: TLabel;
  54.     pmamd: TLabel;
  55.     promd: TLabel;
  56.     Label25: TLabel;
  57.     Label26: TLabel;
  58.     Bevel2: TBevel;
  59.     Bevel3: TBevel;
  60.     Bevel4: TBevel;
  61.     Bevel5: TBevel;
  62.     Bevel6: TBevel;
  63.     Bevel7: TBevel;
  64.     Bevel8: TBevel;
  65.     Bevel9: TBevel;
  66.     Bevel10: TBevel;
  67.     Bevel11: TBevel;
  68.     Label8: TLabel;
  69.     Bevel12: TBevel;
  70.     tmlf: TLabel;
  71.     tmlfd: TLabel;
  72.     Label9: TLabel;
  73.     Label10: TLabel;
  74.     Label11: TLabel;
  75.     Label12: TLabel;
  76.     Label13: TLabel;
  77.     Label14: TLabel;
  78.     Label15: TLabel;
  79.     Label16: TLabel;
  80.     Label17: TLabel;
  81.     ResLabel: TLabel;
  82.     Bevel13: TBevel;
  83.     Label22: TLabel;
  84.     recu: TLabel;
  85.     recud: TLabel;
  86.     Reculab: TLabel;
  87.     Label23: TLabel;
  88.     procedure StartItAll(Sender: TObject);
  89.   private
  90.     { Private-Deklarationen }
  91.     PROCEDURE UserMessage ( VAR Message ); Message WM_USER+5;
  92.     FUNCTION  PostIt : TMyLargeInteger;
  93.   public
  94.     { Public-Deklarationen }
  95.   end;
  96.  
  97. var
  98.   Form1: TForm1;
  99.  
  100. implementation
  101.  
  102. {$R *.DFM}
  103. PROCEDURE ConvertTime ( VAR wertstr : String; wert : Double; AsCycles : Boolean );
  104. VAR
  105.   einheit : String;
  106. BEGIN
  107.   IF AsCycles = TRUE THEN BEGIN
  108.     Str(wert:0:0, einheit);
  109.     wertstr := '';
  110.     WHILE Length(einheit) > 3 DO BEGIN
  111.       wertstr := ',' + Copy(einheit, Length(einheit)-2, 3) + wertstr;
  112.       einheit := Copy(einheit, 1, Length(einheit)-3);
  113.     END;
  114.     wertstr := einheit + wertstr;
  115.     exit;
  116.   END;
  117.   wertstr := '0.000╡S';
  118. END;
  119.  
  120. FUNCTION MidFunction : Integer; Forward;
  121. FUNCTION DeepFunction : Integer; Forward;
  122.  
  123. VAR
  124.   res     : Array[0..10] OF TMyLargeInteger;
  125.   count   : Integer;
  126.   resstr  : Array[0..10] OF String;
  127.   resstr2 : Array[0..10] OF String;
  128.  
  129. PROCEDURE TForm1.UserMessage ( VAR Message );
  130. VAR
  131.   i : Integer;
  132. BEGIN
  133.   FOR i := 1 TO 1000 DO
  134.     INC(count);
  135. END;
  136.  
  137. FUNCTION TForm1.PostIt : TMyLargeInteger;
  138. BEGIN
  139.   Result.lowpart  := 0;
  140.   Result.highpart := 0;
  141.   PostMessage(application.mainform.handle, WM_USER+5, 1, 2);
  142.   Application.ProcessMessages;
  143. END;
  144.  
  145.  
  146. FUNCTION Minimum ( a, b : TMyComp ) : TMyComp;
  147. BEGIN
  148.   IF a > b THEN
  149.     Result := b
  150.   ELSE
  151.     Result := a;
  152. END;
  153.  
  154. FUNCTION FunctionWith10( VAR index : Integer ) : TMyLargeInteger;
  155. VAR
  156.   i : Integer;
  157. BEGIN
  158.   Result.lowpart  := 0;
  159.   Result.highpart := 0;
  160.   FOR i := 1 TO 10 DO
  161.     INC(index);
  162. END;
  163.  
  164. FUNCTION FunctionWith100( VAR index : Integer ) : TMyLargeInteger;
  165. VAR
  166.   i : Integer;
  167. BEGIN
  168.   Result.lowpart  := 0;
  169.   Result.highpart := 0;
  170.   FOR i := 1 TO 100 DO
  171.     INC(index);
  172. END;
  173.  
  174. FUNCTION FunctionWith1000( VAR index : Integer ) : TMyLargeInteger;
  175. VAR
  176.   i : Integer;
  177. BEGIN
  178.   Result.lowpart  := 0;
  179.   Result.highpart := 0;
  180.   FOR i := 1 TO 1000 DO
  181.     INC(index);
  182. END;
  183.  
  184. FUNCTION FunctionWith10000( VAR index : Integer ) : TMyLargeInteger;
  185. VAR
  186.   i : Integer;
  187. BEGIN
  188.   Result.lowpart  := 0;
  189.   Result.highpart := 0;
  190.   FOR i := 1 TO 10000 DO
  191.     INC(index);
  192. END;
  193.  
  194. PROCEDURE Empty;
  195. BEGIN
  196. END;
  197.  
  198. FUNCTION TopFunction ( VAR index : Integer ) : TMyLargeInteger;
  199. VAR
  200.   i : Integer;
  201. BEGIN
  202.   FOR i := 1 TO 10 DO
  203.     index := MidFunction;
  204.   Result.lowpart := 0;
  205.   Result.highpart := 0;
  206. END;
  207.  
  208. FUNCTION MidFunction : Integer;
  209. VAR
  210.   i : Integer;
  211. BEGIN
  212.   FOR i := 1 TO 10 DO
  213.     Result := DeepFunction;
  214. END;
  215.  
  216. FUNCTION DeepFunction : Integer;
  217. BEGIN
  218.   Result := 0;
  219. END;
  220.  
  221. FUNCTION DoRecursion ( VAR HowOften : Integer ) : DWORD;
  222. BEGIN
  223.   DEC(HowOften);
  224.   IF HowOften <= 0 THEN BEGIN
  225.     Result := 0;
  226.     exit;
  227.   END;
  228.   Result := DoRecursion(HowOften);
  229. END;
  230.  
  231. procedure TForm1.StartItAll(Sender: TObject);
  232. VAR
  233.   i, x     : Integer;
  234.   xd       : Real;
  235.   ergebnis : Integer;
  236. begin
  237.  
  238.   FOR i := 0 TO 10 DO
  239.     res[i].quadpart := 0;
  240.  
  241.   Ergebnis := 0;
  242.   FOR i := 1 TO 200 DO
  243.     res[5].lowpart := res[5].lowpart + TopFunction(Ergebnis).lowpart;
  244.   Ergebnis := 0;
  245.   FOR i := 1 TO 200 DO
  246.     res[4].lowpart := res[4].lowpart + FunctionWith10000(Ergebnis).lowpart;
  247.   Ergebnis := 0;
  248.   FOR i := 1 TO 200 DO
  249.     res[3].lowpart := res[3].lowpart + FunctionWith1000(Ergebnis).lowpart;
  250.   Ergebnis := 0;
  251.   FOR i := 1 TO 200 DO
  252.     res[2].lowpart := res[2].lowpart + FunctionWith100(Ergebnis).lowpart;
  253.   Ergebnis := 0;
  254.   FOR i := 1 TO 200 DO
  255.     res[1].lowpart := res[1].lowpart + FunctionWith10(Ergebnis).lowpart;
  256.   Ergebnis := 0;
  257.   FOR i := 1 TO 200 DO
  258.     Empty;
  259.   Ergebnis := 0;
  260.   FOR i := 1 TO 200 DO BEGIN
  261.     Ergebnis := 10;
  262.     res[8].lowpart := res[8].lowpart + DoRecursion(Ergebnis);
  263.   END;
  264.   Ergebnis := 0;
  265.   FOR i := 1 TO 200 DO BEGIN
  266.     count := 0;
  267.     res[6].lowpart := res[6].lowpart + PostIt.lowpart;
  268.   END;
  269.  
  270.   FOR i := 0 TO 10 DO BEGIN
  271.     x := res[i].lowpart;
  272.     IF i <> 8 THEN
  273.       x := x DIV 200;
  274.     ConvertTime(resstr[i], x, TRUE);
  275.     xd := Round(x);
  276.     ConvertTime(resstr2[i], xd, FALSE);
  277.   END;
  278.  
  279.   f0.caption  := resstr[0];
  280.   f10.caption := resstr[1];
  281.   f100.caption := resstr[2];
  282.   f1000.caption := resstr[3];
  283.   f10000.caption := resstr[4];
  284.   tmlf.caption := resstr[5];
  285.   pmam.caption := resstr[6];
  286.   prom.caption := resstr[7];
  287.   recu.caption := resstr[8];
  288.  
  289.   f0d.caption  := resstr2[0];
  290.   f10d.caption := resstr2[1];
  291.   f100d.caption := resstr2[2];
  292.   f1000d.caption := resstr2[3];
  293.   f10000d.caption := resstr2[4];
  294.   tmlfd.caption := resstr2[5];
  295.   pmamd.caption := resstr2[6];
  296.   promd.caption := resstr2[7];
  297.   recud.caption := resstr2[8];
  298.   ResLabel.Visible := TRUE;
  299. end;
  300.  
  301. end.
  302.