Consultas sobre Visual Basic 6

mfrl · 24 Oct 2008

signos zodiaco

Prueba con este código, le falta solo evaluar si se te da por colocar 2.3 en el campo día
ya que lo toma como 2.
Además esta más legible. Crea dos controles textbox y un botón

Código:

Private Sub Command1_Click()
Dim mes As String
Dim dia As Integer
Dim signo As String
signo = ""
mes = LCase(Text1.Text)
If IsNumeric(Text2.Text) Then
    dia = Int(Text2.Text)
    If mes = "enero" Then
        If dia >= 1 And dia <= 19 Then
            signo = "capricornio"
        ElseIf dia <= 31 Then
            signo = "acuario"
        End If
    ElseIf mes = "febrero" Then
        If dia >= 1 And dia <= 17 Then
            signo = "acuario"
        ElseIf dia <= 29 Then
            signo = "piscis"
        End If
    ElseIf mes = "marzo" Then
        If dia >= 1 And dia <= 19 Then
            signo = "piscis"
        ElseIf dia <= 31 Then
            signo = "aries"
        End If
    ElseIf mes = "abril" Then
        If dia >= 1 And dia <= 19 Then
            signo = "aries"
        ElseIf dia <= 30 Then
            signo = "tauro"
        End If
    ElseIf mes = "mayo" Then
        If dia >= 1 And dia <= 20 Then
            signo = "tauro"
        ElseIf dia <= 31 Then
            signo = "géminis"
        End If
    ElseIf mes = "junio" Then
        If dia >= 1 And dia <= 20 Then
            signo = "géminis"
        ElseIf dia <= 30 Then
            signo = "cáncer"
        End If
    ElseIf mes = "julio" Then
        If dia >= 1 And dia <= 22 Then
            signo = "cáncer"
        ElseIf dia <= 31 Then
            signo = "leo"
        End If
    ElseIf mes = "agosto" Then
        If dia >= 1 And dia <= 22 Then
            signo = "leo"
        ElseIf dia <= 31 Then
            signo = "virgo"
        End If
    ElseIf mes = "septiembre" Then
        If dia >= 1 And dia <= 22 Then
            signo = "virgo"
        ElseIf dia <= 30 Then
            signo = "libra"
        End If
    ElseIf mes = "octubre" Then
        If dia >= 1 And dia <= 22 Then
            signo = "libra"
        ElseIf dia <= 31 Then
            signo = "escorpio"
        End If
    ElseIf mes = "noviembre" Then
        If dia >= 1 And dia <= 21 Then
            signo = "escorpio"
        ElseIf dia <= 30 Then
            signo = "sagitario"
        End If
    ElseIf mes = "diciembre" Then
        If dia >= 1 And dia <= 21 Then
            signo = "sagitario"
        ElseIf dia <= 31 Then
            signo = "capricornio"
        End If
    End If
    If signo = "" Then
        MsgBox "Error. Ud. No ha ingresado una fecha válida"
    Else
        MsgBox "Su signo es " + signo
    End If
Else
    MsgBox "Error. Ud. No ha ingresado una fecha válida"
End If
End Sub

MoonSorroW · 26 Oct 2008

que onda comunidad
oigan ocupo ayuda con un programa de formularios y modulos lo que ocupo es que me acomode los numeros de una lista de mayor a menor pero este debe de estar adentro de un procedimento sub, como tambien encontrar el numero mayor y menor de la lista, pero que me los encuentre a dentro de una funcion cada una alguien que me pudiera ayudar se lo agredeceria muchisimo aqui les dejo mi codigo fuente de lo que llevo :

Código:

Private Sub Command1_Click()
List1.AddItem Text1.Text
Text1.Text = ""
Text1.SetFocus

End Sub

Private Sub Command2_Click()
Dim p As Integer
p = List1.ListCount
List1.RemoveItem (p - 1)

End Sub

Private Sub Command3_Click()
Dim j As Integer, y As Integer, nume As Integer

Dim multi() As Integer
nume = List1.ListCount
ReDim multi(nume)

For i = 0 To nume - 1
    multi(i) = List1.List(i)
Next i

For i = 0 To nume - 1
    For y = i + 1 To nume
        If multi(i) < multi(y) Then
            j = multi(i)
            multi(i) = multi(y)
            multi(y) = j
        End If
    Next y
Next i
List1.Clear
Text1.SetFocus
For i = 0 To nume - 1
    List1.List(i) = multi(i)
Next i

End Sub

Private Sub Command4_Click()
List1.Clear
Text1.SetFocus

End Sub

Private Sub Command5_Click()
Unload Me
End Sub

Private Sub Command7_Click()
Dim p As Integer, n As Integer
p = List1.ListCount
mn (D)
n = mn(List1.ListCount)

If n = 1 Then
Text3.Text = D

End If

End Sub

aun no termino todos los comandos y ahi tengo que mandar el ordenamiento
a un procedimiento sub que este en un modulo que alguien me ayude porfas les dejo mi correo nakamamoon@hotmail.com

apacheco · 17 Nov 2008

Utiliza la funcion InputBox 2 veces, una para pedir el dia de nacimiento y otra para el mes

Dario Flores · 14 Dic 2008

