DelphiDabbler Code Snippets Database

Snippet Selection

The following snippets from the Code Snippets Database have been requested.

Delay

Delays processing for the given number of milliseconds without processing any messages.

procedure Delay(ADelay: Integer);
var
  StartTC: Windows.DWORD;   // tick count when routine called
  CurrentTC: Int64;         // tick count at each loop iteration
begin
  StartTC := Windows.GetTickCount;
  repeat
    CurrentTC := Windows.GetTickCount;
    if CurrentTC < StartTC then
      // tick count has wrapped around: adjust it
      CurrentTC := CurrentTC + High(Windows.DWORD);
  until CurrentTC - StartTC >= ADelay;
end;

IsNumeric

Checks if the string Value contains a valid numeric value and returns True if so or False if not. If AllowFloat is true then Value may contain a floating point number, otherwise it must be an integer. If TrimWhiteSpace is True any white space surrounding Value is trimmed before testing.

function IsNumeric(Value: string; const AllowFloat: Boolean;
  const TrimWhiteSpace: Boolean = True): Boolean;
var
  ValueInt: Int64;      // dummy integer value
  ValueFloat: Extended; // dummy float value
begin
  if TrimWhiteSpace then
    Value := SysUtils.Trim(Value);
  // Check for valid integer
  Result := SysUtils.TryStrToInt64(Value, ValueInt);
  if not Result and AllowFloat then
    // Wasn't valid as integer, try float
    Result := SysUtils.TryStrToFloat(Value, ValueFloat);
end;

IsValidURLProtocol

Checks if the given URL is valid per RFC1738. Returns True if valid and False if not.

function IsValidURLProtocol(const URL: string): Boolean;
const
  Protocols: array[1..10] of string = (
    // Array of valid protocols - per RFC 1738
    'ftp://', 'http://', 'gopher://', 'mailto:', 'news:', 'nntp://',
    'telnet://', 'wais://', 'file://', 'prospero://'
  );
var
  I: Integer;   // loops thru known protocols
begin
  // Scan array of protocols checking for a match with start of given URL
  Result := False;
  for I := Low(Protocols) to High(Protocols) do
    if Pos(Protocols[I], SysUtils.LowerCase(URL)) = 1 then
    begin
      Result := True;
      Exit;
    end;
end;

Pause

Pauses for ADelay milliseconds before returning.

procedure Pause(const ADelay: LongWord);
var
  StartTC: Windows.DWORD;   // tick count when routine called
  CurrentTC: Int64;         // tick count at each loop iteration
begin
  StartTC := GetTickCount;
  repeat
    ProcessMessages;
    CurrentTC := Windows.GetTickCount;
    if CurrentTC < StartTC then
      // tick count has wrapped around: adjust it
      CurrentTC := CurrentTC + High(Windows.DWORD);
    Windows.Sleep(5);
  until CurrentTC - StartTC >= ADelay;
end;

View the whole database.

Go to the DelphiDabbler website.