Últimos Temas de: corlo

Mostrar Temas
Páginas: 1 [2] 3

Programación / Programación Visual Basic / descontar valor en list1 de la columna 3

en: 24 Febrero 2021, 00:42 am

Hola soy corlo

estoy haciendo un pequeño programa necesito descontar el valor que le pongo en el text3.text
y lo cambie en el valor seleccionado del list1 de la columna 3

en el programa hay los siguientes objetos:

1 list1
1 list2

text1.text
text2.text
text3.text

1 command1 salida
1 command4 ok

la cuestion es que cuando aprieto el command1 la operacion de resta lo hace bien, cuando voy a el command4 no consigo poner el resultado del text3.text en el list1 del valor seleccionado de la columna 3

aqui esta el codigo que tengo hasta ahora:

Código:



Option Explicit






Private Sub Command1_Click()
'salida ok


 Dim i As Long
Dim arrString() As String
For i = 0 To UBound(arrString)
    List1.AddItem arrString(i)
Next

End Sub

Private Sub Command3_Click()
Unload Me
Form1.Show
End Sub

Private Sub Command4_Click()
'Salida
Dim cantidad As Integer
cantidad = Text1.Text

If Text3.Text > cantidad Then
   MsgBox "No hay suficiente existencia", vbCritical
   Exit Sub
End If

Command1.Visible = True
Text3.Text = Text3.Text - Text1.Text
End Sub

Private Sub Form_Load()
List1.AddItem "p001" & "                     " & "descripciom p001" & "                           " & "42"
List1.AddItem "p002" & "                     " & "descripciom p002" & "                           " & "53"
List1.AddItem "p003" & "                     " & "descripciom p003" & "                           " & "244"
List1.AddItem "p004" & "                     " & "descripciom p004" & "                           " & "75"
Text2.Text = List1.ListCount
Command1.Visible = False
End Sub

Private Sub List1_Click()

    Dim x As Integer
  List2.Clear
   
  List2.AddItem List1.Text

    For x = 0 To List2.ListCount - 1
   
   Text1.Text = Mid(List2.List(x), Len(List2.List(x)) - 2, 3)

   
   Next x
    
    
End Sub

he probado varias formas pero no consigo cambiar el valor del text3 al list1

gracias

Programación / Programación Visual Basic / leer user y password en archivos aleatorios

en: 4 Enero 2021, 23:17 pm

Hola soy corlo
tengo el siguiente problema

cuando pongo lo siguiente en el apartado leer user y password

Text1.Text = Access.uname
Text2.Text = Access.passwd

el problema es cuando estoy leyendo el user y password introduzca datos diferentes en el text1.text y el text2.text , y pongo los datos que hay en fichero siempre me dice bienbenido y va al form2

en cambio cuando quito

Text1.Text = Access.uname
Text2.Text = Access.passwd

siempre me dice El archivo no existe

Aqui pongo el codigo

Código:


Option Explicit
Private Type Authorize
    uname As String * 30
    passwd As String * 30
End Type

Dim Pos As Integer
Dim Cont As Integer
Dim Fnum As Integer






Private Sub Command1_Click()
'Guardar
Dim Access As Authorize


Fnum = FreeFile
Access.uname = Text1.Text
Access.passwd = Text2.Text
Open App.Path & "\members1.dat" For Random As #Fnum Len = Len(Access)
    Cont = LOF(Fnum) / Len(Access)


Pos = Cont + 1
Put Fnum, Pos, Access

MsgBox "Nuevo Usuario Añadido: " & Access.uname & Access.passwd

Close #Fnum
End Sub

Private Sub Command2_Click()
'leer
Dim Access As Authorize
 
    Fnum = FreeFile

Open App.Path & "\members1.dat" For Random As #Fnum Len = Len(Access)
    Cont = LOF(Fnum) / Len(Access)

For Pos = 1 To Cont

   Get #Fnum, Pos, Access
 


   
   
Next
Text1.Text = Access.uname
Text2.Text = Access.passwd

Close #Fnum



   If Text1.Text = "" And Text1.Text <> Access.uname And Text2.Text <> Access.passwd Then
MsgBox "El archivo no existe", vbCritical, "No existe"
Text1.Text = ""
Text2.Text = ""
Exit Sub
End If