Hola, soy nuevo, me podrian ayudar
no soy programador y me gustaria saber como reproducir dos ficheros .wav al mismo tiempo no primero uno y despues otro si no al mismo tiempo es decir mezclado.

GRACIAS.

Tael Yang · 15 Dic 2008

La Facil

Dario Flores dijo:
Hola, soy nuevo, me podrian ayudar
no soy programador y me gustaria saber como reproducir dos ficheros .wav al mismo tiempo no primero uno y despues otro si no al mismo tiempo es decir mezclado.

GRACIAS.

Incluya varios controles del repro y asi puede reproducir varios arvhivos al tiempo.

Dese gusto joven . . . Clic Aqui

Elessars_6 · 15 Dic 2008

olaa
tengo k acer un programa que me represente graficamente el movimiento de dos cuerpos de masas variables en el espacio por el metodo del runge-kutta.. no engo ni idea de como acerlo me podrian ayudar porfavor..

asias d antemano

ccr · 21 Dic 2008

soy novato con VB y deseo que alguin me diga por donde debo empèzar atacar este tema

raven9t · 21 Dic 2008

Te recomiendo que si vas a empezar con vb lo hagas con la plataforma .net porque vb 6.0 ya está mandado a recoger, si no tienes experiencia programando con otro lenguaje, lo mejor es que empieces con conceptos de algoritmia, de lo contrario puedes empezar con un libro sencillo sobre el lenguaje, hay muchos pero no recuerdo bien los nombres (ojo: una cosa es aprender a resolver problemas por medio de la programación y otra es conocer la sintaxis de un lenguaje). Lo que si te puedo decir es que aprender sobre clases y objetos no es dificil, pero si requiere trabajo.

Darkpimp · 10 Ene 2009

Hola , realmente necesito ayuda con esto
Lo que pasa es lo siguiente, en el disco local C tengo un archivo texto que se llama PRUEBA que contiene muchas
lineas de coordenadas asi:

X1.5332Y0.2345Z3.4555
X2.0000Y1.0345Z3.4556
X3.3000Y1.2005Z3.4557
X1.5332Y0.2345Z3.4555
X2.0000Y1.0345Z3.4556
X3.3000Y1.2005Z3.4557
X1.5332Y0.2345Z3.4555
X2.0000Y1.0345Z3.4556
X3.3000Y1.2005Z3.4557
X1.5332Y0.2345Z3.4555
X2.0000Y1.0345Z3.4556
X3.3000Y1.2005Z3.4557
X1.5332Y0.2345Z3.4555
X2.0000Y1.0345Z3.4556
X3.3000Y1.2005Z3.4557

Hice un programa en visual basic 6.0 para leer cada caracter y poder sacar el valor de cada
eje, es decir en la primera linea esta x=1.5332 y=0.2345 z=3.4555 y quiero guardar 1.5332
en una variable, 0.2345 en otra variable y 3.4555 en otra varible para luego procesarlos

este es el programa que hice en visual basic 6.0

Option Explicit

Dim Linea(22) As String * 1
Dim i As Integer
Dim XREG As Double
Dim YREG As Double
Dim ZREG As Double

Private Sub Command1_Click()
If B6 = 0 Then
Open "C

