File: testwait.pp

package info (click to toggle)
lazarus 0.9.30.4-6
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 114,420 kB
  • sloc: pascal: 1,108,945; xml: 249,481; makefile: 120,941; sh: 2,651; perl: 395; sql: 174; ansic: 137
file content (50 lines) | stat: -rw-r--r-- 756 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
unit TestWait;
{$mode objfpc}{$H+}
interface

type
  TWait = class
  private
    FTime: TDateTime;
    FInt: Integer;
  public
    constructor Create(const ATime: Integer);
    procedure Wait(const ATime: Integer);
  end;

implementation

uses
  SysUtils; 

procedure Wait(const ATime: Integer);
var
  time: TDateTime;
begin
  time := now;
  while (now - time) * SecsPerDay < ATime  do;
end;

constructor TWait.Create(const ATime: Integer);
var
  n: Integer;
begin
  FTime := ATime;
  FInt := ATime;
  inherited Create; 
  n := 0;
  while n < ATime do Inc(n); //something useles 
end;

procedure TWait.Wait(const ATime: Integer);
begin
  TestWait.Wait(ATime);
end;

  
var
  n: Integer;
begin
  n := 0;
  while n < 1001 do Inc(n); //something useles 
end.