You may want to use
the sleep function for slowing or pacing a repeating action. But you are going
to have problems if you need sleeps less than 20 milliseconds.
The normal minimum time
period for the sleep function is 20 milliseconds. That means if you use
Sleep(1) trying to set it for 1 millisecond it will actually sleep for 20
milliseconds.
But there is a Windows function that increases the resolution of timers.
You have to turn it
on with
timeBeginPeriod(minimum millisecond resolution);
timeBeginPeriod(1)
will set the minimum timer resolution to 1 millisecond
And turn it off (go
back to default) with
timeEndPeriod(minimum millisecond resolution);
Call it with the
same value you called begin with.
Contained in Unit Winapi.MmSystem.
For Windows XP and
newer.
This is a global
Windows OS function. It will give the higher resolution timing to all running
Windows processes. That’s why you would want to turn it off after you don’t
need it anymore.
Microsoft says
setting a higher resolution can improve the accuracy of time-out intervals in
wait functions. However, it can also reduce overall system performance, because
the thread scheduler switches tasks more often. High resolutions can also
prevent the CPU power management system from entering power-saving modes.
Example Delphi app:
unit MainUnit;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TMainForm = class(TForm)
Memo1: TMemo;
Memo2: TMemo;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
uses
math,Winapi.MmSystem;
procedure TMainForm.Button1Click(Sender: TObject);
var
I, x: Integer;
s: string;
K: Integer;
begin
memo1.Clear;
Application.ProcessMessages; // to clear the memo
for K := 1 to 25 do
begin
s := '';
for I := 1 to 25 do
begin
x := randomrange(33, 57);
s := s + char(x);
sleep(1);
end;
memo1.Lines.Add(s);
end;
end;
procedure TMainForm.Button2Click(Sender: TObject);
var
I, x: Integer;
s: string;
K: Integer;
begin
memo2.Clear;
Application.ProcessMessages; // to clear the memo
TimeBeginPeriod(1);
for K := 1 to 25 do
begin
s := '';
for I := 1 to 25 do
begin
x := randomrange(33, 57);
s := s + char(x);
sleep(1);
end;
memo2.Lines.Add(s);
end;
TimeEndPeriod(1);
end;
end.
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TMainForm = class(TForm)
Memo1: TMemo;
Memo2: TMemo;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
uses
math,Winapi.MmSystem;
procedure TMainForm.Button1Click(Sender: TObject);
var
I, x: Integer;
s: string;
K: Integer;
begin
memo1.Clear;
Application.ProcessMessages; // to clear the memo
for K := 1 to 25 do
begin
s := '';
for I := 1 to 25 do
begin
x := randomrange(33, 57);
s := s + char(x);
sleep(1);
end;
memo1.Lines.Add(s);
end;
end;
procedure TMainForm.Button2Click(Sender: TObject);
var
I, x: Integer;
s: string;
K: Integer;
begin
memo2.Clear;
Application.ProcessMessages; // to clear the memo
TimeBeginPeriod(1);
for K := 1 to 25 do
begin
s := '';
for I := 1 to 25 do
begin
x := randomrange(33, 57);
s := s + char(x);
sleep(1);
end;
memo2.Lines.Add(s);
end;
TimeEndPeriod(1);
end;
end.
*****************************************
DFM file:
object MainForm: TMainForm
Left = 0
Top = 0
BorderStyle = bsSingle
Caption = 'Fast Sleep'
ClientHeight = 309
ClientWidth = 532
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Memo1: TMemo
Left = 8
Top = 55
Width = 249
Height = 242
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Courier New'
Font.Style = []
ParentFont = False
TabOrder = 0
end
object Memo2: TMemo
Left = 276
Top = 55
Width = 245
Height = 242
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Courier New'
Font.Style = []
ParentFont = False
TabOrder = 1
end
object Button1: TButton
Left = 92
Top = 16
Width = 75
Height = 25
Caption = 'Normal'
TabOrder = 2
OnClick = Button1Click
end
object Button2: TButton
Left = 372
Top = 16
Width = 75
Height = 25
Caption = 'Fast'
TabOrder = 3
OnClick = Button2Click
end
end
Left = 0
Top = 0
BorderStyle = bsSingle
Caption = 'Fast Sleep'
ClientHeight = 309
ClientWidth = 532
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Memo1: TMemo
Left = 8
Top = 55
Width = 249
Height = 242
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Courier New'
Font.Style = []
ParentFont = False
TabOrder = 0
end
object Memo2: TMemo
Left = 276
Top = 55
Width = 245
Height = 242
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Courier New'
Font.Style = []
ParentFont = False
TabOrder = 1
end
object Button1: TButton
Left = 92
Top = 16
Width = 75
Height = 25
Caption = 'Normal'
TabOrder = 2
OnClick = Button1Click
end
object Button2: TButton
Left = 372
Top = 16
Width = 75
Height = 25
Caption = 'Fast'
TabOrder = 3
OnClick = Button2Click
end
end
Download Source files:
