String functions

[pappawinni]

The str() function returns "0.000000" for values lower than 1e-6.
I was not lucky about that and created this:

Code: Select all

/*
Xstr as replacement for str()   
*/

Public Function Xstr(dblA)
Dim a as double , c as double
Dim iPot as integer , ig as integer , isigni as integer
Dim strA as string , strVZ as String , strFormat as String , strH as String
a = dblA
  if a = 0 then
    strA = "0"
  else
    strVZ = iif(a < 0,"-","")
    c = abs(a)
    iPot = int(log(c) / log(10.0))

    strFormat = "#.##############E"
    strA = trim(format(c,strFormat))
    ig = instr(1,strA,"E")
    if ig > 0 then
      strA = left(strA,ig-1)
    end if
    do
      ig = ig - 1
    loop while (mid(strA,ig,1) = "0") and (ig > 0)
    isigni = ig-1
    if iPot>=0 then
      If (iPot) > 10 then
         strFormat = "#." & Fill(strH,"#",isigni-1) & "E"
      else
         strFormat = "#."
         if (isigni-iPot-1)>0 then strFormat = strFormat & Fill(strH,"#",isigni-iPot-1)
      end if
    else
       if (Abs(iPot)+isigni)>10 then
         strFormat = "#." & Fill(strH,"#",isigni-1)&"E"
       else
         strFormat = "#." & Fill(strH,"#",isigni + Abs(iPot)-1)
       end if
    end if
    strA = trim(format(c,strFormat))
    strA = strVZ & strA
  end if
return strA
End Function

Dim a as double, i as integer
a = 1.234e8
For i = 1 to 20 
  ? Xstr(a)
  a = a / 10.0
next

By the way.. in VBA there is a function PI()
To get this in Kbasic just put this

Code: Select all

public function PI()
  return(atn(1) * 4.0)
end function


[berndnoetscher]

Thanks for sharing your code

[pappawinni]

i created some function to get numbers in words.
Even if I do not speak spanish I tried to create a function for that also.
I did not do much testing but hope it works.....

Code: Select all

public function NumberInWordsDE( Number as double ) as string
  Dim strNum as string
  Dim sglNumber as double
  Dim strOut as string
  Dim i as integer
  Dim intA as integer , intB as integer
  Dim intTSeg as integer
  Dim strFormat as string
  Dim strAppend as string
  Dim strZero as string
  Dim strLower20(1 to 19) as string
  Dim strTenth(1 to 10) as string
  Dim strExp3(1 to 4) as string
  Dim strOneExt(1 to 4, 1 to 2) as string
  Dim strTenthIn as string
  Dim strHundIn as string
  Dim bolTenthMode as boolean = false
  strZero = "Null"
  strLower20(1) = "ein"
  strLower20(2) = "zwei"
  strLower20(3) = "drei" 
  strLower20(4) = "vier" 
  strLower20(5) = "fünf" 
  strLower20(6) = "sechs" 
  strLower20(7) = "sieben" 
  strLower20(8) = "acht" 
  strLower20(9) = "neun" 
  strLower20(10) = "zehn" 
  strLower20(11) = "elf" 
  strLower20(12) = "zwölf"
  strLower20(13) = "dreizehn" 
  strLower20(14) = "vierzehn" 
  strLower20(15) = "fünfzehn" 
  strLower20(16) = "sechzehn" 
  strLower20(17) = "siebzehn" 
  strLower20(18) = "achtzehn" 
  strLower20(19) = "neunzehn" 
  strTenth(1) = "zehn" 
  strTenth(2) = "zwanzig"
  strTenth(3) = "dreissig" 
  strTenth(4) = "vierzig" 
  strTenth(5) = "fünfzig" 
  strTenth(6) = "sechzig" 
  strTenth(7) = "siebzig" 
  strTenth(8) = "achtzig" 
  strTenth(9) = "neunzig" 
  strTenth(10) = "hundert"
  strExp3(1) = "tausend"
  strExp3(2) = "million"
  strExp3(3) = "milliarde"
  strExp3(4) = "billion"
  strOneExt(1,1) = "s"
  strOneExt(1,2) = ""
  strOneExt(2,1) = ""
  strOneExt(2,2) = ""
  strOneExt(3,1) = "e"
  strOneExt(3,2) = "en"
  strOneExt(4,1) = "e"
  strOneExt(4,2) = "n"
  strOneExt(4,1) = "e"
  strOneExt(4,2) = "en" 
  strTenthIn = "und"
  strHundIn = ""
  strOut = ""

  sglNumber = abs(Number)
 
  intTSeg = int(int(log(sglNumber)/log(10))/3+1)
  strFormat = fill(strFormat,"#",intTSeg*3) & ".##"
  strNum = Format(sglNumber,strFormat," ",True)
 
  if (intTseg > 3) or (intTseg < 1) then
    return("???????????????")
    exit sub
  end if
 
  for i = 1 to intTSeg
    strAppend = strOneExt(intTSeg - i + 1, 2)
    intA = val(left(strNum,3))
    strNum = right(strNum,len(strNum)-3)
    if (strOut <> "") and (intA>99) then strOut = strOut & strHundIn
    if intA > 99 then strOut = strOut & strLower20(int(intA)/100) & strTenth(10)
    intB = intA mod 100
    if (strOut <> "") and (intB >0) then strOut = strOut & strHundIn
    select intB
      case 20 to 99:
        if bolTenthMode = True then
          strOut = strOut & strTenth(int(intB / 10))
          if (intB mod 10) > 0 then strOut = strOut & strTenthIn & strLower20(intB mod 10)
        else
          if (intB mod 10) > 0 then strOut = strOut & strLower20(intB mod 10) & strTenthIn
          strOut = strOut & strTenth(int(intB / 10))
        end if 
      case 2 to 19:
        strOut = strOut & strLower20(intB)
      case 1:
        strOut = strOut & strLower20(intB) & strOneExt(intTSeg - i + 1,1)
        strAppend = ""
      case 0:
        if int(sglNumber)=0 then strOut = strOut & strZero
    end select
    if ((intTseg - i) > 0) and (intA > 0) then
      strOut = strOut & strExp3(intTseg - i) & strAppend
    end if
  next
  strNum = format(val(right(strNum,2)),"#")
  if val(strNum)>0 then strOut = strOut & " " & strNum & "/100"
  return strOut