RUEBA.txt" For Input As #1 ' abrir archivo
B6 = 1
End If
If EOF(1) = False Then 'si el archivo ya finalizo
While i <= 22 ' me lee caracter por caracter
Linea(i) = Input(1, #1) ' leer caracter
i = 1 + i
Wend
'**************** visualizar valores leidos ***********************************
i = 0
XREG = (Val(Linea(1)) * 10000) + (Val(Linea(3)) * 1000) + (Val(Linea(4)) * 100) + (Val(Linea(5)) * 10) +

Val(Linea(6))
Text1.Text = XREG
Linea(1) = 0: Linea(3) = 0: Linea(4) = 0: Linea(5) = 0: Linea(6) = 0
YREG = (Val(Linea(8)) * 10000) + (Val(Linea(10)) * 1000) + (Val(Linea(11)) * 100) + (Val(Linea(12)) * 10) +

Val(Linea(13))
Text2.Text = YREG
Linea(8) = 0: Linea(10) = 0: Linea(11) = 0: Linea(12) = 0: Linea(13) = 0
ZREG = (Val(Linea(15)) * 10000) + (Val(Linea(17)) * 1000) + (Val(Linea(18)) * 100) + (Val(Linea(19)) * 10) +

Val(Linea(20))
Text3.Text = ZREG
Linea(15) = 0: Linea(17) = 0: Linea(18) = 0: Linea(19) = 0: Linea(20) = 0
Linea(0) = 0: Linea(2) = 0: Linea(7) = 0: Linea(9) = 0: Linea(14) = 0: Linea(16) = 0:
Linea(21) = 0: Linea(22) = 0:
'*******************************************************************************
Else
Close #1
B6 = 0
End If
End Sub

cada click que haga en command1 button me lee una linea y me muestra los valores de cada eje,

text1=x,text2=y,text3=z
cuando voy a leer la cuarta linea me saca un mensaje diciendo "error'62' la entrada de datos
ha sobrepasado el final del archivo"
y no se porque, busque sobre ese error y no encontre una respuesta
yo pienso que pareciera que se acumulara valores en la matriz linea, realmente no se
por favor ayudenme esto es para una tesis

raven9t · 10 Ene 2009

Hola amigo Darkpimp, el problema que tienes al hacer el bucle while para capturar cada uno de los caracteres de cada línea en el archivo prueba.txt, es que al llegar a la línea final muchas veces el carácter retorno de carro e inicio de línea no está (son dos caracteres diferentes), por consiguiente el programa sigue en el bucle pero el archivo ya llego a su fin.

Aquí está este código que es mucho más sencillo y hace lo mismo, aunque no es perfecto puedes ver que es más fácil de entender, te recomiendo que sangres tu código para que sea más compresible e intenta no usar mucho los dos puntos “:” ya que vuelve el código ilegible. Lo último, no guardes archivos en la carpeta raíz C:\ en vez de eso usa app.path y guarda el archivo en la carpeta del proyecto.

Código:

Option Explicit

Dim Linea As String
Dim XREG As Double
Dim YREG As Double
Dim ZREG As Double

Private Sub Command1_Click()
    If Not EOF(1) Then
        'leer por lineas en vez de carcateres
        Line Input #1, Linea
        Call mostrarCoordenada
    Else
        'volver a empezar
        Seek #1, 1
    End If
End Sub

Private Sub Form_Load()
    Open App.Path & "\PRUEBA.txt" For Input As #1
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Close #1
End Sub

Private Sub mostrarCoordenada()
    Dim strTemp1 As String
    Dim strTemp2 As String
    Dim initStr As Integer
    strTemp2 = Linea
    
    'extraer subcadenas que contengan solo el codigo de coordenada (ej X1.5332)
    'y la cadena sobrante guardarla para repetir el proceso
    initStr = InStr(1, strTemp2, "y", vbTextCompare) - 1
    strTemp1 = Left$(strTemp2, initStr)
    XREG = CDbl(Right$(strTemp1, Len(strTemp1) - 1))
    strTemp2 = Right$(strTemp2, Len(strTemp2) - initStr)
    
    initStr = InStr(1, strTemp2, "z", vbTextCompare) - 1
    strTemp1 = Left$(strTemp2, initStr)
    YREG = CDbl(Right$(strTemp1, Len(strTemp1) - 1))
    strTemp2 = Right$(strTemp2, Len(strTemp2) - initStr)
    
    ZREG = CDbl(Right$(strTemp2, Len(strTemp2) - 1))
    
    Text1.Text = CStr(XREG)
    Text2.Text = CStr(YREG)
    Text3.Text = CStr(ZREG)
End Sub

Elessars_6 · 12 Ene 2009

ola amigos
tengo un problema con un programa que hice.. el prorgama te simula la interaccion entre dos cuerpos en el espacio mediante el metodo de runge-kutta.. hice el programa y todo pero al iniciarlo en la picture box solo me sale la estela de uno de los dos cuerpos.. si alguien pudiera ayudarme o tuviera un programa que hiciera lo mismo me seria de gran ayuda porque lo necesito para un trabajo de final de baxiller..

les dejo el codigo para que se agan a la idea:

Private Sub CB1_Click()
Dim x, y, vx, vy, h, k1, k2, k3, k4, l1, l2, l3, l4, m1, m2, m3, m4, q1, q2, q3, q4, iter As Double
Dim m, n, vm, vn, hi, k1i, k2i, k3i, k4i, l1i, l2i, l3i, l4i, m1i, m2i, m3i, m4i, q1i, q2i, q3i, q4i As Double
x = 1
y = 0
vy = TB1.Text
vx = 0
iter = 365.26
h = 1 / iter
For I = 1 To 1000

k1 = h * vx
'l1 = -h * Pi2 * 4 * x / ((x * x + y * y) ^ (3 / 2))
l1 = h * calculo(x, y)
q1 = h * vy
'm1 = -h * Pi2 * 4 * y / ((x * x + y * y) ^ (3 / 2))
m1 = h * calculo(y, x)
k2 = h * (vx + l1 / 2)
'l2 = -h * Pi2 * 4 * (x + k1 / 2) / (((x + k1 / 2) ^ 2 + (y + q1 / 2) ^ 2) ^ (3 / 2))
l2 = h * calculo(x + k1 / 2, y + q1 / 2)
q2 = h * (vy + m1 / 2)
'm2 = -h * Pi2 * 4 * (y + q1 / 2) / (((x + k1 / 2) ^ 2 + (y + q1 / 2) ^ 2) ^ (3 / 2))
m2 = h * calculo(y + q1 / 2, x + k1 / 2)
k3 = h * (vx + l2 / 2)
'l3 = -h * Pi2 * 4 * (x + k2 / 2) / (((x + k2 / 2) ^ 2 + (y + q2 / 2) ^ 2) ^ (3 / 2))
l3 = h * calculo(x + k2 / 2, y + q2 / 2)
q3 = h * (vy + m2 / 2)
'm3 = -h * Pi2 * 4 * (y + q2 / 2) / (((x + k2 / 2) ^ 2 + (y + q2 / 2) ^ 2) ^ (3 / 2))
m3 = h * calculo(y + q2 / 2, x + k2 / 2)
k4 = h * (vx + l3)
'l4 = -h * Pi2 * 4 * (x + k3) / (((x + k3) ^ 2 + (y + q3) ^ 2) ^ (3 / 2))
l4 = h * calculo(x + k3, y + q3)
q4 = h * (vy + m3)
'm4 = -h * Pi2 * 4 * (y + q3) / (((x + k3) ^ 2 + (y + q3) ^ 2) ^ (3 / 2))
m4 = h * calculo(y + q3, x + k3)
x = x + (k1 + 2 * k2 + 2 * k3 + k4) / 6
vx = vx + (l1 + 2 * l2 + 2 * l3 + l4) / 6
y = y + (q1 + 2 * q2 + 2 * q3 + q4) / 6
vy = vy + (m1 + 2 * m2 + 2 * m3 + m4) / 6

e = pintax(x)
J = pintay (y)

PB1.PSet (e, J)

Next I
m = 1
n = 0
vm = TB2.Text
vn = 0
For J = 1 To 1000
k1i = hi * vm
'l1i = -hi * Pi2 * 4 * x / ((m * m + n * n) ^ (3 / 2))
l1i = hi * calculo(m, n)
q1i = h * vn
'm1i = -hi * Pi2 * 4 * n / ((m * m + n * n) ^ (3 / 2))
m1i = hi * calculo(m, n)
k2i = hi * (vm + l1i / 2)
'l2i = -hi * Pi2 * 4 * (m + k1i / 2) / (((m + k1i / 2) ^ 2 + (n + q1i / 2) ^ 2) ^ (3 / 2))
l2i = hi * calculo(m + k1i / 2, n + q1i / 2)
q2i = hi * (vn + m1i / 2)
'm2i = -hi * Pi2 * 4 * (n + q1i / 2) / (((m + k1i / 2) ^ 2 + (n + q1i / 2) ^ 2) ^ (3 / 2))
m2i = hi * calculo(n + q1i / 2, m + k1i / 2)
k3i = hi * (vm + l2i / 2)
'l3i = -hi * Pi2 * 4 * (m + k2i / 2) / (((m + k2i / 2) ^ 2 + (n + q2i / 2) ^ 2) ^ (3 / 2))
l3i = hi * calculo(m + k2i / 2, n + q2i / 2)
q3i = hi * (vn + m2i / 2)
'm3i = -hi * Pi2 * 4 * (n + q2i / 2) / (((m + k2i / 2) ^ 2 + (n + q2i / 2) ^ 2) ^ (3 / 2))
m3i = hi * calculo(n + q2i / 2, m + k2i / 2)
k4i = hi * (vm + l3i)
'l4i = -hi * Pi2 * 4 * (m + k3i) / (((m + k3i) ^ 2 + (n + q3i) ^ 2) ^ (3 / 2))
l4i = hi * calculo(m + k3i, n + q3i)
q4i = hi * (vn + m3i)
'm4i = -hi * Pi2 * 4 * (n + q3i) / (((m + k3i) ^ 2 + (n + q3i) ^ 2) ^ (3 / 2))
m4i = hi * calculo(n + q3i, m + k3i)
m = m + (k1i + 2 * k2i + 2 * k3i + k4i) / 6
vm = vm + (l1i + 2 * l2i + 2 * l3i + l4i) / 6
n = n + (q1i + 2 * q2i + 2 * q3i + q4i) / 6
vn = vn + (m1i + 2 * m2i + 2 * m3i + m4i) / 6

o = pintax(m)
p = pintay

PB1.PSet (o, p)

Next J

End Sub
Private Sub CB2_Click()
PB1.Cls
For I = 1 To 10000
PB1.PSet (I, 3500)
Next I
For I = 1 To 7000
PB1.PSet (5000, I)
Next I
For J = 1 To 10000
PB1.PSet (J, 3500)
Next J
For J = 1 To 7000
PB1.PSet (5000, J)
Next J
End Sub
Private Sub CB3_Click()
End
End Sub
Public Function pintay(w) As Double
pintay = 3500 - Int(2000 * w)
End Function
Public Function pintax(v) As Double
pintax = 5000 + Int(2000 * v)
End Function
Public Function calculo(s, t) As Double
Dim r As Double
r = s * s + t * t
r = r ^ (3 / 2)
r = -4 * 3.14159265358979 * 3.14159265358979 * s / r
calculo = r
End Function
Private Sub PB1_Paint()
For I = 1 To 10000
PB1.PSet (I, 3500)
Next I
For I = 1 To 7000
PB1.PSet (5000, I)
Next I
For J = 1 To 10000
PB1.PSet (J, 3500)
Next J
For J = 1 To 7000
PB1.PSet (5000, J)
Next J
End Sub

Darkpimp · 12 Ene 2009

=)=)=)Muchas gracias raven9t, sinceramente apenas llevaba cuatro dias de conocer el visual, ya con lo q hiciste estoy aprendiendo mucho mas, muchas gracias:-p:-p

