More Accurate Sleep Function on Windows

Delphi 10.3.3

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.

 

*****************************************

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

Download Source files:

FastSleep.zip