Visual Basic 6.0: código para botones agregar, eliminar

Resuelto/Cerrado
isa - Modificado por Carlos-vialfa el 8/02/2015, 19:23
 DarkThoughts - 22 nov 2017 a las 19:07
Hola,
alguien que me pueda hacer el favor de decirme cuales los codigos para los botones de agregar, eliminar, guardar y modificar en visual basic 6.0

5 respuestas

Estimado amigo aquí te dejo un ejemplo funcionando que hice para otro foro.
Te servirá para agregar, borrar, editar, cargar imagen, guardar todo, etc...
Estudialo un poco y tendrás la solución.
-------------------------------------------------------------------------------------
Hola aquí te dejo un pequeño programa que trabaja ADO sin el CONTROL, puro código.
En -->proyecto -->referencias ... tildas --->Microsoft ActiveX Data Objects 2.0 Library
En -->Proyecto -->Componentes ... tildas ---> Microsoft Common Dialog Control 6.0 (SP3)
En el formulario agregas:...
Tres textbox, un pictureboxd y 8 commandbutton
les pones los siguientes caption:...
------------------------------------------
Command1.caption ="Inicio"
Command2.caption ="Anterior"
Command3.caption ="Siguiente"
Command4.caption ="Final"
Command5.caption ="Nuevo"
Command6.caption ="Borrar"
Command7.caption ="Cargar Imagen"
Command8.caption ="Editar"
------------------------------------------
En la carpeta en la cual pongas el proyecto crea una sub carpeta "imagenes"
------------------------------------------
La base de datos access, deberá tener una tabla denominada "Tabla1" y por lo menos cuatro campos
1 ---> Apellido
2 ---> Nombres
3 ---> Mail
4 ---> Foto
------------------------------------------

Mas abajo te dejo el código del formulario
------------------------------------------------
Pero antes deseo decirte me parece que esta es la mejor manera de manejarse con fotos, es decir, guardando en la base solamente el texto del path con el nombre y la extensión de la imagen, a mas de que las vas nucleando todas en un directorio puntual, y de esta manera la base de datos no se sobredimensiona y funcionará perfectamente con pocos archivos como con una multitud.-
------------------------------------------
Bueno antes de dejarte el código, te manifiesto que no dudes en consultarme cualquier inquietud que tengas.

Gracias un abrazo.

Luis
------------------------------------------

Ahora el código explicado:
------------------------------------------
Option Explicit
' Objeto para acceder directamente a la base usando código
Private cnn As ADODB.Connection
' WithEvents permite tener acceso a los a los mismos eventos que con el ADO DataControl
Private WithEvents rst As ADODB.Recordset
'variable para la función -cargar_Imagen-
Private foto As IPictureDisp
'variable que se utiliza en el evento de crear un nuevo registro
Dim nuevo As Boolean

Private Sub Command1_Click()
On Error Resume Next
rst.MoveFirst
Call cargar_Imagen(Picture1, rst!foto)
End Sub

Private Sub Command2_Click()
On Error Resume Next
rst.MovePrevious
'Si se sobrepasa el inicio de la base, se mueve el puntero al primer registro
If rst.BOF Then
rst.MoveFirst
End If
Call cargar_Imagen(Picture1, rst!foto)
End Sub

Private Sub Command3_Click()
On Error Resume Next
rst.MoveNext
'Si se sobrepasa el final de la base, se mueve el puntero al ultimo registro
If rst.EOF Then
rst.MoveLast
End If
Call cargar_Imagen(Picture1, rst!foto)
End Sub

Private Sub Command4_Click()
On Error Resume Next
rst.MoveLast
Call cargar_Imagen(Picture1, rst!foto)
End Sub

Private Sub Command5_Click()
On Error Resume Next
'Si se presiona este comando se autoriza un nuevo registro
'Se mueve el foco al text 1
'la variable boolean nuevo se pone a True
'Se renombra el caption del comando Nuevo
'Se hace visible el comando -cargar imagen-

If nuevo = False Then
rst.AddNew
Text1.SetFocus
nuevo = True
Command5.Caption = "Grabar nuevo"
Command7.Visible = True
ocultarcontroles False
Else
Command5.Caption = "Nuevo"
Command7.Visible = False
nuevo = False
rst.Update
mostrarcontroles False
End If
End Sub