Darkpimp · 21 Ene 2009

como puedo leer una linea de un rtftext

buenas

como puedo leer un texto de linea en linea que se encuentra cargado
en un objeto rtftext:chino:, es para poder cargar cada linea en una variable string

muchas garcias

Tael Yang · 23 Ene 2009

Puede que te ayude

Darkpimp dijo:
buenas

como puedo leer un texto de linea en linea que se encuentra cargado
en un objeto rtftext:chino:, es para poder cargar cada linea en una variable string

muchas garcias

En realidad esta busqueda es de manipulacion de archivos te texto plano, pero pueden ayudarte con tu objeto rtf AQUI , de no ser asi me avisas.

zadkiel131 · 6 Feb 2009

hola disculpen estoy hacido un programa pequeño en visula basic y me gustaria saber como puedo ponerle una base de datos o con cual herramienta hacerlo y si se podria hacer en msql o en otro no importa o si la puedo hacer en acces y depues puedo cambiar la base de datos osea emigrar a otra base de datos ? me gustaria mucho que si me pueden pasas un libro o unos tutoriales para que los pueda leer y aprender mejor o alguna pagina que able mas afondo de este tema gracias por su atencion amigos de laneros

|Nc| GeNeTiKo · 10 Feb 2009

que bien.. un tema VB6...