end function

public function NumberInWordsEN( Number as double ) as string
  Dim strNum as string
  Dim sglNumber as double
  Dim strOut as string
  Dim i as integer
  Dim intA as integer , intB as integer
  Dim intTSeg as integer
  Dim strFormat as string
  Dim strAppend as string
  Dim strZero as string
  Dim strLower20(1 to 19) as string
  Dim strTenth(1 to 10) as string
  Dim strExp3(1 to 4) as string
  Dim strOneExt(1 to 4, 1 to 2) as string
  Dim strTenthIn as string
  Dim strHundIn as string
  Dim bolTenthMode as boolean = true
  strZero = "zero"
  strLower20(1) = "one "
  strLower20(2) = "two "
  strLower20(3) = "three " 
  strLower20(4) = "four " 
  strLower20(5) = "five " 
  strLower20(6) = "six " 
  strLower20(7) = "seven " 
  strLower20(8) = "eight " 
  strLower20(9) = "nine " 
  strLower20(10) = "ten " 
  strLower20(11) = "eleven " 
  strLower20(12) = "twelve "
  strLower20(13) = "thirteen " 
  strLower20(14) = "fourteen " 
  strLower20(15) = "fifteen " 
  strLower20(16) = "sixteen " 
  strLower20(17) = "seventeen " 
  strLower20(18) = "eighteen " 
  strLower20(19) = "nineteen " 
  strTenth(1) = "ten" 
  strTenth(2) = "twenty"
  strTenth(3) = "thirty" 
  strTenth(4) = "forty" 
  strTenth(5) = "fifty" 
  strTenth(6) = "sixty" 
  strTenth(7) = "seventy" 
  strTenth(8) = "eighty" 
  strTenth(9) = "ninety" 
  strTenth(10) = "hundred"
  strExp3(1) = "thousand"
  strExp3(2) = "million"
  strExp3(3) = "billion"
  strExp3(4) = "trillion"
  strOneExt(1,1) = ""
  strOneExt(1,2) = ""
  strOneExt(2,1) = ""
  strOneExt(2,2) = ""
  strOneExt(3,1) = ""
  strOneExt(3,2) = ""
  strOneExt(4,1) = ""
  strOneExt(4,2) = ""
  strOneExt(4,1) = ""
  strOneExt(4,2) = "" 
  strTenthIn = "-"
  strHundIn = " and "
  strOut = ""

  sglNumber = abs(Number)
 
  intTSeg = int(int(log(sglNumber)/log(10))/3+1)
  strFormat = fill(strFormat,"#",intTSeg*3) & ".##"
  strNum = Format(sglNumber,strFormat," ",True)
 
  if (intTseg > 3) or (intTseg < 1) then
    return("???????????????")
    exit sub
  end if
 
  for i = 1 to intTSeg
    strAppend = strOneExt(intTSeg - i + 1, 2)
    intA = val(left(strNum,3))
    strNum = right(strNum,len(strNum)-3)
    if (strOut <> "") and (intA>99) then strOut = strOut & strHundIn
    if intA > 99 then strOut = strOut & strLower20(int(intA)/100) & strTenth(10)
    intB = intA mod 100
    if (strOut <> "") and (intB >0) then strOut = strOut & strHundIn
    select intB
      case 20 to 99:
        if bolTenthMode = True then
          strOut = strOut & strTenth(int(intB / 10))
          if (intB mod 10) > 0 then strOut = strOut & strTenthIn & strLower20(intB mod 10)
        else
          if (intB mod 10) > 0 then strOut = strOut & strLower20(intB mod 10) & strTenthIn
          strOut = strOut & strTenth(int(intB / 10))
        end if 
      case 2 to 19:
        strOut = strOut & strLower20(intB)
      case 1:
        strOut = strOut & strLower20(intB) & strOneExt(intTSeg - i + 1,1)
        strAppend = ""
      case 0:
        if int(sglNumber)=0 then strOut = strOut & strZero
    end select
    if ((intTseg - i) > 0) and (intA > 0) then
      strOut = strOut & strExp3(intTseg - i) & strAppend
    end if
  next
  strNum = format(val(right(strNum,2)),"#")
  if val(strNum)>0 then strOut = strOut & " " & strNum & "/100"
  return strOut
