unit GenFunctions;

{
[GenFunctions] [6.0]
Delphi 2005
1997-2005

LICENSE

The contents of this file are subject to the Mozilla Public License Version
1.1 (the "License"); you may not use this file except in compliance with
the License. You may obtain a copy of the License at
"http://www.mozilla.org/MPL/"

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is "[genfunctions.pas]".

The Initial Developer of the Original Code is Martin Holmes (Victoria,
BC, Canada, "http://www.mholmes.com/"). Copyright (C) 2005 Martin Holmes 
and the University of Victoria Computing and Media Centre. The code was 
co-developed for university and personal projects, and rights are shared
by Martin Holmes and the University of Victoria. All Rights Reserved.
}


interface

uses ComObj, ActiveX, ShlObj, ShellAPI,
  Windows, Messages, SysUtils, Classes,
  Controls, Forms, Registry, StdCtrls,
  Dialogs, Graphics, FileCtrl, TntStdCtrls,
  CommDlg, Consts, TntForms;

//Not in ShlObj for some reason:
const CSIDL_COMMON_APPDATA = $0023;

type
 TMyProxySettings = record
   Server: string[255];
   Port: integer;
   Enabled: Boolean;
 end;

procedure CentreForm(MainForm, PopupForm: TForm);
function FontStyleToString(InFont: TFont): string;
procedure StringToFontStyle(InString: string; InFont: TFont);
procedure CreateAShortcut(SourceFile,TargetDir,AppName: string);
function Slash(const Path, S: string): string;
function Slash2(const Path: string): string;
procedure GetFileVersion(FileName: string; var Major1, Major2, Minor1, Minor2: Integer);
function GetFileVersionFull: string;
function GetFileVersionMajor: integer;
function GetFileVersionMinor: integer;
function GetFileVersionShortString: string;
function GetFileVersionDotted: string;
procedure CheckBetaExpiry(ExpiryDate: Double);
procedure ShowHelpIndex;
function GetNetUserName: string;
procedure RegisterFileAssociation(Company, AppTitle, FileExtension: string);
function NormalizeWebColour(InColour: string; MakeHex: Boolean): string;
function WebColourToWinColour(InColour: string): TColor;
function WebColourToWinColourDefNone(InColour: string): TColor;
function ColorToHTML(InColor: TColor; AddHash: Boolean): string;
function GetOSVersion: string;
function IsWin9xFamily: Boolean;
function IsWinNT4: Boolean;
function IsWin2KOrAbove: Boolean;
function IsWinXPOrAbove: Boolean;
function IsWinVistaOrAbove: Boolean;
function AppDataFolder: string;
function CommonAppDataFolder: string;
function LocalAppDataFolder: string;
function CreateAppDataFolder(SuiteName, AppName: string): Boolean;
function MyDocsFolder: string;
function ProgramFilesFolder: string;
function DesktopFolder: string;
function StartMenuFolder: string;
function StartMenuProgramsFolder: string;
function UserFavoritesFolder: string;
function TempFolder: string;
procedure AddRecentFile(FileName:string);
function GetProxySettings: TMyProxySettings;
function RegularizeNumber(NumString: string; DecPlaces: integer): string;

function GetIntegerFromUser(const ACaption, APrompt: string; ADefault: integer): integer;

//WideString dialog boxes
function WInputQuery(const ACaption, APrompt: string; var Value: WideString): Boolean;
function WInputBox(const ACaption, APrompt: string; ADefault: WideString): WideString;
function WGetIntegerFromUser(const ACaption, APrompt: WideString; ADefault: integer): integer;

//Function to shift the cursor a little, just to make cursor changes happen
procedure NudgeCursor;

//Functions for handling GUIDs when they need to be used as XHTML id attributes
//or xml:id atts.
function GUIDToXMLId(GUID: TGUID): WideString;
function WSGUIDToXMLId(wsGUID: WideString): WideString;
function XMLIdToWSGUID(XMLId: WideString): WideString;
function XMLIdToGUID(XMLId: WideString; var GUID: TGUID): Boolean;

var
NSC: TStringList;

implementation

procedure CentreForm(MainForm, PopupForm: TForm);
var
L: integer;
T: integer;

begin
	L := (MainForm.Left div 2) - (PopupForm.Width div 2);
  if L < MainForm.Left then
  	L := MainForm.Left;

  T := (MainForm.Top div 2) - (PopupForm.Top div 2);
  if T < MainForm.Top then
  	T := MainForm.Top;

  PopUpForm.Left := L;
  PopUpForm.Top := T;
end;

function FontStyleToString(InFont: TFont): string;
begin
	Result := '0000';
	if fsBold in InFont.Style then
  	Result[1] := '1';
  if fsItalic in InFont.Style then
  	Result[2] := '1';
  if fsUnderline in InFont.Style then
  	Result[3] := '1';
  if fsStrikeout in InFont.Style then
  	Result[4] := '1';
end;

procedure StringToFontStyle(InString: string; InFont: TFont);
begin
  if Length(InString) < 4 then
  	Exit;
	InFont.Style := [];
  if InString[1] = '1' then
  	InFont.Style := InFont.Style + [fsBold];
  if InString[2] = '1' then
  	InFont.Style := InFont.Style + [fsItalic];
  if InString[3] = '1' then
  	InFont.Style := InFont.Style + [fsUnderline];
  if InString[4] = '1' then
  	InFont.Style := InFont.Style + [fsStrikeout];
end;


procedure CreateAShortcut(SourceFile,TargetDir,AppName: string);
var
   IObj    : IUnknown;
   Link    : IShellLink;
   IPFile  : IPersistFile;
   TargetW : WideString;
begin
     IObj := CreateComObject(CLSID_ShellLink);
     Link := IObj as IShellLink;
     IPFile  := IObj as IPersistFile;
     with Link do
          begin
               SetPath(PChar(SourceFile));
               SetArguments('');
               SetWorkingDirectory('');
               SetDescription(PChar(AppName));
          end;
     TargetW := Slash(TargetDir,ExtractFileName(SourceFile)+'.lnk');
     IPFile.Save(PWChar(TargetW),False);
end;

function Slash(const Path, S: string): string;
begin
     if Path = '' then
        Result := ''
     else
         if AnsiLastChar(Path)^ <> '\' then
            Result := Path + '\' + S
         else
             Result := Path + S;
end;

function Slash2(const Path: string): string;
begin
     Result := Path;
     if Length(Path) > 0 then
        if Path[Length(Path)] <> '\' then
           Result := Path + '\';
end;

