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


Tema destacado: Recopilación de Tutoriales y Manuales del blog ordenados por categorías


  Mostrar Mensajes
Páginas: 1 2 3 [4] 5 6 7 8 9 10 11 12 13
31  Programación / Programación Visual Basic / Re: Guardar list2 y leer list1 en: 1 Mayo 2022, 18:07 pm
Hola serapis

he hecho los cambios y ahora me dice error en crearnuevafacturacion

Código
  1.  
  2. Private Sub mnualmacen_Click(Index As Integer)
  3. 'Crear Nuevo Almacen
  4. Dim File As String
  5.  
  6.    Select Case Index
  7.        Case 0  ' Nueva facturación
  8.             File = InputBox("Elija el nombre del fichero para una nueva facturacón (no debe existir).", "Nueva Facturacion", "Nueva facturacion.dat")
  9.            If (Len(File) > 0) Then
  10.                File = AsegurarExtension(File, FILE_EXTENSION_FACTURA)
  11.  
  12.                If (CrearNuevaFacturacion(File) = True) Then
  13.                    Call Activar(True)
  14.  
  15.                Else
  16.                    Call Activar(False)
  17.                End If
  18.            Else
  19.                Call MsgBox("Proceso de creación de nueva facturación abortado. No se proporcionó un nombre", vbInformation, "Nueva facturación")
  20.            End If
  21.        Case 1  ' Leer fichero de facturación
  22.            Frmfile1.Show 1
  23.            If (Len(Frmfile1.File) > 0) Then
  24.                If (LeerFacturacion(App.Path & "\" & Frmfile1.File) = True) Then
  25.                    Call Activar(True)
  26.                Else
  27.                    Call Activar(False)
  28.                End If
  29.            End If
  30.  
  31.    End Select
  32. End Sub
  33.  
  34.  
  35.  
  36.  

If (CrearNuevaFacturacion(File) = True) Then


error argument not opcional en CrearNuevaFacturacion(file)


gracias


32  Programación / Programación Visual Basic / Re: Guardar list2 y leer list1 en: 1 Mayo 2022, 14:18 pm
Ahora crea el nuevo almacen, pero no logro que me lea el almacen


Código
  1.  
  2. Private Sub mnualmacen_Click(Index As Integer)
  3. 'Crear Nuevo Almacen
  4. Dim File As String
  5.  
  6.    Select Case Index
  7.        Case 0  ' Nuevo Almacen
  8.             File = InputBox("Elija el nombre del fichero para una nuevo Almacen (no debe existir).", "Nuevo Almacen", "Nuevo Almacen.dat")
  9.            If (Len(File) > 0) Then
  10.                File = AsegurarExtension(File, FILE_EXTENSION_FACTURA)
  11.  
  12.                If (CrearNuevaFacturacion(File) = True) Then
  13.                    Call Activar(True)
  14.  
  15.                Else
  16.                    Call Activar(False)
  17.                End If
  18.            Else
  19.                Call MsgBox("Proceso de creación de nuevo Almacen abortado. No se proporcionó un nombre", vbInformation, "Nuevo Almacen")
  20.            End If
  21.        Case 1  ' Leer Nuevo Almacen
  22.            Frmfile1.Show 1
  23.            If (Len(Frmfile1.File) > 0) Then
  24.                If (LeerFacturacion(App.Path & "\" & Frmfile1.File) = True) Then
  25.                    Call Activar(True)
  26.                Else
  27.                    Call Activar(False)
  28.                End If
  29.            End If
  30.  
  31.    End Select
  32. End Sub
  33.  
  34.  
  35.  
  36. Private Function CrearNuevaFacturacion(ByRef NombreFile As String) As Boolean
  37. Dim Ruta As String
  38.  
  39.    If (Abierto = True) Then Call Cerrar(Canal)
  40.  
  41.    Ruta = (App.Path & "\" & NombreFile)
  42.    If (Abrir(Ruta, Canal, True) = True) Then
  43.        Call UpdateHeader(0, 0)
  44.        CrearNuevaFacturacion = True
  45.    Else
  46.        MsgBox "Parece que el fichero que intenta abrir ya existe, elija otro nombre (o bien ocurrió un error)..."
  47.    End If
  48. End Function
  49.  
  50.  
  51. Private Function LeerFacturacion(ByRef Ruta As String) As Boolean
  52.   Dim k As Integer
  53.  
  54.    If (Abierto = True) Then Call Cerrar(Canal)
  55.  
  56.    If (Abrir(Ruta, Canal) = True) Then
  57.        Get #Canal, 1, NumRegistros
  58.        Get #Canal, , AutoIncLote
  59.        Get #Canal, , AutoIncProducto
  60.  
  61.        If (NumRegistros > 0) Then
  62.            With List1
  63.                .Clear
  64.                For k = 1 To NumRegistros
  65.                    Get #Canal, , RegX
  66.                    Call .AddItem(RegCompraToString(RegX, CHAR_SEP))
  67.                Next
  68.  
  69.                ' Ahora si se quiere puede leerse de nuevo el primer registro para transferirlo a los textbox...
  70.                .ListIndex = 0 ' para ello delegamos en el código que pondremos al listbox...
  71.            End With
  72.        End If
  73.  
  74.        LeerFacturacion = True
  75.    End If
  76. End Function
  77.  
  78.  
  79.  
  80.  
  81.  
  82.  
  83.  




el problema esta en esta linea


Call .AddItem(RegCompraToString(RegX, CHAR_SEP))



error byref argument type mismatch en RegX

gracias




33  Programación / Programación Visual Basic / Re: Guardar list2 y leer list1 en: 22 Abril 2022, 19:05 pm
Hola Serapis

Estoy intentando de hacer crear almacen nuevo y leer almacen del menu principal  lo he probado de hacerlo con el formulario frmfile pero no me lo hace

si no es asin no se como hacerlo

gracias
34  Programación / Programación Visual Basic / Re: poner tanto por ciento en el grafico circular en: 3 Abril 2022, 16:21 pm
ok

es algo parecido en 3d

porque en 3d seria de mas grosor
un ejemplo en 3d

gracias
35  Programación / Programación Visual Basic / Re: poner tanto por ciento en el grafico circular en: 3 Abril 2022, 15:48 pm
ok

he puesto el valor relativo en los 4 cajos


Valor relativo (porcentaje): (cstr(v1) & "%")


muchas gracias
36  Programación / Programación Visual Basic / Re: poner tanto por ciento en el grafico circular en: 3 Abril 2022, 13:44 pm
perfecto justo lo que necesitaba


muchisimas gracias serapis
37  Programación / Programación Visual Basic / Re: poner tanto por ciento en el grafico circular en: 1 Abril 2022, 14:02 pm
lo que quiero es poner los valores numericos que hay en los textbox osea text2,text3,text4,text5,en cada particion del grafico circular que sean visibles

lo del indice no hace falta, ya lo he solucionado


y perdona si no me expreso bien



gracias
38  Programación / Programación Visual Basic / Re: poner tanto por ciento en el grafico circular en: 31 Marzo 2022, 22:01 pm
he mejorado el codigo del grafico ahora introduzco los datos fijos y los lee

solo quisiera poner el porcentaje en el grafico circular

el codigo es el siguiente


Código
  1.  
  2.  
  3.  
  4. Option Explicit
  5. Private Type departamento
  6. d As Date
  7. x As Double
  8. y As Double
  9. z As Double
  10. w As Double
  11. End Type
  12.  
  13. Dim dpto As departamento
  14. Dim NumRecs As Long
  15.  
  16. Private Sub Command1_Click()
  17. 'Grafico
  18. DrawPie
  19. End Sub
  20.  
  21.  
  22.  
  23. Private Sub DrawPie()
  24. Const PI As Double = 3.14159265359
  25. Dim x1 As Double, y1 As Double, z1 As Double, w1 As Double
  26. Dim x As Double, y As Double, z As Double, w As Double
  27. Dim r As Double, midx As Double, midy As Double
  28. Dim sum As Double
  29. 'Text1.Text = Format$(Date, "dd/mm/yyyy")
  30.  Picture2.Cls
  31.  
  32.  Picture2.FillStyle = 0
  33.  
  34.  x1 = Val(Text2.Text)
  35.  y1 = Val(Text3.Text)
  36.  z1 = Val(Text4.Text)
  37.  w1 = Val(Text5.Text)
  38.  
  39.  sum = x1 + y1 + z1 + w1
  40.  
  41.  x = x1 / sum
  42.  y = y1 / sum
  43.  z = z1 / sum
  44.  w = w1 / sum
  45.  
  46.  midx = Picture2.Width / 2
  47.  midy = Picture2.Height / 2
  48.  
  49.  r = Picture2.Width / 2 - 300
  50.  
  51.  If x <> 0 And y <> 0 And z <> 0 Then
  52.  
  53.  Picture2.FillColor = vbRed
  54.  Picture2.Circle (midx, midy), r, , -2 * PI, -2 * PI * x, 2 / 3
  55.  Picture2.FillColor = vbYellow
  56.  Picture2.Circle (midx, midy), r, , -2 * PI * x, -2 * PI * (x + y), 2 / 3
  57.  Picture2.FillColor = vbBlue
  58.  Picture2.Circle (midx, midy), r, , -2 * PI * (x + y), -2 * PI * (x + y + z), 2 / 3
  59.  Picture2.FillColor = vbGreen
  60.  Picture2.Circle (midx, midy), r, , -2 * PI * (x + y + z), -2 * PI, 2 / 3
  61.  End If
  62.  
  63. End Sub
  64.  
  65. Private Sub Command2_Click()
  66. 'Guardar
  67. With dpto
  68.      .d = Text1.Text
  69.      .x = Val(Text2.Text)
  70.      .y = Val(Text3.Text)
  71.      .z = Val(Text4.Text)
  72.      .w = Val(Text5.Text)
  73.    End With
  74.  
  75.    NumRecs = 1
  76.    Open App.Path & "\PieData.dat" For Random As #1 Len = Len(dpto)
  77.      Put #1, 1, NumRecs
  78.      Put #1, NumRecs + 1, dpto
  79.    Close #1
  80. End Sub
  81.  
  82. Private Sub Command3_Click()
  83. 'Leer
  84.  
  85.  
  86.  
  87.  
  88. 'If FileLen(App.Path & "\PieData.dat") > 60 Then
  89.    Open App.Path & "\PieData.dat" For Random As #1 Len = Len(dpto)
  90.      Get #1, 1, NumRecs
  91.      Get #1, NumRecs + 1, dpto
  92.  
  93.      With dpto
  94.       Text1.Text = .d
  95.       Text2.Text = Val(.x)
  96.       Text3.Text = Val(.y)
  97.       Text4.Text = Val(.z)
  98.       Text5.Text = Val(.w)
  99. End With
  100.  
  101.  
  102.  
  103.  
  104.    Close #1
  105.    DrawPie
  106.  'End If
  107. End Sub
  108.  
  109. Private Sub Command4_Click()
  110. End
  111. End Sub
  112.  
  113. Private Sub Command5_Click()
  114. Picture2.Cls
  115. Text2.SetFocus
  116. End Sub
  117.  
  118.  
  119.  
  120.  
  121. Private Sub Form_Load()
  122. Text1.Text = Format$(Date, "dd/mm/yyyy")
  123. End Sub
  124.  
  125.  
  126.  
  127.  
  128.  






Gracias
39  Programación / Programación Visual Basic / poner tanto por ciento en el grafico circular en: 30 Marzo 2022, 12:30 pm
estoy haciendo un pequeño programa con el cual hay unos datos fijos y quisiera poner esos datos en el grafico circular hay cuatro datos pero hay un quinto dato que falta dibujar  que es la variable z1 en el grafico y poner el dato en el grafico.

en el programa faltaria controlar el indice de introducir los datos que empezara por 1,2,3,4,5, etc


el ejemplo que tengo hasta ahora es el siguiente:


Código
  1.  
  2.  
  3. Option Explicit
  4. Private Type departamento
  5. d As Date
  6. w As Double
  7. x As Double
  8. y As Double
  9. z As Double
  10. zl As Double
  11. End Type
  12.  
  13. Dim dpto As departamento
  14. Dim NumRecs As Long
  15.  
  16. Private Sub Command1_Click()
  17. 'Grafico
  18. DrawPie
  19. End Sub
  20.  
  21. Private Sub DrawPiePiece(lColor As Long, ByVal fStart As Double, ByVal fEnd As Double)
  22.  Const PI As Double = 3.14159265359
  23.  Const CircleEnd As Double = -2 * PI
  24.  Dim dStart As Double
  25.  Dim dEnd As Double
  26.  
  27.  Picture2.FillColor = lColor
  28.  Picture2.FillStyle = 0
  29.  dStart = fStart * (CircleEnd / 100)
  30.  dEnd = fEnd * (CircleEnd / 100)
  31.  Picture2.Circle (170, 150), 100, , dStart, dEnd
  32. End Sub
  33.  
  34. Private Sub DrawPie()
  35.  Dim Disp As Single, Alq As Single, i As Byte, Vt As Integer, Ang1 As Single, Ang2 As Single
  36.  
  37.  Picture2.Cls
  38.  
  39.  Picture2.AutoRedraw = True
  40.  Picture2.BackColor = &H8000000E
  41.  Picture2.ScaleMode = vbPixels
  42.  
  43.  
  44.  Dim xx As Double
  45.  Dim yy As Double
  46.  Dim zz As Double
  47.  Dim uu As Double
  48.  
  49.  
  50.  With dpto
  51.    If .w = 0 Then MsgBox "No hay registros para" & DateTime.Date & "para ser mostrado"
  52.        Text1.Text = .d
  53.        If .w > 0 Then
  54.        xx = (.x * 100) / .w
  55.        yy = xx + (.y * 100) / .w
  56.        zz = yy + (.z * 100) / .w
  57.        uu = zz + (.zl * 100) / .w
  58.  
  59.        Call DrawPiePiece(QBColor(1), 0.001, xx)
  60.        Call DrawPiePiece(QBColor(6), xx, yy)
  61.        Call DrawPiePiece(QBColor(3), yy, zz)
  62.        Call DrawPiePiece(QBColor(5), zz, uu)
  63.    End If
  64.  
  65.  End With
  66. End Sub
  67.  
  68. Private Sub Command2_Click()
  69. 'Guardar
  70. With dpto
  71.      .d = Date
  72.      .w = 650
  73.      .x = 301
  74.      .y = 39
  75.      .z = 109
  76.      .zl = 201
  77.    End With
  78.  
  79.    NumRecs = 1
  80.    Open App.Path & "\PieData.dat" For Random As #1 Len = 64
  81.      Put #1, 1, NumRecs
  82.      Put #1, NumRecs + 1, dpto
  83.    Close #1
  84. End Sub
  85.  
  86. Private Sub Command3_Click()
  87. 'Leer
  88. If FileLen(App.Path & "\PieData.dat") > 60 Then
  89.    Open App.Path & "\PieData.dat" For Random As #1 Len = 64
  90.      Get #1, 1, NumRecs
  91.      Get #1, NumRecs + 1, dpto
  92.    Close #1
  93.    DrawPie
  94.  End If
  95. End Sub
  96.  
  97. Private Sub Command4_Click()
  98. End
  99. End Sub
  100.  
  101. Private Sub Command5_Click()
  102. Picture2.Cls
  103. End Sub
  104.  
  105.  
  106.  
  107.  




gracias
40  Programación / Programación Visual Basic / Re: Guardar list2 y leer list1 en: 14 Marzo 2022, 23:13 pm
Hola Serapis

ahora si que suma

Código
  1.  
  2. txtTotalFactura.Text = cstr(regx.total)
  3.  
  4.  


muchas gracias
Páginas: 1 2 3 [4] 5 6 7 8 9 10 11 12 13
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines