elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Sigue las noticias más importantes de seguridad informática en el ttwitter! de elhacker.NET


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  [Src] numberToName (Correcion al codigo anterior).
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: [Src] numberToName (Correcion al codigo anterior).  (Leído 1,584 veces)
BlackZeroX
Wiki

Desconectado Desconectado

Mensajes: 3.148


I'Love...!¡.


Ver Perfil WWW
[Src] numberToName (Correcion al codigo anterior).
« en: 12 Noviembre 2011, 08:42 am »

.
Es una correccion al codigo anterior por que contenia HORRORES...

desde el 1 al 999999999999999999999999999999999999999999999999999999999999999999

Ejemplo:

Código
  1.  
  2. Private Sub Form_Load()
  3.    MsgBox numberToName(InputBox("Ingresa un numero cualquiera", "numberToName", "87984516512"))
  4. End Sub
  5.  
  6.  

OutPut (Test Number: 87984516512):
Citar

ochenta y siete mil novecientos ochenta y cuatro millones quinientos dieci seis mil quinientos doce


Código
  1.  
  2. '
  3. '   /////////////////////////////////////////////////////////////
  4. '   // Autor:   BlackZeroX ( Ortega Avila Miguel Angel )       //
  5. '   //                                                         //
  6. '   // Web:     http://InfrAngeluX.Sytes.Net/                  //
  7. '   //                                                         //
  8. '   //    |-> Pueden Distribuir Este codigo siempre y cuando   //
  9. '   // no se eliminen los creditos originales de este codigo   //
  10. '   // No importando que sea modificado/editado o engrandecido //
  11. '   // o achicado, si es en base a este codigo                 //
  12. '   /////////////////////////////////////////////////////////////
  13. '   // http://infrangelux.hostei.com/index.php?option=com_content&view=article&id=8:arrtnum2string&catid=2:catprocmanager&Itemid=3
  14. '   /////////////////////////////////////////////////////////////
  15.  
  16. Option Explicit
  17.  
  18. Public Function numberToName(ByVal sNumber As String) As String
  19. '   //  MAXIMO  --> 999999999999999999999999999999999999999999999999999999999999999999 ' sección Decillones...
  20.  
  21. '   //  Millon          1 * 10^6
  22. '   //  Billon          1 * 10^12
  23. '   //  Trillon         1 * 10^18
  24. '   //  Cuatrillón      1 * 10^24
  25. '   //  Quintillón      1 * 10^30
  26. '   //  Sextillón       1 * 10^36
  27. '   //  Sptillon        1 * 10^42
  28. '   //  Octillón        1 * 10^48
  29. '   //  Sextillón       1 * 10^54
  30. '   //  Octillón        1 * 10^60
  31. '   //  <--Son bastantes numeros... como para seguirle no creen?-->
  32.  
  33. Dim i           As Long
  34. Dim lLn         As Long
  35. Dim sTmp        As String
  36. Dim bCentena    As Byte
  37. Dim bDecena     As Byte
  38. Dim bUnidad     As Byte
  39. Const MAXLEN    As Long = &H42
  40.  
  41.    lLn = Len(sNumber)
  42.    If (lLn > MAXLEN) Or (lLn = 0) Then Exit Function
  43.  
  44.    sTmp = String$(MAXLEN, "0")
  45.  
  46.    Mid$(sTmp, MAXLEN - lLn + 1) = Mid$(sNumber, 1, lLn)
  47.  
  48.    For i = 1 To MAXLEN Step 3
  49.  
  50.        bCentena = CByte(Mid$(sTmp, i, 1))
  51.        bDecena = CByte(Mid$(sTmp, i + 1, 1))
  52.        bUnidad = CByte(Mid$(sTmp, i + 2, 1))
  53.  
  54.        numberToName = numberToName & centena(bUnidad, bDecena, bCentena) & _
  55.                                      decena(bUnidad, bDecena) & _
  56.                                      unidad(bUnidad, bDecena) & _
  57.                                      IIf(Not (i = (MAXLEN - &H2)), getLeyenda(sNumber, i, bUnidad, bDecena, bCentena), "")
  58.    Next
  59.  
  60. End Function
  61.  
  62. Private Function getLeyenda(ByRef sTmp As String, ByVal i As Long, ByVal bUnidad As Byte, ByVal bDecena As Byte, ByVal bCentena As Byte) As String
  63. '   //  Se obtiene la leyenda con referencia a la ESCALA CORTA.
  64.  
  65.    Select Case i
  66.        Case &H4
  67.            If ((bCentena + bDecena) = 0) And (bUnidad = 1) Then
  68.                getLeyenda = "decillon "
  69.            ElseIf ((bCentena + bDecena + bUnidad) > 1) Then
  70.                getLeyenda = "decillones "
  71.            End If
  72.  
  73.        Case &HA
  74.            If ((bCentena + bDecena) = 0) And (bUnidad = 1) Then
  75.                getLeyenda = "nonillon "
  76.            ElseIf ((bCentena + bDecena + bUnidad) > 1) Then
  77.                getLeyenda = "nonillones "
  78.            End If
  79.  
  80.        Case &H10
  81.            If ((bCentena + bDecena) = 0) And (bUnidad = 1) Then
  82.                getLeyenda = "octillón "
  83.            ElseIf ((bCentena + bDecena + bUnidad) > 1) Then
  84.                getLeyenda = "octillónes "
  85.            End If
  86.  
  87.        Case &H16
  88.            If ((bCentena + bDecena) = 0) And (bUnidad = 1) Then
  89.                getLeyenda = "septillon "
  90.            ElseIf ((bCentena + bDecena + bUnidad) > 1) Then
  91.                getLeyenda = "septillones "
  92.            End If
  93.  
  94.        Case &H1C
  95.            If ((bCentena + bDecena) = 0) And (bUnidad = 1) Then
  96.                getLeyenda = "sextillón "
  97.            ElseIf ((bCentena + bDecena + bUnidad) > 1) Then
  98.                getLeyenda = "sextillónes "
  99.            End If
  100.  
  101.        Case &H22
  102.            If ((bCentena + bDecena) = 0) And (bUnidad = 1) Then
  103.                getLeyenda = "quintillón "
  104.            ElseIf ((bCentena + bDecena + bUnidad) > 1) Then
  105.                getLeyenda = "quintillónes "
  106.            End If
  107.  
  108.        Case &H28
  109.            If ((bCentena + bDecena) = 0) And (bUnidad = 1) Then
  110.                getLeyenda = "cuatrillón "
  111.            ElseIf ((bCentena + bDecena + bUnidad) > 1) Then
  112.                getLeyenda = "cuatrillónes "
  113.            End If
  114.  
  115.        Case &H2E
  116.            If ((bCentena + bDecena) = 0) And (bUnidad = 1) Then
  117.                getLeyenda = "trillon "
  118.            ElseIf ((bCentena + bDecena + bUnidad) > 1) Then
  119.                getLeyenda = "trillones "
  120.            End If
  121.  
  122.        Case &H34
  123.            If ((bCentena + bDecena) = 0) And (bUnidad = 1) Then
  124.                getLeyenda = "billón "
  125.            ElseIf ((bCentena + bDecena + bUnidad) > 1) Then
  126.                getLeyenda = "billones "
  127.            End If
  128.  
  129.        Case &H3A
  130.            If ((bCentena + bDecena) = 0) And (bUnidad = 1) Then
  131.                getLeyenda = "millón "
  132.            ElseIf ((bCentena + bDecena + bUnidad) > 1) Then
  133.                getLeyenda = "millones "
  134.            End If
  135.  
  136.        Case Else
  137.            If ((bCentena + bDecena + bUnidad) > 1) Then getLeyenda = "mil "
  138.  
  139.    End Select
  140.  
  141. End Function
  142.  
  143. Private Function centena(ByVal bUnidad As Byte, ByVal bDecena As Byte, ByVal bCentena As Byte) As String
  144.    Select Case bCentena
  145.        Case 1: If (bDecena + bUnidad) = 0 Then centena = "cien " Else centena = "ciento "
  146.        Case 2: centena = "doscientos "
  147.        Case 3: centena = "trescientos "
  148.        Case 4: centena = "cuatrocientos "
  149.        Case 5: centena = "quinientos "
  150.        Case 6: centena = "seiscientos "
  151.        Case 7: centena = "setecientos "
  152.        Case 8: centena = "ochocientos "
  153.        Case 9: centena = "novecientos "
  154.    End Select
  155. End Function
  156.  
  157. Private Function decena(ByVal bUnidad As Byte, ByVal bDecena As Byte) As String
  158.    Select Case bDecena
  159.        Case 1
  160.            Select Case bUnidad
  161.                Case 0: decena = "diez "
  162.                Case 1: decena = "once "
  163.                Case 2: decena = "doce "
  164.                Case 3: decena = "trece "
  165.                Case 4: decena = "catorce "
  166.                Case 5: decena = "quince "
  167.                Case 6 To 9: decena = "dieci "
  168.            End Select
  169.        Case 2
  170.            If bUnidad = 0 Then
  171.                decena = "veinte "
  172.            ElseIf bUnidad > 0 Then
  173.                decena = "veinti "
  174.            End If
  175.        Case 3: decena = "treinta "
  176.        Case 4: decena = "cuarenta "
  177.        Case 5: decena = "cincuenta "
  178.        Case 6: decena = "sesenta "
  179.        Case 7: decena = "setenta "
  180.        Case 8: decena = "ochenta "
  181.        Case 9: decena = "noventa "
  182.    End Select
  183.    If bUnidad > 0 And bDecena > 2 Then decena = decena + "y "
  184. End Function
  185.  
  186. Private Function unidad(ByVal bUnidad As Byte, ByVal bDecena As Byte) As String
  187.    If bDecena <> 1 Then
  188.        Select Case bUnidad
  189.            Case 1: unidad = "un "
  190.            Case 2: unidad = "dos "
  191.            Case 3: unidad = "tres "
  192.            Case 4: unidad = "cuatro "
  193.            Case 5: unidad = "cinco "
  194.        End Select
  195.    End If
  196.    Select Case bUnidad
  197.            Case 6: unidad = "seis "
  198.            Case 7: unidad = "siete "
  199.            Case 8: unidad = "ocho "
  200.            Case 9: unidad = "nueve "
  201.    End Select
  202. End Function
  203.  
  204.  