mEm@ · 11 Feb 2009

Me gustaria conocer tu idea ...

kamilo_32 dijo:
hola lenux sabes es interesante tu problema.... y ya se me ocurrio algo como solucionarlo...es simple pero el problema eske es en visual basic la unika solucion que puedo ayudarte...

si te interesa puedes mandarme un MP

Hola, kamilo32 ¡¡¡ Hacía muchísimo que no andaba x el foro, y hoy me puse a leer un poco de todo, y encontre esto. Hace un tiempito, me plantée el mismo problemita que sugirió otro forista (acerca de escribir en palabras el importe numérico de una factura ; X Ej : $ 450.88 = cuatrocientos cincuenta con ochenta y ocho). Vi que contestabas a esta otra persona, sugiriéndole que te enviara un MP para sugerirle una idea.
Bueno, no sé si lenux se habrá puesto en contacto contigo, pero a mí me vendría muy bien una sugerencia sobre el tema, así que es por esto que me tomo el atrevimiento de contactarte. Si tenés oportunidad de leer esto, estaría muy bueno que me envíes un MP.
Espero no haberte aburrido con todo esto, y bueno, desde ya, muchas gracias.:-p

|Nc| GeNeTiKo · 11 Feb 2009

no deberian hablar por MP, seria bueno compartir el codigo

raven9t · 11 Feb 2009

Si quieren un codigo de conversion de numeros a letras, aqui les dejo esta clase (.cls) en visual basic 6.0, la cual se puede convertir facilmente a mano a vb.net, lo hice hace varios años ya (6 mas o menos), asi que entenderan si el codigo no les parece elegante. convierte numeros maximo hasta 15 cifras(puede manejar billones), espero les guste.

Código:

Option Explicit
Dim m_AsignarNum As String

Private Function AlgUno(ByVal Cad As String) As String
    Dim VSign As String
    Dim vigia As Integer
    vigia = 0
    If Len(Cad) = 2 Then
        Select Case Left(Cad, 1)
            Case "0"
            Case "1"
                If Right(Cad, 1) = 0 Then
                    VSign = "diez"
                    vigia = 1
                ElseIf Right(Cad, 1) = 1 Then
                    VSign = "once"
                    vigia = 1
                ElseIf Right(Cad, 1) = 2 Then
                    VSign = "doce"
                    vigia = 1
                ElseIf Right(Cad, 1) = 3 Then
                    VSign = "trece"
                    vigia = 1
                ElseIf Right(Cad, 1) = 4 Then
                    VSign = "catorce"
                    vigia = 1
                ElseIf Right(Cad, 1) = 5 Then
                    VSign = "quince"
                    vigia = 1
                Else
                    VSign = "diesi"
                End If
            Case "2"
                If Right(Cad, 1) = 0 Then
                    vigia = 1
                    VSign = "veinte"
                ElseIf Right(Cad, 1) <> 0 Then
                    VSign = "veinti"
                End If
            Case "3"
                If Right(Cad, 1) = 0 Then
                    vigia = 1
                    VSign = "treinta"
                ElseIf Right(Cad, 1) <> 0 Then
                    VSign = "treinta y "
                End If
            Case "4"
                If Right(Cad, 1) = 0 Then
                    vigia = 1
                    VSign = "cuarenta"
                ElseIf Right(Cad, 1) <> 0 Then
                    VSign = "cuarenta y "
                End If
            Case "5"
                If Right(Cad, 1) = 0 Then
                    vigia = 1
                    VSign = "cincuenta"
                ElseIf Right(Cad, 1) <> 0 Then
                    VSign = "cincuenta y "
                End If
            Case "6"
                If Right(Cad, 1) = 0 Then
                    vigia = 1
                    VSign = "sesenta"
                ElseIf Right(Cad, 1) <> 0 Then
                    VSign = "sesenta y "
                End If
            Case "7"
                If Right(Cad, 1) = 0 Then
                    vigia = 1
                    VSign = "setenta"
                ElseIf Right(Cad, 1) <> 0 Then
                    VSign = "setenta y "
                End If
            Case "8"
                If Right(Cad, 1) = 0 Then
                    vigia = 1
                    VSign = "ochenta"
                ElseIf Right(Cad, 1) <> 0 Then
                    VSign = "ochenta y "
                End If
            Case "9"
                If Right(Cad, 1) = 0 Then
                    vigia = 1
                    VSign = "noventa"
                ElseIf Right(Cad, 1) <> 0 Then
                    VSign = "noventa y "
                End If
        End Select
        Cad = Right$(Cad, Len(Cad) - 1)
    End If
    
    If Len(Cad) = 1 Then
        Select Case Cad
            Case "0"
                If vigia = 1 Then AlgUno = VSign
                If vigia = 0 Then AlgUno = "cero"
            Case "1"
                If vigia = 1 Then AlgUno = VSign
                If vigia = 0 Then AlgUno = VSign & "uno"
            Case "2"
                If vigia = 1 Then AlgUno = VSign
                If vigia = 0 Then AlgUno = VSign & "dos"
            Case "3"
                If vigia = 1 Then AlgUno = VSign
                If vigia = 0 Then AlgUno = VSign & "tres"
            Case "4"
                If vigia = 1 Then AlgUno = VSign
                If vigia = 0 Then AlgUno = VSign & "cuatro"
            Case "5"
                If vigia = 1 Then AlgUno = VSign
                If vigia = 0 Then AlgUno = VSign & "cinco"
            Case "6"
                AlgUno = VSign & "seis"
            Case "7"
                AlgUno = VSign & "siete"
            Case "8"
                AlgUno = VSign & "ocho"
            Case "9"
                AlgUno = VSign & "nueve"
        End Select
        vigia = 0
    End If