end function

public function NumberInWordsESP( Number as double ) as string
  Dim strNum as string
  Dim sglNumber as double
  Dim strOut as string
  Dim i as integer
  Dim intA as integer , intB as integer
  Dim intTSeg as integer
  Dim strFormat as string
  Dim strAppend as string
  Dim strZero as string
  Dim strLower20(1 to 29) as string
  Dim strTenth(1 to 10) as string
  Dim strExp3(1 to 4) as string
  Dim strOneExt(1 to 4, 1 to 2) as string
  Dim strTenthIn as string
  Dim strHundIn as string
  Dim bolTenthMode as boolean = true
  strZero = "cero"
  strLower20(1) = "un "
  strLower20(2) = "dos "
  strLower20(3) = "tres " 
  strLower20(4) = "cuatro " 
  strLower20(5) = "cinco " 
  strLower20(6) = "seis " 
  strLower20(7) = "siete " 
  strLower20(8) = "ocho " 
  strLower20(9) = "nueve " 
  strLower20(10) = "diez " 
  strLower20(11) = "once " 
  strLower20(12) = "doce "
  strLower20(13) = "trece " 
  strLower20(14) = "catorce " 
  strLower20(15) = "quince " 
  strLower20(16) = "dieciseis " 
  strLower20(17) = "diecisiete " 
  strLower20(18) = "dieciocho " 
  strLower20(19) = "diecinueve " 
  strLower20(20) = "veinte "
  strLower20(21) = "veintiuno "
  strLower20(22) = "veintidos "
  strLower20(23) = "veintitres " 
  strLower20(24) = "veinticuatro " 
  strLower20(25) = "veinticinco " 
  strLower20(26) = "veintiseis " 
  strLower20(27) = "veintisiete " 
  strLower20(28) = "veintiocho " 
  strLower20(29) = "veintinueve " 
  strLower20(10) = "diez " 
  strLower20(11) = "once " 
  strLower20(12) = "doce "
  strLower20(13) = "trece " 
  strLower20(14) = "catorce " 
  strLower20(15) = "quince " 
  strLower20(16) = "dieciseis " 
  strLower20(17) = "diecisiete " 
  strLower20(18) = "dieciocho " 
  strLower20(19) = "diecinueve " 
  strTenth(1) = "diez" 
  strTenth(2) = "veinte"
  strTenth(3) = "treinta" 
  strTenth(4) = "cuarenta" 
  strTenth(5) = "cincuenta" 
  strTenth(6) = "sesenta" 
  strTenth(7) = "setenta" 
  strTenth(8) = "ochenta" 
  strTenth(9) = "noventa" 
  strTenth(10) = "cien"
  strExp3(1) = "mil"
  strExp3(2) = "million"
  strExp3(3) = "mil milliones"
  strExp3(4) = "billion"
  strOneExt(1,1) = "o "
  strOneExt(1,2) = ""
  strOneExt(2,1) = " "
  strOneExt(2,2) = ""
  strOneExt(3,1) = " "
  strOneExt(3,2) = "es"
  strOneExt(4,1) = " "
  strOneExt(4,2) = ""
  strOneExt(4,1) = " "
  strOneExt(4,2) = "es" 
  strTenthIn = " y "
  strHundIn = " "
  strOut = ""

  sglNumber = abs(Number)
 
  intTSeg = int(int(log(sglNumber)/log(10))/3+1)
  strFormat = fill(strFormat,"#",intTSeg*3) & ".##"
  strNum = Format(sglNumber,strFormat," ",True)
 
  if (intTseg > 3) or (intTseg < 1) then
    return("???????????????")
    exit sub
  end if
 
  for i = 1 to intTSeg
    strAppend = strOneExt(intTSeg - i + 1, 2)
    intA = val(left(strNum,3))
    strNum = right(strNum,len(strNum)-3)
    if (strOut <> "") and (intA>99) then strOut = strOut & strHundIn
    if intA > 99 then strOut = strOut & strLower20(int(intA)/100) & strTenth(10)
    intB = intA mod 100
    if (strOut <> "") and (intB >0) then strOut = strOut & strHundIn
    select intB
      case 30 to 99:
        if bolTenthMode = True then
          strOut = strOut & strTenth(int(intB / 10))
          if (intB mod 10) > 0 then strOut = strOut & strTenthIn & strLower20(intB mod 10)
        else
          if (intB mod 10) > 0 then strOut = strOut & strLower20(intB mod 10) & strTenthIn
          strOut = strOut & strTenth(int(intB / 10))
        end if 
      case 2 to 29:
        strOut = strOut & strLower20(intB)
      case 1:
        strOut = strOut & trim(strLower20(intB)) & strOneExt(intTSeg - i + 1,1)
        strAppend = ""
      case 0:
        if int(sglNumber)=0 then strOut = strOut & strZero
    end select
    if ((intTseg - i) > 0) and (intA > 0) then
      strOut = strOut & strExp3(intTseg - i) & strAppend
    end if
  next
  strNum = format(val(right(strNum,2)),"#")
  if val(strNum)>0 then strOut = strOut & " " & strNum & "/100"
  return strOut