Temibles Lunas!¡.


« Última modificación: 12 Noviembre 2011, 08:51 am por BlackZeroX (Astaroth) » En línea

The Dark Shadow is my passion.
CAR3S?


Desconectado Desconectado

Mensajes: 343


Level xXx


Ver Perfil
Re: [Src] numberToName (Correcion al codigo anterior).
« Respuesta #1 en: 13 Noviembre 2011, 21:13 pm »

buen aporte!!! x)  >:D >:D >:D >:D >:D >:D


En línea

Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
continuacion tema anterior
Ingeniería Inversa
Ch@CaL 0 967 Último mensaje 17 Enero 2007, 18:45 pm
por Ch@CaL
Correcion al FileManager de E0N (1 linea)
Programación Visual Basic
‭‭‭‭jackl007 1 3,549 Último mensaje 6 Marzo 2008, 18:16 pm
por ~~
Codigo sobre mi duda anterior (crear server desde exe)
Programación Visual Basic
fede_cp 9 2,408 Último mensaje 11 Julio 2009, 04:37 am
por BlackZeroX
correción error ortográfico
Software
jemez44 2 514 Último mensaje 6 Enero 2014, 13:52 pm
por z3nth10n
correcion de codigo para subir archivos via ftp
Scripting
binario010101 0 806 Último mensaje 20 Abril 2014, 04:06 am
por binario010101
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines