unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
CONST
Floating = 255;
type msecs = real;
type
TForm1 =
class(TForm)
Label1: TLabel;
Timer1: TTimer;
procedure Timer1Timer(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function Strip(L,C:char;Str:
string):
string;
{L is left,center,right,all,ends}
var I : byte;
begin
Case Upcase(L)
of
'
L' :
begin {Left}
while (Str[1] = C)
and (length(Str) > 0)
do
Delete(Str,1,1);
end;
'
R' :
begin {Right}
while (Str[length(Str)] = C)
and (length(Str) > 0)
do
Delete(Str,length(Str),1);
end;
'
B' :
begin {Both left and right}
while (Str[1] = C)
and (length(Str) > 0)
do
Delete(Str,1,1);
while (Str[length(Str)] = C)
and (length(Str) > 0)
do
Delete(Str,length(Str),1);
end;
'
A' :
begin {All}
I := 1;
repeat
if (Str[I] = C)
and (length(Str) > 0)
then
Delete(Str,I,1)
else
I := succ(I);
until (I > length(Str))
or (Str = '
');
end;
end;
Strip := Str;
end;
{Strip}
function RealToStr(Number:extended;Decimals:byte):
string;
var Temp :
string;
begin
Str(Number:20:Decimals,Temp);
repeat
if copy(Temp,1,1) = '
'
then delete(Temp,1,1);
until copy(temp,1,1) <> '
';
if Decimals = Floating
then
begin
Temp := Strip('
R','
0',Temp);
if Temp[Length(temp)] = '
.'
then
Delete(temp,Length(temp),1);
end;
RealToStr := Temp;
end;
{RealToStr}
function resolution: msecs;
var t0 : tdatetime;
begin
t0 := now;
while now = t0
do ;
result := msecsperday * (now -t0);
end;
function avgres : real;
var j : integer;
begin
result := 0;
for j := 1
to 100
do
result := result + resolution;
result := result /100;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Label1.Caption:='
Average resolution = '+ RealToStr(avgres,3)+'
msec';
//15.620 msec
end;
end.