procedure GetFileVersion(FileName: string; var Major1, Major2,
   Minor1, Minor2: Integer);
 { Helper function to get the actual file version information }
 var
   Info: Pointer;
   InfoSize: DWORD;
   FileInfo: PVSFixedFileInfo;
   FileInfoSize: DWORD;
   Tmp: DWORD;
 begin
   // Get the size of the FileVersionInformatioin
   InfoSize := GetFileVersionInfoSize(PChar(FileName), Tmp);
   // If InfoSize = 0, then the file may not exist, or
   // it may not have file version information in it.
   if InfoSize = 0 then
     raise Exception.Create('Can''t get file version information for '
       + FileName);
   // Allocate memory for the file version information
   GetMem(Info, InfoSize);
   try
     // Get the information
     GetFileVersionInfo(PChar(FileName), 0, InfoSize, Info);
     // Query the information for the version
     VerQueryValue(Info, '\', Pointer(FileInfo), FileInfoSize);
     // Now fill in the version information
     Major1 := FileInfo.dwFileVersionMS shr 16;
     Major2 := FileInfo.dwFileVersionMS and $FFFF;
     Minor1 := FileInfo.dwFileVersionLS shr 16;
     Minor2 := FileInfo.dwFileVersionLS and $FFFF;
   finally
     FreeMem(Info, FileInfoSize);
   end;
 end;

function GetFileVersionFull: string;
var
 VersionMajor: Integer;
 VersionMinor: Integer;
 Build1: integer;
 Build2: Integer;
begin

// Get the file version
	GetFileVersion(Application.ExeName, VersionMajor, VersionMinor, Build1, Build2);

//Return it
	Result := IntToStr(VersionMajor) +
  				'.' + IntToStr(VersionMinor) +
              ' Release ' + IntToStr(Build1) +
              ' Build ' + IntToStr(Build2);
end;

function GetFileVersionMajor: integer;
var
 VersionMajor: Integer;
 VersionMinor: Integer;
 Build1: integer;
 Build2: Integer;

begin
	GetFileVersion(Application.ExeName, VersionMajor, VersionMinor, Build1, Build2);
  Result := VersionMajor;
end;

function GetFileVersionMinor: integer;
var
 VersionMajor: Integer;
 VersionMinor: Integer;
 Build1: integer;
 Build2: Integer;

begin
	GetFileVersion(Application.ExeName, VersionMajor, VersionMinor, Build1, Build2);
  Result := VersionMinor;
end;

function GetFileVersionShortString: string;
begin
//This appeared to be reversed in error! Fixed it 24/03/05.
//	Result := IntToStr(GetFileVersionMinor) + '.' + IntToStr(GetFileVersionMajor);
  Result := IntToStr(GetFileVersionMajor) + '.' + IntToStr(GetFileVersionMinor);
end;

function GetFileVersionDotted: string;
var
 VersionMajor: Integer;
 VersionMinor: Integer;
 Build1: integer;
 Build2: Integer;

begin
        GetFileVersion(Application.ExeName, VersionMajor, VersionMinor, Build1, Build2);
  Result := IntToStr(VersionMajor) + '.' +
            IntToStr(VersionMinor) + '.' +
            IntToStr(Build1) + '.' +
            IntToStr(Build2);
end;

procedure CheckBetaExpiry(ExpiryDate: Double);
begin
  if Date > ExpiryDate then
  	begin
			ShowMessage('This beta version expired on ' +
        				DateToStr(ExpiryDate) +
                    '. You will have to download a new version from the Website.');
        Application.Terminate;
     end;
end;

procedure ShowHelpIndex;
var
P: PChar;
begin
  P := StrNew('');
  Application.HelpCommand(Help_PartialKey, longint(P));
  StrDispose(P);
end;

function GetNetUserName: string;
var
  pcUser: PChar;
  dwUSize: DWORD;
begin
  dwUSize := 21;              // user name can be up to 20 characters
  GetMem(pcUser, dwUSize);    // allocate memory for the string
  try
     if NO_ERROR = WNetGetUser(nil, pcUser, dwUSize)
        then Result := pcUser
    	else
     	Result := 'user';
  finally
     FreeMem(pcUser);
  end;
	if Length(Result) < 1 then
  	Result := 'user';
end;

procedure RegisterFileAssociation(Company, AppTitle, FileExtension: string);
var
RegIni: TRegIniFile;
KeyInfo: string;

begin
//Check file association entry and add it if not there or inaccurate
	RegIni := TRegIniFile.Create('');
  try
     try
        RegIni.RootKey := HKEY_CLASSES_ROOT;
        if FileExtension[1] <> '.' then
        	FileExtension := '.' + FileExtension;
        RegIni.WriteString(FileExtension, '', AppTitle);
        RegIni.WriteString(FileExtension, 'Content type', AppTitle + ' file');
        KeyInfo := Application.ExeName + ' "%1"';
        RegIni.WriteString(AppTitle + '\Shell\open\command', '', KeyInfo);
     except
     	MessageDlg('Unable to register file extension "' + FileExtension + '".', mtWarning, [mbOK], 0);
     end;
  finally
  	RegIni.Free;
  end;
end;

function NormalizeWebColour(InColour: string; MakeHex: Boolean): string;
var
i: integer;
const
HexDigits = ['0'..'9','a'..'f','A'..'F'];

begin
	InColour := Trim(InColour);

//Check it against the named colours table
	if NSC.Values[InColour] <> '' then
  	begin
     	if MakeHex = True then
        	Result := NSC.Values[InColour]
        else
        	Result := InColour;
        Exit;
     end;
  
//Add a hash if there isn't one
	if InColour[1] <> '#' then
  	InColour := '#' + InColour;

//Make it the right length
	if Length(InColour) > 7 then
  	InColour := Copy(InColour, 1, 7);
  while Length(InColour) < 7 do
  	InColour := InColour + '9';

//Make each relevant digit correct
	for i := 2 to 7 do
  	if not (InColour[i] in HexDigits) then
     	InColour[i] := '9';

  Result := InColour;
end;

function WebColourToWinColour(InColour: string): TColor;
begin
//First set default
	Result := clGray;

  try
//Normalize to a hex colour
	  InColour := NormalizeWebColour(InColour, True);

//Discard the initial hash
	  InColour := Copy(InColour, 2, 6);

//Reorder the components
	  InColour := '$' + Copy(InColour, 5, 2) + Copy(InColour, 3, 2) + Copy(InColour, 1, 2);

//Convert to colour
	  Result := StrToIntDef(InColour, $00CCCCCC);
  except
  end;
end;

function WebColourToWinColourDefNone(InColour: string): TColor;
begin
//First set default
	Result := clNone;
  if LowerCase(InColour) = 'transparent' then
    Exit;
  try
//Normalize to a hex colour
	  InColour := NormalizeWebColour(InColour, True);

//Discard the initial hash
	  InColour := Copy(InColour, 2, 6);

//Reorder the components
	  InColour := '$' + Copy(InColour, 5, 2) + Copy(InColour, 3, 2) + Copy(InColour, 1, 2);

//Convert to colour
	  Result := StrToIntDef(InColour, clNone);
  except
  end;
end;

function ColorToHTML(InColor: TColor; AddHash: Boolean): string;
var
  TheRgbValue : TColorRef;
begin
	TheRgbValue := ColorToRGB(InColor);
  Result := Format('%.2x%.2x%.2x',
                       [GetRValue(TheRGBValue),
                        GetGValue(TheRGBValue),
                        GetBValue(TheRGBValue)]);
	if AddHash = True then
  	Result := '#' + LowerCase(Result);
end;

function GetOSVersion: string;
var
OSName: string;

begin
  OSName := '';
	Case Win32Platform of
  	Ver_Platform_Win32_NT:
     	begin
        case Win32MajorVersion of
          4: OSName := 'NT';
          5:
            begin
              if Win32MinorVersion = 0 then
                OSName := '2000';
              if Win32MinorVersion = 1 then
                OSName := 'XP';
            end;
          6:
            if Win32MinorVersion = 0 then
              OSName := 'Vista';
          else
            begin
              if Win32MajorVersion >= 6 then
                OSName := 'Unknown successor to Vista';
            end;
        end;
     		Result := Format('Windows ' + OSName + ' (NT %d.%d Build %d %s).',
        					[Win32MajorVersion, Win32MinorVersion,
                        Win32BuildNumber and $FFFF, Win32CSDVersion]);
        end;
     Ver_Platform_Win32_Windows:
     	begin
        	if Win32MinorVersion <= 0 then
           	begin
           		OSName := '95';
                 if Length(Win32CSDVersion) > 1 then
                 	if (Win32CSDVersion[2] = 'C') or (Win32CSDVersion[2] = 'B') then
                 		OSName := OSName + ' OSR2';
              end
           else
           	if Win32MinorVersion = 10 then
              	begin
           			OSName := '98';
                 	if Length(Win32CSDVersion) > 1 then
                    	if Win32CSDVersion[2] = 'A' then
                 			OSName := OSName + ' SE';
              	end
              else
                 if Win32MinorVersion = 90 then
                 	OSName := 'ME'
                 else
                 	OSName := 'Unknown successor to ME';
     		Result := Format('Windows ' + OSName + ' (%d %d Build %d %s).',
        					[Win32MajorVersion, Win32MinorVersion,
                        Win32BuildNumber and $FFFF, Win32CSDVersion]);
        end;
  else
  	Result := 'Unknown platform.';
  end;
end;

function IsWin9xFamily: Boolean;
begin
	Result := (Win32Platform = Ver_Platform_Win32_Windows);
end;

function IsWinNT4: Boolean;
begin
 	Result := (Win32Platform = Ver_Platform_Win32_NT) and
  			 (Win32MajorVersion = 4);
end;

function IsWin2KOrAbove: Boolean;
begin
 	Result := (Win32Platform = Ver_Platform_Win32_NT) and
  			 (Win32MajorVersion >= 5);
end;

function IsWinXPOrAbove: Boolean;
begin
	Result := False;
	if Win32Platform <> Ver_Platform_Win32_NT then
  	Exit;
  if Win32MajorVersion < 5 then
  	Exit;
	if (Win32MajorVersion > 5) or (Win32MinorVersion >= 1) then
  	Result := True;
end;

function IsWinVistaOrAbove: Boolean;
begin
 	Result := (Win32Platform = Ver_Platform_Win32_NT) and
  			 (Win32MajorVersion >= 6);
end;

function AppDataFolder: string;
var
PIDL: PItemIDList;
InFolder: array[0..MAX_PATH] of Char;
Malloc: IMalloc;

begin
	SHGetMalloc(Malloc);
  SHGetSpecialFolderLocation(0, CSIDL_APPDATA, PIDL);
  SHGetPathFromIDList(PIDL, InFolder);
  Malloc.Free(PIDL);
  Result := StrPas(InFolder);
end;

function CommonAppDataFolder: string;
var
PIDL: PItemIDList;
InFolder: array[0..MAX_PATH] of Char;
Malloc: IMalloc;

begin
	SHGetMalloc(Malloc);
  SHGetSpecialFolderLocation(0, CSIDL_COMMON_APPDATA, PIDL);
  SHGetPathFromIDList(PIDL, InFolder);
  Malloc.Free(PIDL);
  Result := StrPas(InFolder);
end;

function MyDocsFolder: string;
var
PIDL: PItemIDList;
InFolder: array[0..MAX_PATH] of Char;
Malloc: IMalloc;

begin
	SHGetMalloc(Malloc);
  SHGetSpecialFolderLocation(0, CSIDL_PERSONAL, PIDL);
  SHGetPathFromIDList(PIDL, InFolder);
  Malloc.Free(PIDL);
  Result := StrPas(InFolder);
end;



function ProgramFilesFolder: string;
var
PIDL: PItemIDList;
InFolder: array[0..MAX_PATH] of Char;
Malloc: IMalloc;

begin
	SHGetMalloc(Malloc);
  SHGetSpecialFolderLocation(0, $0026, PIDL);
  SHGetPathFromIDList(PIDL, InFolder);
  Malloc.Free(PIDL);
  Result := StrPas(InFolder);
end;

function DesktopFolder: string;
var
PIDL: PItemIDList;
InFolder: array[0..MAX_PATH] of Char;
Malloc: IMalloc;

begin
	SHGetMalloc(Malloc);
  SHGetSpecialFolderLocation(0, CSIDL_DESKTOPDIRECTORY, PIDL);
  SHGetPathFromIDList(PIDL, InFolder);
  Malloc.Free(PIDL);
  Result := StrPas(InFolder);
end;

function StartMenuFolder: string;
var
PIDL: PItemIDList;
InFolder: array[0..MAX_PATH] of Char;
Malloc: IMalloc;

begin
	SHGetMalloc(Malloc);
  SHGetSpecialFolderLocation(0, CSIDL_STARTMENU, PIDL);
  SHGetPathFromIDList(PIDL, InFolder);
  Malloc.Free(PIDL);
  Result := StrPas(InFolder);
end;

function StartMenuProgramsFolder: string;
var
PIDL: PItemIDList;
InFolder: array[0..MAX_PATH] of Char;
Malloc: IMalloc;

begin
	SHGetMalloc(Malloc);
  SHGetSpecialFolderLocation(0, CSIDL_PROGRAMS, PIDL);
  SHGetPathFromIDList(PIDL, InFolder);
  Malloc.Free(PIDL);
  Result := StrPas(InFolder);
end;

function LocalAppDataFolder: string;
var
PIDL: PItemIDList;
InFolder: array[0..MAX_PATH] of Char;
Malloc: IMalloc;

begin
	SHGetMalloc(Malloc);
  SHGetSpecialFolderLocation(0, $1c{CSIDL_LOCAL_APPDATA}, PIDL);
  SHGetPathFromIDList(PIDL, InFolder);
  Malloc.Free(PIDL);
  Result := StrPas(InFolder);
end;

function UserFavoritesFolder: string;
var
PIDL: PItemIDList;
InFolder: array[0..MAX_PATH] of Char;
Malloc: IMalloc;

begin
  SHGetMalloc(Malloc);
  SHGetSpecialFolderLocation(0, CSIDL_FAVORITES, PIDL);
  SHGetPathFromIDList(PIDL, InFolder);
  Malloc.Free(PIDL);
  Result := StrPas(InFolder);
end;

function TempFolder: string;
var
  TempDir   : array[0..MAX_PATH] of Char;
begin
  GetTempPath(MAX_PATH, @TempDir);
  Result := string(TempDir);
end;

procedure AddRecentFile(FileName:string);
begin
  { Add file to Recent directory }
  SHAddtoRecentDocs(SHARD_PATH, PChar(FileName));
end;

function CreateAppDataFolder(SuiteName, AppName: string): Boolean;
	function AddSlashIfNeeded(InString: string): string;
  begin
  	if InString[Length(InString)] <> '\' then
     	InString := InString + '\';
     Result := InString;
  end;
var
FullPath: string;

begin
	Result := False;
//Check whether it's there already
  FullPath := AppDataFolder;
  if Length(SuiteName) > 0 then
  	begin
  		FullPath := AddSlashIfNeeded(FullPath) + SuiteName;
        if not DirectoryExists(FullPath) then
        	if CreateDir(FullPath) = False then
           	Exit;
     end;
  if Length(AppName) > 0 then
  	begin
  		FullPath := AddSlashIfNeeded(FullPath) + AppName;
        if not DirectoryExists(FullPath) then
        	if CreateDir(FullPath) = False then
           	Exit;
     end;
	if DirectoryExists(FullPath) then
 		Result := True;
end;

function GetProxySettings: TMyProxySettings;
const
IE_REG_KEY = 'Software\Microsoft\Windows\CurrentVersion\Internet Settings';
DEFAULT_PORT: integer = 80;

var
Reg: TRegistry;
CP: integer;
S: string;

begin
  Reg := TRegistry.Create;
  try
     with Reg do
        begin
           RootKey := HKEY_CURRENT_USER;
           if OpenKey(IE_REG_KEY,false) then
              begin
//get server name & port (usually combined)
                 S := ReadString('ProxyServer');
                 CP := Pos(':',s);
                 if CP > 0 then
                    begin
                       Result.Server := Copy(S,1,CP-1);
                       Result.Port := StrToIntDef(Copy(S,CP+1,Length(S)-CP),DEFAULT_PORT);
                    end
                 else
                    begin
                       Result.Server := S;
                       Result.Port := DEFAULT_PORT;
                    end;
//get proxy enabled state
                 try
                    CP := ReadInteger('ProxyEnable');
                 except
                    CP := 0;
                 end;
                 Result.Enabled := CP > 0;
//all done
                 CloseKey;
              end
           else
              begin
                 Result.Server := '';
                 Result.Port := DEFAULT_PORT;
              end;
        end;
  finally
     Reg.free;
  end;
end;

function RegularizeNumber(NumString: string; DecPlaces: integer): string;
//This function takes a string version of a number, and makes sure
//it's a proper number consisting of digits and an optional point.
//Then it checks to make sure the correct number of decimal places are
//there, deleting extra ones, and adding where necessary.

var
Temp: string;
TempAsInt: string;
IntValue: integer;
i: integer;
FoundDecimal: integer;
IsNegative: Boolean;

begin
  Result := '0';
  IsNegative := False;
  Temp := NumString;
  FoundDecimal := 0;
  
  if Length(Temp) > 0 then
//Delete extraneous characters
     begin
        IsNegative := (Temp[1] = '-');
        for i := Length(Temp) downto 1 do
           begin
//Delete illegal characters
              if not (Temp[i] in ['0'..'9','.']) then
                 Delete(Temp, i, 1);
//Delete any duplicate points
              if (FoundDecimal > 0) and (Temp[i] = '.') then
                 Delete(Temp, i, 1)
              else
                 if (Temp[i] = '.') then
                    FoundDecimal := i;
           end;
//Finally, add a zero if there's only a point there
        if Temp = '.' then
           Temp := '0.';
     end
  else
     Temp := '0.';

//Add a zero at the beginning if needed
  if Pos('.', Temp) = 1 then
     Temp := '0' + Temp;

//Add a point if needed
  if (DecPlaces > 0) and (Pos('.', Temp) < 1) then
     Temp := Temp + '.';

//Now we know it has only numbers and one point.
//If no decimal places required, just use the integer portion
  if DecPlaces < 1 then
     begin
        if FoundDecimal > 0 then
           Temp := Copy(Temp, 1, Pos('.', Temp)-1);
     end
  else
     begin
//Add required decimal places
        while Pos('.', Temp) > (Length(Temp) - DecPlaces) do
           Temp := Temp + '0';

//Remove extra decimal places
        while Pos('.', Temp) < (Length(Temp) - DecPlaces) do
           Delete(Temp, Length(Temp), 1);
     end;
//Test the number as an integer to see if it can be handled
  FoundDecimal := Pos('.', Temp);
  TempAsInt := Temp;
  if DecPlaces > 0 then
     Delete(TempAsInt, FoundDecimal, 1);

//If it's too large or won't fit, reduce it appropriately
  try
     IntValue := StrToInt(TempAsInt);
  except
     Temp := '0';
     if DecPlaces > 0 then
        Temp := Temp + '.' + StringOfChar('0', DecPlaces);
  end;

  Result := Temp;
  if IsNegative then Result := '-' + Temp;
end;

{ Input dialog }

function GetIntegerFromUser(const ACaption, APrompt: string; ADefault: integer): integer;
var
strNum: string;

begin
//Tries to get the user to enter a number. If this fails, returns -1 to signal no valid number entered.
  Result := -1;
  strNum := IntToStr(ADefault);
  if InputQuery(ACaption, APrompt, strNum) = True then
     begin
        try
           Result := StrToInt(strNum);
        except
           Result := -1;
        end;
     end;
end;

function WInputQuery(const ACaption, APrompt: string;
  var Value: WideString): Boolean;

   function GetAveCharSize(Canvas: TCanvas): TPoint;
   var
     I: Integer;
     Buffer: array[0..51] of Char;
   begin
     for I := 0 to 25 do Buffer[I] := Chr(I + Ord('A'));
     for I := 0 to 25 do Buffer[I + 26] := Chr(I + Ord('a'));
     GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
     Result.X := Result.X div 52;
   end;

var
  Form: TTntForm;
  Prompt: TTntLabel;
  UEdit: TTntEdit;
  DialogUnits: TPoint;
  ButtonTop, ButtonWidth, ButtonHeight: Integer;
begin
  Result := False;
  Form := TTntForm.Create(Application);
  with Form do
    try
      Canvas.Font := Font;
      DialogUnits := GetAveCharSize(Canvas);
      BorderStyle := bsDialog;
      Caption := ACaption;
      ClientWidth := MulDiv(180, DialogUnits.X, 4);
      ClientHeight := MulDiv(63, DialogUnits.Y, 8);
      Position := poScreenCenter;
      Prompt := TTntLabel.Create(Form);
      with Prompt do
      begin
        Parent := Form;
        AutoSize := True;
        //WordWrap := True;
        Left := MulDiv(8, DialogUnits.X, 4);
        Top := MulDiv(8, DialogUnits.Y, 8);
        Caption := APrompt;
      end;

//Resize the dialog if necessary
      if Prompt.Width > (ClientWidth - (2*(MulDiv(8, DialogUnits.X, 4)))) then
         ClientWidth := (2*(MulDiv(8, DialogUnits.X, 4))) + Prompt.Width;
      UEdit := TTntEdit.Create(Form);
      with UEdit do
      begin
        Parent := Form;
        Left := Prompt.Left;
        Top := MulDiv(19, DialogUnits.Y, 8);
        //Width := MulDiv(164, DialogUnits.X, 4);
        Width := Prompt.Width;
        MaxLength := 255;
        Text := Value;
        SelectAll;
      end;
      ButtonTop := MulDiv(41, DialogUnits.Y, 8);
      ButtonWidth := MulDiv(50, DialogUnits.X, 4);
      ButtonHeight := MulDiv(14, DialogUnits.Y, 8);
      with TTntButton.Create(Form) do
      begin
        Parent := Form;
        Caption := SMsgDlgOK;
        ModalResult := mrOk;
        Default := True;
        SetBounds(((Form.ClientWidth div 2) -  (ButtonWidth + 4)), ButtonTop,
            ButtonWidth, ButtonHeight);
        {SetBounds(MulDiv(38, DialogUnits.X, 4), ButtonTop, ButtonWidth,
          ButtonHeight);}
      end;
      with TTntButton.Create(Form) do
      begin
        Parent := Form;
        Caption := SMsgDlgCancel;
        ModalResult := mrCancel;
        Cancel := True;
        SetBounds((Form.ClientWidth div 2) + 4, ButtonTop, ButtonWidth, ButtonHeight);
        {SetBounds(MulDiv(92, DialogUnits.X, 4), ButtonTop, ButtonWidth,
          ButtonHeight);}
      end;
      if ShowModal = mrOk then
      begin
        Value := UEdit.Text;
        Result := True;
      end;
    finally
      FreeAndNil(Form);
    end;
end;

function WInputBox(const ACaption, APrompt: string; ADefault: WideString): WideString;
begin
  Result := ADefault;
  WInputQuery(ACaption, APrompt, Result);
end;

function WGetIntegerFromUser(const ACaption, APrompt: WideString; ADefault: integer): integer;
var
wsNum: WideString;

begin
//Tries to get the user to enter a number. If this fails, returns -1 to signal no valid number entered.
  Result := -1;
  wsNum := IntToStr(ADefault);
  if WInputQuery(ACaption, APrompt, wsNum) = True then
     begin
        try
           Result := StrToInt(wsNum);
        except
           Result := -1;
        end;
     end;
end;

procedure NudgeCursor;
var
P: TPoint;

begin
  GetCursorPos(P);
  SetCursorPos(P.X+1, P.Y+1);
  Application.ProcessMessages;
  SetCursorPos(P.X, P.Y);
end;

function GUIDToXMLId(GUID: TGUID): WideString;
begin
  Result := WSGUIDToXMLId(WideString(GUIDToString(GUID)));
end;

function WSGUIDToXMLId(wsGUID: WideString): WideString;
begin
  Result := WideString(StringReplace(wsGUID, '{', '_', [rfReplaceAll]));
  Result := WideString(StringReplace(Result, '}', '_', [rfReplaceAll]));
end;

function XMLIdToWSGUID(XMLId: WideString): WideString;
begin
//Replace the first underscore with an open parenthesis
  Result := StringReplace(XMLId, '_', '{', []);
//Replace the second with a close parenthesis
  Result := StringReplace(Result, '_', '}', []);
end;

function XMLIdToGUID(XMLId: WideString; var GUID: TGUID): Boolean;
begin
  Result := False;
  try
    GUID := StringToGUID(string(XMLIdToWSGUID(XMLId)));
    Result := True;
  except
//Returning false is sufficient
  end;
end;

initialization

   NSC := TStringList.Create;
   NSC.Add('aliceblue=#F0F8FF');
   NSC.Add('antiquewhite=#FAEBD7');
   NSC.Add('aqua=#00FFFF');
   NSC.Add('aquamarine=#7FFFD4');
   NSC.Add('azure=#F0FFFF');
   NSC.Add('beige=#F5F5DC');
   NSC.Add('bisque=#FFE4C4');
   NSC.Add('black=#000000');
   NSC.Add('blanchedalmond=#FFEBCD');
   NSC.Add('blue=#0000FF');
   NSC.Add('blueviolet=#8A2BE2');
   NSC.Add('brown=#A52A2A');
   NSC.Add('burlywood=#DEB887');
   NSC.Add('cadetblue=#5F9EA0');
   NSC.Add('chartreuse=#7FFF00');
   NSC.Add('chocolate=#D2691E');
   NSC.Add('coral=#FF7F50');
   NSC.Add('cornflowerblue=#6495ED');
   NSC.Add('cornsilk=#FFF8DC');
   NSC.Add('crimson=#DC1436');
   NSC.Add('cyan=#00FFFF');
   NSC.Add('darkblue=#00008B');
   NSC.Add('darkcyan=#008B8B');
   NSC.Add('darkgoldenrod=#B8860B');
   NSC.Add('darkgrey=#A9A9A9');
   NSC.Add('darkgreen=#006400');
   NSC.Add('darkkhaki=#BDB76B');
   NSC.Add('darkmagenta=#8B008B');
   NSC.Add('darkolivegreen=#556B2F');
   NSC.Add('darkorange=#FF8C00');
   NSC.Add('darkorchid=#9932CC');
   NSC.Add('darkred=#8B0000');
   NSC.Add('darksalmon=#E9967A');
   NSC.Add('darkseagreen=#8FBC8F');
   NSC.Add('darkslateblue=#483D8B');
   NSC.Add('darkslategray=#2F4F4F');
   NSC.Add('darkturquoise=#00CED1');
   NSC.Add('darkviolet=#9400D3');
   NSC.Add('deeppink=#FF1493');
   NSC.Add('deepskyblue=#00BFFF');
   NSC.Add('dimgray=#696969');
   NSC.Add('dodgerblue=#1E90FF');
   NSC.Add('firebrick=#B22222');
   NSC.Add('floralwhite=#FFFAF0');
   NSC.Add('forestgreen=#228B22');
   NSC.Add('fuchsia=#FF00FF');
   NSC.Add('gainsboro=#DCDCDC');
   NSC.Add('ghostwhite=#F8F8FF');
   NSC.Add('gold=#FFD700');
   NSC.Add('goldenrod=#DAA520');
   NSC.Add('gray=#808080');
   NSC.Add('green=#008000');
   NSC.Add('greenyellow=#ADFF2F');
   NSC.Add('honeydew=#F0FFF0');
   NSC.Add('hotpink=#FF69B4');
   NSC.Add('indianred=#CD5C5C');
   NSC.Add('indigo=#4B0082');
   NSC.Add('ivory=#FFFFF0');
   NSC.Add('khaki=#F0E68C');
   NSC.Add('lavender=#E6E6FA');
   NSC.Add('lavenderblush=#FFF0F5');
   NSC.Add('lawngreen=#7CFC00');
   NSC.Add('lemonchiffon=#FFFACD');
   NSC.Add('lightblue=#ADD8E6');
   NSC.Add('lightcoral=#F08080');
   NSC.Add('lightcyan=#E0FFFF');
   NSC.Add('lightgoldenrodyellow=#FAFAD2');
   NSC.Add('lightgreen=#90EE90');
   NSC.Add('lightgrey=#D3D3D3');
   NSC.Add('lightpink=#FFB6C1');
   NSC.Add('lightsalmon=#FFA07A');
   NSC.Add('lightseagreen=#20B2AA');
   NSC.Add('lightskyblue=#87CEFA');
   NSC.Add('lightslategray=#778899');
   NSC.Add('lightsteelblue=#B0C4DE');
   NSC.Add('lightyellow=#FFFFE0');
   NSC.Add('lime=#00FF00');
   NSC.Add('limegreen=#32CD32');
   NSC.Add('linen=#FAF0E6');
   NSC.Add('magenta=#FF00FF');
   NSC.Add('maroon=#800000');
   NSC.Add('mediumaquamarine=#66CDAA');
   NSC.Add('mediumblue=#0000CD');
   NSC.Add('mediumorchid=#BA55D3');
   NSC.Add('mediumpurple=#9370DB');
   NSC.Add('mediumseagreen=#3CB371');
   NSC.Add('mediumslateblue=#7B68EE');
   NSC.Add('mediumspringgreen=#00FA9A');
   NSC.Add('mediumturquoise=#48D1CC');
   NSC.Add('mediumvioletred=#C71585');
   NSC.Add('midnightblue=#191970');
   NSC.Add('mintcream=#F5FFFA');
   NSC.Add('mistyrose=#FFE4E1');
   NSC.Add('moccasin=#FFE4B5');
   NSC.Add('navajowhite=#FFDEAD');
   NSC.Add('navy=#000080');
   NSC.Add('oldlace=#FDF5E6');
   NSC.Add('olive=#808000');
   NSC.Add('olivedrab=#6B8E23');
   NSC.Add('orange=#FFA500');
   NSC.Add('orangered=#FF4500');
   NSC.Add('orchid=#DA70D6');
   NSC.Add('palegoldenrod=#EEE8AA');
   NSC.Add('palegreen=#98FB98');
   NSC.Add('paleturquoise=#AFEEEE');
   NSC.Add('palevioletred=#DB7093');
   NSC.Add('papayawhip=#FFEFD5');
   NSC.Add('peachpuff=#FFDAB9');
   NSC.Add('peru=#CD853F');
   NSC.Add('pink=#FFC0CB');
   NSC.Add('plum=#DDA0DD');
   NSC.Add('powderblue=#B0E0E6');
   NSC.Add('purple=#800080');
   NSC.Add('red=#FF0000');
   NSC.Add('rosybrown=#BC8F8F');
   NSC.Add('royalblue=#4169E1');
   NSC.Add('saddlebrown=#8B4513');
   NSC.Add('salmon=#FA8072');
   NSC.Add('sandybrown=#F4A460');
   NSC.Add('seagreen=#2E8B57');
   NSC.Add('seashell=#FFF5EE');
   NSC.Add('sienna=#A0522D');
   NSC.Add('silver=#C0C0C0');
   NSC.Add('skyblue=#87CEEB');
   NSC.Add('slateblue=#6A5ACD');
   NSC.Add('slategray=#708090');
   NSC.Add('snow=#FFFAFA');
   NSC.Add('springgreen=#00FF7F');
   NSC.Add('steelblue=#4682B4');
   NSC.Add('tan=#D2B48C');
   NSC.Add('teal=#008080');
   NSC.Add('thistle=#D8BFD8');
   NSC.Add('tomato=#FF6347');
   NSC.Add('turquoise=#40E0D0');
   NSC.Add('violet=#EE82EE');
   NSC.Add('wheat=#F5DEB3');
   NSC.Add('white=#FFFFFF');
   NSC.Add('whitesmoke=#F5F5F5');
   NSC.Add('yellow=#FFFF00');
   NSC.Add('yellowgreen=#9ACD32');


finalization
	NSC.Free;

end.