Strings

Equivalent of Trim$(),Mid$(), etc?

Solution 1

From: bobs@dragons.nest.nl (Bob Swart)

 unit TrimStr;
 {$B-}
 {
      File: TrimStr
    Author: Bob Swart [100434,2072]
   Purpose: routines for removing leading/trailing spaces from strings,
            and to take parts of left/right of string (a la Basic).
   Version: 2.0

   LTrim()    - Remove all spaces from the left side of a string
   RTrim()    - Remove all spaces from the right side of a string
   Trim()     - Remove all extraneous spaces from a string
   RightStr() - Take a certain portion of the right side of a string
   LeftStr()  - Take a certain portion of the left side of a string
   MidStr()   - Take the middle portion of a string

 }
 interface
 Const
   Space = #$20;

   function LTrim(Const Str: String): String;
   function RTrim(Str: String): String;
   function Trim(Str: String):  String;
   function RightStr(Const Str: String; Size: Word): String;
   function LeftStr(Const Str: String; Size: Word): String;
   function MidStr(Const Str: String; Size: Word): String;

 implementation

   function LTrim(Const Str: String): String;
   var len: Byte absolute Str;
       i: Integer;
   begin
     i := 1;
     while (i <= len) and (Str[i] = Space) do Inc(i);
     LTrim := Copy(Str,i,len)
   end {LTrim};

   function RTrim(Str: String): String;
   var len: Byte absolute Str;
   begin
     while (Str[len] = Space) do Dec(len);
     RTrim := Str
   end {RTrim};

   function Trim(Str: String): String;
   begin
     Trim := LTrim(RTrim(Str))
   end {Trim};

   function RightStr(Const Str: String; Size: Word): String;
   var len: Byte absolute Str;
   begin
     if Size > len then Size := len;
     RightStr := Copy(Str,len-Size+1,Size)
   end {RightStr};

   function LeftStr(Const Str: String; Size: Word): String;
   begin
     LeftStr := Copy(Str,1,Size)
   end {LeftStr};

   function MidStr(Const Str: String; Size: Word): String;
   var len: Byte absolute Str;
   begin
     if Size > len then Size := len;
     MidStr := Copy(Str,((len - Size) div 2)+1,Size)
   end {MidStr};
 end.

Solution 2

From: jbui@scd.hp.com (Joseph Bui)

For Mid$, use Copy(S: string; start, length: byte): string;
You can make copy perform Right$ and Left$ as well by doing:
Copy(S, 1, Length) for left$ and
Copy(S, Start, 255) for right$
Note: Start and Length are the byte positions of your starting point, get these with Pos().

Here are some functions I wrote that come in handy for me. Way down at the bottom is a trim() function that you can modify into TrimRight$ and TrimLeft$. Also, they all take pascal style strings, but you can modify them to easily null terminated.

