|
Mostrar Temas
|
Páginas: 1 [2] 3 4
|
11
|
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: Option Explicit Private Type departamento d As Date w As Double x As Double y As Double z As Double zl As Double End Type Dim dpto As departamento Dim NumRecs As Long Private Sub Command1_Click() 'Grafico DrawPie End Sub Private Sub DrawPiePiece(lColor As Long, ByVal fStart As Double, ByVal fEnd As Double) Const PI As Double = 3.14159265359 Const CircleEnd As Double = -2 * PI Dim dStart As Double Dim dEnd As Double Picture2.FillColor = lColor Picture2.FillStyle = 0 dStart = fStart * (CircleEnd / 100) dEnd = fEnd * (CircleEnd / 100) Picture2.Circle (170, 150), 100, , dStart, dEnd End Sub Private Sub DrawPie() Dim Disp As Single, Alq As Single, i As Byte, Vt As Integer, Ang1 As Single, Ang2 As Single Picture2.Cls Picture2.AutoRedraw = True Picture2.BackColor = &H8000000E Picture2.ScaleMode = vbPixels Dim xx As Double Dim yy As Double Dim zz As Double Dim uu As Double With dpto If .w = 0 Then MsgBox "No hay registros para" & DateTime.Date & "para ser mostrado" Text1.Text = .d If .w > 0 Then xx = (.x * 100) / .w yy = xx + (.y * 100) / .w zz = yy + (.z * 100) / .w uu = zz + (.zl * 100) / .w Call DrawPiePiece(QBColor(1), 0.001, xx) Call DrawPiePiece(QBColor(6), xx, yy) Call DrawPiePiece(QBColor(3), yy, zz) Call DrawPiePiece(QBColor(5), zz, uu) End If End With End Sub Private Sub Command2_Click() 'Guardar With dpto .d = Date .w = 650 .x = 301 .y = 39 .z = 109 .zl = 201 End With NumRecs = 1 Open App.Path & "\PieData.dat" For Random As #1 Len = 64 Put #1, 1, NumRecs Put #1, NumRecs + 1, dpto Close #1 End Sub Private Sub Command3_Click() 'Leer If FileLen(App.Path & "\PieData.dat") > 60 Then Open App.Path & "\PieData.dat" For Random As #1 Len = 64 Get #1, 1, NumRecs Get #1, NumRecs + 1, dpto Close #1 DrawPie End If End Sub Private Sub Command4_Click() End End Sub Private Sub Command5_Click() Picture2.Cls End Sub
gracias
|
|
|
12
|
Programación / Programación Visual Basic / Problema hacer Menu
|
en: 5 Febrero 2022, 13:51 pm
|
Hola soy corlo
estoy haciendo un formulario menu mdi principal aqui no hay problema cuando hago el primer menu fichero no hay problema pero cuando hago el segundo menu clientes los botones de nuevo, editar,eliminar,imprimir me van al formulario mdi hay alguna manera de que los botones me vaya al menu clientes con su respectivo codigo. si voy haciendo mas menus los botones de los respectivos menus me van ha ir al formulario principal mdi y todo el codigo tambien. gracias
|
|
|
13
|
Programación / Programación Visual Basic / Guardar list2 y leer list1
|
en: 15 Diciembre 2021, 17:59 pm
|
Hola soy corlo
ahora en pantalla principal hay list1 y list2
en el list2 es donde se va entrando los articulos desde el formulario y en el list1 es donde se guardan los datos del list2 al list1 para poder sumar el contado y tarjeta de credito
A la hora de entrar los datos al list2 desde el formulario lo hace bien, el problema es para guardar todos los datos del list2 a una fila del list1 asi sucesivamente con numero de ticket 1,2,3, etc del list1
a la hora de guardar seria:Command2_click()
N de ticket, fecha y hora, metodo de pago, total en el list1
en el metodo de pago esta en la pantalla principal no desde el formulario
a la hora de leer seria list1_click() N ticket, Fecha y hora, Producto, Precio Unitario, cantidad, subtotal, total, en el list2
Gracias
|
|
|
14
|
Programación / Programación Visual Basic / sumar list1
|
en: 3 Diciembre 2021, 00:44 am
|
Hola soy colro necesito sumar el total contado y el total tarjeta de credito consigo sumar el total del list1 pongo el codigo Case 1 ' Leer fichero de facturación FrmFile.Show 1 Dim h As Integer Dim totalcontado As Integer Dim totaltcredito As Integer totalcontado = 0: totaltcredito = 0 If (Len(FrmFile.File) > 0) Then If (LeerFacturacion(App.Path & "\" & FrmFile.File) = True) Then Call Activar(True) For h = 0 To List1.ListCount - 1 If reg2.MetodoDePago = "0" Then totalcontado = totalcontado + Val(Split(List1.List(h), vbTab)(6)) End If If reg2.MetodoDePago = "1" Then totaltcredito = totaltcredito + Val(Split(List1.List(h), vbTab)(6)) End If Next h txttotal.Text = Format(totalcontado, "#,##0.00") Txttotal1.Text = Format(totaltcredito, "#,##0.00") Else Call Activar(False) End If End If
Gracias
|
|
|
15
|
Programación / Programación Visual Basic / leer datos en archivo secuencial
|
en: 22 Noviembre 2021, 16:41 pm
|
Hola soy corlo estoy haciendo una mini aplicacion de guardar datos de factura y leerlos por pantalla, en archivo secuencial. guardar datos lo hace bien el problema esta en leer los datos de la factura en pantalla el archivo es 1.txt y hay lo siguiente: ============================== COMPROBANTE DE VENTA ============================== TICKET Nº: 1 TIPO : CONTADO FECHA : 20/11/2021 HORA : 20:30:59 ------------------------------------------------------- R.U.C/C.I : a CLIENTE : a =============================== CANTIDAD PRODUCTO PRECIO SUBTOTAL =============================== 12 r 8 96 3 k 1.5 4,5 =============================== TOTAL : 100,50 ------------------------------------------- GRACIAS POR SU COMPRA! me sale todo mezclado el código que tengo hasta ahora es el siguiente: Option Explicit Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Const LB_SETTABSTOPS = &H192 Dim I As Integer Dim orden As Integer 'numero de ticket Dim fecha As Date 'para leer la fecha Dim hora As Date 'para leer la hora Dim contado As String 'para contado Dim credito As String 'para credito Dim cedu1 As String ' para el RUC/C.I Dim nom1 As String ' para el cliente 'abajo son datos del list1 Dim cantidad As Integer Dim producto As String * 12 Dim preciox As String * 8 Dim subtot As Double 'varible del total Dim tot As Double Private Sub Command4_Click() End End Sub Private Sub Command5_Click() 'Nuevo registro '//recuperar el dato. Open App.Path & "\Numero1.txt" For Input As #1 Do While Not EOF(1) Input #1, orden Loop Close #1 Txtnum = orden + 1 List1.Clear txtCedula1.Text = "" txtNombre1.Text = "" total.Text = "" txtCedula1.SetFocus End Sub Private Sub Command6_Click() 'Guardar Factura Dim cantidadtotal As Double Dim k As Integer orden = Txtnum.Text On Error GoTo salir Open App.Path & "\Numero1.txt" For Append As #1 Print #1, Txtnum Close #1 Dim bmx As String bmx = App.Path + "\" + Txtnum + ".txt" Open bmx For Append As #1 Txtnum = orden Print #1, Print #1, Print #1, Print #1, Tab(1); String(44, "=") Print #1, Tab((44 - Len("COMPROBANTE DE VENTA")) \ 2); "COMPROBANTE DE VENTA" Print #1, Tab(1); String(44, "=") If Option1.Value = True Then Print #1, Tab(1); "TICKET Nº: " & Txtnum.Text; Tab(44 - Len("TIPO : CONTADO")); "TIPO : CONTADO" Else Print #1, Tab(1); "TICKET Nº: " & Txtnum.Text; Tab(44 - Len("TIPO : CREDITO")); "TIPO : CREDITO" End If Print #1, Tab(1); "FECHA : " & Date; Tab(44 - Len("HORA : " & Time)); "HORA : " & Time Print #1, Tab(1); String(44, "-") Print #1, Tab(1); "R.U.C/C.I : " & txtCedula1.Text Print #1, Tab(1); "CLIENTE : " & txtNombre1.Text Print #1, Tab(1); String(44, "=") Print #1, Tab(1); "CANTIDAD"; Tab(11); "PRODUCTO"; Tab(24); "PRECIO"; Tab(37); "SUBTOTAL" Print #1, Tab(1); String(44, "=") For k = 0 To List1.ListCount - 1 Print #1, List1.List(k) Next k Print #1, Tab(1); String(44, "=") Print #1, Tab(15); "TOTAL : "; Tab(43 - Len(Format(total.Text, "#,##0.00"))); Format(total.Text, "#,##0.00") Print #1, Tab(16); "-----------------------------" Print #1, Print #1, Tab((44 - Len("GRACIAS POR SU COMPRA!")) \ 2); "GRACIAS POR SU COMPRA!" For I = 1 To 10 Print #1, Next I Close #1 Option1.Value = False Option2.Value = False txtCedula1.Text = "" txtNombre1.Text = "" List1.Clear cant.Text = "" prod.Text = "" precio.Text = "" subtotal.Text = "" total.Text = "" cant.SetFocus Exit Sub salir: Dim msgb msgb = MsgBox("Error Nº : [ " & Err.Number & " ]" & " " & Err.Description, vbOKCancel + vbInformation) End Sub Private Sub Command7_Click() 'Leer Factura Dim tabs(0 To 3) As Long tabs(0) = 20 tabs(1) = 60 tabs(2) = 95 tabs(3) = 138 ' Set the tabs. SendMessage List1.hwnd, LB_SETTABSTOPS, 4, tabs(1) Dim str As String Dim thj As String Dim plo As Boolean Dim j As Integer Dim h As Integer On Error GoTo lo List1.Clear thj = App.Path + "\" + Txtnum.Text + ".txt" If Dir(thj) <> "" Then Open thj For Input As #1 Input #1, orden Txtnum.Text = orden Input #1, fecha Label4.Caption = fecha Input #1, hora Label5.Caption = hora Input #1, contado Input #1, credito Input #1, cedu1, nom1 txtCedula1.Text = cedu1 txtNombre1.Text = nom1 While Not EOF(1) Input #1, cantidad, producto, preciox, subtot cant.Text = cantidad prod.Text = producto precio.Text = preciox subtotal.Text = subtot List1.AddItem cantidad & vbTab & producto & vbTab & preciox & vbTab & subtot Wend j = 0 For h = 0 To List1.ListCount - 1 j = j + Val(Split(List1.List(h), vbTab)(3)) Next h total.Text = j Close #1 End If If contado= contado Then Option1.Value = True Else If credito = credito Then Option2.Value = True End If End If Exit Sub lo: If Not plo = True Then MsgBox "La Factura no existe, gracias", vbCritical End If End Sub Private Sub Command8_Click() 'Agregar Dim h As Integer Dim j As Double cantidad = cant.Text producto = prod.Text preciox = precio.Text subtot = subtotal.Text List1.AddItem cantidad & vbTab & producto & vbTab & preciox & vbTab & subtot j = 0 For h = 0 To List1.ListCount - 1 j = j + Split(List1.List(h), vbTab)(3) Next h total.Text = Format(j, "#,##0.00") cant.Text = "" prod.Text = "" precio.Text = "" subtotal.Text = "" cant.SetFocus End Sub Private Sub Form_Load() Dim tabs(0 To 3) As Long tabs(0) = 20 tabs(1) = 123 tabs(2) = 237 tabs(3) = 370 SendMessage List1.hwnd, LB_SETTABSTOPS, 4, tabs(1) Option1.Value = False Option2.Value = False Open App.Path & "\Numero1.txt" For Append As #1 Close #1 Open App.Path & "\Numero1.txt" For Append As #1 Close #1 '//recuperar el dato. Open App.Path & "\Numero1.txt" For Input As #1 Do While Not EOF(1) Input #1, orden Loop Close #1 Txtnum = orden + 1 End Sub Private Sub List1_Click() Text1.Text = Mid(List1.Text, 1, InStr(1, List1.Text, " ") - 1) Text2.Text = Mid(List1.Text, InStr(1, List1.Text, " ") + 1) I = List1.ListIndex End Sub Private Sub Option1_Click() Option2.Value = False End Sub Private Sub Option2_Click() Option1.Value = False End Sub Private Sub precio_KeyUp(KeyCode As Integer, Shift As Integer) subtotal.Text = cant.Text * Val(precio.Text) End Sub Private Sub Timer1_Timer() Label4.Caption = Date Label5.Caption = Format(Time, "hh:mm:ss") End Sub
Gracias
|
|
|
16
|
Programación / Programación Visual Basic / eliminar registro
|
en: 9 Noviembre 2021, 19:14 pm
|
Hola soy corlo estoy haciendo una mini aplicacion en añadir datos a los textbox , para luego leer los datos con el combo y una opcion para eliminar los datos. añadir los datos: lo hace bien leer los datos: lo hace bien eliminar los datos: elimina el dato en el combo pero no elimina los datos de los textbox no se que hago mal paso el codigo que tengo hasta ahora en un formulario Option Explicit
Private Sub Boton_añadir_Click() totalregistros = totalregistros + 1 If totalregistros > 50 Then MsgBox "lista completa", 16, "error" Else agenda(totalregistros).Nombre = Nom.Text agenda(totalregistros).apellidos = Ape.Text agenda(totalregistros).telefono = Tel.Text agenda(totalregistros).Edad = Val(Edad.Text)
Combo2.AddItem Nom.Text End If Nom.SetFocus End Sub
Private Sub Boton_eliminar_Click() Dim b As String
b = MsgBox("Eliminar Registro:" + Nom.Text, 3 + 32, "Eliminar") If b = vbYes Then
If Combo2.ListIndex <> -1 Then
Combo2.RemoveItem (Combo2.ListIndex)
End If
totalregistros = totalregistros - 1
agenda(totalregistros).Nombre = Nom.Text agenda(totalregistros).apellidos = Ape.Text agenda(totalregistros).telefono = Tel.Text agenda(totalregistros).Edad = Val(Edad.Text)
End If Nom.Text = "" Ape.Text = "" Tel.Text = "" Edad.Text = "" End Sub
Private Sub Boton_fin_Click() End End Sub
Private Sub Botonnuevo_Click() Nom.Text = "" Ape.Text = "" Tel.Text = "" Edad.Text = "" Nom.SetFocus
End Sub
Private Sub Combo2_Click() Dim n As Integer n = Combo2.ListIndex + 1
Nom.Text = agenda(n).Nombre Ape.Text = agenda(n).apellidos Tel.Text = agenda(n).telefono Edad.Text = Val(agenda(n).Edad)
End Sub
Private Sub Ape_GotFocus() Ape.SelStart = 0 Ape.SelLength = Len(Ape.Text) End Sub
Private Sub Edad_GotFocus() Edad.SelStart = 0 Edad.SelLength = Len(Edad.Text) End Sub
Private Sub Nom_GotFocus() Nom.SelStart = 0 Nom.SelLength = Len(Nom.Text) End Sub Private Sub Tel_GotFocus() Tel.SelStart = 0 Tel.SelLength = Len(Tel.Text) End Sub
Private Sub Form_Load() totalregistros = 0 End Sub
y en un modulo Type registro Nombre As String * 15 apellidos As String * 25 telefono As String * 15 Edad As String * 3 End Type Global agenda(1 To 50) As registro Global totalregistros As Integer
gracias
|
|
|
17
|
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:
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
|
|
|
18
|
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 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
|
|
|
19
|
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 DrawWidth = 5 DrawStyle = 2
Line (950, 2950)-(12000, 2950)
Pero cuando lo hago por impresora, no me hace nada intento hacer esto:
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
|
|
|
20
|
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
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)
|
|
|
|
|
|
|