End Function

Private Function AlgDos(ByVal Cad As String) As String
    Dim VmasSign As String
    Dim VMenSign As String
    If Len(Cad) = 3 Then
        VmasSign = AlgUno(Left$(Cad, 1))
        VMenSign = AlgUno(Right$(Cad, 2))
        Select Case VmasSign
            Case "cero"
                If VMenSign = "cero" Then
                    AlgDos = "cero"
                Else
                    AlgDos = AlgUno(Right(Cad, 2))
                End If
            Case "uno"
                If VMenSign = "cero" Then
                    AlgDos = "cien"
                Else
                    AlgDos = "ciento " & VMenSign
                End If
            Case "dos"
                If VMenSign = "cero" Then
                    AlgDos = VmasSign & "cientos"
                Else
                    AlgDos = VmasSign & "cientos " & VMenSign
                End If
            Case "tres"
                If VMenSign = "cero" Then
                    AlgDos = VmasSign & "cientos"
                Else
                    AlgDos = VmasSign & "cientos " & VMenSign
                End If
            Case "cuatro"
                If VMenSign = "cero" Then
                    AlgDos = VmasSign & "cientos"
                Else
                    AlgDos = VmasSign & "cientos " & VMenSign
                End If
            Case "cinco"
                If VMenSign = "cero" Then
                    AlgDos = "quinientos"
                Else
                    AlgDos = "quinientos " & VMenSign
                End If
            Case "seis"
                If VMenSign = "cero" Then
                    AlgDos = VmasSign & "cientos"
                Else
                    AlgDos = VmasSign & "cientos " & VMenSign
                End If
            Case "siete"
                If VMenSign = "cero" Then
                    AlgDos = VmasSign & "cientos"
                Else
                    AlgDos = VmasSign & "cientos " & VMenSign
                End If
            Case "ocho"
                If VMenSign = "cero" Then
                    AlgDos = VmasSign & "cientos"
                Else
                    AlgDos = VmasSign & "cientos " & VMenSign
                End If
            Case "nueve"
                If VMenSign = "cero" Then
                    AlgDos = "novecientos"
                Else
                    AlgDos = "novecientos " & VMenSign
                End If
        End Select
    ElseIf Len(Cad) = 2 Or Len(Cad) = 1 Then
        AlgDos = AlgUno(Cad)
    End If
End Function

Private Function AlgTres(ByVal CadNum As String) As String
    Dim ArrCadena() As String
    Dim ArrNombres() As String
    Dim i As Integer
    
    ArrCadena = Split(CadNum, ".", , vbTextCompare)
    ReDim ArrNombres(UBound(ArrCadena))
    For i = LBound(ArrCadena) To UBound(ArrCadena)
        ArrNombres(i) = AlgDos(ArrCadena(i))
    Next
    If UBound(ArrCadena) = 0 Then
        AlgTres = ArrNombres(0)
    ElseIf UBound(ArrCadena) = 1 Then
        AlgTres = SubAlg3A(ArrCadena(), ArrNombres())
    ElseIf UBound(ArrCadena) = 2 Then
        AlgTres = SubAlg3B(ArrCadena(), ArrNombres())
    ElseIf UBound(ArrCadena) = 3 Then
        AlgTres = SubAlg3C(ArrCadena(), ArrNombres())
    ElseIf UBound(ArrCadena) = 4 Then
        AlgTres = SubAlg3D(ArrCadena(), ArrNombres())
    End If
End Function

