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 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

Function toFront()
LOCAL cTitle  := "my Window Title"
LOCAL hWndDlg := DllCall( "User32.dll", DLL_STDCALL, "FindWindowA", 0, cTitle )
   IF !( hWndDlg == 0 )
      DllCall( "User32.dll", DLL_STDCALL, "SetForegroundWindow", hWndDlg )
      DllCall( "User32.dll", DLL_STDCALL, "BringWindowToTop", hWndDlg )
      DllCall( "User32.dll", DLL_STDCALL, "ShowWindow", hWndDlg, 1 )
      DllCall( "User32.dll", DLL_STDCALL, "UpdateWindow", hWndDlg )
   ENDIF
RETURN

Code: Select all

SetWindowPos( MyForm.HANDLE, -1 , 0, 0, 0, 0, hb_bitOR( SWP_NOMOVE, SWP_NOSIZE ) )

Code: Select all

PROCEDURE Tab_Change_Icon( cParentForm, cControlName, nNo )
LOCAL nControlHandle
LOCAL xTab, nTab, Images, i, NoTrans := .F.
LOCAL aImages        := {}

   xTab := GetProperty( cParentForm, cControlName, "Value" )
   IF VALTYPE( xTab ) = "A"
      nTab := xTab[ 1 ]
   ELSE
      nTab := xTab
   ENDIF

   IF nNo = 2 // right side
      nDimRight := LEN( Stack_Right )
      FOR i := 1 TO nDimRight
         IF i = nTab
            AADD( aImages, "GRUENPUNKT" )
         ELSE
            AADD( aImages, "MYFIXDRIVE16" )
         ENDIF
      NEXT
   ELSE 
      nDimLeft := LEN( Stack_Left )
      FOR i := 1 TO nDimLeft
         IF i = nTab
            AADD( aImages, "GRUENPUNKT" )
         ELSE
            AADD( aImages, "MYFIXDRIVE16" )
         ENDIF
      NEXT
   ENDIF

   nControlHandle := GetControlHandle( cControlName, cParentForm )
   // not sure need to Destroy "old" Imagelist before
   IMAGELIST_DESTROY( nControlHandle )
   // will create own Imagelist and set TCM_SETIMAGELIST
   ADDTABBITMAP( nControlHandle, aImages, NoTrans ) // found in \SOURCE\h_tab.prg

RETURN

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

   FOR i := 1 TO nWiersze
	   //kryteria.Grid_1.CellEx (nKolumnyNowe, i) := "New text" 
      SetProperty('kryteria', 'Grid_1', 'CellEx', i,nKolumnyNowe , "New text" )  
   NEXT