unit uUtility;
interface
  uses Graphics, INIFiles, SysUtils, FileCtrl, Windows, Forms, Dialogs, DateUtils;

  const
    StartBarHeight = 28;

  type
    TProcFN    = function(S: string): string;
    stringproc = function(S: string): string;
    float      = extended;

  function GetTempFolder: string;

  function _uVolumeExists( FN: string; var VolumeName: string ): boolean;
  function uVolumeExists( FN: string ): boolean;
  function uFileExists( FN: string ): boolean;
    // Returns TRUE if volume and file exist, does not trip Windows "Insert a Disk"
  function uDirectoryExists( FN: string ): boolean;
    // Returns TRUE if volume and directory exist, does not trip Windows "Insert a Disk"
  procedure uDeleteFile( FN: string );
    // Deletes file if it exists
  function  uRemoveDirectoy( Path: string ): boolean;
    // Deletes the directory if it exists
  function uForceDirectories( D: string ): boolean;
    // Insure that directory D exists
    
  function DecPointStr: string;

  function BitSet( W: WORD; Bit: WORD ): boolean;
  function GetCharN( S: string; N: integer ): char;
  function FirstChar( S: string ): char;
  function LastChar( S: string ): char;
  procedure CA( var S: string; A: string; C: char );

  function ZSt(S: string): boolean;
  function InStr( Subst: string; S: string ): boolean;

  function DeltaTimeMinutes( StartT: tDateTime ): extended;
  function DeltaTimeSeconds( StartT: tDateTime ): extended;
  function dTimeStr( dT: cardinal ): string; // dT in Seconds!

  function fInc( var Value: extended; IncDec: extended ): extended;
  function fDec( var Value: extended; IncDec: extended ): extended;
  // Increments Value by IncDec (and returns the changed value). WARNING: Value is MODIFIED!

  function SmallerOf( e1: extended; e2: extended ): extended;
  function LargerOf( e1: extended; e2: extended ): extended;

  function SmallestOf( e: array of extended ): extended;
  function LargestOf( e: array of extended ): extended;
  function iSmallestOf( e: array of integer ): integer;
  function iLargestOf( e: array of integer ): integer;

  function iSmallerOf( e1: int64; e2: int64 ): int64;
  function iLargerOf( e1: int64; e2: int64 ): int64;

  function keepchar(c: string; s: string): string;
  function TitleCase( s: string ): string;
  function FixAddress( s: string ): string;
  function FixCompanyName( s: string ): string;

  // InRange returns TRUE if Value is within V1 and V2 inclusive
  procedure Order( var v1, v2: extended ); overload;
  procedure Order( var v1, v2: integer ); overload;
  function fInRange( Value: extended; V1: extended; V2: extended ): boolean;
  function iInRange( Value: integer; V1: integer; V2: integer ): boolean;

  function  ForceInRange( var Value: extended; V1: extended; V2: extended ): boolean;
  function  iForceInRange( var Value: integer; V1: integer; V2: integer ): boolean;

  // ForceInRange retruns TRUE if Value is within V1 and V2 inclusive AND then forces Value within the range
  function RoundTo( Value: extended; Nearest: extended ): extended;

  function  ExtFormatStr( np: integer ): string;

  procedure Exchange( var V1: extended; var V2: extended ); overload;
  procedure Exchange( var V1: LongInt; var V2: LongInt ); overload;
  procedure Exchange( var V1: string; var V2: string ); overload;
  // Exchange the values of V1 and V2

  function  fMod( n: extended; d: extended ): extended;

  function ZeroPad( s: string; n: integer ): string;

  FUNCTION _HHMMSS( T: extended ): string;
  FUNCTION HHMMSS( T1, T2: tDateTime ): string;

  FUNCTION _ElapsedTimeStr( dT: extended; L: BOOLEAN ): STRING;
  FUNCTION ElapsedTimeStr( T1, T2: tDateTime; L: BOOLEAN ): STRING;
  // returns a string describing the elapsed time between T1 and T2. If L is true, constants are not abbreviated

  FUNCTION MinSecToSTR( MS: extended ): string;
  function AddBackSlash(const DirName : String) : String;

  function RemoveFromString( S: String; R: String ): String;
  function RemoveCharsFromString( S, R: string ): string;
  function KeepInString( S: String; K: String ): String;

  function BoolToStr( B: boolean ): string;
  function BoolToYN( B: boolean ): string;
  function BoolToInt( B: boolean ): integer;
  function IntToBool( I: integer ): boolean;

  function INIReadExtended( INIFile: TIniFile;
                            Section: string;
                            Item:    string;
                            Def: extended ): extended;

  procedure INIWriteExtended( INIFile: TIniFile;
                            Section: string;
                            Item:    string;
                            Value: extended );


  function TClr( T: extended; MaxTemp: extended ): TColor;
  function TP( T: extended; MaxTemp: extended ): BYTE;

  function DegC2F( V: extended ): extended;
  function DegF2C( V: extended ): extended;

  function StripPastTab( S: string ): string;
  procedure Touch( filename: string );
  function  MatchFileDate( src, dst: string ): boolean;
  procedure SetFileDate( dst: string; DateTime: tDateTime );
  function  GetFileDateStr( filename: string ): string;
  function  GetFileDateDT( filename: string ): tDateTime;
  function  UFileDate( filename: string ): integer;
  procedure USetFileDate( dst: string; DateTime: integer );

  function  UFileSize( filename: string ): int64;
  function IsFileReadOnly( filename: string ): boolean;
  procedure FileReadOnly( filename: string;
                          ReadOnly: boolean;
                          Hidden:   boolean );

  procedure DeleteAllInPath( FilePath: string;
                             FileExt: string       // Include dot EX: '.CHK'
  );
  procedure CleanupDir( FilePath: string;
                             FileSpec: string;
                             MaxSize: integer;
                             KillSimilar: boolean;
                             var ErrMsg: string
  );
  function DeleteAll( FilePath: string;
                       FileSpec: string
  ): boolean;

  function ExactlyEQ( Subst: string; S: string ): boolean;
  function StringCompare( s1: string; s2: string ): boolean;

  function DriveTypeStr( DriveType: TDriveType ): string;
  function CheckDriveType( Path: String ): TDriveType;
  function iSign( I: integer ): integer;
  function sign( E: extended ): extended;
  function plural( i: integer ): string;

  procedure FatalError(const Msg: string);

  FUNCTION ParseNoToss( VAR Input: STRING; Tokens: STRING ): STRING;
  FUNCTION TokenParse( VAR Input: STRING; Token: String ): STRING;
  FUNCTION TokenParseEX( VAR Input: STRING; Token: String ): STRING;
  FUNCTION GetFromStr( VAR Input: STRING; MaxLen: integer; Tokens: String ): STRING;

  FUNCTION CommaParse( VAR Input: STRING ): STRING;
  FUNCTION SemiParse( VAR Input: STRING ): STRING;
  FUNCTION LFParse( VAR Input: STRING ): STRING;

  function EPad( S: string; Ch: Char; I: integer ): string;
  function Pad( S: string; I: integer ): string;

  FUNCTION StrReplace( S: String; Search: String; Replace: String ): String;
  FUNCTION StrReplaceBool( var S: String; Search: String; Replace: String ): boolean;
  FUNCTION StrReplaceBool1( var S: String; Search: String; Replace: String ): boolean;
  FUNCTION StrReplaceBoolNC1( var S: String; Search: String; Replace: String ): boolean;

  FUNCTION StrReplaceNC( S: String; Search: String; Replace: String ): String; // case insensitive
  FUNCTION StrReplaceNC1( S: String; Search: String; Replace: String ): String;
  FUNCTION StrReplace1( S: String; Search: String; Replace: String ): String;

  function OnOff2Str( B: Boolean ): string;

  procedure BreakNumStr( S: string;
                       var Pre: string;
                       var Num: integer;
                       var Post: string );

  function IncLastIntInStr( S: string;    // Input and Output string
                            D: integer    // Amount to increment by
  ): string;
  // IncNumInStr( 'T24WR32E', 2, -1 ) returns 'T24WR31E'

  procedure BreakFilename( S: string; var path, name, ext: string );
  function UniqueFN( S: string ): string;

  function BinComp( p1: pointer; p2: pointer; size: integer ): boolean;
  function iRotation( Rot: extended ): integer;
  function StrLenCh( S: string ): integer;
  function GChar( S: string ): char;

  function LowCase( c: char ): char;
  procedure SentanceCase(var S: string );

  function ProcessNotQuoted( S: string; P: stringproc ): string;
  function ReduceWhite( S: string ): string;
  function ReduceSpace( S: string ): string;   // convert unquoted '  ' to ' '
  function DropCommasInNumbers( S: string ): string;
  function DropFreeStandingCommas( S: string ): string;
  function BindEquals( S: string ): string;
  function StripQuotes( S: string ): string;
  function StripPercent( Name: string ): string;

  function  CR2Pipe( S: string ): string;
  function  _CR2Pipe( S: string ): string;
  function  Pipe2CR( S: string ): string;

  function VolumeID(Drive: String): string;

  function IsNum( C: char ): boolean;
  function IsAlpha( C: char ): boolean;
  function IsWhite( C: char ): boolean;
  function IsWhiteString( S: string ): boolean;
  function ExtractFileNameNoExt( FN: string ): string;

  function ArcSin( x: extended ): extended;
  function ArcCos( x: extended ): extended;

  procedure INIReadFont( INIFile: TIniFile;
                         Section: string;
                         Item:    string;
                         var Fnt: tFont );
  procedure INIWriteFont(INIFile: TIniFile;
                         Section: string;
                         Item:    string;
                         var Fnt: tFont );

  function ExpandFN( Filename: string ): string;

  function FindFileInPaths( PathS, FN: string; FNProc: TProcFN; var FoundFN: string ): boolean;

  procedure SetFontWithRotation( var Canvas: TCanvas;
                                 Rotation: extended );

  procedure FORINIT( var i: integer );
  function FORLOOP( var i: integer; _Low, _High: integer ): boolean;

  function HexDecode( c: char ): byte;
  function Int2StrN( I: Int64; N: integer ): string;

  procedure TabDel( NewStr: string; var OutStr: string );
  function FindAllExt( Path, Ext: string ): string;

  function RelativePathEval( FN, BasePath: string ): string;
  procedure AddIfNotEmpty( var S: string; R: string );

  function  AString( S: string ): string;

  function RationalizeDir( Dir: string ): string;
  function BreakUpCoor( S: string ): string;
  function SeparateLettersAndNumbers( S: string ): string;
  function DdotMS2DMS( s: string ): string;
  function DdotM2DM( s: string ): string;

  procedure CommaAppend( var S: string; T: string );
  procedure SemiAppend( var S: string; T: string );
  procedure TabAppend( var S: string; T: string );
  function _CRAppend( const S: string ):  string;
  procedure CRAppend( var S: string; T: string );
  procedure SpaceAppend( var S: string; T: string );

  function SameFileDate( TS1, TS2: integer ): boolean;
  function SameFileDateName( N1, N2: string ): boolean;
  function FileDateStr( FN: string ): string;

  function IntlFix0to60( S: string ): string;
  function CIN( C: char; InS: string ): boolean;
  function StripNextInteger( S: string ): string;
  function StripNextFloat( S: string ): string;

  function Str2Int( S: string ): integer;
  function Str2IntD( S: string; Def: integer ): integer;
  function Str2Int64( S: string ): int64;
  function Str2Int64D( S: string; Def: int64 ): int64;
  function Str2Float( S: string ): extended;
  function Str2Ext( S: string ): extended;
  function Str2FloatD( S: string; Def: extended ): extended;
  function Str2ExtD( S: string; Def: extended ): extended;
  function Str2ExtDNI( S: string; Def: extended ): extended;

  function RightCommaizeStr( s: string ): string;
  function LeftCommaizeStr( s: string ): string;
  function Commatize( S: string ): string;
  function Float2Str( E: extended; N: integer ): string;

  function Ext2Str( E: extended; N: integer ): string;
  function Ext2StrNI( E: extended; N: integer ): string; // NOT Internationalized Always writes '.' as '.'!
  function ExtToStr( E: extended; N: integer ): string;
  function Ext2StrComma( E: extended; N: integer ): string;
  function ExtToStrComma( E: extended; N: integer ): string;

  function Int2Str( V: int64 ): string;
  function Int2StrComma( V: int64 ): string;
  function IntToStrComma( V: int64 ): string;
  function IntToStrCommaN( V: int64; N: integer ): string;

  function IToStr( i: int64 ): string;

  function QuoteIfNeeded( S: string ): string;
  function EncodeInteger( i, N: integer ): string;

  procedure StripHTMLCode( var S: string );
  function StripBetween( T1, T2: char; var S: string ): boolean;
  procedure StripTo( Find: string; var S: string );
  procedure StripFrom( Find: string; var S: string );
  function ForceCRLF( S: string ): string;

  function Say( N: integer ): string;

  function GetLockFile( FN: string ): boolean;
  function GetLockFileX( FN: string; Ext: string ): boolean;
  function DeleteLockFile( FN: string; Ext: string ): boolean;

  function BoolStrSelect( B: boolean; t, f: string ): string;
  function StrSameStart( S1, S2: string ): boolean;
  function SimplifyKeywords( S: string ): string;
  function StrIfBool( S: string; B: boolean ): string;

  function DayOfWeekStr( T: tDateTime ): string;
  procedure Delay( s: extended );
  procedure Set_INIFilename( S: string );

  procedure AppendIfFileExists( FN: string; var List: string );
  // Adds FN to the list if it exists. If FN does not exist, List is not modified.

  function Int64ToInt( I: Int64 ): integer;
  function StringToDisplay( S: string ): string;
  function CharCount( SS: char; S: string ): integer;