Private Sub Command6_Click()
On Error Resume Next
' Elimina el registro actual
rst.Delete
On Error Resume Next
' Mueve el puntero al siguiente registro
rst.MoveNext
' Si no puede mover al siguiente, se posiciona en el primer registro.
If rst.EOF Then
rst.MoveFirst
End If
End Sub

Private Sub Command7_Click()
On Error Resume Next
With CommonDialog1
.DialogTitle = " Seleccionar imagen"
.Filter = "BMP|*.bmp|JPEG|*.jpeg|GIF|*.gif|JPG|*.jpg|Todos|*.*"
.ShowOpen
If .FileName = "" Then
Exit Sub
Else
'Carga en nombre el path donde se ejecuta el programa, el directorio especificado
'y el nombre y la extensión de la imagen seleccionada.
Dim nombre As String: nombre = App.Path & "\imagenes\" & .FileTitle
'Copia la imagen seleccionada en el cuadro de dialogo en el lugar que dice la variable -nombre-
Call FileCopy(CommonDialog1.FileName, nombre)
'actualiza el campo -foto- con el valor de la variable -nombre-
rst!foto = nombre
'actualiza el picture1 con la nueva imagen seleccionada.
Call cargar_Imagen(Picture1, nombre)
End If
End With
End Sub

Private Sub Command8_Click()
On Error Resume Next
If Command7.Visible = False Then
Command7.Visible = True
Command8.Caption = "Grabar cambios"
ocultarcontroles True
Else
' Guardar el contenido de las cajas de texto
With rst
.Fields("Apellido") = Text1
.Fields("Nombres") = Text2
.Fields("Mail") = Text3
.Update
End With
Command8.Caption = "Editar"
Command7.Visible = False
mostrarcontroles True
End If
End Sub

Private Sub Form_Load()
On Error Resume Next
' Asignar el nombre de la base de datos
' (si la aplicación se ejecuta en el directorio raiz, quitar el \)
Dim sBase
sBase = App.Path & "\fotos.mdb"
' Crear los objetos
Set cnn = New ADODB.Connection
Set rst = New ADODB.Recordset

cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & sBase
rst.Open "SELECT * FROM Tabla1", cnn, adOpenDynamic, adLockOptimistic

' Conectar manualmente los Text1 al recordset
' Asignar el recordset al que estarán los datos conectados
' Esto funciona igual que si se conectaran a un DataControl,
' Por tanto no hay que preocuparse de actualizar el contenido, etc.
Set Text1.DataSource = rst
Set Text2.DataSource = rst
Set Text3.DataSource = rst
' Asiganr los nombres de los campos
Text1.DataField = "Apellido"
Text2.DataField = "Nombres"
Text3.DataField = "Mail"
rst.MoveFirst
Call cargar_Imagen(Picture1, rst!foto)
End Sub

Private Sub Form_Unload(Cancel As Integer)
On Local Error Resume Next
rst.Close
cnn.Close

Set rst = Nothing
Set cnn = Nothing

End Sub

Sub cargar_Imagen(Objeto As Object, Path_Foto As String)
On Error Resume Next
Dim Pos_x As Single
Dim Pos_y As Single
Dim Anchoimagen As Single
Dim Altoimagen As Single
Dim Anchoobjeto As Single
Dim Altoobjeto As Single

Dim escalaoriginal As Single
Set foto = LoadPicture(Path_Foto)

With Objeto
.AutoRedraw = True
.Cls
escalaoriginal = .ScaleMode
.ScaleMode = vbPixels

Anchoimagen = .ScaleX(foto.Width, vbHimetric, vbPixels)
Altoimagen = .ScaleY(foto.Height, vbHimetric, vbPixels)

Anchoobjeto = .ScaleWidth
Altoobjeto = .ScaleHeight

If Anchoimagen > Anchoobjeto Then
Anchoimagen = Anchoimagen - (Anchoimagen - Anchoobjeto)
Altoimagen = Altoobjeto
End If

If Altoimagen > Altoobjeto Then
Altoimagen = Altoimagen - (Altoimagen - Altoobjeto)
Anchoimagen = Anchoobjeto - (Anchoimagen - Anchoobjeto)
End If

Pos_x = (Anchoobjeto - Anchoimagen) / 2
Pos_y = (Altoobjeto - Altoimagen) / 2

End With
Objeto.PaintPicture foto, Pos_x, Pos_y, Anchoimagen, Altoimagen
Objeto.ScaleMode = escalaoriginal
End Sub