const
   BlackSpace = [#33..#126];

{
   squish() returns a string with all whitespace not inside single
quotes deleted.
}
function squish(const Search: string): string;
var
   Index: byte;
   InString: boolean;
begin
   InString:=False;
   Result:='';
   for Index:=1 to Length(Search) do
   begin
      if InString or (Search[Index] in BlackSpace) then
         AppendStr(Result, Search[Index]);
      InString:=((Search[Index] = '''') and (Search[Index - 1] <> '\'))
            xor InString;
   end;
end;

{
   before() returns everything before the first occurance of
Find in Search. If Find does not occur in Search, Search is
returned.
}
function before(const Search, Find: string): string;
var
   index: byte;
begin
   index:=Pos(Find, Search);
   if index = 0 then
      Result:=Search
   else
      Result:=Copy(Search, 1, index - 1);
end;

{
   after() returns everything after the first occurance of
Find in Search. If Find does not occur in Search, a null
string is returned.
}
function after(const Search, Find: string): string;
var
   index: byte;
begin
   index:=Pos(Find, Search);
   if index = 0 then
      Result:=''
   else
      Result:=Copy(Search, index + Length(Find), 255);
end;

{
   RPos() returns the index of the first character of the last
occurance of Find in Search. Returns 0 if Find does not occur
in Search. Like Pos() but searches in reverse.
}
function RPos(const Find, Search: string): byte;
var
   FindPtr, SearchPtr, TempPtr: PChar;
begin
   FindPtr:=StrAlloc(Length(Find)+1);
   SearchPtr:=StrAlloc(Length(Search)+1);
   StrPCopy(FindPtr,Find);
   StrPCopy(SearchPtr,Search);
   Result:=0;
   repeat
      TempPtr:=StrRScan(SearchPtr, FindPtr^);
      if TempPtr <> nil then
         if (StrLComp(TempPtr, FindPtr, Length(Find)) = 0) then
         begin
            Result:=TempPtr - SearchPtr + 1;
            TempPtr:=nil;
         end
         else
            TempPtr:=#0;
   until TempPtr = nil;
end;

{
   inside() returns the string between the most inside nested
Front ... Back pair.
}
function inside(const Search, Front, Back: string): string;
var
   Index, Len: byte;
begin
   Index:=RPos(Front, before(Search, Back));
   Len:=Pos(Back, Search);
   if (Index > 0) and (Len > 0) then
      Result:=Copy(Search, Index + 1, Len - (Index + 1))
   else
      Result:='';
end;

{
   leftside() returns what is to the left of inside() or Search.
}
function leftside(const Search, Front, Back: string): string;
begin
   Result:=before(Search, Front + inside(Search, Front, Back) + Back);
end;

{
   rightside() returns what is to the right of inside() or Null.
}
function rightside(const Search, Front, Back: string): string;
begin
   Result:=after(Search, Front + inside(Search, Front, Back) + Back);
end;

{
   trim() returns a string with all right and left whitespace removed.
}
function trim(const Search: string): string;
var
   Index: byte;
begin
   Index:=1;
   while (Index <= Length(Search)) and not (Search[Index] in BlackSpace) do
      Index:=Index + 1;
   Result:=Copy(Search, Index, 255);
   Index:=Length(Result);
   while (Index > 0) and not (Result[Index] in BlackSpace) do
      Index:=Index - 1;
   Result:=Copy(Result, 1, Index);
end;

String Pattern matching

From: stidolph@magnet.com (David Stidolph)

There are many times when you need to compare two strings, but want to use wild cards in the match - all last names that begin with 'St', etc. The following is a piece of code I got from Sean Stanley in Tallahassee Florida in C. I translated it into Delphi an am uploading it here for all to use. I have not tested it extensivly, but the original function has been tested quite thoughly.

I would love feedback on this routine - or peoples changes to it. I want to forward them to Sean to get him to release more tidbits like this.

{
  This function takes two strings and compares them.  The first string
  can be anything, but should not contain pattern characters (* or ?).
  The pattern string can have as many of these pattern characters as you want.
  For example: MatchStrings('David Stidolph','*St*') would return True.

  Orignal code by Sean Stanley in C
  Rewritten in Delphi by David Stidolph
}
function MatchStrings(source, pattern: String): Boolean;
var
  pSource: Array [0..255] of Char;
  pPattern: Array [0..255] of Char;

  function MatchPattern(element, pattern: PChar): Boolean;

    function IsPatternWild(pattern: PChar): Boolean;
    var
      t: Integer;
    begin
      Result := StrScan(pattern,'*') <> nil;
      if not Result then Result := StrScan(pattern,'?') <> nil;
    end;

  begin
    if 0 = StrComp(pattern,'*') then
      Result := True
    else if (element^ = Chr(0)) and (pattern^ <> Chr(0)) then
      Result := False
    else if element^ = Chr(0) then
      Result := True
    else begin
      case pattern^ of
      '*': if MatchPattern(element,@pattern[1]) then
             Result := True
           else
             Result := MatchPattern(@element[1],pattern);
      '?': Result := MatchPattern(@element[1],@pattern[1]);
      else
        if element^ = pattern^ then
          Result := MatchPattern(@element[1],@pattern[1])
        else
          Result := False;
      end;
    end;
  end;

begin
  StrPCopy(pSource,source);
  StrPCopy(pPattern,pattern);
  Result := MatchPattern(pSource,pPattern);
end;

GetToken

Thomas Scheffczyk <SCHEFFCZYK@islay.verwaltung.uni-mainz.de>

I don't know if this will help you, but the following (simple) functions helped me handling substrings. Perhaps you can use them to seperate the text for each field (for i := 1 to NumToken do ...) and store it seperatly in the database-fields.

function GetToken(aString, SepChar: String; TokenNum: Byte):String;
{
parameters: aString : the complete string
            SepChar : a single character used as separator 
                      between the substrings
            TokenNum: the number of the substring you want
result    : the substring or an empty string if the are less then
            'TokenNum' substrings
}
var
   Token     : String;
   StrLen    : Byte;
   TNum      : Byte;
   TEnd      : Byte;

begin
     StrLen := Length(aString);
     TNum   := 1;
     TEnd   := StrLen;
     while ((TNum <= TokenNum) and (TEnd <> 0)) do
     begin
          TEnd := Pos(SepChar,aString);
          if TEnd <> 0 then
          begin
               Token := Copy(aString,1,TEnd-1);
               Delete(aString,1,TEnd);
               Inc(TNum);
          end
          else
          begin
               Token := aString;
          end;
     end;
     if TNum >= TokenNum then
     begin
          GetToken1 := Token;
     end
     else
     begin
          GetToken1 := '';
     end;
end;

function NumToken(aString, SepChar: String):Byte;
{
parameters: aString : the complete string
            SepChar : a single character used as separator 
                      between the substrings
result    : the number of substrings
}

var
   RChar     : Char;
   StrLen    : Byte;
   TNum      : Byte;
   TEnd      : Byte;

begin
     if SepChar = '#' then
     begin
          RChar := '*'
     end
     else
     begin
         RChar := '#'
     end;
     StrLen := Length(aString);
     TNum   := 0;
     TEnd   := StrLen;
     while TEnd <> 0 do
     begin
          Inc(TNum);
          TEnd := Pos(SepChar,aString);
          if TEnd <> 0 then
          begin
               aString[TEnd] := RChar;
          end;
     end;
     NumToken1 := TNum;
end;

"Hrvoje Brozovic" <Hrvoje.Brozovic@ring.hr>

function CopyColumn( const s_string: string; c_fence: char; i_index: integer ): string;
var i, i_left: integer;
begin
    result := EmptyStr;
    if i_index = 0 then begin
        exit;
    end;
    i_left := 0;
    for i := 1 to Length( s_string ) do begin
        if s_string[ i ] = c_fence then begin
            Dec( i_index );
            if i_index = 0 then begin
                result := Copy( s_string, i_left + 1, i - i_left - 1 );
                exit;
            end else begin
                i_left := i;
            end;
        end;
    end;
    Dec( i_index );
    if i_index = 0 then begin
        result := Copy( s_string, i_left + 1, Length( s_string ));
    end;
end;

I know that in GetToken SepChar parameter ( c_fence in my case ) is string, not char, but comment says that he is expecting single char in that string, and it is obvious that if you send more than one char, it won't work correctly. ( Delete(aString,1,TEnd) is buggy if Length( SepChar ) > 1 ).

Replacing substrings

From: michael@quinto.ruhr.de (Michael Bialas)

 Does anyone know a fast algorithm that replaces all occurences of any
substring sub1 to any string sub2 in any string str.

This should do the job:

  function ReplaceSub(str, sub1, sub2: String): String;
  var
    aPos: Integer;
    rslt: String;
  begin
    aPos := Pos(sub1, str);
    rslt := '';
    while (aPos <> 0) do begin
      rslt := rslt + Copy(str, 1, aPos - 1) + sub2;
      Delete(str, 1, aPos + Length(sub1));
      aPos := Pos(sub1, str);
    end;
    Result := rslt + str;
  end;

Capitalize the first letter of each word in a string

Erik Sperling Johansen <erik@info-pro.no>

function LowCase(ch : CHAR) : CHAR;
begin
  case ch of
    'A'..'Z' : LowCase := CHR (ORD(ch)+31);
  else
    LowCase := ch;
  end;
end;

function Proper (source, separators : STRING) : STRING;
var
  LastWasSeparator : BOOLEAN;
  ndx              : INTEGER;
begin
  LastWasSeparator := TRUE;  
  ndx := 1;
  while (ndx<=Length(source)) do begin
    if LastWasSeparator
    then source[ndx] := UpCase(source[ndx])
    else source[ndx] := LowCase(source[ndx]);
    LastWasSeparator := Pos(source[ndx], separators)>0;
    inc(ndx);
  end;
  Result := source;
end;

From: "Cleon T. Bailey" <baileyct@ionet.net>

Function  TfrmLoadProtocolTable.ToMixCase(InString: String): String;
Var I: Integer;
Begin
  Result := LowerCase(InString);
  Result[1] := UpCase(Result[1]);
  For I := 1 To Length(InString) - 1 Do Begin
    If (Result[I] = ' ') Or (Result[I] = '''') Or (Result[I] = '"')
    Or (Result[I] = '-') Or (Result[I] = '.')  Or (Result[I] = '(') Then
      Result[I + 1] := UpCase(Result[I + 1]);
  End;
End;

From: "Paul Motyer" <paulm@linuxserver.pccity.com.au>

Both Tim Stannard's and Cleon T. Bailey's functions will bomb in D2 if sent an empty string (where accessing InString[1] causes an access violation, the second attempt will do the same if the last character is in the set.

try this instead:

function proper(s:string):string;
var t:string;
    i:integer;
    newWord:boolean;
begin
if s='' then exit;
s:=lowercase(s);
t:=uppercase(s);
newWord:=true;
for i:=1 to length(s) do
    begin
    if newWord and (s[i] in ['a'..'z']) then
       begin s[i]:=t[i]; newWord:=false; continue; end;
    if s[i] in ['a'..'z',''''] then continue;
    newWord:=true;
    end;
result:=s;
end;

How do I determine if two strings sound alike?

{ This code came from Lloyd's help file! }

Soundex function--determines whether two words sound alike. Written after reading an article in PC Magazine about the Soundex algorithm. Pass the function a string. It returns a Soundex value string. This value can be saved in a database or compared to another Soundex value. If two words have the same Soundex value, then they sound alike (more or less).

Note that the Soundex algorithm ignores the first letter of a word. Thus, "won" and "one" will have different Soundex values, but "Won" and "Wunn" will have the same values.

Soundex is especially useful in databases when one does not know how to spell a last name.

Function Soundex(OriginalWord: string): string;
var
  Tempstring1, Tempstring2: string;
  Count: integer;
begin
  Tempstring1 := '';
  Tempstring2 := '';
  OriginalWord := Uppercase(OriginalWord); {Make original word uppercase}
  Appendstr(Tempstring1, OriginalWord[1]); {Use the first letter of the word}
  for Count := 2 to length(OriginalWord) do
    {Assign a numeric value to each letter, except the first}

    case OriginalWord[Count] of
      'B','F','P','V': Appendstr(Tempstring1, '1');
      'C','G','J','K','Q','S','X','Z': Appendstr(Tempstring1, '2');
      'D','T': Appendstr(Tempstring1, '3');
      'L': Appendstr(Tempstring1, '4');
      'M','N': Appendstr(Tempstring1, '5');
      'R': Appendstr(Tempstring1, '6');
      {All other letters, punctuation and numbers are ignored}
    end;
  Appendstr(Tempstring2, OriginalWord[1]);
  {Go through the result removing any consecutive duplicate numeric values.}

  for Count:=2 to length(Tempstring1) do
    if Tempstring1[Count-1]<>Tempstring1[Count] then
        Appendstr(Tempstring2,Tempstring1[Count]);
  Soundex:=Tempstring2; {This is the soundex value}
end;

SoundAlike--pass two strings to this function. It returns True if they sound alike, False if they don't. Simply calls the Soundex function.

Function SoundAlike(Word1, Word2: string): boolean;
begin
  if (Word1 = '') and (Word2 = '') then result := True
  else
  if (Word1 = '') or (Word2 = '') then result := False
  else
  if (Soundex(Word1) = Soundex(Word2)) then result := True
  else result := False;
end;

What are the values for the virtual keys?

  vk_LButton   = $01;
  vk_RButton   = $02;
  vk_Cancel    = $03;
  vk_MButton   = $04;   { NOT contiguous with L & RBUTTON }
  vk_Back      = $08;
  vk_Tab       = $09;
  vk_Clear     = $0C;
  vk_Return    = $0D;
  vk_Shift     = $10;
  vk_Control   = $11;
  vk_Menu      = $12;
  vk_Pause     = $13;
  vk_Capital   = $14;
  vk_Escape    = $1B;
  vk_Space     = $20;
  vk_Prior     = $21;
  vk_Next      = $22;

  vk_End       = $23;
  vk_Home      = $24;
  vk_Left      = $25;
  vk_Up        = $26;
  vk_Right     = $27;
  vk_Down      = $28;
  vk_Select    = $29;
  vk_Print     = $2A;
  vk_Execute   = $2B;
  vk_SnapShot  = $2C;
{ vk_Copy      = $2C not used by keyboards }
  vk_Insert    = $2D;
  vk_Delete    = $2E;
  vk_Help      = $2F;
{ vk_A thru vk_Z are the same as their ASCII equivalents: 'A' thru 'Z' }
{ vk_0 thru vk_9 are the same as their ASCII equivalents: '0' thru '9' }

  vk_NumPad0   = $60;
  vk_NumPad1   = $61;
  vk_NumPad2   = $62;
  vk_NumPad3   = $63;
  vk_NumPad4   = $64;
  vk_NumPad5   = $65;
  vk_NumPad6   = $66;
  vk_NumPad7   = $67;
  vk_NumPad8   = $68;
  vk_NumPad9   = $69;
  vk_Multiply  = $6A;
  vk_Add       = $6B;
  vk_Separator = $6C;
  vk_Subtract  = $6D;
  vk_Decimal   = $6E;
  vk_Divide    = $6F;
  vk_F1        = $70;
  vk_F2        = $71;
  vk_F3        = $72;
  vk_F4        = $73;
  vk_F5        = $74;

  vk_F6        = $75;
  vk_F7        = $76;
  vk_F8        = $77;
  vk_F9        = $78;
  vk_F10       = $79;
  vk_F11       = $7A;
  vk_F12       = $7B;
  vk_F13       = $7C;
  vk_F14       = $7D;
  vk_F15       = $7E;
  vk_F16       = $7F;
  vk_F17       = $80;
  vk_F18       = $81;
  vk_F19       = $82;
  vk_F20       = $83;
  vk_F21       = $84;
  vk_F22       = $85;
  vk_F23       = $86;
  vk_F24       = $87;
  vk_NumLock   = $90;
  vk_Scroll    = $91;

{ This code came from Lloyd's help file! }

Delphi currency amount converter

From: "Donald Johnson" <binary@computerbargain.com>

Function  HundredAtATime(TheAmount:Integer):String;
var
  TheResult : String;
Begin
  TheResult := '';
  TheAmount := Abs(TheAmount);
  While TheAmount > 0 do Begin
    If TheAmount >= 900 Then Begin
      TheResult := TheResult + 'Nine hundred ';
      TheAmount := TheAmount - 900;
    End;
    If TheAmount >= 800 Then Begin
      TheResult := TheResult + 'Eight hundred ';
      TheAmount := TheAmount - 800;
    End;
    If TheAmount >= 700 Then Begin
      TheResult := TheResult + 'Seven hundred ';
      TheAmount := TheAmount - 700;
    End;
    If TheAmount >= 600 Then Begin
      TheResult := TheResult + 'Six hundred ';
      TheAmount := TheAmount - 600;
    End;
    If TheAmount >= 500 Then Begin
      TheResult := TheResult + 'Five hundred ';
      TheAmount := TheAmount - 500;
    End;
    If TheAmount >= 400 Then Begin
      TheResult := TheResult + 'Four hundred ';
      TheAmount := TheAmount - 400;
    End;
    If TheAmount >= 300 Then Begin
      TheResult := TheResult + 'Three hundred ';
      TheAmount := TheAmount - 300;
    End;
    If TheAmount >= 200 Then Begin
      TheResult := TheResult + 'Two hundred ';
      TheAmount := TheAmount - 200;
    End;
    If TheAmount >= 100 Then Begin
      TheResult := TheResult + 'One hundred ';
      TheAmount := TheAmount - 100;
    End;
    If TheAmount >= 90 Then Begin
      TheResult := TheResult + 'Ninety ';
      TheAmount := TheAmount - 90;
    End;
    If TheAmount >= 80 Then Begin
      TheResult := TheResult + 'Eighty ';
      TheAmount := TheAmount - 80;
    End;
    If TheAmount >= 70 Then Begin
      TheResult := TheResult + 'Seventy ';
      TheAmount := TheAmount - 70;
    End;
    If TheAmount >= 60 Then Begin
      TheResult := TheResult + 'Sixty ';
      TheAmount := TheAmount - 60;
    End;
    If TheAmount >= 50 Then Begin
      TheResult := TheResult + 'Fifty ';
      TheAmount := TheAmount - 50;
    End;
    If TheAmount >= 40 Then Begin
      TheResult := TheResult + 'Fourty ';
      TheAmount := TheAmount - 40;
    End;
    If TheAmount >= 30 Then Begin
      TheResult := TheResult + 'Thirty ';
      TheAmount := TheAmount - 30;
    End;
    If TheAmount >= 20 Then Begin
      TheResult := TheResult + 'Twenty ';
      TheAmount := TheAmount - 20;
    End;
    If TheAmount >= 19 Then Begin
      TheResult := TheResult + 'Nineteen ';
      TheAmount := TheAmount - 19;
    End;
    If TheAmount >= 18 Then Begin
      TheResult := TheResult + 'Eighteen ';
      TheAmount := TheAmount - 18;
    End;
    If TheAmount >= 17 Then Begin
      TheResult := TheResult + 'Seventeen ';
      TheAmount := TheAmount - 17;
    End;
    If TheAmount >= 16 Then Begin
      TheResult := TheResult + 'Sixteen ';
      TheAmount := TheAmount - 16;
    End;
    If TheAmount >= 15 Then Begin
      TheResult := TheResult + 'Fifteen ';
      TheAmount := TheAmount - 15;
    End;
    If TheAmount >= 14 Then Begin
      TheResult := TheResult + 'Fourteen ';
      TheAmount := TheAmount - 14;
    End;
    If TheAmount >= 13 Then Begin
      TheResult := TheResult + 'Thirteen ';
      TheAmount := TheAmount - 13;
    End;
    If TheAmount >= 12 Then Begin
      TheResult := TheResult + 'Twelve ';
      TheAmount := TheAmount - 12;
    End;
    If TheAmount >= 11 Then Begin
      TheResult := TheResult + 'Eleven ';
      TheAmount := TheAmount - 11;
    End;
    If TheAmount >= 10 Then Begin
      TheResult := TheResult + 'Ten ';
      TheAmount := TheAmount - 10;
    End;
    If TheAmount >= 9 Then Begin
      TheResult := TheResult + 'Nine ';
      TheAmount := TheAmount - 9;
    End;
    If TheAmount >= 8 Then Begin
      TheResult := TheResult + 'Eight ';
      TheAmount := TheAmount - 8;
    End;
    If TheAmount >= 7 Then Begin
      TheResult := TheResult + 'Seven ';
      TheAmount := TheAmount - 7;
    End;
    If TheAmount >= 6 Then Begin
      TheResult := TheResult + 'Six ';
      TheAmount := TheAmount - 6;
    End;
    If TheAmount >= 5 Then Begin
      TheResult := TheResult + 'Five ';
      TheAmount := TheAmount - 5;
    End;
    If TheAmount >= 4 Then Begin
      TheResult := TheResult + 'Four ';
      TheAmount := TheAmount - 4;
    End;
    If TheAmount >= 3 Then Begin
      TheResult := TheResult + 'Three ';
      TheAmount := TheAmount - 3;
    End;
    If TheAmount >= 2 Then Begin
      TheResult := TheResult + 'Two ';
      TheAmount := TheAmount - 2;
    End;
    If TheAmount >= 1 Then Begin
      TheResult := TheResult + 'One ';
      TheAmount := TheAmount - 1;
    End;
  End;
  HundredAtATime := TheResult;
End;

Function  Real2CheckAmount(TheAmount:Real):String;
Var
  IntVal  : LongInt;
  TmpVal  : Integer;
  TmpStr,
  RetVal  : String;
begin
  TheAmount := Abs(TheAmount);

  { cents}
  TmpVal    := Round(Frac(TheAmount) * 100);
  IntVal    := Trunc(TheAmount);
  TmpStr    := HundredAtATime(TmpVal);
  If TmpStr  = '' Then TmpStr := 'Zero ';
  RetVal    := TmpStr + 'cents';
  If IntVal > 0 Then RetVal := 'dollars and ' + RetVal;

  { hundreds }
  TmpVal    := Round(Frac((IntVal * 1.0) / 1000.0) * 1000);
  IntVal    := Trunc((IntVal * 1.0) / 1000.0);
  TmpStr    := HundredAtATime(TmpVal);
  RetVal    := TmpStr + RetVal;

  { thousands }
  TmpVal    := Round(Frac((IntVal * 1.0) / 1000.0) * 1000);
  IntVal    := Trunc((IntVal * 1.0) / 1000.0);
  TmpStr    := HundredAtATime(TmpVal);
  If TmpStr <> '' Then
    RetVal    := TmpStr + 'Thousand ' + RetVal;

  { millions }
  TmpVal    := Round(Frac((IntVal * 1.0) / 1000.0) * 1000);
  IntVal    := Trunc((IntVal * 1.0) / 1000.0);
  TmpStr    := HundredAtATime(TmpVal);
  If TmpStr <> '' Then
    RetVal    := TmpStr + 'Million ' + RetVal;

  { billions }
  TmpVal    := Round(Frac((IntVal * 1.0) / 1000.0) * 1000);
  IntVal    := Trunc((IntVal * 1.0) / 1000.0);
  TmpStr    := HundredAtATime(TmpVal);
  If TmpStr <> '' Then
    RetVal    := TmpStr + 'Billion ' + RetVal;

  Real2CheckAmount := RetVal;
end;

Please email me and tell me if you liked this page.

This page has been created with