If Text1.Text = Access.uname Or Text2.Text = Access.passwd Then
MsgBox "Bienvenido", vbInformation
Form2.Show
Me.Hide
End If











End Sub

Private Sub Command3_Click()
End
End Sub


Private Sub Command4_Click()
Text1.Text = ""
Text2.Text = ""
Text1.SetFocus
End Sub

la pregunta seria:

como solucionar el tema de los avisos en el apartado leer

1. para ir al formulario dos

2. para el registro no existe

Gracias

13	Programación / Programación Visual Basic / imprimir por impresora linea recta mas gruesa	en: 14 Noviembre 2020, 23:23 pm
Hola soy Corlo Mi problema es el siguiente: Cuando lo hago por pantalla me lo hace bien en un commandbutton1 Código: DrawWidth = 5 DrawStyle = 2 Line (950, 2950)-(12000, 2950) Pero cuando lo hago por impresora, no me hace nada intento hacer esto: Código: DrawWidth = 5 DrawStyle = 2 Printer.Line (950, 2950)-(12000, 2950) Printer.EndDoc pero no sale, he buscado por internet y no encuentro la solucion, gracias

Programación / Programación Visual Basic / imprimir list1

en: 3 Octubre 2020, 16:32 pm

Hola soy corlo
tengo una duda para imprimir list1

el codigo que tengo hasta ahora es el siguiente

Código:



Private Sub Command7_Click()
' Imprimir
Dim total As String
Dim total1 As String
Dim total2 As String
Dim i As Integer

Dim factura As Integer

ReDim lbtab(1 To 4) As Long

lbtab(1) = 31
lbtab(2) = 141
lbtab(3) = 278
lbtab(4) = 478
SendMessageArray List1.hwnd, LB_SETTABSTOPS, 4, lbtab(1)

total = Label5.Caption
total1 = Label6.Caption
total2 = Label7.Caption

Printer.FontSize = 18

Printer.CurrentX = 3100
Printer.CurrentY = 0
Printer.Print "Factura Nº:"
Printer.CurrentX = 5000
Printer.CurrentY = 0
Printer.Print Txtnum.Text


Printer.CurrentX = 1000
Printer.CurrentY = 3000
Printer.Print "Cantidad"
Printer.CurrentX = 3500
Printer.CurrentY = 3000
Printer.Print "Producto"
Printer.CurrentX = 7350
Printer.CurrentY = 3000
Printer.Print "Precio"
Printer.CurrentX = 9900
Printer.CurrentY = 3000
Printer.Print "Subtotal"


For i = 0 To List1.ListCount - 1
List1.ListIndex = i

Printer.Print List1.List(i)
Next


List1.Clear

Printer.CurrentX = 8400
Printer.CurrentY = 10000
Printer.Print "Subtotal:"
Printer.CurrentX = 9300
Printer.CurrentY = 10500
Printer.Print "iva:"
Printer.CurrentX = 9000
Printer.CurrentY = 11000
Printer.Print "Total:"

Printer.CurrentX = 10000
Printer.CurrentY = 10000
Printer.Print total
Printer.CurrentX = 10000
Printer.CurrentY = 10500
Printer.Print total1
Printer.CurrentX = 10000
Printer.CurrentY = 11000
Printer.Print total2


Printer.Print









 Printer.EndDoc
 


End Sub

la impresion lo hace bien

como puedo hacer las separaciones del list1 a la hora de imprimir las columnas
el list1 tiene 4 columnas

ReDim lbtab(1 To 4) As Long

lbtab(1) = 31
lbtab(2) = 141
lbtab(3) = 278
lbtab(4) = 478
SendMessageArray List1.hwnd, LB_SETTABSTOPS, 4, lbtab(1)