end function

Dim sglA as double
for i as integer = 1145025 to 1145035
sglA = i + 0.21
print( sglA )
print( NumberInWordsEN(sglA) )
print( NumberInWordsDE(sglA) )
print( NumberInWordsESP(sglA) )
next

[Slowdown]

@pappawinni

And again a nice one.
I was looking at your code and find myself thinking how does some make up something like that ?
one small error pappawinni in the english part 'thausend' must be thousand
Thanks for sharing.

[pappawinni]

thx Slowdown, this i did not realize, strange, but I corrected now.
On the other hand... its just an example....
...and the idea for this example came from a thread (in portoguese I think) I found.
Don't remember the topic but I interpreted form google
translator that this user was looking for a function like this. Who knows.

"ola sera q alguem pode me ajudar estou precisando escrever numeros por extensso com o kbasic"

[pappawinni]

User PMan was looking for the function strconv() to convert a string to a unicode byte array and vice versa.
As this function is not implemented in KBasic, here a proposal as work around:

Code: Select all

function f_Str2Unicode( strChar as String , byRef arrByte[] as byte ) as boolean
/*
emulation of VB function strconv() for Option vbUnicode
but here the byte array holding the return values must be a parameter and the number
of its elements should be 4 times the length of the string to convert.
The functions return value just indicates if an error occured (false) or not (true).
W. Oestreicher
*/
 

   dim arrB() as byte
   dim strUtf as string
   dim intLstr as integer , intBound as integer
   dim i as integer, j as integer
   
   on error goto myerr

   intLstr = len(strChar)

   redim arrB(intLstr * 4 - 1 )
   
   If Ubound(arrByte) < Ubound(arrB) then
     intBound = Ubound(arrByte)
   else
     intBound = Ubound(arrB)
   end if

   J=0
   
   For i = 1 to intLstr
     
     strUtf = Utf8(mid(strChar,i,1))
     J = ( i - 1 ) * 4
     select case len(strUtf)
       case 1:
         arrB[ j     ] = ( asc(strUtf) and 127 )
         arrB[ J + 1 ] = 0
         arrB[ J + 2 ] = 0
       case 2:
         arrB[ j     ] = (asc(mid(strUtf,2)) and 63)      + (asc(mid(strUtf,1)) and 3 ) * 64
         arrB[ J + 1 ] = (asc(mid(strUtf,1)) and 28) \ 4
         arrB[ J + 2 ] = 0
       case 3:   
         arrB[ j     ] = (asc(mid(strUtf,3)) and 63)       + (asc(mid(strUtf,2)) and 3 ) * 64
         arrB[ J + 1 ] = (asc(mid(strUtf,2)) and 60) \ 4   + (asc(mid(strUtf,1)) and 15) * 16
         arrB[ J + 2 ] = 0
       case 4:       
         arrB[ j     ] = (asc(mid(strUtf,4)) and 63)       + (asc(mid(strUtf,3)) and 3 ) * 64
         arrB[ J + 1 ] = (asc(mid(strUtf,3)) and 60) \ 4   + (asc(mid(strUtf,2)) and 15) * 16
         arrB[ J + 2 ] = (asc(mid(strUtf,2)) and 48) \ 16  + (asc(mid(strUtf,1)) and 7 ) * 8
       case else
         arrB[ J ] = 0 : arrB[ J + 1 ] = 0 : arrB[ J + 2 ] = 0
     end select
     arrB[ J + 3 ] = 0
   next
   for i = 0 to intBound
     arrByte[i]=arrB[i]
   next
   return true
   exit function