Private Function SubAlg3A(ByVal ArCad As Variant, ByVal ArNom As Variant) As String
        If ArCad(0) = "000" Then
            SubAlg3A = ArNom(1)
        ElseIf (ArCad(0) = "1" Or ArCad(0) = "001") And ArCad(1) <> "000" Then
            SubAlg3A = "mil " & ArNom(1)
        ElseIf (ArCad(0) = "1" Or ArCad(0) = "001") And ArCad(1) = "000" Then
            SubAlg3A = "mil"
        ElseIf ArCad(0) <> "1" And ArCad(1) = "000" Then
            If Right(ArCad(0), 1) = "1" And Right(ArCad(0), 2) <> "11" Then
                SubAlg3A = Left$(ArNom(0), Len(ArNom(0)) - 1) & " mil"
            Else
                SubAlg3A = ArNom(0) & " mil"
            End If
        ElseIf ArCad(0) <> "1" And ArCad(1) <> "000" Then
            If Right(ArCad(0), 1) = "1" And Right(ArCad(0), 2) <> "11" Then
                SubAlg3A = Left$(ArNom(0), Len(ArNom(0)) - 1) & " mil " & ArNom(1)
            Else
                SubAlg3A = ArNom(0) & " mil " & ArNom(1)
            End If
        End If
End Function

Private Function SubAlg3B(ByVal ArCad As Variant, ByVal ArNom As Variant) As String
        Dim ArCad2() As String
        Dim ArNom2() As String

        ReDim ArCad2(UBound(ArCad) - 1)
        ReDim ArNom2(UBound(ArCad) - 1)
        ArCad2(0) = ArCad(1)
        ArCad2(1) = ArCad(2)
        ArNom2(0) = ArNom(1)
        ArNom2(1) = ArNom(2)
        
        If ArCad(0) = "000" And ArCad(1) <> "000" Then
            SubAlg3B = "millones " & SubAlg3A(ArCad2, ArNom2)
        ElseIf (ArCad(0) & ArCad(1)) = "000000" And ArCad(2) <> "000" Then
            SubAlg3B = "millones " & SubAlg3A(ArCad2, ArNom2)
        ElseIf (ArCad(0) = "1" Or ArCad(0) = "001") And (ArCad(1) & ArCad(2)) <> "000000" Then
            SubAlg3B = "un millon " & SubAlg3A(ArCad2, ArNom2)
        ElseIf (ArCad(0) = "1" Or ArCad(0) = "001") And (ArCad(1) & ArCad(2)) = "000000" Then
            SubAlg3B = "un millon"
        ElseIf ArCad(0) <> 1 And (ArCad(1) & ArCad(2)) = "000000" Then
            If Right(ArCad(0), 1) = "1" And Right(ArCad(0), 2) <> "11" Then
                SubAlg3B = Left$(ArNom(0), Len(ArNom(0)) - 1) & " millones"
            Else
                SubAlg3B = ArNom(0) & " millones"
            End If
        ElseIf ArCad(0) <> "1" And (ArCad(1) & ArCad(2)) <> "000000" Then
            If Right(ArCad(0), 1) = "1" And Right(ArCad(0), 2) <> "11" Then
                SubAlg3B = Left$(ArNom(0), Len(ArNom(0)) - 1) & " millones " & SubAlg3A(ArCad2, ArNom2)
            Else
                SubAlg3B = ArNom(0) & " millones " & SubAlg3A(ArCad2, ArNom2)
            End If
        End If
End Function

Private Function SubAlg3C(ByVal ArCad As Variant, ByVal ArNom As Variant) As String
        Dim ArCad2() As String
        Dim ArNom2() As String
        
        ReDim ArCad2(UBound(ArCad) - 1)
        ReDim ArNom2(UBound(ArCad) - 1)
        ArCad2(0) = ArCad(1)
        ArCad2(1) = ArCad(2)
        ArCad2(2) = ArCad(3)
        ArNom2(0) = ArNom(1)
        ArNom2(1) = ArNom(2)
        ArNom2(2) = ArNom(3)
        
        If ArCad(0) = "000" And ArCad(1) <> "000" Then
            SubAlg3C = SubAlg3B(ArCad2, ArNom2)
        ElseIf (ArCad(0) & ArCad(1)) = "000000" And ArCad(2) <> "000" Then
            ArCad2(0) = ArCad(2)
            ArCad2(1) = ArCad(3)
            ArNom2(0) = ArNom(2)
            ArNom2(1) = ArNom(3)
            SubAlg3C = SubAlg3A(ArCad2, ArNom2)
        ElseIf (ArCad(0) & ArCad(1) & ArCad(2)) = "000000000" And ArCad(3) <> "000" Then
            SubAlg3C = ArNom2(2)
        ElseIf (ArCad(0) = "1" Or ArCad(0) = "001") And (ArCad(1) & ArCad(2) & ArCad(3)) <> "000000000" Then
            SubAlg3C = "mil " & SubAlg3B(ArCad2, ArNom2)
        ElseIf (ArCad(0) = "1" Or ArCad(0) = "001") And (ArCad(1) & ArCad(2) & ArCad(3)) = "000000000" Then
            SubAlg3C = "mil millones"
        ElseIf ArCad(0) <> 1 And (ArCad(1) & ArCad(2) & ArCad(3)) = "000000000" Then
            If Right(ArCad(0), 1) = "1" And Right(ArCad(0), 2) <> "11" Then
                SubAlg3C = Left$(ArNom(0), Len(ArNom(0)) - 1) & " mil millones"
            Else
                SubAlg3C = ArNom(0) & " mil millones"
            End If
        ElseIf ArCad(0) <> "1" And (ArCad(1) & ArCad(2) & ArCad(3)) <> "000000000" Then
            If Right(ArCad(0), 1) = "1" And Right(ArCad(0), 2) <> "11" Then
                SubAlg3C = Left$(ArNom(0), Len(ArNom(0)) - 1) & " mil " & SubAlg3B(ArCad2, ArNom2)
            Else
                SubAlg3C = ArNom(0) & " mil " & SubAlg3B(ArCad2, ArNom2)
            End If
        End If