15	Programación / Programación Visual Basic / imagenes aleatorias seguidas	en: 7 Septiembre 2020, 23:22 pm
Hola soy corlo estoy haciendo un pequeño codigo de imagenes aleatorias, que apretando un command1 me va generando una imagen aleatoria, funciona perfectamente ahora lo que quiero es que con otro boton command2 me haga todas las imagenes aleatorias seguidas mediante un intervalo de tiempo. en el formulario hay : filelistbox=archivos image1 el codigo es el siguiente: Código: Private Sub Command1_Click() Dim aleatorio As Integer aleatorio = Int(((archivos.ListCount - 1) * -1) * Rnd + archivos.ListCount - 1) Image1.Picture = LoadPicture(App.Path + "\imagenes\" + archivos.List(aleatorio)) End Sub Private Sub Form_Load() archivos.Path = App.Path + "\imagenes\" End Sub gracias

Programación / Programación Visual Basic / leer indice del archivo txt

en: 17 Junio 2020, 12:49 pm

Hola soy corlo
estoy haciendo un codigo para leer el final del archivo del indice o sea text6.text
text6.text=contador
text1.text=azar
text2.text=azar1
text3.text=azar2
text3.text=azar3
text4.text=azar4

a la hora de grabar la informacion me lo hace bien, pero cuando cierro el programa y lo ejecuto
otra vez me dice el siguiente error en el form load

Error '62' en tiempo de ejecucion:
la entrada de datos se ha sobrepasado el final del archivo
en la linea:
Input #1, azar, azar1, azar2, azar3, azar4

y lo que yo quiero es leer la variable contador al final del archivo

Código:




Dim contador As Integer
Dim azar As Integer
Dim azar1 As Integer
Dim azar2 As Integer
Dim azar3 As Integer
Dim azar4 As Integer

Private Sub Command1_Click()
'Nuevo
Text6.Text = contador + 1
contador = contador + 1
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""


End Sub

Private Sub Command2_Click()

'Guardar

    Open App.Path & "\azar" & ".txt" For Append As #1
    Print #1, Text6.Text & vbCrLf
    Print #1, Text1.Text, Text2.Text, Text3.Text, Text4.Text, Text5.Text & vbCrLf
    Close #1


End Sub

Private Sub Command4_Click()
End
End Sub

Private Sub Command5_Click()
' Calcular

Randomize
azar = Int(Rnd * 45) + 1
Text1.Text = azar
azar1 = Int(Rnd * 45) + 1
Text2.Text = azar1
azar2 = Int(Rnd * 45) + 1
Text3.Text = azar2
azar3 = Int(Rnd * 45) + 1
Text4.Text = azar3
azar4 = Int(Rnd * 45) + 1
Text5.Text = azar4
End Sub

Private Sub Form_Load()
If contador = 0 Then
Open App.Path & "\azar" & ".txt" For Append As #1
Close #1
End If
If contador = 0 Then contador = 1
Open App.Path & "\azar" & ".txt" For Input As #1
     While Not EOF(1)
     Input #1, contador
     Input #1, azar, azar1, azar2, azar3, azar4

en el segunda lectura me pone el siguiente error:
Error '62' en tiempo de ejecucion:
la entrada de datos se ha sobrepasado el final del archivo


     Wend
      Close #1
Text6.Text = contador
End Sub

Gracias

Programación / Programación Visual Basic / modificar list1

en: 4 Marzo 2020, 23:20 pm

Hola soy corlo
modificar datos de text1,text2 a list1 del formulario 2 al formulario 1
leer datos de list1 a text1, text2 del formulario 1 al formulario 2

aqui dejo el codigo que tengo hasta ahora

en el formulario1

Código:


Private Sub Form_Load()
List1.AddItem "jorge" & "               " & "Ramirez"
List1.AddItem "luis" & "                " & "Rodriguez"
List1.AddItem "pedro" & "               " & "Gonzalez"

End Sub



Private Sub List1_DblClick()

'Form2.Text1.Text = List1.List(List1.ListIndex)

Dim i As Integer

 Form2.Text1.Text = Mid(List1.Text, 1, InStr(1, List1.Text, " ") - 1)
Form2.Text2.Text = Mid(List1.Text, InStr(List1.Text, " ") + 16)
i = List1.ListIndex
   

Form2.Show
End Sub

y en el formulario 2 esto

Código:



Private Sub Command1_Click()
 Form1.List1.List(Form1.List1.ListIndex) = Form2.Text1.Text
Form1.List1.List(Form1.List1.ListIndex) = Form2.Text2.Text
Unload Me
End Sub

no logro hacer la modificacion del formulario 2 al formulario 1
gracias

Programación / Programación Visual Basic / archivo de texto resumen de un mes

en: 22 Enero 2020, 15:46 pm

hola soy corlo
tengo un pequeño problema a la hora de pasar informacion de un archivo de texto , combo1 tengo los 12 meses, y cuando selecciono un mes vaya leyendo en list1.

en el formulario hay un combo1, y un list1

en el list1 hay lo iguiente:

en el dia 1/1/2020

1 1/1/2020 a
1 1/1/2020 b
1 1/1/2020 c
4 1/1/2020 d
5 11/12/2018 e

en dia 2/1/2020

5 2/1/2020 f
7 2/1/2020 g
8 2/1/2020 h
9 2/1/2020 i

en dia 3/1/2020

10 3/1/2020 o
11 3/1/2020 p
12 3/1/2020 s

y este el codigo:

Código:


Option Explicit
Dim g As Integer
Dim i As Integer
Dim fencontrada As Boolean

Private Sub Combo1_Click()
 Dim f_Canal As Long
On Error GoTo plo
fencontrada = False
List1.Clear
Select Case Combo1.Text
Case "enero":
g = 0
Call BuscarItems(List1.List(List1.ListIndex))

Case "febrero":
g = 1
Call BuscarItems(List1.List(List1.ListIndex))


Case "marzo":
g = 2
Call BuscarItems(List1.List(List1.ListIndex))


Case "abril":
g = 3
Call BuscarItems(List1.List(List1.ListIndex))


Case "mayo":
g = 4
Call BuscarItems(List1.List(List1.ListIndex))

Case "junio":
g = 5
Call BuscarItems(List1.List(List1.ListIndex))



Case "julio":
g = 6
Call BuscarItems(List1.List(List1.ListIndex))


Case "agosto":
g = 7
Call BuscarItems(List1.List(List1.ListIndex))


Case "septiembre":
g = 8
Call BuscarItems(List1.List(List1.ListIndex))

Case "octubre":
g = 9
Call BuscarItems(List1.List(List1.ListIndex))



Case "noviembre":
g = 10
Call BuscarItems(List1.List(List1.ListIndex))


Case "diciembre":
g = 11
Call BuscarItems(List1.List(List1.ListIndex))



End Select



plo:
If Not fencontrada Then
    MsgBox "El Mes " & Combo1.Text & " no existe."
    Combo1.Text = ""
   Close f_Canal

End If
End Sub



Private Sub Form_Load()
Combo1.Clear
Combo1.AddItem "enero"
Combo1.AddItem "febrero"
Combo1.AddItem "marzo"
Combo1.AddItem "abril"
Combo1.AddItem "mayo"
Combo1.AddItem "junio"
Combo1.AddItem "julio"
Combo1.AddItem "agosto"
Combo1.AddItem "septiembre"
Combo1.AddItem "octubre"
Combo1.AddItem "noviembre"
Combo1.AddItem "diciembre"
End Sub


Private Sub BuscarItems(ByVal strFecha As String)
    Dim item As String
 Dim f_Canal As Long
   
 
    With file
        Text1.Text = CStr(.Id)
        Text2.Text = CStr(.Date)
        Text3.Text = CStr(.Name)
    End With
 Open App.Path & "\database.txt" For Random As f_Canal Len = Len(file)
    Seek (f_Canal), 1     ' posicionar el puntero de lectura al comienzo del fichero (en vb6 es la dirección 1).
    Do While Not EOF(f_Canal)
        Get f_Canal, , file
        With file
            If (StrComp(strFecha, CStr(.date), vbTextCompare) = 0) Then
                item = FormatStr(CStr(.id), 4, True)
                item = FormatStr(item, 12) & _
                       FormatStr(CStr(.date), 16) & _
                       FormatStr(.name, 40)
            Call List1.AddItem(item)
            End If
        End With
    Loop
    Close f_Canal
End Sub

Private Function FormatStr(ByRef Txt As String, ByVal Limite As Integer, Optional ByVal EsNumero As Boolean = False)

    If EsNumero Then
        FormatStr = FormatNumber(Txt, Limite)
    Else
        FormatStr = FormatString(Txt, Limite)
    End If
End Function
 
' Asegura que el texto tenga por tamaño exactamente el valor de límite
' Si es más corto añade espacios a la derecha.
Private Function FormatString(ByRef Txt As String, ByVal Limite As Integer) As String
    Dim k As Integer
 Dim maximo As Integer
    k = Len(Txt)
    k = (Limite - k)
    If (k > 0) Then
        FormatString = Txt & Space$(k)
    ElseIf (k < 0) Then
        FormatString = Left$(Txt, maximo)
    Else
        FormatString = Txt
    End If
End Function
 
 'Asegura que el texto tenga por tamaño exactamente el valor de límite
' OJO: Si es más corto añade 'ceros' a la izquierda.
Private Function FormatNumber(ByRef Txt As String, ByVal Limite As Integer) As String
    Dim k As Integer
 
    k = Len(Txt)
    k = (Limite - k)
    If (k > 0) Then
       FormatNumber = String$(k, "0") & Txt
    ElseIf (k < 0) Then
        FormatNumber = Left$(Txt, Limite)
Else
        FormatNumber = Txt
    End If
End Function



y en un modulo:

Type Task
id As Integer
date As Date
name As String * 30
End Type


Option Explicit
Global file As Task

gracias

Programación / Programación Visual Basic / cambiar contador a uno al dia siguiente

en: 24 Noviembre 2019, 14:22 pm

Hola soy Corlo
necesito una ayuda para el siguiente tema
La cuestion es que el siguiente programa que he hecho funciona correctamente, pero el problema que hay es que cuando pasa un dia entero que cambie el contador de n=1 en la caja de texto text1.text y que vaya sumando el contador correlativamente
dejo el codigo

Código:


Option Explicit
Dim n As Integer



Private Sub Command1_Click()
'Nuevo
Open App.Path & "\database.txt" For Random As 1 Len = Len(file)


n = LOF(1) / Len(file)

Get #1, n, file
Text1.Text = n + 1
Close #1

Text2.Text = Format(date, "dd/mm/yyyy")
Text3.Text = ""
Text3.SetFocus
End Sub

Private Sub Command2_Click()
'Guardar
file.id = Text1.Text
file.date = Text2.Text
file.name = Text3.Text

Open App.Path & "\database.txt" For Random As 1 Len = Len(file)

n = LOF(1) / Len(file)
Put #1, n + 1, file
Close #1
End Sub

Private Sub Command3_Click()
End
End Sub

Private Sub Command4_Click()
Unload Me
Form2.Show
End Sub

Private Sub Form_Load()
Open App.Path & "\database.txt" For Random As 1 Len = Len(file)

n = LOF(1) / Len(file)

Get #1, n, file
Text1.Text = n + 1

Close #1

Text2.Text = Format(date, "dd/mm/yyyy")
End Sub

y en un modulo

Código:


Type Task
id As Integer
date As Date
name As String * 30
End Type


Option Explicit
Global file As Task

Gracias

Programación / Programación Visual Basic / como hacer un pdf

en: 12 Marzo 2019, 23:07 pm

hola soy corlo
quisiera hacer un pdf del siguiente codigo

Código:



en un modulo:


Type Task
id As Integer
date As Date
name As String * 30
End Type


Option Explicit
Global file As Task



en el formulario






Private f_Canal     As Integer     ' canal del fichero.

Private Sub List1_Click()
    Call BuscarItems(lisFechas.List(lisFechas.ListIndex))
End Sub
 
' Qué buscamos?: El dato (fecha), que se ha pulsado en list1...
'  y lo buscamos en todos los registros del fichero.
Private Sub BuscarItems(ByVal strFecha As String)
    Dim item As String
 
    List2.Clear
    Open App.Path & "\database.txt" For Random As f_canal Len = Len(file)
 
    Seek (f_Canal), 1     ' posicionar el puntero de lectura al comienzo del fichero (en vb6 es la dirección 1).
    Do While Not EOF(f_Canal)
        Get f_Canal, , file
        With file
            If (StrComp(strFecha, CStr(.Date), vbTextCompare) = 0) Then
                item = FormatStr(CStr(.Id), 6, True)
                item = FormatStr(item, 12) & _
                       FormatStr(CStr(.Date), 16) & _
                       FormatStr(.Name, 44)
                Call List2.AddItem(item)  ' list2, probablemente no precise estar ordenado...
            End If
        End With
    Loop

Close #f_canal
End Sub

gracias

Páginas: 1 [2] 3