implementation
  uses
    Classes, uFileSizeEx;

  const
    _INIFilename: string = '';

{$IFDEF VER270}
  function ThousandSeparator: char;
  begin
    result := FormatSettings.ThousandSeparator;
  end;

  function DecimalSeparator: char;
  begin
    result := FormatSettings.DecimalSeparator;
  end;
{$ENDIF}

  function Int64ToInt( I: Int64 ): integer;
  begin
    if I > 2147483647 then
      result := 2147483647
    else if I < -2147483648 then
      result := -2147483648
    else
      result := I;
  end;

  procedure AppendIfFileExists( FN: string; var List: string );
  // Adds FN to the list if it exists. If FN does not exist, List is not modified.
  begin
    if uFileExists( FN ) then CRAppend( List, ' '+FN );
  end;

  function GetTempFolder: string;
  var
    TF: array[0..4095] of char;
  begin
    GetTempPath( sizeof(TF), @TF );
    result := AddBackSlash(TF);
  end;

  function _uVolumeExists( FN: string; var VolumeName: string ): boolean;
  var
    sDrive: string;
    VolumeNameBuffer, FileSystemNameBuffer: array[0..256] of char;
    VolumeSerialNumber,MaximumComponentLength,FileSystemFlags: DWord;
  begin
    FN := ExpandFileName( FN );
    sDrive := ExtractFileDrive( FN );

    if FirstChar(sDrive)='\' then
    begin
      if (Length(sDrive)>0) AND (NOT(sDrive[Length(sDrive)] in ['\'])) then
        sDrive := sDrive + '\';
    end else
    begin
      // Not a network path
      sDrive := FirstChar( sDrive ) + ':\';
    end;

    VolumeNameBuffer := '';
    VolumeSerialNumber := 0;
    MaximumComponentLength := 0;
    FileSystemFlags := 0;
    result := GetVolumeInformation(
                    PChar(sDrive),
                    @VolumeNameBuffer, SizeOf( VolumeNameBuffer ),
                    @VolumeSerialNumber, MaximumComponentLength, FileSystemFlags,
                    @FileSystemNameBuffer, sizeof( FileSystemNameBuffer ) );
    if result then VolumeName := VolumeNameBuffer else VolumeName := '';
  end;

  function uVolumeExists( FN: string ): boolean;
  // Same as above, but does not return the VolumneName
  var
    VolumeName: string;
  begin
    result := _uVolumeExists( FN, VolumeName );
  end;


  function uFileExists( FN: string ): boolean;
  // Returns TRUE if file exists. Does a volume check FIRST and does not trigger windows
  // insert disk message if volume is NOT inserted.
  begin
    FN := ExpandFileName( FN );
    result := uVolumeExists( FN );
    if result then
    begin
      result := FileExists( FN );
    end;
  end;

  function uForceDirectories( D: string ): boolean;
  begin
    D := ExtractFilePath( D );
    if NOT uDirectoryExists( D ) then ForceDirectories( D );
    result := uDirectoryExists( D );
  end;

  procedure uDeleteFile( FN: string );
  begin
    if uFileExists( FN ) then DeleteFile( PChar(FN) );
  end;

  function uDirectoryExists( FN: string ): boolean;
  // Returns TRUE if file exists. Does a volume check FIRST and does not trigger windows
  // insert disk message if volume is NOT inserted.
  begin
    FN := ExpandFileName( FN );
    result := uVolumeExists( FN );
    if result then
    begin
      result := DirectoryExists( FN );
    end;
  end;

  function uRemoveDirectoy( Path: string ): boolean;
  begin
    result := FALSE;
    if uDirectoryExists( Path ) then result := RemoveDir( Path );
  end;


  function _EXEDir: string;
  begin
    result := AddBackSlash( ExtractFilePath( Application.EXEName ) );
  end;

  procedure Set_INIFilename( S: string );
  begin
    _INIFilename := S;
  end;

  function  UINIFilename: string;
  // This is the ONLY acceptable place to get an INIFilename for the project from
  // ALWAYS returns AllTopo.INI in the current directory
  begin
    // only compute name if empty
    if _INIFilename = '' then
    begin
      _INIFilename := ExpandFilename( AddBackSlash(ExtractFilePath(ParamStr(0))) + 'AllTopo.ini' );
    end;
    result := _INIFilename;
  end;

  function UOurINIFilename: string;
  begin
    result := ChangeFileExt( ExpandFilename( AddBackSlash(ExtractFilePath(Application.EXEName))), '.ini' );
  end;

  function BitSet( W: WORD; Bit: WORD ): boolean;
  // check if a bit is set within a word.
  begin
    result := (W AND (1 SHL Bit)) <> 0;
  end;

  function GetCharN( S: string; N: integer ): char;
  // return the first character of a string. Returns space if the
  // string has no length.
  begin
    if Length(S)>=N then
      result := S[N]
    else
      result := ' ';
  end;

  function FirstChar( S: string ): char;
  // return the first character of a string. Returns space if the
  // string has no length.
  begin
    result := GetCharN( S, 1 );
  end;

  procedure CA( var S: string; A: string; C: char );
  begin
    if Length(S)=0 then S := A else S := S + C + A;
  end;
  
  function LastChar( S: string ): char;
  // return the last character of the string
  begin
    if Length(S)>0 then
      result := GetCharN( S, Length(S) )
    else
      result := ' ';
  end;

  function ZSt(S: string): boolean;
  // return true if the S string has no length (Zero String Length)
  begin
    result := Length(S)=0;
  end;

  function ExactlyEQ( Subst: string; S: string ): boolean;
  // Are the two strings exactly the same?
  begin
    result := (UpperCase(Trim(Subst)) = UpperCase(Trim(S)));
  end;

  function InStr( Subst: string; S: string ): boolean;
  // does the entire Subs exist in S?
  begin
    result := Pos( UpperCase(Subst), UpperCase(Trim(S)) ) > 0;
  end;

  function StringCompare( s1: string; s2: string ): boolean;
  // Are the strings the same?
  begin
    result := (Pos( s1, s2 ) > 0) and (Length(s1)=Length(s2));
  end;

  function DeltaTimeMinutes( StartT: tDateTime ): extended;
  // returns the elapsed time in minutes from StartT to Now
  const
    MinutesPerDay = (60.0 * 24.0);
  var
    E: extended;
  begin
    E := (Now - StartT) * (60.0 * 24.0);
    // Wow, a compiler problem prevents a direct assignment...
    result := E;
  end;

  function DeltaTimeSeconds( StartT: tDateTime ): extended;
  // returns the elapsed time in minutes from StartT to Now
  const
    SecondsPerDay = (60.0 * 60.0 * 24.0);
  var
    E: extended;
  begin
    E := (Now - StartT) * SecondsPerDay;
    result := E;
  end;

  function fInc( var Value: extended; IncDec: extended ): extended;
  begin
    Value := Value + IncDec;
    result := Value;
  end;

  function fDec( var Value: extended; IncDec: extended ): extended;
  begin
    result := fInc( Value, -1.0 * IncDec );
  end;

  function SmallerOf( e1: extended; e2: extended ): extended;
  begin
    if e1 < e2 then
      result := e1
    else
      result := e2;
  end;

  function LargerOf( e1: extended; e2: extended ): extended;
  begin
    if e1 > e2 then
      result := e1
    else
      result := e2;
  end;

  function iSmallerOf( e1: int64; e2: int64 ): int64;
  begin
    if e1 < e2 then
      result := e1
    else
      result := e2;
  end;

  function iLargerOf( e1: int64; e2: int64 ): int64;
  begin
    if e1 > e2 then
      result := e1
    else
      result := e2;
  end;

  function SmallestOf( e: array of extended ): extended;
  var
    i: integer;
  begin
    result := e[Low(e)];
    for i:=Low(e) to High(e) do
      if e[i] < result then result := e[i];
  end;

  function LargestOf( e: array of extended ): extended;
  var
    i: integer;
  begin
    result := e[Low(e)];
    for i:=Low(e) to High(e) do
      if e[i] > result then result := e[i];
  end;

  function iSmallestOf( e: array of integer ): integer; overload;
  var
    i: integer;
  begin
    result := e[Low(e)];
    for i:=Low(e) to High(e) do
      if e[i] < result then result := e[i];
  end;

  function iLargestOf( e: array of integer ): integer; overload;
  var
    i: integer;
  begin
    result := e[Low(e)];
    for i:=Low(e) to High(e) do
      if e[i] > result then result := e[i];
  end;

  procedure Order( var v1, v2: extended ); overload;
  var
    t: extended;
  begin
    if v1 > v2 then
    begin
      t := v2;
      v2 := v1;
      v1 := t;
    end;
  end;

  procedure Order( var v1, v2: integer ); overload;
  var
    t: integer;
  begin
    if v1 > v2 then
    begin
      t := v2;
      v2 := v1;
      v1 := t;
    end;
  end;

  function fInRange( Value: extended; V1: extended; V2: extended ): boolean;
  // InRange returns TRUE if Value is within V1 and V2 inclusive
  var
    Max, Min: extended;
  begin
    Max := LargerOf( V1, V2 );
    Min := SmallerOf( V1, V2 );
    result := ( Value >= Min ) and ( Value <= Max );
  end;

  function iInRange( Value: integer; V1: integer; V2: integer ): boolean;
  // InRange returns TRUE if Value is within V1 and V2 inclusive
  var
    Max, Min: integer;
  begin
    Max := iLargerOf( V1, V2 );
    Min := iSmallerOf( V1, V2 );
    result := ( Value >= Min ) and ( Value <= Max );
  end;

  function  ForceInRange( var Value: extended; V1: extended; V2: extended ): boolean;
  // ForceInRange returns TRUE if Value is within V1 and V2 inclusive AND then forces Value within the range
  var
    Max, Min: extended;
  begin
    Max := LargerOf( V1, V2 );
    Min := SmallerOf( V1, V2 );
    result := fInRange( Value, Max, Min );
    if Value > Max then
      Value := Max
    else if Value < Min then
      Value := Min;
  end;

  function  iForceInRange( var Value: integer; V1: integer; V2: integer ): boolean;
  // ForceInRange returns TRUE if Value is within V1 and V2 inclusive AND then forces Value within the range
  var
    Max, Min: integer;
  begin
    Max := iLargerOf( V1, V2 );
    Min := iSmallerOf( V1, V2 );
    result := iInRange( Value, Max, Min );
    if Value > Max then
      Value := Max
    else if Value < Min then
      Value := Min;
  end;

  function RoundTo( Value: extended; Nearest: extended ): extended;
  begin
    result := Int( Value / Nearest ) * Nearest;
  end;

  procedure Exchange( var V1: extended; var V2: extended ); overload;
  var
    T: extended;
  begin
    T := V2;
    V2 := V1;
    V1 := T;
  end;

  procedure Exchange( var V1: longint; var V2: longint ); overload;
  var
    T: longint;
  begin
    T := V2;
    V2 := V1;
    V1 := T;
  end;

  procedure Exchange( var V1: String; var V2: string ); overload;
  var
    T: string;
  begin
    T := V2;
    V2 := V1;
    V1 := T;
  end;

  function  fMod( n: extended; d: extended ): extended;
  begin
    result := d * Frac( n / d );
  end;

  function ZeroPad( s: string; n: integer ): string;
  begin
    result := s;
    while length( result ) < N do result := '0'+result;
  end;

  FUNCTION MinSecToSTR( MS: extended ): string;
  { returns a string of the form 'MM:SS', if minutes are >= 60.0 then hours are also
    displayed: 'HH:MM:SS' }
  var
    T: extended;
  begin
    if MS < 0.0 then
    begin
      result := '-';
      MS := abs( MS );
    end else
      result := '';
    if MS >= 60.0 then
    begin
      T := Trunc( MS / 60.0 ) * 60.0;
      MS := Frac( MS / 60.0 ) * 60.0;
      result := result + Ext2Str( T, 0 ) + ' hour';
    end;
    if Trunc( MS ) >= 0.0 then
    begin
      result := result + ' ' + Ext2STR( Trunc(MS), 0 ) + ' min'
    end;
    if ( Trunc(Frac(MS)*60.0) >= 0.5 ) then
    begin
      result := result + ' ' + Ext2STR( Trunc(Frac(MS)*60.0), 0 ) + ' sec';
    end;
  end;

  FUNCTION _HHMMSS( T: extended ): string;
  { dTime is time in days
    returns a string of the form 'MM:SS', if minutes are >= 60.0 then hours are also
    displayed: 'HH:MM:SS' }
  var
    H,M,S: extended;
    iH,iM,iSe: integer;
  begin
    if NOT fInRange( T, 1/3600.0, 3600.0 ) then
    begin
      result := '??:??:??';
      exit;
    end;
    try
      T := T * 24.0; // Convert to hours
      H := Trunc( T );
      M := Frac( T ) * 60.0;
      S := Frac( M ) * 60.0;
      iM := Trunc( M );
      iSe := Trunc( S );
      iH := Trunc( H );
      result := Int2StrN(iH,2)+':'+Int2StrN(iM,2)+':'+Int2StrN(iSe,2);
    except
      result := 'xx:xx:xx';
    end;
  end;

  FUNCTION HHMMSS( T1, T2: tDateTime ): string;
  { returns a string of the form 'MM:SS', if minutes are >= 60.0 then hours are also
    displayed: 'HH:MM:SS' }
  begin
    result := _HHMMSS( T2 - T1 );
  end;

  FUNCTION ElapsedTimeStr( T1, T2: tDateTime; L: BOOLEAN ): STRING;
  var
    DT: extended;
  begin
    IF (T2=0.0) THEN
      DT := T1
    ELSE IF ( T1=0.0 ) THEN
    BEGIN
      Result := '*?*';
      EXIT;
    END ELSE
      DT := T2 - T1;
    result :=_ElapsedTimeStr( DT, L );
  end;

  FUNCTION _ElapsedTimeStr( dT: extended; L: BOOLEAN ): STRING;
  { Returns a string represnting the elapsed time.
    Use this form normally:
      ElapsedTimeStr( StartTime, Now, TRUE );   if you have two times and T2>T1
      if StartTime = 0.0 then '*?*' is returned!
      if T2 = 0.0 then the time from 0.0 to StartTime is returned.
  }
    VAR
    _Sep: STRING;
    CONST
      N: ARRAY[FALSE..TRUE,1..12] OF STRING =
        ( ( 'Y','Y', 'M','M', 'D','D', 'h','h', 'm','m', 's','s' ),
          ('Years','Year', 'Months','Month', 'Days','Day',
          'hours','hour', 'minutes','minute', 'seconds','second') );

    FUNCTION Sep: STRING;
    { returns an empty string the first time called, then a space every time after }
    BEGIN
      Result := _Sep;
      _Sep := ' ';
    END;

  VAR
    T: Integer;
    Years: WORD;
    Months: WORD;
    Days: WORD;
    Hours: WORD;
    Minutes: WORD;
    Seconds: WORD;
    MSecs:   WORD;
    S: STRING;
  BEGIN
    _Sep := '';
    DecodeTime( DT, Hours, Minutes, Seconds, MSecs );
    T := Trunc( DT );
    Days := T MOD 30;
    T := T DIV 30;
    Months := T MOD 12;
    T := T DIV 12;
    Years := T;
    S := '';
    IF Years>0 THEN
    BEGIN
      S := IntToStr( Years );
      IF Years<>1 THEN
        S := Sep+S+' '+N[L,1]
      ELSE
        S := Sep+S+' '+N[L,2];
    END;
    IF ( (Years>0) OR (Months>0) ) THEN
    BEGIN
      IF Months <> 1 THEN
        S := S + Sep+IntToStr(Months)+' '+N[L,3]
      ELSE
        S := S + Sep+IntToStr(Months)+' '+N[L,4];
    END;
    IF ( (Years>0) OR (Months>0) OR (Days>0)) THEN
    BEGIN
      IF Days<>1 THEN
        S := S + Sep + IntToStr(Days) + ' ' + N[L,5]
      ELSE
        S := S + Sep + IntToStr(Days) + ' ' + N[L,6];
    END;
    IF ( (Years>0) OR (Months>0) OR (Days>0) OR (Hours>0) ) THEN
    BEGIN
      IF Hours<>1 THEN
        S := S + Sep + IntToStr(Hours) + ' ' + N[L,7]
      ELSE
        S := S + Sep + IntToStr(Hours) + ' ' + N[L,8];
    END;
    IF ( (Years>0) OR (Months>0) OR (Days>0) OR (Hours>0) OR (Minutes>0) ) THEN
    BEGIN
      IF Minutes <> 1 THEN
        S := S + Sep + IntToStr(Minutes) + ' ' + N[L,9]
      ELSE
        S := S + Sep + IntToStr(Minutes) + ' ' + N[L,10]
    END;
    S := S + ' ' + IntToStr(Seconds) + '.' + Int2StrN(Round(MSecs/100),1)+' seconds';
    Result := S;
  END;

  function AddBackSlash(const DirName : String) : String;
  // OLD WAY
  const
   DosDelimSet : set of Char = ['\'];
   // -Add a default backslash to a directory name
  begin
    if Length(DirName) = 0 then Exit;
    if DirName[Length(DirName)] in DosDelimSet then
      Result := DirName
    else
      Result := DirName + '\';
  end;

  // NEW WAY
{
  begin
    // A little easier ;-)
    result := IncludeTrailingPathDelimiter( DirName );
  end;
}

  function RemoveFromString( S: String; R: String ): String;
  // if the string R is found in S, remove it. CASE INSENSITIVE!
  var
    i: integer;
  begin
    result := S;
    repeat
      i := Pos( UpperCase(R), UpperCase(result) );
      if i>0 then Delete(result, i, Length(R) );
    until i=0;
  end;

  function RemoveCharsFromString( S, R: string ): string;
  var
    i: integer;
  begin
    result := S;
    for i := Low(R) to High(R) do
    begin
      result := RemoveFromString( result, R[i] );
    end;
  end;

  function KeepInString( S: String; K: String ): String;
  // Removes all characters except those in K from the string. Case insensitive.
  var
    i: integer;
  begin
    K := UpperCase(K);
    result := S;
    i := 1;
    while i<=Length(result) do
      if Pos( UpCase(result[i]), K ) > 0 then
        Inc(i)
      else
        Delete( result, i, 1 );
  end;

  function INIReadExtended( INIFile: TIniFile;
                            Section: string;
                            Item:    string;
                            Def: extended ): extended;
  // Updated for internationalizim handling
  var
    S, tS: string;
  begin
    WITH INIFile DO
    BEGIN
      try
        ts := FloatToStr( Def ); // FloatToStr ok here!
      except
        ts := '0.0'; // Float_ToStr will fail on NAN
      end;
      try
        S      := ReadString( Section, Item, tS );
        // Convert opposite comma/decimal point to current style
        //  "123456,789" -> "123456.789" if english
        //  "123456.789" -> "123456,789" if german
        S      := StrReplace( S, ThousandSeparator, DecimalSeparator );
        // Try to interpret
        result := Str2ExtD( S, Def );
      except
        result := Def;
      end;
    END;
  end;

  function  ExtFormatStr( np: integer ): string;
  begin
    case np of
      0: result := '###,###,###.';
      1: result := '###,###,###.#';
      2: result := '###,###,###.##';
      3: result := '###,###,###.###';
      4: result := '###,###,###.####';
      5: result := '###,###,###.#####';
      6: result := '###,###,###.######';
      7: result := '###,###,###.#######';
    end;
  end;

  procedure INIWriteExtended( INIFile: TIniFile;
                            Section: string;
                            Item:    string;
                            Value: extended );
  // Internationalizim notes: We write the value using the default format, but when we
  // read the values, we change out '.' and ',' as appropriate.
  begin
    with INIFile do
    begin
      try
        WriteString( Section, Item, FloatToStr( Value ) );  // FloatToStr ok here!
      except
      end;
    end;
  end;

  function TClr( T: extended; MaxTemp: extended ): TColor;
  begin
    if (T < (0.33*MaxTemp)) then
      result := clGreen
    else if (T < (0.66*MaxTemp)) then
      result := clYellow
    else
      result := clRed;
  end;

  function TP( T: extended; MaxTemp: extended ): BYTE;
  begin
    T := (100.0 / MaxTemp ) * T;
    if T >= 100.0 then T := 100.0;
    if T <= 0.0 then T := 0.0;
    result := Round( T );
  end;

  function DegC2F( V: extended ): extended;
  begin
    result := V * 9.0 / 5.0 + 32.0;
  end;

  function DegF2C( V: extended ): extended;
  begin
    result := (V - 32.0) * 5.0 / 9.0;
  end;

  function keepchar(c: string; s: string): string;
  var
    i: integer;
  begin
    result := '';
    for i:=1 to length(s) do if Pos(s[i],c)>0 then result := result + s[i];
  end;

  function StripPastTab( S: string ): string;
  var
    j: integer;
  begin
    j := Pos( ^I, S );
    if j>0 then
      result := Copy( S, 1, J-1 )
    else
      result := s;
  end;

  function TitleCase( s: string ): string;
  var
    i: integer;
  begin
    result := LowerCase(TrimLeft(S));
    if length(result)>0 then result[1] := UpCase(result[1]);
    for i:=2 to length(result)-1 do
      if (result[i] IN[' ','-','_',^I,'.',',','[',']','/','\','<','>','#','^','*']) then result[i+1] := UpCase(result[i+1]);
  end;

  procedure Touch( filename: string );
  // Set the files' date/time to right now
  var
    filehandle: integer;
  begin
    filehandle := FileOpen( filename, fmOpenWrite + fmShareExclusive );
    try
      if filehandle <> -1 then
      begin
        FileSetDate( filehandle, DateTimeToFileDate( Now ) );
      end;
    finally
      try
        fileclose( filehandle );
      except
      end;
    end;
  end;

  function uFileDate( filename: string ): integer;
  // Set the files' date/time to right now
  begin
    // Get Date
    if uFileExists( Filename ) then
      result := FileAge( Filename )
    else
      result := -1;
  end;

  procedure USetFileDate( dst: string; DateTime: integer );
  // Set the files' date/time to right now
  var
    filehandle: integer;
  begin
    // Set Date
    filehandle := FileOpen( dst, fmOpenWrite + fmShareExclusive );
    try
      if filehandle <> -1 then
      begin
        FileSetDate( filehandle, DateTime );
      end;
    finally
      try
        fileclose( filehandle );
      except
      end;
    end;
  end;

  function MatchFileDate( src, dst: string ): boolean;
  // Set the files' date/time to right now
  var
    filehandle: THandle;
    fDate: integer;
  begin
    try
      result := FALSE;
      // Get Date
      fDate := -1;
      filehandle := FileOpen( src, fmOpenRead );
      try
        if filehandle <> -1 then
        begin
          fDate := FileGetDate( filehandle );
        end;
      finally
        fileclose( filehandle );
      end;
      // Set Date
      if fDate <> -1 then
      begin
        filehandle := FileOpen( dst, fmOpenReadWrite );
        try
          if filehandle <> -1 then
          begin
            result := 0 = FileSetDate( filehandle, fDate );
          end;
        finally
          fileclose( filehandle );
        end;
      end;
      if NOT result then exit; // don't bother checking if FileSetDate failed

      // Check if match was successful
      filehandle := FileOpen( dst, fmOpenRead );
      try
        if filehandle <> -1 then
        begin
          result := fDate = FileGetDate( filehandle );
        end;
      finally
        fileclose( filehandle );
      end;
    except
      result := FALSE;
    end;
  end;

  function  GetFileDateStr( filename: string ): string;
  // returns a string holding the file date/time
  begin
    result := DateTimeToStr( FileDateToDateTime( uFileDate( filename ) ) );
  end;

  function GetFileDateDT( filename: string ): tDateTime;
  begin
    result := FileDateToDateTime( uFileDate( filename ) );
  end;

  procedure SetFileDate( dst: string; DateTime: tDateTime );
  // Set the files' date/time to right now
  var
    filehandle: THandle;
    fDate: integer;
  begin
    // Convert Date
    fDate := DateTimeToFileDate( DateTime );
    // Set Date
    filehandle := FileOpen( dst, fmOpenWrite + fmShareExclusive );
    if filehandle <> -1 then
    begin
      try
        FileSetDate( filehandle, fDate );
      finally
        fileclose( filehandle );
      end;
    end;
  end;

  function  UFileSize( filename: string ): int64;
  var
    F: THandle;
    iFS: int64;
    fm: integer;
  begin
    result := 0;
    if NOT uFileExists( filename ) then exit;
    F := IOResult;
    FM := FileMode;
    try
      FileMode := fmOpenRead;
      try
        F := FileOpen( PChar(Filename), fmOpenRead );
        if F=-1 then
          result := 0
        else
        begin
          if NOT GetFileSizeEx( F, @iFS ) then iFS := 1;
          CloseHandle( F );
        end;
        result := iFS;
      except
        result := 0;
      end;
    finally
      FileMode := FM;
    end;
  end;

  procedure FileReadOnly( filename: string;
                          ReadOnly: boolean;
                          Hidden:   boolean );
  var
    V: dword;
  begin
    try
      V := GetFileAttributes( PChar(Filename) );
      if V <> 0 then
      begin
        if ReadOnly then V := V OR FILE_ATTRIBUTE_READONLY
        else             V := V AND NOT FILE_ATTRIBUTE_READONLY;
        if Hidden   then V := V OR FILE_ATTRIBUTE_HIDDEN
        else             V := V AND NOT FILE_ATTRIBUTE_HIDDEN;
        if V = 0 then    V := FILE_ATTRIBUTE_NORMAL;
        SetFileAttributes( PChar(Filename), V );
      end;
    except
    end;
  end;

  function IsFileReadOnly( filename: string ): boolean;
  var
    V: dword;
  begin
    try
      V := GetFileAttributes( PChar(Filename) );
      result := (V AND FILE_ATTRIBUTE_READONLY) > 0;
    except
      result := TRUE;
    end;
  end;


  procedure CleanupDir( FilePath: string;
                             FileSpec: string;
                             MaxSize: integer;
                             KillSimilar: boolean;
                             var ErrMsg: string
  );
  // if KillSimilar then any file in the same directory that has the same base name
  // (filename less extension), is also deleted.
  var
    OK: boolean;
    FSR: TSearchRec;

    TotalSize: int64;     // required for HUGE directories
    OldestName, BaseName: string;
    OldestDateTime: integer;
  begin
    ErrMsg := '';
    FilePath := Trim( FilePath );
    if FilePath = '' then
    begin
      ErrMsg := 'CleanupDir: Will not clean empty path!';
      exit;
    end;
    FilePath := AddBackSlash( FilePath );
    repeat
      OldestName := '';
      OldestDateTime := DateTimeToFileDate( Now );
      TotalSize := 0;
      OK := 0 = SysUtils.FindFirst( FilePath + FileSpec, faAnyFile, FSR );
      try
        while OK do
        begin
          TotalSize := TotalSize + FSR.Size;
          if FSR.Time < OldestDateTime then
          begin
            OldestName     := FSR.Name;
            OldestDateTime := FSR.Time;
          end;
          OK := 0 = SysUtils.FindNext( FSR );
        end;
      finally
        SysUtils.FindClose( FSR );
      end;
      // Do we need to delete a file
      if ((TotalSize >= MaxSize) and (Length(OldestName)>0)) then
      begin
        // Bail if delete fails, user might have made file READ ONLY.
        if NOT SysUtils.DeleteFile( FilePath + OldestName ) then
        begin
          //If the user sets a single file as read-only, it will prevent us from
          //ever deleting a file. We exit to avoid looping forever.
          ErrMsg := 'A read-only file in the map cache ('+FilePath + OldestName+') '+
                    'is preventing the automatic deletion of cached maps. Currently the '+
                    'map cache occupies '+IntToStrComma(TotalSize)+' bytes, '+
                    IntToStrComma(TotalSize-MaxSize)+' bytes more than allocated.';
          EXIT;
        end;
        if KillSimilar then
        begin
          try
            // Kill all other files with the same base name
            BaseName := ChangeFileExt( FilePath + OldestName, '.*' );
            OK := 0 = SysUtils.FindFirst( BaseName, faAnyFile, FSR );
            try
              while OK do
              begin
                SysUtils.DeleteFile( FilePath + FSR.Name );
                OK := 0 = SysUtils.FindNext( FSR );
              end;
            finally
              SysUtils.FindClose( FSR );
            end;
          except
          end;
        end; // of KillSimilar
      end else
      begin
        Exit;     // either delete or get out!
      end;
    until ( TRUE = FALSE );
  end;

  function DeleteAll( FilePath: string;
                       FileSpec: string
  ): boolean;
  // returns true if all files matching FileSpec in FilePath were deleted succesfully.
  var
    OK: integer;
    FSR: TSearchRec;
  begin
    result := FALSE;
    FilePath := Trim( FilePath );
    if FilePath = '' then exit;   // don't do empty folder paths!
    result := TRUE;
    FilePath := AddBackSlash( FilePath );
    // If the input path does not exist, then nothing to do
    if NOT uDirectoryExists( FilePath ) then
      exit; //
    OK := SysUtils.FindFirst( FilePath + FileSpec, faAnyFile, FSR );
    try
      while (OK = 0) do
      begin
        // Don't delete files '.' and '..'
        if (Length(FSR.Name)>0) AND (FSR.Name[1]<>'.') then
        begin
          if NOT DeleteFile( PChar(FilePath + FSR.Name) ) then
            result := FALSE;
        end;
        OK := SysUtils.FindNext( FSR );
      end;
    finally
      SysUtils.FindClose( FSR );
    end;
  end;

  procedure DeleteAllInPath( FilePath: string;
                             FileExt: string       // Include dot EX: '.CHK'
  );
  // returns true if all files matching FileSpec in FilePath were deleted succesfully.
  var
    OK: integer;
    FSR: TSearchRec;
    Ext: string;
  begin
    FileExt := UpperCase(FileExt);
    FilePath := Trim( FilePath );
    if FilePath = '' then exit;   // don't do empty folder paths!
    FilePath := AddBackSlash( FilePath );
    // If the input path does not exist, then nothing to do
    if NOT uDirectoryExists( FilePath ) then
      exit; //
    OK := SysUtils.FindFirst( FilePath + '*.*', faAnyFile, FSR );
    try
      while (OK = 0) do
      begin
        // Don't delete files '.' and '..'
        if (Length(FSR.Name)>0) AND (FSR.Name[1]<>'.') then
        begin
          if ((FSR.Attr AND faDIRECTORY) > 0) then
          begin
            DeleteAllInPath( FilePath + FSR.Name, FileExt ); // WARNING!!! RECURSIVE
          end else
          begin
            Ext := UpperCase( ExtractFileExt( FSR.Name ) );   // '.CHK'
            if Ext = FileExt then DeleteFile( PChar(FilePath + FSR.Name) );
          end;
        end;
        OK := SysUtils.FindNext( FSR );
      end;
    finally
      SysUtils.FindClose( FSR );
    end;
  end;

  function DriveTypeStr( DriveType: TDriveType ): string;
  begin
    case DriveType of
      dtNoDrive:     result := 'No drive';
      dtFloppy:      result := 'Removable Disk';
      dtFixed:       result := 'Fixed Disk';
      dtNetwork:     result := 'Network Disk';
      dtCDROM:       result := 'CD ROM';
      dtRAM:         result := 'RAM Disk';
      dtUnknown:     result := 'Unknown drive type';
      else           result := 'Unknown Disk Type/Directory';
    end;
  end;

  function CheckDriveType( Path: string ): TDriveType;
  begin
    { fill list }
    result := TDriveType(GetDriveType(PChar(SysUtils.ExtractFileDrive(Path))));
  end;

  function iSign( I: integer ): integer;
  begin
    try
      if I < 0.0 then result := -1 else result := 1;
    except
      result := 1;
    end;
  end;

  function sign( E: extended ): extended;
  begin
    try
      if E < 0.0 then result := -1.0 else result := 1.0;
    except
      result := 1.0;
    end;
  end;

  function plural( i: integer ): string;
  begin
    if (i>1) OR (i=0) then result := 's' else result := '';
  end;

  procedure FatalError(const Msg: string);
  begin
    raise Exception.Create(Msg);
  end;

  FUNCTION ParseNoToss( VAR Input: STRING; Tokens: STRING ): STRING;
  var
    c,t: integer;
  begin
    if Length(Tokens)=0 then Tokens := ' ;,'+^I;
    t := 1;
    repeat
      c := Pos( Tokens[t], Input );
      Inc(t);
    until (c>0) OR (t>Length(Tokens));
    if c > 0 then
    begin
      Result := Copy( Input, 1, C );
      Delete( Input, 1, C );
    end else
    begin
      Result := Input;
      Input  := '';
    end;
  end;

  FUNCTION TokenParse( VAR Input: STRING; Token: String ): STRING;
  { Return everything in Input, up to the first Token, deleted
    the returned string and the comma from the input. Any single character
    in Token will serve as a token }
  VAR
    C: integer;
    i: integer;
  BEGIN
    // fixup trivial case
    if Token = '' then Token := ' ;,'+^I;
    Trim( Input );
    if Input = '' then
    begin
      Token := '';
      result := '';
    end else if Input[1]='"' then
    begin
      // Quote Delmited
      Delete( Input, 1, 1 );
      C := Pos( '"', Input );
      if C<1 then
      begin
        Result := Input;
        Input  := '';
      end else if C=1 then
      begin
        Result := '""';
        Delete( Input, 1, C+1 );
      end else
      begin
        Result := '"'+Copy( Input, 1, C-1 )+'"';
        Delete( Input, 1, C+1 );
      end;
    end else
    if Input[1]='''' then
    begin
      // Quote Delmited
      Delete( Input, 1, 1 );
      C := Pos( '''', Input );
      if C<1 then
      begin
        Result := Input;
        Input  := '';
      end else if C=1 then
      begin
        Result := '';
        Delete( Input, 1, 1 );
      end else
      begin
        Result := '"'+Copy( Input, 1, C-1 )+'"';
        Delete( Input, 1, C+1 );
      end;
    end else
    begin
      i:=1;
      repeat
        C := Pos( Token[i], Input );
        Inc(i);
      until (C>0) or (i>length(Token));

      IF C<1 THEN
      BEGIN
        Result := Input;
        Input  := '';
      END ELSE IF C=1 THEN
      BEGIN
        Result := '';
        Delete( Input, 1, 1 );
      END ELSE
      BEGIN
        Result := Copy( Input, 1, C-1 );
        Delete( Input, 1, C );
      END;
    end;
  END;

  FUNCTION IsIn( C: Char; Tokens: string ): boolean;
  begin
    result := Pos(C,Tokens)>0;
  end;

  FUNCTION TokenParseEX( VAR Input: STRING; Token: String ): STRING;
  { Return everything in Input, up to the first Token, deleted
    the returned string and the comma from the input. Any single character
    in Token will serve as a token.

    NOTE: 24 Dec 2004 MES. TokenParse does not handle quoted strings within Input correctly.
    It seems way too complicated for what it is doing too. I have rewritten it as TokenParseEX
    but am afraid to substitute it for the regular token parse which is used so many places.
  }
  VAR
    i: integer;
    Quot: char;
  BEGIN
    result := '';
    // If user passes blank token string, then use the normal characters
    if Token = '' then Token := ' ;,'+^I;
    Trim( Input );
    // Trap trivial input case
    if Input = '' then exit;
    i := 1;
    while (i <= Length(Input)) do
    begin
      if Input[i] IN['"',''''] then
      begin
        // Increment through the string until the same quote character is found
        Quot := Input[i];
        Inc(i);
        while (i <= Length(Input)) AND (Input[i]<>Quot) do Inc(i);
        // i now points to the closing quote, or the last character in the Input string
        Inc(i);  // point past closing quote
      end else if IsIn( Input[i], Token ) then
      begin
        // All done, return everything upto the token and retain everything after the token
        result := Copy( Input, 1, i-1 );
        Delete( Input, 1, i );
        exit;
      end else Inc(i);
    end;
    // Token was never found, just return the entire string
    result := Input;
    Input  := '';
  END;

    FUNCTION GetFromStr( VAR Input: STRING; MaxLen: integer; Tokens: String ): STRING;
    { Return up to MaxLen characters from Input, deleting returned characters from Input.
      Attempt to break the line at the characters contained in Tokens. Give preferance to
      the first tokens over the last ones if the occur within 15% of the end of the line.

      Modified 10/10/2000-no longer breaks a line at non-token.
    }
      FUNCTION Ok2Brk( S: string; p: integer ): boolean;
      // returns true if there are NOT unmatched quotes before in line
      var
        q: char;
        i: integer;
      begin
        result := TRUE;               // assume ok to break
        if Length(S)<1 then exit;     // OK to break if no length
        s := Copy( S, 1, p );         // get a local copy of the proposed string
        // Quick Check
        if (Pos('''',S)=0) AND (Pos('"',S)=0) then exit;  // OK if no Quotes anywhere...
        i := 1;
        while i <= Length(S) do
        begin
          if S[i] in ['''', '"'] then
          begin
            result := FALSE;         // Not ok to split here
            q := S[i];               // keep character to search for
            repeat
              Inc(i);
              if i > Length(S) then exit;
            until (S[i]=q);          // find matching Quote
          end;
          result := TRUE;            // OK to break again
          Inc(i);
        end;
      end;
    VAR
      i, t: integer;
      Margin: Cardinal;
    BEGIN
      if Length(Input)<1 then
      begin // that was easy!
        result := '';
        exit;
      end;
      if Length(Input)<MaxLen then
      begin // return the whole line
        result := Trim( Input );
        Input  := '';
        exit;
      end;
      // Look for a break point in the margin area
      Margin := Round( MaxLen * 0.85 );
      for t := 1 to length(Tokens) do
      begin
        for i:=MaxLen downto Margin do
        begin
          if (Input[i] = Tokens[t]) AND Ok2Brk(Input,i) then
          begin
            // Break The Line Here
            result := Trim( Copy( Input, 1, i ) );
            Delete( Input, 1, i );
            exit;
          end;
        end;
      end;
      // Find the next token location on the line
      for i:=MaxLen to Length(Input) do
      begin
        for t:=1 to length(Tokens) do
        begin
          if (Input[i] = Tokens[t]) AND Ok2Brk(Input,i) then
          begin
            // Break The Line Here
            result := Trim( Copy( Input, 1, i ) );
            Delete( Input, 1, i );
            exit;
          end;
        end;
      end;
      // No Match return entire line
      result := Input;
      Input  := '';
      exit;
    END;

    FUNCTION CommaParse( VAR Input: STRING ): STRING;
    { Return everything in Input, up to the first comma, deleted
      the returned string and the comma from the input }
    BEGIN
      result := TokenParse( Input, ',' );
    END;

    FUNCTION SemiParse( VAR Input: STRING ): STRING;
    { Return everything in Input, up to the first semicolan, deleted
      the returned string and the comma from the input }
    BEGIN
      result := TokenParse( Input, ';' );
    END;

    FUNCTION LFParse( VAR Input: STRING ): STRING;
    { Return everything in Input, up to the first semicolan, deleted
      the returned string and the comma from the input }
    BEGIN
      result := TokenParse( Input, ^J );
    END;

    function EPad( S: string; Ch: Char; I: integer ): string;
    begin
      result := s;
      while length(result)<I do result := result + Ch;
    end;

    function Pad( S: string; I: integer ): string;
    begin
      result := s;
      while length(result)<I do result := ' '+ result;
    end;

    FUNCTION StrReplaceBool( var S: String; Search: String; Replace: String ): boolean;
    // Replace all occurances of Search with Replace in S. Case Sensitive.
    var
      i: integer;
    begin
      result := FALSE;

      // Trap calls like  S := StrReplace( S, '123', '123' );
      //                  S := StrReplace( S, '123', ' 123 ' );
      // which cause us to hang forever
      Assert( Pos(Search,Replace)=0, 'Call to StrReplace() with recursive arguments!');
      if Pos(Search,Replace)>0 then exit;

      repeat
        i := Pos( Search, S );
        if i>0 then
        begin
          Delete( S, i, Length(Search) );
          Insert( Replace, S, i );
          result := TRUE;
        end;
      until i<=0;
    end;

    FUNCTION StrReplaceBool1( var S: String; Search: String; Replace: String ): boolean;
    // Replace all occurances of Search with Replace in S. Case Sensitive.
    var
      i: integer;
    begin
      result := FALSE;
      if Search = Replace then exit;  // avoid hanging forever
      i := Pos( Search, S );
      if i>0 then
      begin
        Delete( S, i, Length(Search) );
        Insert( Replace, S, i );
        result := TRUE;
      end;
    end;

    FUNCTION StrReplaceBoolNC1( var S: String; Search: String; Replace: String ): boolean;
    // Replace all occurances of Search with Replace in S. Case Sensitive.
    var
      i: integer;
    begin
      result := FALSE;
      if UpperCase(Search) = UpperCase(Replace) then exit;  // avoid hanging forever
      i := Pos( UpperCase(Search), UpperCase(S) );
      if i>0 then
      begin
        Delete( S, i, Length(Search) );
        Insert( Replace, S, i );
        result := TRUE;
      end;
    end;

    FUNCTION StrReplace( S: String; Search: String; Replace: String ): String;
    // Replace all occurances of Search with Replace in S. Case Sensitive.
    var
      i: integer;
    begin
      // Trap calls like  S := StrReplace( S, '123', '123' );
      //                  S := StrReplace( S, '123', ' 123 ' );
      // which cause us to hang forever
      if Pos(Search,Replace)>0 then
      begin
        result := S;
        exit;
      end;
      repeat
        i := Pos( Search, S );
        if i>0 then
        begin
          Delete( S, i, Length(Search) );
          Insert( Replace, S, i );
        end;
      until i<=0;
      result := S;
    end;

    FUNCTION StrReplaceNC( S: String; Search: String; Replace: String ): String;
    // Replace all occurances of Search with Replace in S. Case In-Sensitive.
    var
      i: integer;
    begin
      // Trap calls like  S := StrReplace( S, '123', '123' );
      //                  S := StrReplace( S, '123', ' 123 ' );
      // which cause us to hang forever
      Assert( Pos(UpperCase(Search),UpperCase(Replace))=0, 'Call to StrReplace() with recursive arguments!');
      if Pos(UpperCase(Search),UpperCase(Replace))>0 then
      begin
        result := S;
        exit;
      end;
      repeat
        i := Pos( UpperCase(Search), UpperCase(S) );
        if i>0 then
        begin
          Delete( S, i, Length(Search) );
          Insert( Replace, S, i );
        end;
      until i<=0;
      result := S;
    end;

    FUNCTION StrReplaceNC1( S: String; Search: String; Replace: String ): String;
    // Replace all occurances of Search with Replace in S. Case In-Sensitive.
    var
      i: integer;
    begin
      i := Pos( UpperCase(Search), UpperCase(S) );
      if i>0 then
      begin
        Delete( S, i, Length(Search) );
        Insert( Replace, S, i );
      end;
      result := S;
    end;

    FUNCTION StrReplace1( S: String; Search: String; Replace: String ): String;
    var
      i: integer;
    begin
      i := Pos( Search, S );
      if i>0 then
      begin
        Delete( S, i, Length(Search) );
        Insert( Replace, S, i );
      end;
      result := S;
    end;

  function OnOff2Str( B: Boolean ): string;
  begin
    if B then
      result := 'ON' else result := 'OFF';
  end;

  function BoolToStr( B: boolean ): string;
  begin
    result := OnOff2Str(B);
  end;

  function BoolToYN( B: boolean ): string;
  begin
    if B then result := 'Y' else result := 'N';
  end;

  function BoolToInt( B: boolean ): integer;
  begin
    if B then
      result := 1
    else
      result := 0;
  end;

  function IntToBool( I: integer ): boolean;
  begin
    result := NOT (i = 0);
  end;

  procedure BreakFilename( S: string; var path, name, ext: string );
  begin
    Path := AddBackSlash( ExtractFilePath(S) );
    name := ChangeFileExt(ExtractFileName(S),'');
    ext  := ExtractFileExt(S);
  end;

  function UniqueFN( S: string ): string;
  var
    Path, FN, Ext, T: String;
  begin
    BreakFilename( S, Path, FN, Ext );
    while uFileExists( Path + FN + Ext ) do
    begin
      T := IncLastIntInStr( FN, 1 );
      if T=FN then T := T + '1';
      FN := T;
    end;
    result := Path+FN+Ext;
  end;

  procedure BreakNumStr( S: string;
                       var Pre: string;
                       var Num: integer;
                       var Post: string );
  // break Name into three parts, Pre is all alpha characters at the beginning,
  // num is integer in the center, post is all alapha characters at the end
  var
    i: integer;
    sNum: string;
  begin
    Pre := ''; SNum := ''; Post := '';
    i := Length(S);
    while (i > 0) AND NOT(S[i] IN['0'..'9']) DO
    begin
      Post := S[i] + Post;
      Dec(i);
    end;
    while (i > 0) AND (S[i] IN['0'..'9','-']) DO
    begin
      sNum := S[i] + SNum;
      Dec(i);
    end;
    Pre := Copy( S, 1, i );
    if Length( sNum )=0 then
    begin
      Num := 0;
      Pre := Pre + Post + '_';
      Post := '';
    end;
    try
      SNum := Trim( SNum );
      if sNum = '' then
      begin
        Pre  := Pre + Post;
        Post := '';
      end else
      begin
        Num := StrToInt( sNum );
      end;
    except
      Num := 0;
      Pre := Pre + Post;
      Post := '';
    end;
  end;

  function IncLastIntInStr( S: string;    // Input and Output string
                            D: integer    // Amount to increment by
  ): string;
  var
    Pre, Post: string;
    Num: integer;             // index of first and last character of correct number
  begin
    BreakNumStr( S, Pre, Num, Post );
    try
      Num := Num + D;
    except
      Num := 0;
    end;
    result := Pre + IntToStr(Num) + Post;
  end;

  function UniqueFilename( Path, Name, Ext: string ): string;
  var
    FN:      string;
    NewName: string;
  begin
    repeat
      FN := AddBackSlash(Path) + Name + Ext;
      if uFileExists(FN) then
      begin
        NewName := IncLastIntInStr( Name, 1 );
        if NewName = Name then NewName := Name + '1';
      end else break;
    until TRUE=FALSE;
  end;

  function BinComp( p1: pointer; p2: pointer; size: integer ): boolean;
  type
    ba = array[0..1] of byte;
    tba = ^ba;
  var
    i: integer;
  begin
    result := false;
    for i:=0 to size-1 do
      if tba(p1)^[i] <> tba(p2)^[i] then exit;
    result := true;
  end;

  function iRotation( Rot: extended ): integer;
  // return an integer from 0 to 359
  begin
    result := Round( Rot );
    while result > 360 do Dec( result, 360 );
    while result < 0   do Inc( result, 360 );
  end;

  function StrLenCh( S: string ): integer;
  // return the length of S, not including spaces
  var
    i: integer;
  begin
    result := 0;
    for i:=1 to Length(S) do if NOT( UpCase(S[i]) IN[^A..^Z,' ']) then Inc(result);
  end;

  function GChar( S: string ): char;
  begin
    if Length(S)>0 then
      result := S[1]
    else
      result := ' ';
  end;

  function LowCase( c: char ): char;
  begin
    if C in ['A'..'Z'] then
      result := char( ord(C) - ord('A') + ord('a' ) )
    else
      result := c;
  end;

  procedure SentanceCase(var S: string );
  var
    lcs: boolean;
    i: integer;
  begin
    lcs := TRUE;
    for i:=1 to length(S) do
    begin
      if lcs then S[i] := UpCase( S[i] ) else S[i] := LowCase( S[i] );
      lcs := S[i] IN [' ',^I,^J,^M];
    end;
  end;

  function ProcessNotQuoted( S: string; P: stringproc ): string;
  // call P with the unquoted parts of S. For example:
  //    procedure P( S: string ): string; begin result := UpperCase(S); end;
  // S = 'This is a quoted "quoted material in here" string example.'
  // will return:
  // S = 'THIS IS A QUOTED "quoted material in here" STRING EXAMPLE.'
  var
    Q1, Q2, QQ1, QQ2: integer;
    s1,s2,s3,s4: string;
  begin
    // Check for a matched set of ' (single quote)
    Q1 := Pos( '''', S );
    if Q1 > 0 then
    begin
      // Look for the end of the matched set of quotes
      Q2 := Pos( '''', Copy( S, Q1+1, Length(S)-Q1 ) ) + Q1;    // Look for matching quote
      if Q2 < 1 then Q1 := 0;                              // Not a matched set!
    end else Q2 := 0;

    // Check for a matched set of " (double quote)
    QQ1 := Pos( '"', S );
    if QQ1 > 0 then
    begin
      // Look for the end of the matched set of quotes
      QQ2 := Pos( '"', Copy( S, QQ1+1, Length(S)-QQ1 ) ) + QQ1;  // Look for matching quote
      if QQ2 < 1 then QQ1 := 0;                            // Not a matched set, disqualify first one
    end else QQ2 := 0;

    // if both single and double matched sets are found, use the first
    if ( (Q1>0) AND (QQ1>0) ) then
    begin
      // Which is first?
      if (Q1 < QQ1) then
      begin
        result := P( Copy(S,1,Q1-1) ) +      // Process the part up to the quote
                  Copy(S,Q1,Q2-Q1+1) +       // The quoted part, including quotes
                  ProcessNotQuoted( Copy(S,Q2+1,Length(S)-Q2), P ); // recursevly process the rest of the line
        exit;
      end else
      begin
        result := P( Copy(S,1,QQ1-1) ) +     // Process the part up to the quote
                  Copy(S,QQ1,QQ2-QQ1+1) +    // The quoted part, including quotes
                  ProcessNotQuoted( Copy(S,QQ2+1,Length(S)-QQ2), P ); // recursevly process the rest of the line
        exit;
      end;
    end else if (Q1>0) then
    begin
      s1 := P( Copy(S,1,Q1-1) );             // Process the part up to the quote
      s2 := Copy(S,Q1,Q2-Q1+1);              // The quoted part, including quotes
      s3 := Copy(S,Q2+1,Length(S)-Q2);       // recursevly process the rest of the line
      s4 := ProcessNotQuoted( S3, P );       // recursevly process the rest of the line
      result := s1 + s2 + s4;
      exit;
    end else if (QQ1>0) then
    begin
      s1 := P( Copy(S,1,QQ1-1) );            // Process the part up to the quote
      s2 := Copy(S,QQ1,QQ2-QQ1+1);           // The quoted part, including quotes
      s3 := Copy(S,QQ2+1,Length(S)-QQ2);     // recursevly process the rest of the line
      s4 := ProcessNotQuoted( S3, P );       // recursevly process the rest of the line
      result := s1 + s2 + s4;
      exit;
    end;
    // just process the rest of the line
    result := P(S);
  end;

  function _ReduceWhite( S: string ): string;
  // translate whitespace to a single space
  begin
    result := S;
    result := StrReplace( result, ^I,   ' ' );
    result := StrReplace( result, ^M,   ' ' );
    result := StrReplace( result, ^J,   ' ' );
    result := StrReplace( result, '  ', ' ' );
  end;

  function ReduceWhite( S: string ): string;
  // translate unquoted whitespace to a single space.
  begin
    result := ProcessNotQuoted( S, _ReduceWhite );
  end;

  function _ReduceSpace( S: string ): string;
  // translate whitespace to a single space
  begin
    result := S;
    result := StrReplace( result, '  ', ' ' );
  end;

  function ReduceSpace( S: string ): string;
  // translate whitespace to a single space, but not if it occurs within a quoted string
  begin
    result := ProcessNotQuoted( S, _ReduceSpace );
  end;

  function _DropCommasInNumbers( S: string ): string;
  // convert '12,345.0' to '12345.0'
  var
    i: integer;
  begin
    result := S;
    i := 2;
    while i<Length(result) do
    begin
      if (result[i]= ThousandSeparator) AND
         (result[i-1] IN['0'..'9']) AND
         (result[i+1] IN['0'..'9'])
      then
        Delete( result, i, 1 )
      else
        Inc(i);
    end;
  end;

  function DropCommasInNumbers( S: string ): string;
  begin
    result := ProcessNotQuoted( S, _DropCommasInNumbers );
  end;

  function _DropFreeStandingCommas( S: string ): string;
  // Remove commas (Note NOT ThousandSeparators) that are NOT followed by a number
  var
    i: integer;
  begin
    result := S;
    i := 1;
    while i<Length(result) do
    begin
      if (result[i]=',') AND
         (NOT (result[i+1] IN['0'..'9']))
      then
        Delete( result, i, 1 )
      else
        Inc(i);
    end;
  end;

  function DropFreeStandingCommas( S: string ): string;
  begin
    result := ProcessNotQuoted( S, _DropFreeStandingCommas );
  end;

  function _BindEquals( S: string ): string;
  // Make sure and = signs are tightly bound to neighboring tokens
  begin
    result := ReduceWhite(S);
    result := StrReplace( result, ' =', '=' );
    result := StrReplace( result, '= ', '=' );
  end;

  function BindEquals( S: string ): string;
  // translate whitespace to a single space, but not if it occurs within a quoted string
  begin
    result := ProcessNotQuoted( S, _BindEquals );
  end;

  function _StripPercent( Name: string ): string;
  // Removes tokens (like %UTM%) from the passed string.
  var
    i1, i2: integer;
  begin
    // Remove any strings surrounded by '%'. So '%Dist% Meters' becomes ' Meters'
    i2 := 0;
    repeat
      i1 := Pos('%',Name);
      if i1>0 then
      begin
        i2 := Pos('%',Copy(Name,i1+1,Length(Name)));
        if i2>0 then Name := Copy(Name,1,i1-1)+Copy(Name,i1+i2+1,Length(Name));
      end;
    until (i1=0) OR (i2=0);
    result := Name;
  end;

  function StripQuotes( S: string ): string;
  begin
    Trim( S );
    if (Length( S ) > 1) AND
       (S[1] in['''','"']) AND
       (S[Length(S)]=S[1])
    then
      result := Copy( S, 2, Length(S)-2 )
    else
      result := S;
  end;

  function StripPercent( Name: string ): string;
  begin
    result := ProcessNotQuoted( Name, _StripPercent );
  end;

  function _Pipe2CR( S: string ): string;
  begin
    result := StrReplace( S, '|', ^M^J );
  end;

  function Pipe2CR( S: string ): string;
  // Convert pipe '|' symbols to ^M^J
  begin
    result := ProcessNotQuoted( S, _Pipe2CR );
  end;

  function _CR2Pipe( S: string ): string;
  begin
    result := StrReplace( S,      ^M^J, '|' );
    result := StrReplace( result, ^J,   '|' );
  end;

  function CR2Pipe( S: string ): string;
  begin
    result := ProcessNotQuoted( S, _CR2Pipe );
  end;

  function VolumeID(Drive: String): string;
  var
    OldErrorMode: Integer;
    NotUsed, VolFlags: DWORD;
    Buf: array [0..MAX_PATH] of Char;
    DrvChar: string;
  begin
    try
      OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
      try
        Buf[0] := #$00;
        if FirstChar(Drive)='\' then
        begin
          // A Network path  '\\ATM\DAT\'
          DrvChar  := ExtractFileDrive( Drive );
          if (Length(DrvChar)>0) AND (NOT(DrvChar[Length(DrvChar)] in ['\'])) then
            Drive := Drive + '\';
        end else
        begin
          // Not a network path
          DrvChar := FirstChar( Drive ) + ':\';
        end;
        if GetVolumeInformation(PChar(DrvChar), Buf, DWORD(sizeof(Buf)),
          nil, NotUsed, VolFlags, nil, 0) then
          SetString(Result, Buf, StrLen(Buf))
        else Result := '';
      finally
        SetErrorMode(OldErrorMode);
      end;
    except
      result := '';
    end;
  end;

  function IsNum( C: char ): boolean;
  begin
    result := C IN ['0'..'9'];
  end;

  function IsAlpha( C: char ): boolean;
  begin
    result := C IN ['a'..'Z','A'..'Z'];
  end;

  function IsWhite( C: char ): boolean;
  begin
    result := C IN [' ',^I,^J];
  end;

  function IsWhiteString( S: string ): boolean;
  begin
    result := Trim(S)='';
  end;

  function ExtractFileNameNoExt( FN: string ): string;
  begin
    result := ChangeFileExt( ExtractFileName(FN), '' );
  end;

  function ArcSin( x: extended ): extended;
  begin
    ArcSin := ArcTan (x/sqrt (1.0-sqr (x)));
  end;

  function ArcCos( x: extended ): extended;
  begin
    ArcCos := ArcTan (sqrt (1.0-sqr (x)) /x);
  end;

  procedure INIWriteFont( INIFile: TIniFile;
                         Section: string;
                         Item:    string;
                         var Fnt: tFont );
  begin
    with INIFile do
    begin
      WriteString( Section, Item+'_Name', Fnt.Name );
      WriteInteger( Section, Item+'_Color', Fnt.Color );
      WriteInteger( Section, Item+'_Size', Fnt.Size );
      WriteBool( Section, Item+'_Bold', fsBold in Fnt.Style );
      WriteBool( Section, Item+'_Italic', fsItalic in Fnt.Style );
      WriteBool( Section, Item+'_Underline',fsUnderLine in Fnt.Style );
      WriteBool( Section, Item+'_Strikeout', fsStrikeout in Fnt.Style );
    end;
  end;

  procedure INIReadFont( INIFile: TIniFile;
                          Section: string;
                          Item:    string;
                          var Fnt: tFont );
  begin
    with INIFile do
    begin
      Fnt.Name    := ReadString( Section, Item+'_Name', Fnt.Name );
      Fnt.Color   := ReadInteger( Section, Item+'_Color', Fnt.Color );
      Fnt.Size    := ReadInteger( Section, Item+'_Size', Fnt.Size );
      Fnt.Style   := [];
      if ReadBool( Section, Item+'_Bold', fsBold in Fnt.Style ) then Fnt.Style := Fnt.Style + [fsBold];
      if ReadBool( Section, Item+'_Italic', fsItalic in Fnt.Style ) then Fnt.Style := Fnt.Style + [fsItalic];
      if ReadBool( Section, Item+'_Underline',fsUnderLine in Fnt.Style ) then Fnt.Style := Fnt.Style + [fsUnderLine];
      if ReadBool( Section, Item+'_Strikeout', fsStrikeout in Fnt.Style ) then Fnt.Style := Fnt.Style + [fsStrikeout];
    end;
  end;

   
  function ExpandFN( Filename: string ): string;
  // Convert FN to Expanded FN:
  //  EX:   C:\Out\O42119H5.it5    ->    C:\Out\42\119\O42119H5.it5
  var
    Path, FN, Ext: string;
  begin
    BreakFilename( Filename, Path, FN, Ext );
    if Length(FN) < 6 then
      result := Filename
    else
      result := Path + FN[2]+FN[3]+'\'+FN[4]+FN[5]+FN[6]+'\'+FN+Ext;
  end;

procedure SetFontWithRotation( var Canvas: TCanvas;
                                  Rotation: extended );
// Change the font of the passed Canvas to have the selected Rotation
var
  LogFont: TLogFont;
  Fnt:     HFont;
  iRot:    integer;
const
  LastRotation: integer = 0;
begin
  while Rotation > 360.0 do Rotation := Rotation - 360.0;
  while Rotation < 0.0   do Rotation := Rotation + 360.0;
  iRot := Round( Rotation * 10.0 );
  if LastRotation = iRot then exit; // All Done!
  LastRotation := iRot;
  with LogFont do
  begin
    lfHeight := Canvas.Font.Height;
    lfWidth := 0; { have font mapper choose }
    lfEscapement := iRot; { Make Escapement and Orientation the same }
    lfOrientation := iRot; { no rotation }
    if fsBold in Canvas.Font.Style then
      lfWeight := FW_BOLD
    else
      lfWeight := FW_NORMAL;
    lfItalic := Byte(fsItalic in Canvas.Font.Style);
    lfUnderline := Byte(fsUnderline in Canvas.Font.Style);
    lfStrikeOut := Byte(fsStrikeOut in Canvas.Font.Style);
    lfCharSet := Byte(Canvas.Font.Charset);
    if AnsiCompareText(Canvas.Font.Name, 'Default') = 0 then  // do not localize
      StrPCopy(lfFaceName, DefFontData.Name)
    else
      StrPCopy(lfFaceName, Canvas.Font.Name);
    lfQuality := DEFAULT_QUALITY;
    { Everything else as default }
    lfOutPrecision := OUT_DEFAULT_PRECIS;
    lfClipPrecision := CLIP_DEFAULT_PRECIS;
    case Canvas.Font.Pitch of
      fpVariable: lfPitchAndFamily := VARIABLE_PITCH;
      fpFixed: lfPitchAndFamily := FIXED_PITCH;
    else
      lfPitchAndFamily := DEFAULT_PITCH;
    end;
    Fnt := CreateFontIndirect(LogFont);
    if Fnt <> 0 then Canvas.Font.Handle := Fnt; // This will destroy the existing Handle
  end;
end;

procedure FORINIT( var i: integer );
begin
  i := MAXINT;
end;

function FORLOOP( var i: integer; _Low, _High: integer ): boolean;
begin
  if (i=MAXINT) OR (i<_Low) then
    i := _Low
  else
    Inc(i);
  result := (i <= _High)
end;

  function HexDecode( c: char ): byte;
  begin
    case C of
      '0': result := 0;
      '1': result := 1;
      '2': result := 2;
      '3': result := 3;
      '4': result := 4;
      '5': result := 5;
      '6': result := 6;
      '7': result := 7;
      '8': result := 8;
      '9': result := 9;
      'A': result := 10;
      'B': result := 11;
      'C': result := 12;
      'D': result := 13;
      'E': result := 14;
      'F': result := 15;
      'a': result := 10;
      'b': result := 11;
      'c': result := 12;
      'd': result := 13;
      'e': result := 14;
      'f': result := 15;
      else result := 0;
    end;
  end;

  function Int2StrN( I: Int64; N: integer ): string;
  begin
    result := ZeroPad( IntToStr(i), N );
  end;

  function dTimeStr( dT: cardinal ): string;
  // converts dT (in seconds) to a string
    function XMod( var N: cardinal; D: cardinal ): cardinal;
    begin
      result := N DIV D;
      N      := N MOD D;
    end;
    function plur( N: cardinal ): string;
    begin
      case N of
        0: result := 's';
        1: result := '';
        else result := 's';
      end;
    end;
  var
    Year, Month, Day, Hour, Minute, Sec: cardinal;
  begin
    Year  := XMOD( dT, (365 * 24 * 60 * 60 ));
    Month := XMOD( dT, Round((365.0/12) * 24 * 60 * 60 ));
    Day   := XMOD( dT, (24 * 60 * 60));
    Hour  := XMOD( dT, (60 * 60));
    Minute:= XMOD( dT, 60);
    Sec   := dT;
    result := '';
    if Year > 0 then result := result + ' ' + IntToStr(Year) + ' year' + plur(Year);
    if Month > 0 then result := result + ' ' + IntToStr(Month) + ' month' + plur(Month);
    if Day > 0 then result := result + ' ' + IntToStr(Day) + ' day' + plur(Day);
    if Hour > 0 then result := result + ' ' + IntToStr(Hour) + ' hour' + plur(Hour);
    if Minute > 0 then result := result + ' ' + IntToStr(Minute) + ' minute' + plur(Minute);
    if Sec > 0 then result := result + ' ' + IntToStr(Sec) + ' second' + plur(Sec);
  end;

  procedure TabDel( NewStr: string; var OutStr: string );
  begin
    if (Length(OutStr)>0) AND (Length(NewStr)>0) then
      OutStr := OutStr + ^I;
    OutStr := OutStr + NewStr;
  end;

  function FindAllExt( Path, Ext: string ): string;
  // returns a tab delimited string of all files below Path that match
  // extensions with Ext. Ext may contain '?' wildcards.
  var
    SR1: tSearchRec;
    OK, Match: boolean;
    S, _Ext: string;
    i: integer;
  begin
    result := '';
    Path := AddBackSlash( Path );
    Ext  := UpperCase( Ext );
    OK := 0 = FindFirst( Path + '*.*', faAnyFile, SR1 );
    try
      while OK do
      begin
        if (Length(SR1.Name)>0) AND (SR1.Name[1]<>'.') then
        begin
          if (SR1.Attr AND faDirectory)>0 then
          begin
            S := FindAllExt( Path+SR1.Name, Ext );
            TabDel( S, result );
          end else
          begin
            // Does file match?
            _Ext := UpperCase(ExtractFileExt(SR1.Name));
            i := 1;
            if Length(Ext)=Length(_Ext) then
            begin
              Match := TRUE;
              while (i <= Length(Ext)) AND Match do
              begin
                Match := Match AND ( (Ext[i]='?') OR (Ext[i]=_Ext[i]) );
                Inc(i);
              end;
              if Match then
              begin
                // Add File to List
                TabDel( Path+SR1.Name, result );
              end;
            end;
          end;
        end;
        OK := 0 = FindNext( SR1 );
      end;
    finally
      SysUtils.FindClose( SR1 );
    end;
  end;

  function RelativePathEval( FN, BasePath: string ): string;
  // Correctly interpret a relative path and force a base path
  begin
    result := FN;
    if (Pos('.\',FN)=1) OR (Pos('..\',FN)=1) then
    begin
      BasePath := AddBackSlash(BasePath);
      result   := BasePath + result;
      result   := ExpandUNCFilename(result);
    end;
  end;

  procedure AddIfNotEmpty( var S: string; R: string );
  begin
    if S<>'' then S := S + R;
  end;

  function AString( S: string ): string;
  var
    i: integer;
  begin
    result := '';
    if Length(S)<1 then exit;
    for i:=1 to Length(S) do
    begin
      case S[i] of
        ' '..'~':  result := result + S[i];
        #0..#31:   result := result + '^'+Char(Ord(S[i])+Ord('A')-1);
        else       result := result + '['+IntToHex(Ord(S[i]),2)+']';
      end;
    end;
  end;

  function RationalizeDir( Dir: string ): string;
  // Take a folder like "..\..\MAPS\WY" and convert it to
  //                    "H:\MAPS\WY" assuming the EXEpath is "H:\AllTopo\Bin"
  // Kind of opposite of ExtractRelativePath function
  begin
    result := Dir;
    if (Length(result)>0) AND
       (result[1]='.') then
    begin
      result := ExpandFileName( _EXEDir + result );
    end;
  end;

  function IsAllNumbers( S: string ): boolean;
  // returns TRUE if all characters in S are numbers
  var
    i: integer;
  begin
    result := FALSE;
    for i:=1 to Length(S) do if NOT( IsNum(S[i]) ) then exit;
    result := TRUE;
  end;

  function BreakUpCoor( S: string ): string;
  // Convert tokens in S from nubmers like 37504630 to 37 50 46.30
  var
    T: string;
  begin
    result := '';
    S := SeparateLettersAndNumbers( S );
    while Length(S) > 0 do
    begin
      T := TokenParse( S, ' ,' );
      if IsAllNumbers( T ) then
      begin
        case Length(T) of
          6: result := result + ' ' + T[1]+T[2]+' '+T[3]+T[4]+' '+T[5]+T[6];
          7: result := result + ' ' + T[1]+T[2]+T[3]+' '+T[4]+T[5]+' '+T[6]+T[7];
          8: result := result + ' ' + T[1]+T[2]+' '+T[3]+T[4]+' '+T[5]+T[6]+'.'+T[7]+T[8];
          9: result := result + ' ' + T[1]+T[2]+T[3]+' '+T[4]+T[5]+' '+T[6]+T[7]+'.'+T[8]+T[9];
          else result := result + ' ' + T;
        end;
      end else result := result + ' ' + T;
    end;
  end;

  function SeparateLettersAndNumbers( S: string ): string;
  // CONVERT a string like "N41.123 W109.78" to
  //                       "N 41.123 W 109.78"
    function IsNumb( c: char ): boolean;
    begin
      result := c IN['0'..'9','-',',','.',' '];
    end;
    function IsLetr( c: char ): boolean;
    begin
      result := NOT (c IN['0'..'9','-','.',',']);
    end;
  var
    i: integer;
  begin
    result := '';
    if Length(S)=0 then exit;
    i := 1;
    while (i<=Length(S)) do
    begin
      if (i>1) AND
         ( NOT (S[i] = ' ') ) AND
         ( NOT (S[i-1] = ' ') ) AND
         ( (IsNumb(S[i-1]) AND IsLetr(S[i])) OR
           (IsLetr(S[i-1]) AND IsNumb(S[i]))
         ) then
      begin
        result := result + ' ' + S[i];
      end else
      begin
        result := result + S[i];
      end;
      Inc(i);
    end;
  end;

  function DdotMS2DMS( s: string ): string;
  var
    T,T1: string;
    i,bc,dp: integer;
  begin
    result := '';
    while Length(S)>0 do
    begin
      T  := TokenParse( S, ' ,' );
      T1 := Trim(T);
      dp := Pos('.',T1);
      if (T1<>'') AND (dp>0) then
      begin
        bc := 0;
        for i:=1 to Length(T1) do
        begin
          if NOT( T1[i] IN['-','0','1'..'9','.'] ) then Inc(bc);
        end;
        // If there are no wierd characters in the token, convert it
        if bc=0 then
        begin
          // break number apart
          result := result + ' ' +
                    Copy( T1, 1, DP-1 ) + ' ' + Copy( T1, DP+1, 2 ) + ' ' +
                    Copy( T1, DP+3, 2 ) + '.' + Copy( T1, DP+5, MAXINT );
        end else result := result + ' ' + T;
      end else result := result + ' ' + T;
    end;
  end;

  function DdotM2DM( s: string ): string;
  var
    T,T1: string;
    i,bc,dp: integer;
  begin
    result := '';
    while Length(S)>0 do
    begin
      T  := TokenParse( S, ' ,' );
      T1 := Trim(T);
      dp := Pos('.',T1);
      if (T1<>'') AND (dp>0) then
      begin
        bc := 0;
        for i:=1 to Length(T1) do
        begin
          if NOT( T1[i] IN['-','0','1'..'9','.'] ) then Inc(bc);
        end;
        // If there are no wierd characters in the token, convert it
        if bc=0 then
        begin
          // break number apart
          result := result + ' ' +
                    Copy( T1, 1, DP-1 ) + ' ' + Copy( T1, DP+1, 2 ) + '.' +
                    Copy( T1, DP+3, MAXINT );
        end else result := result + ' ' + T;
      end else result := result + ' ' + T;
    end;
  end;

  procedure CommaAppend( var S: string; T: string );
  // Add T to the end of S, delimet with ','
  begin
    if Length(S)>0 then
      S := S + ',' + T
    else
      S := T;
  end;

  procedure SemiAppend( var S: string; T: string );
  // Add T to the end of S, delimet with Tab
  begin
    if Length(S)>0 then
      S := S + ';' + T
    else
      S := T;
  end;

  procedure TabAppend( var S: string; T: string );
  // Add T to the end of S, delimet with Tab
  begin
    if Length(S)>0 then
      S := S + ^I + T
    else
      S := T;
  end;

  function _CRAppend( const S: string ): string;
  begin
    result := Trim( S );
    if result <> '' then result := result + ^M^J;
  end;
  
  procedure CRAppend( var S: string; T: string );
  // Add T to the end of S, delimet with Tab
  begin
    if Length(S)>0 then
      S := S + ^M^J + T
    else
      S := T;
  end;

  procedure SpaceAppend( var S: string; T: string );
  // Add T to the end of S, delimet with Tab
  begin
    S := Trim(S);
    if Length(S)>0 then
      S := S + ' ' + T
    else
      S := T;
  end;

  function SameFileDateName( N1, N2: string ): boolean;
  begin
    result := SameFileDate( uFileDate( N1 ), uFileDate( N2 ) );
  end;

  function SameFileDate( TS1, TS2: integer ): boolean;
  // different machines handle time zones differently. It is not sufficent
  // to compare the date filestamp. If the change in time is EXACTLY hours, no minutes
  // or seconds, then the change in time is due to OS considerations.
  var
    T: tDateTime;
    H,M,S,N: word;
  begin
    if (TS1 < 0) OR (TS2 < 0) then
    begin
      result := FALSE;
      exit;
    end;
    T := Abs( FileDateToDateTime(TS1) - FileDateToDateTime(TS2));
    if T > 1.0 then
    begin
      result := FALSE;
      exit;
    end;
    DecodeTime( T, H, M, S, N );
    result := (M=0) AND (S=0) AND (N=0);
  end;

  function FileDateStr( FN: string ): string;
  var
    IT: integer;
    T: tDateTime;
  begin
    IT := uFileDate( FN );
    T  := FileDateToDateTime(IT);
    result := FN + ' ' + DateTimeToStr( T ) + ' [' + IntToStrComma(IT)+']';
  end;

  // *** Internationalized String <-> Number Methods ***

  function IntlFix0to60( S: string ): string;
  // Assuming the contained number will ALWAYS be less than 1,000.0 we
  // can check for numbers like "45,123.567" and convert them to
  // "45.123567"
  var
    dp, cma: integer;
  begin
    dp  := Pos( DecimalSeparator, S );
    cma := Pos( ThousandSeparator, S );
    if (cma > 0) AND ((cma < dp) OR (dp = 0)) then
    begin
      // number separators are inverted for our standard!
      S := StrReplace( S, DecimalSeparator, '' );
      S := StrReplace( S, ThousandSeparator, DecimalSeparator );
    end;
    result := S;
  end;

  function CIN( C: char; InS: string ): boolean;
  begin
    result := Pos( UpCase(C), UpperCase(InS) ) > 0;
  end;

  function DecPointStr: string;
  begin
    result := 'International Settings: ThousandSeparator '''+ThousandSeparator+
              ''', DecimalSeparator '''+DecimalSeparator+
              ''', Numeric Example '''+Ext2StrComma( 1234.567895, 6 ) + '''';
  end;

  function StripNextInteger( S: string ): string;
  // returns the next integer from the front of S
  var
    i: integer;
  begin
    S := Trim(S);
    S := StrReplace( S, ThousandSeparator, '' );  // remove thousands separators
    result := '';
    i := 1;
    while i <= Length(S) do
    begin
      if (S[i] IN['0'..'9','A'..'F','a'..'f','-','+','$']) then
      begin
        result := result + S[i];
        Inc(i);
      end else exit;
    end;
  end;

  function StripNextFloat( S: string ): string;
  // returns the next float from the front of S
  var
    i: integer;
  begin
    S := Trim(S);
    S := StrReplace( S, ThousandSeparator, '' );  // remove thousands separators
    result := '';
    i := 1;
    while i <= Length(S) do
    begin
      if (S[i] IN['0'..'9','-','+']) OR
         (S[i] = DecimalSeparator) then
      begin
        result := result + S[i];
        Inc(i);
      end else exit;
    end;
  end;

  function Str2Int( S: string ): integer;
  // Convert a string to an integer.
  begin
    S := StripNextInteger( S );
    S := StrReplace( S, ThousandSeparator, '' );  // remove and thousands separators
    try
      if S = '' then
        result := 0
      else
        result := StrToInt( S );
    except
      result := 0;
    end;
  end;

  function Str2IntD( S: string; Def: integer ): integer;
  begin
    if S='' then
    begin
      result := Def;
      exit;
    end;
    try
      result := Str2Int( S );
    except
      result := Def;
    end;
  end;

  function Str2Int64( S: string ): int64;
  begin
    S := StrReplace( S, ThousandSeparator, '' );  // remove and thousands separators
    result := StrToInt64( S );
  end;

  function Str2Int64D( S: string; Def: int64 ): int64;
  begin
    try
      result := Str2Int64( S );
    except
      result := Def;
    end;
  end;

  function Str2Float( S: string ): extended;
  begin
    S := StrReplace( S, ThousandSeparator, '' );  // remove and thousands separators
    result := StrToFloat( S );
  end;

  function Str2Ext( S: string ): extended;
  begin
    result := Str2Float(S);
  end;

  function Str2FloatD( S: string; Def: extended ): extended;
  begin
    try
      S      := StripNextFloat( S );
      if S<>'' then result := Str2Float( S ) else result := Def;
    except
      result := Def;
    end;
  end;

  function Str2ExtD( S: string; Def: extended ): extended;
  begin
    result := Str2FloatD( S, Def );
  end;

  function Str2ExtDNI( S: string; Def: extended ): extended;
  // NOT Internationalize!
  begin
    try
      S      := StrReplace( S, ThousandSeparator, DecimalSeparator );
      S      := StripNextFloat( S );
      result := Str2Float( S );
    except
      result := Def;
    end;
  end;

  function RightCommaizeStr( s: string ): string;
  // '12345' changed to '12,345'
  // Comma character inserted from right hand side count
  var
    NumCommas, I, Len : Cardinal;
  begin
    Len := System.Length(s);
    NumCommas := Pred(Len) div 3;
    for I := 1 to NumCommas do
      System.Insert( ThousandSeparator, s, Succ(Len-(I * 3)) );
    result := S;
  end;

  function LeftCommaizeStr( s: string ): string;
  // '12345' changed to '123,45'
  // Comma character inserted from left hand side count
  var
    NumCommas, I : Cardinal;
  begin
    NumCommas := (Pred(System.Length(s))) div 3;
    for I := 1 to NumCommas do
      System.Insert( ThousandSeparator, s, I * 3 + I );
    result := S;
  end;

  function Commatize( S: string ): string;
  var
    Negative: boolean;
    Pre,Post: string;
    i: integer;
  begin
    S := Trim(S);
    // bail if there is not input
    if Length(S)=0 then
    begin
      result := '';
      exit;
    end;
    // bail if the input is not a number
    for i:=1 to Length(S) do
    begin
      if NOT CIN( S[i], '0123456789+-'+DecimalSeparator ) then
      begin
        result := S;
        exit;
      end;
    end;
    Negative := (S[1]='-');          // is the number negative?
    if Negative then Delete(S,1,1);  // get rid of negative sign
    i := Pos( DecimalSeparator, S ); // find decimal point
    if i > 0 then
    begin
      // Break at decimal point
      Pre  := Copy( S, 1, i-1 );
      Post := Copy( S, i+1, MAXINT );
      result := RightCommaizeStr( Pre ) + DecimalSeparator + LeftCommaizeStr( Post );
    end else
    begin
      // No decimal point, treat as integer
      result := RightCommaizeStr( S );
    end;
    // Put negative sign back!
    if Negative then result := '-' + result;
  end;

  function Float2Str( E: extended; N: integer ): string;
  begin
    result := FloatToStrF( e, ffFixed, 18, N );  // FloatToStrF OK Here!
    result := Trim( result );
  end;

  function Ext2Str( E: extended; N: integer ): string;
  begin
    result := Float2Str( E, N );
  end;

  function Ext2StrNI( E: extended; N: integer ): string; // NOT Internationalized Always writes '.' as '.'!
  begin
    result := Float2Str( E, N );
    result := StrReplace( result, ',', '.' );
  end;

  function ExtToStr( E: extended; N: integer ): string;
  begin
    result := Float2Str( E, N );
  end;

  function Ext2StrComma( E: extended; N: integer ): string;
  begin
    result := Commatize( Float2Str( E, N ));
  end;

  function ExtToStrComma( E: extended; N: integer ): string;
  begin
    result := Ext2StrComma( E, N );
  end;

  function Int2Str( V: int64 ): string;
  begin
    result := IntToStr( V );
  end;

  function Int2StrComma( V: int64 ): string;
  begin
    result := Commatize( Int2Str( V ));
  end;

  function IntToStrComma( V: int64 ): string;
  begin
    result := Int2StrComma( V );
  end;

  function IntToStrCommaN( V: int64; N: integer ): string;
  begin
    result := IntToStrComma( V );
    while Length(result) < N do result := ' ' + result;
  end;

  function IToStr( i: int64 ): string;
  // Protected against failure (how can there be one anyway?)
  begin
    try
      result := Int2StrComma( i );
    except
    end;
  end;

  function QuoteIfNeeded( S: string ): string;
  begin
    result := S;
    if Length(S)=0 then exit;  // string = ''
    if (result[1] IN['''','"']) AND (result[Length(result)]=result[1]) then exit; // already quoted
    if (Pos( '''', result )>0) OR
       (Pos( '"', result )>0) OR
       (Pos( ' ', result )>0) OR
       (Pos( ';', result )>0) OR
       (Pos( ^I, result )>0) then
    begin
      if Pos('''',result)<0 then
        result := '''' + result + ''''
      else
      begin
        result := StrReplace( result, '"', '''' );
        result := '"' + result + '"';
      end;
    end;
  end;

  function EncodeInteger( i, N: integer ): string;
  // encode i, but make sure N characters long
  const
    C: string = '0123456789ABCDEFGHJKLMNPQRSTUVWXYZ';
  var
    r: integer;
    m: boolean;
  begin
    m := i < 0;
    i := Abs(i);
    result := '';
    while i > 0 do
    begin
      r := i MOD Length(C);
      i := i DIV Length(C);
      result := C[r+1]+result;
    end;
    if m then result := '-' + result;
    while Length(result)<N do result := '0'+result;
  end;

  function FindFileInPaths( PathS, FN: string; FNProc: TProcFN; var FoundFN: string ): boolean;
  var
    S,T: string;
  begin
    result := FALSE;
    S := Paths;
    while Length(S)>0 do
    begin
      T := Trim(TokenParse(S,';'));
      T := AddBackSlash(T) + FN;
      // Process filename if FNProc is defined
      if Assigned(FNProc) then T := FNProc( T );
      // Does the file exist there?
      if uFileExists( T ) then
      begin
        FoundFN := T;
        result := TRUE;
        exit;
      end;
    end;
  end;


function ForceCRLF( S: string ): string;
// Convert linefeeds without preceeding ^M to ^M^J
var
  i: integer;
begin
  result := '';
  i := 1;
  while i <= Length(S) do
  begin
    case S[i] of
      ' '..'~':  result := result + S[i];
      ^J:        begin
                   if (i>1) AND (S[i-1]<>^M) then
                     result := result + ^M^J
                   else
                     result := S[i];
                 end;
    end;
    Inc(i);
  end;
end;

procedure StripTo( Find: string; var S: string );
// Strip everything from the beginning of S, upto and including Find from S
var
  i: integer;
begin
  i := Pos(Find,UpperCase(S));
  if i>0 then Delete(S,1,i+Length(Find)-1);
end;

procedure StripFrom( Find: string; var S: string );
// Strip everything from and including Find to the end of S from S
var
  i: integer;
begin
  i := Pos(Find,UpperCase(S));
  if i>0 then Delete(S,i,MAXINT);
end;

function StripBetween( T1, T2: char; var S: string ): boolean;
// Strip the first occurance of everyting between T1 and T2 from S, including
// T1 and T2.
var
  i1, i2: integer;
begin
  i1 := Pos(T1,S);
  i2 := Pos(T2,Copy(S,I1+1,MAXINT));
  if (i1>0) AND (i2>0) then
  begin
    Delete( S, i1, i2+1 );
    result := TRUE;
  end else result := FALSE;
end;

procedure StripHTMLCode( var S: string );
// Strips HTML code pairs from S
begin
  repeat
  until NOT( StripBetween( '<', '>', S ));
end;

function Say( N: integer ): string;
begin
  if N > 99 then
  begin
    result := IntToStr(N);
    exit;
  end;
  case N of
    0:  result := 'Zero';
    1:  result := 'One';
    2:  result := 'Two';
    3:  result := 'Three';
    4:  result := 'Four';
    5:  result := 'Five';
    6:  result := 'Six';
    7:  result := 'Seven';
    8:  result := 'Eight';
    9:  result := 'Nine';
    10: result := 'Ten';
    11: result := 'Eleven';
    12: result := 'Tweleve';
    13: result := 'Thirteen';
    14: result := 'Fourteen';
    15: result := 'Fifteen';
    16: result := 'Sixteen';
    17: result := 'Seventeen';
    18: result := 'Eighteen';
    19: result := 'Nineteen';
    20: result := 'Twenty';
    30: result := 'Thirty';
    40: result := 'Forth';
    50: result := 'Fifty';
    60: result := 'Sixty';
    70: result := 'Seventy';
    80: result := 'Eighty';
    90: result := 'Ninety';
    else result := Say((N DIV 10)*10)+'-'+Say(N MOD 10);
  end;
end;

function DeleteLockFile( FN: string; Ext: string ): boolean;
begin
  uDeleteFile(ChangeFileExt( FN, Ext ));
end;

function GetLockFileX( FN: string; Ext: string ): boolean;
var
  OFN: string;
  F: system.Text;
begin
  Result := FALSE;
  OFN := ChangeFileExt( FN, Ext );
  // Does valid lock file already exist? (Filedate must also match)
  if uFileExists( OFN ) AND SameFileDateName( FN, OFN ) then exit;
  try
    ForceDirectories( ExtractFilePath( OFN ) );
    AssignFile( F, OFN );
    try
      ReWrite( F );
      WriteLn( F, 'Locked by '+Application.EXEName + ', ' + DateTimeToStr( Now ) );
    finally
      CloseFile( F );
      MatchFileDate( FN, OFN );
    end;
    result := TRUE;
  except
  end;
end;

function GetLockFile( FN: string ): boolean;
begin
  result := GetLockFileX( FN, '.lck' );
end;

function BoolStrSelect( B: boolean; t, f: string ): string;
begin
  if B then result := T else result := f;
end;

  function StrSameStart( S1, S2: string ): boolean;
  // Are the first characters of S1 and S2 the same? S1 or S2 may be shorter.
  // EX:     StrSameStart( 'NMPro', 'nm' ) = TRUE
  //         StrSameStart( 'NMPro', 'np' ) = FALSE
  var
    i: integer;
  begin
    i  := iSmallerOf( Length( S1 ), Length( S2 ) );
    if i < 1 then
    begin
      result := FALSE;
      exit;
    end;
    S1 := UpperCase( Copy( S1, 1, i ) );
    S2 := UpperCase( Copy( S2, 1, i ) );
    result := S1=S2;
  end;

  function SimplifyKeywords( S: string ): string;
  var
    t: string;
    i: integer;
    L: tStringList;
  begin
    result := S;
    // Dump US
    L := tStringList.Create;
    try
      L.Sorted := FALSE;
      while Length( result ) > 0 do
      begin
        t := TokenParse( result, ';, .' );
        t := UpperCase(Trim( t ));
        if (t <> '') AND (t <> 'US') then L.Add(t);
      end;
      L.Sorted := TRUE;
      for i:=0 to L.Count-1 do
      begin
        if length(result)>0 then
          result := result + ',' + L[i]
        else
          result := result + L[i];
      end;
    finally
      L.Free;
    end;
  end;

  function StrIfBool( S: string; B: boolean ): string;
  begin
    if B then result := S else result := '';
  end;

  function DayOfWeekStr( T: tDateTime ): string;
  begin
    case DayOfTheWeek( T ) of
      1: result := 'Monday';
      2: result := 'Tuesday';
      3: result := 'Wednesday';
      4: result := 'Thursday';
      5: result := 'Friday';
      6: result := 'Saturday';
      7: result := 'Sunday';
      else result := '???';
    end;
  end;

  procedure Delay( s: extended );
  var
    st: tDateTime;
    i: integer;
  begin
    st := Now;
    while DeltaTimeSeconds(st) < s do
    begin
      for i:=1 to 10 do Application.ProcessMessages;
    end;
  end;

  function StringToDisplay( S: string ): string;
  begin
    result := StrReplace( S, ^M, '[CR]'+^M );
    result := StrReplace( result, ^I, '[^I]' );
  end;

  function ProcessWords( S: string; P: stringproc ): string;
  var
    T: string;
  begin
    result := '';
    while Length(S)>0 do
    begin
      T := P( Trim(TokenParse(S,' _-,;.'+^I)));
      SpaceAppend( result, T );
    end;
  end;

    function srADR( w: string ): string;
    var
      ucw: string;
    begin
      ucw := UpperCase( w );
      if (UCW='NE') OR
         (UCW='SE') OR
         (UCW='NW') OR
         (UCW='SE') OR
         (UCW='LLC') OR
         (UCW='PO') OR
         (UCW='CO') then
      begin
        result := UCW;
      end
      else if UCW='P.O.' then result := 'PO'
      else if UCW='APARTMENT' then result := 'APT'
      else if UCW='N.' then result := 'N'
      else if UCW='E.' then result := 'E'
      else if UCW='W.' then result := 'W'
      else if UCW='S.' then result := 'S'
      else if UCW='NORTH' then result := 'N'
      else if UCW='SOUTH' then result := 'S'
      else if UCW='EAST' then result := 'E'
      else if UCW='WEST' then result := 'W'
      else if UCW='SUITE' then result := 'STE'
      else if UCW='STE' then result := 'STE'
      else                    result := W;
    end;
  function FixAddress( S: string ): string;
  begin
    result := S;
    result := TitleCase( result );
    result := StrReplace( result, ',', ' ' );
    result := StrReplace( result, '#', ' STE ' );
    result := StrReplace( result, '  ', ' ' );
    result := ProcessWords( result, srADR );
  end;

    function srCompName( w: string ): string;
    var
      ucw: string;
    begin
      ucw := UpperCase( w );
      if (UCW='LLC') OR
         (UCW='US') OR
         (UCW='CO') then
      begin
        result := UCW;
      end
      else if UCW='INC' then result := 'Inc'
      else if UCW='INC.' then result := 'Inc'
      else if UCW='OF' then result := 'of'
      else if UCW='THE' then result := 'the'
      else if UCW='AND' then result := 'and'
      else if Length(w)<4 then result := UCW
      else result := W;
    end;
  function FixCompanyName( s: string ): string;
  var
    i: integer;
  begin
    result := S;
    result := ProcessWords( result, srCompName );
  end;


  function CharCount( SS: char; S: string ): integer;
  var
    i: integer;
  begin
    result := 0;
    for i:=1 to Length(S) do
    begin
      if S[i] = SS then Inc( result );
    end;
  end;


end.






