Codigos De Prgramacion De Visual Basic 6

Manual de programación.

Nombre: Jorge Alberto Martínez Hernández

Grado y grupo: 4L

Especialidad: Informática

Modulo: Sub III Elaborar sistemas de información mediante un lenguaje de programación visual.

Nombre del docente:
Lic. Tomas Hernández Medina.

Frm Password


Private Sub CmdAceptar_Click()
Dim RsBuscar As New ADODB.Recordset
Dim Bandera As Boolean
Bandera =False
RsBuscar.Open "SELECT NomUsuario, Password From TBLPassword WHERE NomUsuario='" & TxtUsuario.Text & "' and Password='" & TxtPassword.Text & "'", conexion
While Not RsBuscar.EOF
Bandera = True
RsBuscar.MoveNext
Wend
If Bandera = True Then
MdiMenu.Show
Else
MsgBox "Error de Acceso", vbInformation, "Mensaje del sistema"
End
End If
Unload Me
End Sub

MDi menuPrivate Sub Productos_Click()
FrmDatos.Show
End Sub

Private Sub Ventas_Click()
FrmVentas.Show
End Sub

Frm Datos



Private Sub CmbMarca_Click()
LlenarMsgrid
End Sub

Public Sub LlenarMsgrid()

Dim RsSemGpo As New ADODB.Recordset
'While Not RsProducto.EOF
RsSemGpo.Open "SELECT Productos.IdProducto, Productos.Nombre, Productos.[PrecioC/U], Productos.Existencia,Productos.Descripcion, Marca.IdMarca, Marca.Marca FROM Marca INNER JOIN Productos ON Marca.IdMarca = Productos.IdMarca WHERE (([Marca].[IdMarca]=[Productos].[IdMarca])AND([Marca].[Marca]='" & CmbMarca & "') AND Activo = True)", conexion
MsLista.Clear
MsLista.Rows = 2
MsLista.FormatString = " Codigo | Nombre Del Producto | Precio | Existencia | Descripcion"
While Not RsSemGpo.EOF
With MsLista
If Not (.TextMatrix(.Rows - 1, 0) = Empty) Then
.Rows = .Rows + 1
End If
.TextMatrix(.Rows - 1, 0) = RsSemGpo.Fields(0)
.TextMatrix(.Rows - 1, 1) = RsSemGpo.Fields(1)
.TextMatrix(.Rows - 1, 2) = RsSemGpo.Fields(2)
.TextMatrix(.Rows - 1, 3) = RsSemGpo.Fields(3)
.TextMatrix(.Rows - 1, 4) = RsSemGpo.Fields(4)RsSemGpo.MoveNext
End With
Wend

End Sub

Private Sub CmdEliminar_Click()
On Error GoTo LineaError
Dim RsEliminar As New ADODB.Recordset
RsEliminar.Open "Update Productos set activo=false Where IdProducto='" & TxtNumcontrol.Text & "'", conexion
LlenarMsgrid
CmdLimpiar2_Click
Exit Sub
LineaError:
MsgBox Err.Description, vbCritical, "Mensaje del sistema"
End Sub

Private Sub CmdGuardar_Click()
OnError GoTo LineaError
Dim RsAlta2 As New ADODB.Recordset
RsAlta2.Open "Insert into Productos(IdProducto,Nombre,IdMarca,[PrecioC/U],Existencia,Descripcion,Activo)values ('" & TxtNumcontrol.Text & "','" & TxtNombre.Text & "','" & FunBusCveGpo(CmbMarca.Text) & "'," & TxtPrecio.Text & ",'" & TxtExistencia.Text & "','" & TxtDescripcion.Text & "',True)", conexion

LlenarMsgrid
CmdLimpiar2_ClickExit Sub
LineaError:
If Err.Number = -2147217900 Then
MsgBox "Clave repetida", vbCritical, "Mensaje del Sistema"
TxtNumcontrol.Text = Empty
TxtNumcontrol.SetFocus
End If
End Sub

Public Function FunBusCveGpo(MSemGpo As String) As String
Dim RsCveGpo As New ADODB.Recordset
RsCveGpo.Open "SELECT Marca.IdMarca FROM Marca WHERE (([Marca].[Marca]='" & CmbMarca & "'))", conexion
While NotRsCveGpo.EOF
FunBusCveGpo = RsCveGpo.Fields(0)
RsCveGpo.MoveNext
Wend
End Function

Private Sub CmdLimpiar_Click()
TxtNumcontrol.Text = Empty
TxtNombre.Text = Empty
TxtDescripcion.Text = Empty
TxtPrecio.Text = Empty
TxtExistencia.Text = Empty

End Sub
Private Sub CmdLimpiar2_Click()
TxtNumcontrol.Text = Empty
TxtNombre.Text = Empty
TxtDescripcion.Text = Empty
TxtPrecio.Text = EmptyTxtExistencia.Text = Empty
TxtNumcontrol.SetFocus
End Sub
Private Sub CmdModificar_Click()
On Error GoTo LineaError
Dim RsModificar As New ADODB.Recordset
RsModificar.Open "Update Productos set Nombre='" & TxtNombre.Text & "',IdMarca='" & FunBusCveGpo(CmbMarca.Text) & "',[PrecioC/U]=" & TxtPrecio.Text & ",Existencia='" & TxtExistencia.Text & "',Descripcion='" & TxtDescripcion.Text & "'...