End Function

Private Function SubAlg3D(ByVal ArCad As Variant, ByVal ArNom As Variant) As String
        Dim ArCad2() As String
        Dim ArNom2() As String
        
        ReDim ArCad2(UBound(ArCad) - 1)
        ReDim ArNom2(UBound(ArCad) - 1)
        ArCad2(0) = ArCad(1)
        ArCad2(1) = ArCad(2)
        ArCad2(2) = ArCad(3)
        ArCad2(3) = ArCad(4)
        ArNom2(0) = ArNom(1)
        ArNom2(1) = ArNom(2)
        ArNom2(2) = ArNom(3)
        ArNom2(3) = ArNom(4)
        
        If ArCad(0) = "1" And (ArCad(1) & ArCad(2) & ArCad(3) & ArCad(4)) <> "000000000000" Then
            SubAlg3D = "un billon " & SubAlg3C(ArCad2, ArNom2)
        ElseIf ArCad(0) = "1" And (ArCad(1) & ArCad(2) & ArCad(3) & ArCad(4)) = "000000000000" Then
            SubAlg3D = "un billon"
        ElseIf ArCad(0) <> 1 And (ArCad(1) & ArCad(2) & ArCad(3) & ArCad(4)) = "000000000000" Then
            If Right(ArCad(0), 1) = "1" And Right(ArCad(0), 2) <> "11" Then
                SubAlg3D = Left$(ArNom(0), Len(ArNom(0)) - 1) & " billones"
            Else
                SubAlg3D = ArNom(0) & " billones"
            End If
        ElseIf ArCad(0) <> "1" And (ArCad(1) & ArCad(2) & ArCad(3) & ArCad(4)) <> "000000000000" Then
            If Right(ArCad(0), 1) = "1" And Right(ArCad(0), 2) <> "11" Then
                SubAlg3D = Left$(ArNom(0), Len(ArNom(0)) - 1) & " billones " & SubAlg3C(ArCad2, ArNom2)
            Else
                SubAlg3D = ArNom(0) & " billones " & SubAlg3C(ArCad2, ArNom2)
            End If
        End If
End Function

Public Property Get AsignarNum() As Variant
    If m_AsignarNum = "" Then
        Err.Raise 515, "Conversor a tipos", "La propiedad no tiene asignado un valor"
    Else
        AsignarNum = m_AsignarNum
    End If
End Property

Public Property Let AsignarNum(ByVal NValor As Variant)
    If VarType(NValor) <> vbString Then
        Err.Raise 513, "Conversor a tipos", "El valor asignado a la propiedad no es una cadena"
    Else
        m_AsignarNum = FiltroCadena(NValor)
    End If
End Property

Private Function FiltroCadena(ByVal Text As String) As String
    Dim ValidCar As String
    Dim i As Long
    Dim Resultado As String
    
    ValidCar = "0123456789."
    For i = 1 To Len(Text)
        If InStr(ValidCar, Mid$(Text, i, 1)) Then
            Resultado = Resultado & Mid$(Text, i, 1)
        Else
            Err.Raise 514, "Conversor a tipos", "Esta cadena contiene caracteres que no coinciden con los numericos o contiene numeros decimales"
        End If
    Next
    On Error Resume Next
    FiltroCadena = Format(Resultado, "#,###,##0")
End Function

Property Get ConvNum() As String
    ConvNum = AlgTres(AsignarNum)
End Property

'Explicacion de metodos y propiedades

'Propiedad AsignarNum:Escritura/Lectura
'Escritura: Asigna a la propiedad una cadena que representa un numero, no se admiten numeros que no
'sean cadenas o cadenas con caracteres como "*/-+," pero si se admiten los puntos".".
'Lectura: Devuelve una cadena preformateada con puntos de separacion de miles para
'utilizarse en un textbox o cualquier otro control.

'propiedad ConvNum: Lectura
'Lectura:Devuelve una cadena que representa en letras el valor del numero introducido.

kunra · 16 Feb 2009

hola a todos porfa necesito urgente quien me explique como me conecto a una base de datos en access que tiene contraseña porfa es urgente porfa porfaaaaaa mi msn es juancho1984_2007@hotmail.com

Consultas sobre Visual Basic 6

Lanero Reconocido

Lanero Regular

Lanero Regular

Lanero Novato

Lanero Reconocido

Lanero Regular

Lanero Regular

Lanero Reconocido

Lanero Regular

Lanero Reconocido

Lanero Regular

Lanero Regular

Lanero Regular

Lanero Reconocido

Lanero Regular

Lanero Reconocido

Lanero Regular

Lanero Reconocido

Lanero Reconocido

Lanero Regular