Sub mostrarcontroles(control As Boolean)
Text1.Enabled = False
Text2.Enabled = False
Text3.Enabled = False
Command1.Enabled = True
Command2.Enabled = True
Command3.Enabled = True
Command4.Enabled = True
If control = True Then
Command5.Enabled = True
Else
Command8.Enabled = True
End If
Command6.Enabled = True
End Sub

Sub ocultarcontroles(control As Boolean)
Text1.Enabled = True
Text2.Enabled = True
Text3.Enabled = True
Command1.Enabled = False
Command2.Enabled = False
Command3.Enabled = False
Command4.Enabled = False
If control = True Then
Command5.Enabled = False
Else
Command8.Enabled = False
End If
Command6.Enabled = False
End Sub

---------------------------------------

Cualquier cosa a tu disposición.

Luis
135
dark_zen Message postés 152 Date d'inscription lunes, 6 de septiembre de 2010 Estatus Miembro Última intervención martes, 3 de enero de 2012 107
9 jul 2011 a las 02:39
BIEN QUE CODIGO TAN LARGO xD E UTIL
AUN QUE PREFIERO USAR PROCEDIMIENTOS ALMACENADOS
CASI AL FINAL EL CODIGO DE SQL

CODIGO DE MODULO EN VISUAL BASIC
'---------------------------------------------------------------------------------
Imports System.Data.SqlClient
Imports System.Data

Module SERIEDETA
Private LFnD_ID As Long
Private LFnD_IDSD As Long
Private LFnD_DSCP As String

Private Sub CLEAR()
LFnD_IDSD = Nothing
LFnD_DSCP = Nothing
End Sub
Public Sub ASIGNAR(ByVal CODIGO As Long)
LFnD_ID = CODIGO
End Sub
Public Sub ASIGNAR(ByVal CODIGO As Long, ByVal ENCABEZADO As Long, ByVal DESCRIPCION As String)
LFnD_ID = CODIGO
LFnD_IDSD = ENCABEZADO
LFnD_DSCP = DESCRIPCION
End Sub
Private Function COD() As Long
Dim cmd As New SqlCommand
Dim dr As SqlDataReader, dt As New DataTable
With cmd
.Connection = Conexion.cn
.CommandType = CommandType.StoredProcedure
.CommandText = "SP_SERIEDOCDETA_FINDINDEX"
End With
Try
dr = cmd.ExecuteReader
dt.Load(dr)
If dt.Rows.Count = 0 Then
Return 0
End If
Return CLng(dt.Rows(0)(0).ToString)
Catch ex As Exception
Return 0 : Conexion.ShDesconect()
Err.Raise(vbObjectError + 514, , "DAO: " & ex.Message)
End Try
End Function
Private Sub INDEXUPDATE(ByVal indice As Long)
Dim cmd As New SqlCommand

With cmd
.Connection = Conexion.cn
.CommandType = CommandType.StoredProcedure
.CommandText = "SP_SERIEDOCDETA_UPDINDEX"
End With
Try
cmd.Parameters.AddWithValue("@valor", indice)
cmd.ExecuteNonQuery()
Catch ex As Exception
Conexion.ShDesconect()
Err.Raise(vbObjectError + 514, , "DAO: " & ex.Message)
End Try
End Sub
Function GUARDAR(ByVal NUEVO As Boolean) As Boolean
Try
If NUEVO = True Then
Conexion.ShConect()
LFnD_ID = SERIEDETA.COD() + 1
Conexion.ShDesconect()
End If