myerr:
   return false
end function



function f_Unicode2Str( ByRef aByte[] as byte) as string
/*
emulation of VB function strconv() for Option vbFromUnicode
but here the Parameter must be an array of bytes
w.Oestreicher
*/

Dim sC as CString
Dim sC1 as CString , sC2 as CString , sC3 as CString , sC4 as CString
Dim sOut as String
Dim iLstr as Integer , iBound as Integer
Dim i as Integer, j as Integer

on error goto myerr

   iBound = Ubound(aByte)
   J      = Lbound(aByte)
   iLstr  = (iBound-J+1) \ 4

   For i = 1 to iLstr
     sC = ""     
     If aByte[j+2] > 0 Then
       '4Byte Utf8
       sc1 = Utf16(Chr((aByte[j+2] AND 28 )  \ 4                              + 240),1)
       sc2 = Utf16(Chr((aByte[j+2] AND 3  )  * 16 + (aByte[j+1] AND 240) \ 16 + 128),1)
       sc3 = Utf16(Chr((aByte[j+1] AND 15 )  * 4  + (aByte[j]   AND 192) \ 64 + 128),1)
       sc4 = Utf16(Chr((aByte[j]   AND 63 )                                   + 128),1)
       sc = sc1 & sc2 & sc3 & sc4
     ElseIf aByte[j+1] > 7 Then
       '3Byte Utf8
       sc1 = Utf16(chr((aByte[j+1] AND 240)  \ 16                             + 224),1)
       sc2 = Utf16(chr((aByte[j+1] AND 15 )  * 4  + (aByte[j]   AND 192) \ 64 + 128),1)
       sc3 = Utf16(chr((aByte[j]   AND 63 )                                   + 128),1)
       sc = sc1 & sc2 & sc3
     ElseIf (aByte[j+1] > 0) or (aByte[j]>127) Then
       '2Byte Utf8
       sc1 = Utf16(Chr((aByte[j+1] AND 7  )  * 4  + (aByte[j]   AND 192) \ 64 + 192),1)
       sc2 = Utf16(Chr((aByte[j]   AND 63 )                                   + 128),1)
       sc = sc1 & sc2
     Else
       '1Byte Utf8
       sc = Utf16(Chr(aByte[j] AND 127),1)
     EndIf
     sOut = sOut & Utf8(sC)
     j = j + 4   
   Next i
   
   Return sOut
   exit function
myerr:
   return ""
end function



sub showByteArray( arrByte[] as byte , bolHex as boolean = True )
  Dim I as integer , J as integer
  j=0
  for i = LBound(arrByte) to ubound(arrByte)
     ? iif(bolHex, Right("00"& Hex(arrByte[i]),2), arrByte[i]),
     j = iif(j=3,0,j+1)
     if j = 0 then ?
  next 
end sub


sub Main()
Dim strC as string, strA as String
Dim arrA[] as byte
Dim i as integer, j as integer

'strC = "±ðþA?DZABCdef*ä"
'strC = "المملكة العربية السعودية"
'strC = "ஏறத்தாழ நான்"
strC = "中國 / 中国, 秦始皇帝횊픎"
? strC

Redim arrA(len(strC)*4-1)
f_Str2Unicode(strC,arrA)
showByteArray( arrA )

strC=f_Unicode2Str(arrA)
? strC


end sub


main()