Code: Select all
// -------------------------------------------------------------------------- //
Function NumToLe( nImporte )
Local cRes := ""
Local nEntero := Int( nImporte )
Local nCentavos := Round( ( nImporte - nEntero ) * 100, 0 )
Local aGrupos := {}
Local i, nBloque
If nEntero == 0
cRes := "CERO"
Else
// Dividimos en bloques de 3 dígitos (Unidades, Miles, Millones, Mil Millones, Billones)
Do While nEntero > 0
AAdd( aGrupos, nEntero % 1000 )
nEntero := Int( nEntero / 1000 )
EndDo
For i := Len( aGrupos ) To 1 Step -1
nBloque := aGrupos[i]
If nBloque == 0 .And. i != 3 // No procesar bloques vacíos excepto lógica de millones
Loop
EndIf
// Lógica para el "Mil" (i=2 o i=4 o i=6...)
If ( i == 2 .Or. i == 4 .Or. i == 6 ) .And. nBloque == 1
cRes += "MIL "
Else
cRes += ConvertirBloque( nBloque, i )
// Sufijos de Magnitud
Do Case
Case i == 2 .Or. i == 4 .Or. i == 6
cRes += "MIL "
Case i == 3
cRes += If( nBloque == 1, "MILLON ", "MILLONES " )
Case i == 5
cRes += If( nBloque == 1, "BILLON ", "BILLONES " )
EndCase
EndIf
Next
EndIf
// Limpieza de redundancias gramaticales
cRes := AllTrim( cRes )
cRes := StrTran( cRes, "MIL MILLONES", "MIL MILLONES" ) // Estándar
Return cRes + " PESOS CON " + PadL( AllTrim(Str(nCentavos)), 2, "0") + "/100 M/L."
// -------------------------------------------------------------------------- //
Static Function ConvertirBloque( n, nPosicion )
Local cText := ""
Local nCen := Int( n / 100 )
Local nDec := Int( ( n % 100 ) / 10 )
Local nUni := n % 10
// Centenas
Do Case
Case nCen == 1 ; cText += If( nDec == 0 .And. nUni == 0, "CIEN ", "CIENTO " )
Case nCen == 2 ; cText += "DOSCIENTOS "
Case nCen == 3 ; cText += "TRESCIENTOS "
Case nCen == 4 ; cText += "CUATROCIENTOS "
Case nCen == 5 ; cText += "QUINIENTOS "
Case nCen == 6 ; cText += "SEISCIENTOS "
Case nCen == 7 ; cText += "SETECIENTOS "
Case nCen == 8 ; cText += "OCHOCIENTOS "
Case nCen == 9 ; cText += "NOVECIENTOS "
EndCase
// Decenas y Unidades
Do Case
Case nDec == 1
Do Case
Case nUni == 0 ; cText += "DIEZ "
Case nUni == 1 ; cText += "ONCE "
Case nUni == 2 ; cText += "DOCE "
Case nUni == 3 ; cText += "TRECE "
Case nUni == 4 ; cText += "CATORCE "
Case nUni == 5 ; cText += "QUINCE "
Case nUni > 5 ; cText += "DIECI" + Unidades( nUni )
EndCase
Case nDec == 2
cText += If( nUni == 0, "VEINTE ", "VEINTI" + Unidades( nUni ) )
Case nDec > 2
cText += Decenas( nDec )
If nUni > 0 ; cText += "Y " + Unidades( nUni ) ; EndIf
Case nDec == 0
If nUni > 0
// Evitar "UN MILLONES", debe ser "UN MILLON" manejado en el sufijo
cText += Unidades( nUni )
EndIf
EndCase
Return cText
Static Function Unidades( n )
Local aU := { "UN ", "DOS ", "TRES ", "CUATRO ", "CINCO ", "SEIS ", "SIETE ", "OCHO ", "NUEVE " }
Return aU[n]
Static Function Decenas( n )
Local aD := { "", "", "TREINTA ", "CUARENTA ", "CINCUENTA ", "SESENTA ", "SETENTA ", "OCHENTA ", "NOVENTA " }
Return aD[n]
Code: Select all
// -------------------------------------------------------------------------- //
Function NumToLe( nImporte )
Local cRes := ""
Local nEntero := Int( nImporte )
Local nCentavos := Round( ( nImporte - nEntero ) * 100, 0 )
Local aGrupos := {}
Local i, nBloque
If nEntero == 0
cRes := "CERO"
Else
// Dividimos en bloques de 3 dígitos (Unidades, Miles, Millones, Mil Millones, Billones)
Do While nEntero > 0
AAdd( aGrupos, nEntero % 1000 )
nEntero := Int( nEntero / 1000 )
EndDo
For i := Len( aGrupos ) To 1 Step -1
nBloque := aGrupos[i]
If nBloque == 0 .And. i != 3 // No procesar bloques vacíos excepto lógica de millones
Loop
EndIf
// Lógica para el "Mil" (i=2 o i=4 o i=6...)
If ( i == 2 .Or. i == 4 .Or. i == 6 ) .And. nBloque == 1
cRes += "MIL "
Else
cRes += ConvertirBloque( nBloque, i )
// Sufijos de Magnitud
Do Case
Case i == 2 .Or. i == 4 .Or. i == 6
cRes += "MIL "
Case i == 3
cRes += If( nBloque == 1, "MILLON ", "MILLONES " )
Case i == 5
cRes += If( nBloque == 1, "BILLON ", "BILLONES " )
EndCase
EndIf
Next
EndIf
// Limpieza de redundancias gramaticales
cRes := AllTrim( cRes )
cRes := StrTran( cRes, "MIL MILLONES", "MIL MILLONES" ) // Estándar
Return cRes + " PESOS CON " + PadL( AllTrim(Str(nCentavos)), 2, "0") + "/100 M/L."
// -------------------------------------------------------------------------- //
Static Function ConvertirBloque( n, nPosicion )
Local cText := ""
Local nCen := Int( n / 100 )
Local nDec := Int( ( n % 100 ) / 10 )
Local nUni := n % 10
// Centenas
Do Case
Case nCen == 1 ; cText += If( nDec == 0 .And. nUni == 0, "CIEN ", "CIENTO " )
Case nCen == 2 ; cText += "DOSCIENTOS "
Case nCen == 3 ; cText += "TRESCIENTOS "
Case nCen == 4 ; cText += "CUATROCIENTOS "
Case nCen == 5 ; cText += "QUINIENTOS "
Case nCen == 6 ; cText += "SEISCIENTOS "
Case nCen == 7 ; cText += "SETECIENTOS "
Case nCen == 8 ; cText += "OCHOCIENTOS "
Case nCen == 9 ; cText += "NOVECIENTOS "
EndCase
// Decenas y Unidades
Do Case
Case nDec == 1
Do Case
Case nUni == 0 ; cText += "DIEZ "
Case nUni == 1 ; cText += "ONCE "
Case nUni == 2 ; cText += "DOCE "
Case nUni == 3 ; cText += "TRECE "
Case nUni == 4 ; cText += "CATORCE "
Case nUni == 5 ; cText += "QUINCE "
Case nUni > 5 ; cText += "DIECI" + Unidades( nUni )
EndCase
Case nDec == 2
cText += If( nUni == 0, "VEINTE ", "VEINTI" + Unidades( nUni ) )
Case nDec > 2
cText += Decenas( nDec )
If nUni > 0 ; cText += "Y " + Unidades( nUni ) ; EndIf
Case nDec == 0
If nUni > 0
// Evitar "UN MILLONES", debe ser "UN MILLON" manejado en el sufijo
cText += Unidades( nUni )
EndIf
EndCase
Return cText
Static Function Unidades( n )
Local aU := { "UN ", "DOS ", "TRES ", "CUATRO ", "CINCO ", "SEIS ", "SIETE ", "OCHO ", "NUEVE " }
Return aU[n]
Static Function Decenas( n )
Local aD := { "", "", "TREINTA ", "CUARENTA ", "CINCUENTA ", "SESENTA ", "SETENTA ", "OCHENTA ", "NOVENTA " }
Return aD[n]
Code: Select all
PROCEDURE NUM_LET
set color to w/b,r/n
parameters NOMBRE,LETTRES
*--paramŠtres : NOMBRE :nombre à convertir
* LETTRES :resultat en toutes lettres
* -- initialisations
LETTRES=""
XLN = int(NOMBRE) && seule la partie entiere est convertie
if NOMBRE > 1000000000
* -- debordement de capacite
return
endif
if XLN = 0
* -- cas particulier du zero
LETTRES = "ZERO"
return
endif
* -- cas general
if XLN >1000000
XCH = str(XLN,9,0)
else
XCH = str(XLN,6,0)
endif
XLPOS = 1
* -- boucle executee pour les milles et pour les unites
do while XLN>0
if XLN >1000000
XLPARTIE = HB_USUBSTR(XCH,1,6)
else
XLPARTIE = HB_USUBSTR(XCH,XLPOS,3)
if XLPARTIE = space(3)
XLPARTIE = HB_USUBSTR(XCH,4,3)
endif
endif
XLCEN = HB_USUBSTR(XLPARTIE,1,1) && centaines
XLDIZ = HB_USUBSTR(XLPARTIE,2,1) && dizaines
XLUNI = HB_USUBSTR(XLPARTIE,3,1) && unites
XLV = val(XLCEN)
do case && cas des centaines
case XLV = 1
LETTRES = LETTRES + " CENT "
case XLV > 1
LETTRES = LETTRES + XN&XLCEN + " CENT "
endcase
XLV = val(XLDIZ)
XLET = iif(XLUNI="1"," ET "," ")
do case && cas des dizaines et unites
case XLV = 0
LETTRES = LETTRES + XN&XLUNI
case XLV = 1
LETTRES = LETTRES + XN1&XLUNI
case XLV = 7
LETTRES = LETTRES + XN60 + XLET + XN1&XLUNI
case XLV = 8
LETTRES = LETTRES + XN80 + ' ' + XN&XLUNI
case XLV = 9
LETTRES = LETTRES + XN80 + XLET + XN1&XLUNI
otherwise
LETTRES = LETTRES + XN&XLDIZ.0 + XLET + XN&XLUNI
endcase
if XLN>=1000000
* correction des millions
do case
case XLN >= 2000000
LETTRES = LETTRES + ' MILLIONS '
case XLN >=1000000
LETTRES = 'UN MILLION '
endcase
else
* -- correction des milliers
do case
case XLN >= 2000
LETTRES = LETTRES + ' MILLE '
case XLN >=1000
LETTRES = 'MILLE '
endcase
endif
if XLN>=1000000
XLN =XLN-(int(XLN/1000000))*1000000
XCH = str(XLN,6,0)
else
XLN = int(XLN/1000)
XLPOS = 4
endif
enddo
store lettres to xlettres
return
]]>Code: Select all
PROCEDURE NUM_LET
set color to w/b,r/n
parameters NOMBRE,LETTRES
*--paramŠtres : NOMBRE :nombre à convertir
* LETTRES :resultat en toutes lettres
* -- initialisations
LETTRES=""
XLN = int(NOMBRE) && seule la partie entiere est convertie
if NOMBRE > 1000000000
* -- debordement de capacite
return
endif
if XLN = 0
* -- cas particulier du zero
LETTRES = "ZERO"
return
endif
* -- cas general
if XLN >1000000
XCH = str(XLN,9,0)
else
XCH = str(XLN,6,0)
endif
XLPOS = 1
* -- boucle executee pour les milles et pour les unites
do while XLN>0
if XLN >1000000
XLPARTIE = HB_USUBSTR(XCH,1,6)
else
XLPARTIE = HB_USUBSTR(XCH,XLPOS,3)
if XLPARTIE = space(3)
XLPARTIE = HB_USUBSTR(XCH,4,3)
endif
endif
XLCEN = HB_USUBSTR(XLPARTIE,1,1) && centaines
XLDIZ = HB_USUBSTR(XLPARTIE,2,1) && dizaines
XLUNI = HB_USUBSTR(XLPARTIE,3,1) && unites
XLV = val(XLCEN)
do case && cas des centaines
case XLV = 1
LETTRES = LETTRES + " CENT "
case XLV > 1
LETTRES = LETTRES + XN&XLCEN + " CENT "
endcase
XLV = val(XLDIZ)
XLET = iif(XLUNI="1"," ET "," ")
do case && cas des dizaines et unites
case XLV = 0
LETTRES = LETTRES + XN&XLUNI
case XLV = 1
LETTRES = LETTRES + XN1&XLUNI
case XLV = 7
LETTRES = LETTRES + XN60 + XLET + XN1&XLUNI
case XLV = 8
LETTRES = LETTRES + XN80 + ' ' + XN&XLUNI
case XLV = 9
LETTRES = LETTRES + XN80 + XLET + XN1&XLUNI
otherwise
LETTRES = LETTRES + XN&XLDIZ.0 + XLET + XN&XLUNI
endcase
if XLN>=1000000
* correction des millions
do case
case XLN >= 2000000
LETTRES = LETTRES + ' MILLIONS '
case XLN >=1000000
LETTRES = 'UN MILLION '
endcase
else
* -- correction des milliers
do case
case XLN >= 2000
LETTRES = LETTRES + ' MILLE '
case XLN >=1000
LETTRES = 'MILLE '
endcase
endif
if XLN>=1000000
XLN =XLN-(int(XLN/1000000))*1000000
XCH = str(XLN,6,0)
else
XLN = int(XLN/1000)
XLPOS = 4
endif
enddo
store lettres to xlettres
return
]]>Code: Select all
Function SpellNumber( nMyNumber )
Local cDollars := "", cCents := ""
Local cTemp
Local nDecimalPlace, nCount := 1
Local aPlace := { "", " Thousand ", " Million ", " Billion ", " Trillion " }
Local cStrNumber := AllTrim( Str( nMyNumber, 18, 2 ) )
nDecimalPlace := At( ".", cStrNumber )
// Convert cents
If nDecimalPlace > 0
cCents := GetTens( SubStr( cStrNumber, nDecimalPlace + 1 ) )
cStrNumber := AllTrim( Left( cStrNumber, nDecimalPlace - 1 ) )
EndIf
Do While !Empty( cStrNumber )
cTemp := GetHundreds( Right( cStrNumber, 3 ) )
If !Empty( cTemp )
cDollars := cTemp + aPlace[ nCount ] + cDollars
EndIf
If Len( cStrNumber ) > 3
cStrNumber := Left( cStrNumber, Len( cStrNumber ) - 3 )
Else
cStrNumber := ""
EndIf
nCount ++
EndDo
/* Descomentar para dolares y centavos
// Clean up Dollars
Do Case
Case Empty( cDollars )
cDollars := "No Dollars"
Case AllTrim( cDollars ) == "One"
cDollars := "One Dollar"
Otherwise
cDollars := AllTrim( cDollars ) + " Dollars"
EndCase
// Clean up Cents
Do Case
Case Empty( cCents )
cCents := " and No Cents"
Case AllTrim( cCents ) == "One"
cCents := " and One Cent"
Otherwise
cCents := " and " + AllTrim( cCents ) + " Cents"
EndCase
*/
Return cDollars + cCents
Function GetHundreds( cMyNumber )
Local cResult := ""
If Val( cMyNumber ) == 0 ; Return "" ; EndIf
cMyNumber := PadL( AllTrim( cMyNumber ), 3, "0" )
// Convert the hundreds place
If SubStr( cMyNumber, 1, 1 ) != "0"
cResult := GetDigit( SubStr( cMyNumber, 1, 1 ) ) + " Hundred "
EndIf
// Convert the tens and ones place
If SubStr( cMyNumber, 2, 1 ) != "0"
cResult += GetTens( SubStr( cMyNumber, 2 ) )
Else
cResult += GetDigit( SubStr( cMyNumber, 3 ) )
EndIf
Return cResult
Function GetTens( cTensText )
Local cResult := ""
If Val( Left( cTensText, 1 ) ) == 1
Do Case
Case Val( cTensText ) == 10 ; cResult := "Ten"
Case Val( cTensText ) == 11 ; cResult := "Eleven"
Case Val( cTensText ) == 12 ; cResult := "Twelve"
Case Val( cTensText ) == 13 ; cResult := "Thirteen"
Case Val( cTensText ) == 14 ; cResult := "Fourteen"
Case Val( cTensText ) == 15 ; cResult := "Fifteen"
Case Val( cTensText ) == 16 ; cResult := "Sixteen"
Case Val( cTensText ) == 17 ; cResult := "Seventeen"
Case Val( cTensText ) == 18 ; cResult := "Eighteen"
Case Val( cTensText ) == 19 ; cResult := "Nineteen"
EndCase
Else
Do Case
Case Val( Left( cTensText, 1 ) ) == 2 ; cResult := "Twenty "
Case Val( Left( cTensText, 1 ) ) == 3 ; cResult := "Thirty "
Case Val( Left( cTensText, 1 ) ) == 4 ; cResult := "Forty "
Case Val( Left( cTensText, 1 ) ) == 5 ; cResult := "Fifty "
Case Val( Left( cTensText, 1 ) ) == 6 ; cResult := "Sixty "
Case Val( Left( cTensText, 1 ) ) == 7 ; cResult := "Seventy "
Case Val( Left( cTensText, 1 ) ) == 8 ; cResult := "Eighty "
Case Val( Left( cTensText, 1 ) ) == 9 ; cResult := "Ninety "
EndCase
cResult += GetDigit( Right( cTensText, 1 ) )
EndIf
Return cResult
Static Function GetDigit( cDigit )
Local aDigits := { "One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight", "Nine" }
Local nPos := Val( cDigit )
Return If( nPos > 0, aDigits[ nPos ], "" )
Code: Select all
Function SpellNumber( nMyNumber )
Local cDollars := "", cCents := ""
Local cTemp
Local nDecimalPlace, nCount := 1
Local aPlace := { "", " Thousand ", " Million ", " Billion ", " Trillion " }
Local cStrNumber := AllTrim( Str( nMyNumber, 18, 2 ) )
nDecimalPlace := At( ".", cStrNumber )
// Convert cents
If nDecimalPlace > 0
cCents := GetTens( SubStr( cStrNumber, nDecimalPlace + 1 ) )
cStrNumber := AllTrim( Left( cStrNumber, nDecimalPlace - 1 ) )
EndIf
Do While !Empty( cStrNumber )
cTemp := GetHundreds( Right( cStrNumber, 3 ) )
If !Empty( cTemp )
cDollars := cTemp + aPlace[ nCount ] + cDollars
EndIf
If Len( cStrNumber ) > 3
cStrNumber := Left( cStrNumber, Len( cStrNumber ) - 3 )
Else
cStrNumber := ""
EndIf
nCount ++
EndDo
/* Descomentar para dolares y centavos
// Clean up Dollars
Do Case
Case Empty( cDollars )
cDollars := "No Dollars"
Case AllTrim( cDollars ) == "One"
cDollars := "One Dollar"
Otherwise
cDollars := AllTrim( cDollars ) + " Dollars"
EndCase
// Clean up Cents
Do Case
Case Empty( cCents )
cCents := " and No Cents"
Case AllTrim( cCents ) == "One"
cCents := " and One Cent"
Otherwise
cCents := " and " + AllTrim( cCents ) + " Cents"
EndCase
*/
Return cDollars + cCents
Function GetHundreds( cMyNumber )
Local cResult := ""
If Val( cMyNumber ) == 0 ; Return "" ; EndIf
cMyNumber := PadL( AllTrim( cMyNumber ), 3, "0" )
// Convert the hundreds place
If SubStr( cMyNumber, 1, 1 ) != "0"
cResult := GetDigit( SubStr( cMyNumber, 1, 1 ) ) + " Hundred "
EndIf
// Convert the tens and ones place
If SubStr( cMyNumber, 2, 1 ) != "0"
cResult += GetTens( SubStr( cMyNumber, 2 ) )
Else
cResult += GetDigit( SubStr( cMyNumber, 3 ) )
EndIf
Return cResult
Function GetTens( cTensText )
Local cResult := ""
If Val( Left( cTensText, 1 ) ) == 1
Do Case
Case Val( cTensText ) == 10 ; cResult := "Ten"
Case Val( cTensText ) == 11 ; cResult := "Eleven"
Case Val( cTensText ) == 12 ; cResult := "Twelve"
Case Val( cTensText ) == 13 ; cResult := "Thirteen"
Case Val( cTensText ) == 14 ; cResult := "Fourteen"
Case Val( cTensText ) == 15 ; cResult := "Fifteen"
Case Val( cTensText ) == 16 ; cResult := "Sixteen"
Case Val( cTensText ) == 17 ; cResult := "Seventeen"
Case Val( cTensText ) == 18 ; cResult := "Eighteen"
Case Val( cTensText ) == 19 ; cResult := "Nineteen"
EndCase
Else
Do Case
Case Val( Left( cTensText, 1 ) ) == 2 ; cResult := "Twenty "
Case Val( Left( cTensText, 1 ) ) == 3 ; cResult := "Thirty "
Case Val( Left( cTensText, 1 ) ) == 4 ; cResult := "Forty "
Case Val( Left( cTensText, 1 ) ) == 5 ; cResult := "Fifty "
Case Val( Left( cTensText, 1 ) ) == 6 ; cResult := "Sixty "
Case Val( Left( cTensText, 1 ) ) == 7 ; cResult := "Seventy "
Case Val( Left( cTensText, 1 ) ) == 8 ; cResult := "Eighty "
Case Val( Left( cTensText, 1 ) ) == 9 ; cResult := "Ninety "
EndCase
cResult += GetDigit( Right( cTensText, 1 ) )
EndIf
Return cResult
Static Function GetDigit( cDigit )
Local aDigits := { "One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight", "Nine" }
Local nPos := Val( cDigit )
Return If( nPos > 0, aDigits[ nPos ], "" )
Code: Select all
FOR A := 9999 TO 9999999 STEP 19
? A, a/100, AmountToWordsBE_Cent( A )
NEXT
MSGINFO('Ready')
FUNCTION AmountToWordsBE_Cent( nCent )
/*************************************/
LOCAL lNegatief := .F.
LOCAL nEuro, nRest
LOCAL cResult
IF !HB_ISNUMERIC( nCent )
RETURN ""
ENDIF
IF nCent < 0
lNegatief := .T.
nCent := ABS( nCent )
ENDIF
nEuro := INT( nCent / 100 )
nRest := nCent % 100
cResult := NumToWordsNL( nEuro ) + " euro"
IF nRest > 0
cResult += " en " + NumToWordsNL( nRest ) + " cent"
ENDIF
IF lNegatief
cResult := "min " + cResult
ENDIF
cResult := strtran(cResult, 'nul euro en ', '')
RETURN cResult
FUNCTION NumToWordsNL( n )
/**************************/
LOCAL aEen := { ;
"", "een", "twee", "drie", "vier", "vijf", "zes", "zeven", "acht", "negen", ;
"tien", "elf", "twaalf", "dertien", "veertien", "vijftien", ;
"zestien", "zeventien", "achttien", "negentien" }
LOCAL aTien := { ;
"", "", "twintig", "dertig", "veertig", "vijftig", ;
"zestig", "zeventig", "tachtig", "negentig" }
LOCAL c := ""
LOCAL nMil, nDui, n100, n10, n1
IF n == 0
RETURN "nul"
ENDIF
* miljoenen
IF n >= 1000000
nMil := INT( n / 1000000 )
c := NumToWordsNL( nMil ) + ;
IF( nMil == 1, " miljoen", " miljoen" )
n := n % 1000000
IF n > 0
c += " " + NumToWordsNL( n )
ENDIF
RETURN c
ENDIF
* duizenden
IF n >= 1000
nDui := INT( n / 1000 )
IF nDui == 1
c := "duizend"
ELSE
c := NumToWordsNL( nDui ) + " duizend"
ENDIF
n := n % 1000
IF n > 0
c += " " + NumToWordsNL( n )
ENDIF
RETURN c
ENDIF
* honderden
IF n >= 100
n100 := INT( n / 100 )
c := aEen[ n100 + 1 ] + "honderd"
n := n % 100
IF n > 0
c += " " + NumToWordsNL( n )
ENDIF
RETURN c
ENDIF
* < 20
IF n < 20
RETURN aEen[ n + 1 ]
ENDIF
* tientallen
n10 := INT( n / 10 )
n1 := n % 10
IF n1 == 0
RETURN aTien[ n10 + 1 ]
ENDIF
IF n1 == 2
c := "tweeën"
ELSEIF n1 == 3
c := "drieën"
ELSE
c := aEen[ n1 + 1 ] + "en"
ENDIF
RETURN c + aTien[ n10 + 1 ]
Code: Select all
FOR A := 9999 TO 9999999 STEP 19
? A, a/100, AmountToWordsBE_Cent( A )
NEXT
MSGINFO('Ready')
FUNCTION AmountToWordsBE_Cent( nCent )
/*************************************/
LOCAL lNegatief := .F.
LOCAL nEuro, nRest
LOCAL cResult
IF !HB_ISNUMERIC( nCent )
RETURN ""
ENDIF
IF nCent < 0
lNegatief := .T.
nCent := ABS( nCent )
ENDIF
nEuro := INT( nCent / 100 )
nRest := nCent % 100
cResult := NumToWordsNL( nEuro ) + " euro"
IF nRest > 0
cResult += " en " + NumToWordsNL( nRest ) + " cent"
ENDIF
IF lNegatief
cResult := "min " + cResult
ENDIF
cResult := strtran(cResult, 'nul euro en ', '')
RETURN cResult
FUNCTION NumToWordsNL( n )
/**************************/
LOCAL aEen := { ;
"", "een", "twee", "drie", "vier", "vijf", "zes", "zeven", "acht", "negen", ;
"tien", "elf", "twaalf", "dertien", "veertien", "vijftien", ;
"zestien", "zeventien", "achttien", "negentien" }
LOCAL aTien := { ;
"", "", "twintig", "dertig", "veertig", "vijftig", ;
"zestig", "zeventig", "tachtig", "negentig" }
LOCAL c := ""
LOCAL nMil, nDui, n100, n10, n1
IF n == 0
RETURN "nul"
ENDIF
* miljoenen
IF n >= 1000000
nMil := INT( n / 1000000 )
c := NumToWordsNL( nMil ) + ;
IF( nMil == 1, " miljoen", " miljoen" )
n := n % 1000000
IF n > 0
c += " " + NumToWordsNL( n )
ENDIF
RETURN c
ENDIF
* duizenden
IF n >= 1000
nDui := INT( n / 1000 )
IF nDui == 1
c := "duizend"
ELSE
c := NumToWordsNL( nDui ) + " duizend"
ENDIF
n := n % 1000
IF n > 0
c += " " + NumToWordsNL( n )
ENDIF
RETURN c
ENDIF
* honderden
IF n >= 100
n100 := INT( n / 100 )
c := aEen[ n100 + 1 ] + "honderd"
n := n % 100
IF n > 0
c += " " + NumToWordsNL( n )
ENDIF
RETURN c
ENDIF
* < 20
IF n < 20
RETURN aEen[ n + 1 ]
ENDIF
* tientallen
n10 := INT( n / 10 )
n1 := n % 10
IF n1 == 0
RETURN aTien[ n10 + 1 ]
ENDIF
IF n1 == 2
c := "tweeën"
ELSEIF n1 == 3
c := "drieën"
ELSE
c := aEen[ n1 + 1 ] + "en"
ENDIF
RETURN c + aTien[ n10 + 1 ]
Code: Select all
#include "hmg.ch"
FUNCTION Main
LOCAL nLiczbaKryt, nLiczbaRol, x, y, cWiersz
PRIVATE aItems, aNaglowki, aSzerokosci
SET EXACT ON
SET DELETED ON
SET DATE FORMAT "dd.mm.yyyy"
aItems := {}
aNaglowki := {}
aSzerokosci := {}
nLiczbaKryt := 10
nLiczbaRol := 10
FOR x = 1 TO nLiczbaKryt
AAdd( aNaglowki, ALLTRIM(STR(x)) )
AAdd( aSzerokosci, 80 )
NEXT
FOR y = 1 to nLiczbaRol
cWiersz := {}
ASize (cWiersz, nLiczbaKryt)
FOR x = 1 to nLiczbaKryt
cWiersz [x] := ALLTRIM (STR (x + y))
NEXT
AAdd (aItems, cWiersz)
NEXT
Edit_criteria ()
DoMethod("kryteria", "Activate")
RETURN Nil
PROCEDURE Edit_criteria ()
DEFINE WINDOW kryteria AT 162 , 472 WIDTH 1137 HEIGHT 744 TITLE "Kryteria" MAIN
DEFINE GRID Grid_1
ROW 70
COL 40
WIDTH 840
HEIGHT 420
ITEMS aItems
WIDTHS aSzerokosci
HEADERS aNaglowki
FONTNAME "Arial"
FONTSIZE 9
END GRID
DEFINE BUTTON Button_11
ROW 540
COL 140
WIDTH 150
CAPTION "Dodaj kryterium"
ACTION DodajKryterium()
END BUTTON
END WINDOW
RETURN
FUNCTION DodajKryterium()
LOCAL i, nWiersze, nKolumnyNowe, aNowyWiersz
LOCAL aNoweNaglowki := {}, aNoweSzer := {}
LOCAL aNoweItems := {}
nWiersze := Len(aItems)
nKolumnyNowe := GetProperty("kryteria", "Grid_1", "ColumnCount") + 1
FOR i := 1 TO nKolumnyNowe
AAdd(aNoweNaglowki, ALLTRIM(STR(i)))
AAdd(aNoweSzer, 80)
NEXT i
DoMethod("kryteria", "Grid_1", "AddColumnEx", nKolumnyNowe, "K" + ALLTRIM(STR(nKolumnyNowe)), 80, 0, )
SetProperty("kryteria", "Grid_1", "Headers", aNoweNaglowki)
SetProperty("kryteria", "Grid_1", "Widths", aNoweSzer)
DoMethod ("kryteria", "Grid_1", "Refresh")
FOR i := 1 TO nWiersze
kryteria.Grid_1.Cell (nKolumnyNowe, i) := "New text"
NEXT
DoMethod ("kryteria", "Grid_1", "Refresh")
RETURN Nil
Code: Select all
#include "hmg.ch"
FUNCTION Main
LOCAL nLiczbaKryt, nLiczbaRol, x, y, cWiersz
PRIVATE aItems, aNaglowki, aSzerokosci
SET EXACT ON
SET DELETED ON
SET DATE FORMAT "dd.mm.yyyy"
aItems := {}
aNaglowki := {}
aSzerokosci := {}
nLiczbaKryt := 10
nLiczbaRol := 10
FOR x = 1 TO nLiczbaKryt
AAdd( aNaglowki, ALLTRIM(STR(x)) )
AAdd( aSzerokosci, 80 )
NEXT
FOR y = 1 to nLiczbaRol
cWiersz := {}
ASize (cWiersz, nLiczbaKryt)
FOR x = 1 to nLiczbaKryt
cWiersz [x] := ALLTRIM (STR (x + y))
NEXT
AAdd (aItems, cWiersz)
NEXT
Edit_criteria ()
DoMethod("kryteria", "Activate")
RETURN Nil
PROCEDURE Edit_criteria ()
DEFINE WINDOW kryteria AT 162 , 472 WIDTH 1137 HEIGHT 744 TITLE "Kryteria" MAIN
DEFINE GRID Grid_1
ROW 70
COL 40
WIDTH 840
HEIGHT 420
ITEMS aItems
WIDTHS aSzerokosci
HEADERS aNaglowki
FONTNAME "Arial"
FONTSIZE 9
END GRID
DEFINE BUTTON Button_11
ROW 540
COL 140
WIDTH 150
CAPTION "Dodaj kryterium"
ACTION DodajKryterium()
END BUTTON
END WINDOW
RETURN
FUNCTION DodajKryterium()
LOCAL i, nWiersze, nKolumnyNowe, aNowyWiersz
LOCAL aNoweNaglowki := {}, aNoweSzer := {}
LOCAL aNoweItems := {}
nWiersze := Len(aItems)
nKolumnyNowe := GetProperty("kryteria", "Grid_1", "ColumnCount") + 1
FOR i := 1 TO nKolumnyNowe
AAdd(aNoweNaglowki, ALLTRIM(STR(i)))
AAdd(aNoweSzer, 80)
NEXT i
DoMethod("kryteria", "Grid_1", "AddColumnEx", nKolumnyNowe, "K" + ALLTRIM(STR(nKolumnyNowe)), 80, 0, )
SetProperty("kryteria", "Grid_1", "Headers", aNoweNaglowki)
SetProperty("kryteria", "Grid_1", "Widths", aNoweSzer)
DoMethod ("kryteria", "Grid_1", "Refresh")
FOR i := 1 TO nWiersze
kryteria.Grid_1.Cell (nKolumnyNowe, i) := "New text"
NEXT
DoMethod ("kryteria", "Grid_1", "Refresh")
RETURN Nil
Attachments
Attachments
Code: Select all
FOR i := 1 TO nWiersze
//kryteria.Grid_1.CellEx (nKolumnyNowe, i) := "New text"
SetProperty('kryteria', 'Grid_1', 'CellEx', i,nKolumnyNowe , "New text" )
NEXT
Code: Select all
FOR i := 1 TO nWiersze
//kryteria.Grid_1.CellEx (nKolumnyNowe, i) := "New text"
SetProperty('kryteria', 'Grid_1', 'CellEx', i,nKolumnyNowe , "New text" )
NEXT