Dim SAVEAR As New SqlDataAdapter
SAVEAR.SelectCommand = New SqlCommand
Dim cmd As New SqlCommand("P_SERIEDOCDETA_INSERT", Conexion.cn)
cmd.CommandType = CommandType.StoredProcedure
cmd.Parameters.Add("@INSERTED", SqlDbType.Bit).Value = NUEVO
cmd.Parameters.Add("@ID", SqlDbType.BigInt).Value = LFnD_ID
cmd.Parameters.Add("@USER", SqlDbType.BigInt).Value = SYSUSUARIO.IDUSER
cmd.Parameters.Add("@IDSD", SqlDbType.BigInt).Value = LFnD_IDSD
cmd.Parameters.Add("@DSCP", SqlDbType.Text).Value = LFnD_DSCP
Conexion.ShConect()
cmd.ExecuteNonQuery()
If NUEVO = True Then SERIEDETA.INDEXUPDATE(LFnD_ID)
Conexion.ShDesconect()
SERIEDETA.CLEAR()
Return True
Catch EX As Exception
Return False
End Try
End Function
Function ELIMINAR(ByVal LOGICAMENTE As Boolean) As Boolean
Try
Dim DELETE As New SqlDataAdapter
DELETE.SelectCommand = New SqlCommand
Dim cmd As New SqlCommand("P_SERIEDOCDETA_DELETE", Conexion.cn)
cmd.CommandType = CommandType.StoredProcedure
cmd.Parameters.Add("@ID", SqlDbType.BigInt).Value = LFnD_ID
cmd.Parameters.Add("@USER", SqlDbType.BigInt).Value = SYSUSUARIO.IDUSER
cmd.Parameters.Add("@DLT", SqlDbType.Bit).Value = LOGICAMENTE
Conexion.ShConect()
cmd.ExecuteNonQuery()
Conexion.ShDesconect()
SERIEDETA.CLEAR()
Return True
Catch EX As Exception
Return False
End Try
End Function
Function RESTAURAR() As Boolean
Try
Dim RESTORE As New SqlDataAdapter
RESTORE.SelectCommand = New SqlCommand
Dim cmd As New SqlCommand("P_SERIEDOCDETA_RESTORE", Conexion.cn)
cmd.CommandType = CommandType.StoredProcedure
cmd.Parameters.Add("@ID", SqlDbType.BigInt).Value = LFnD_ID
cmd.Parameters.Add("@USER", SqlDbType.BigInt).Value = SYSUSUARIO.IDUSER
Conexion.ShConect()
cmd.ExecuteNonQuery()
Conexion.ShDesconect()
SERIEDETA.CLEAR()
Return True
Catch EX As Exception
Return False
End Try
End Function
Public Function RETURN_ID() As Long
Return LFnD_ID
End Function
End Module

//////////////////////////////////////////////////////////////////////////////
FORMULARIO
//////////////////////////////////////////////////////////////////////////////


'GUARDAR
'* SI Lb_NEW=TRUE ENTONCES GUARDA UN NUEVO REGISTRO SI ESTA EN FALSE SOLO ACTUALIZA

SERIEDETA.ASIGNAR(Ll_CODIGO, Ll_header, Ls_DSCP)
SERIEDETA.GUARDAR(Lb_NEW)


'ELIMINAR LOGICAMENTE(SE MANTINEN EN LA BASE DE DATOS SOLO CAMBIA SU ESTADO)

SERIEDETA.ELIMINAR(FALSE)
' O FICICAMENTE( SE ELIMINA PERMANENTEMENTE DE LA BASE DE DATOS)
SERIEDETA.ELIMINAR(TRUE)

TAMBIEN ESTA RESTAURAR Y Y RECUPERAR ID Y LIMPIAR



///////////////////////////////////////////////////////////////////////////////////
SQL
///////////////////////////////////////////////////////////////////////////////////
-----------------------------------------

CREATE PROC P_SERIEDOCDETA_INSERT
(
@INSERTED BIT,
@ID BIGINT,
@USER BIGINT,
@IDSD BIGINT,
@DSCP TEXT
)
AS
IF @INSERTED=1
BEGIN
INSERT INTO SERIEDOCDETA VALUES
(
@ID,0,@USER,-2,-2,GETDATE(),GETDATE(),GETDATE(),
@IDSD,
@DSCP
)
END
ELSE
BEGIN
UPDATE SERIEDOCDETA SET
U_UPD=@USER,
F_UPD=GETDATE(),
IDSD=@IDSD,
DSCP=@DSCP
WHERE ID=@ID
END
GO

0
hola elinv vi ru post me parece interesante. Y veo q te mqnejas mbien con el tema te puedo hacer una consulta
0
sera que me podrian ayudar en crear un inventario
0
dark_zen Message postés 152 Date d'inscription lunes, 6 de septiembre de 2010 Estatus Miembro Última intervención martes, 3 de enero de 2012 107
23 sep 2011 a las 00:33
jajaja todos aprendemos dia a dia...
pero nesesitas ayuda debes en cuando !

mi correo esta en mi perfil atiendo online en mi face... aunque demore un poco pero la yauda llega.

NOTA: no doy ayuda masticada (solo para copiar y pegar),
0
Gracias, muy bueno el codigo excelente aporte
0