Sección de códigos , trucos y ejemplos para visual basic

191 - Ejemplo para guardar las rutas de imágenes en una bd de Access usando ADO

Este ejemplo lo que hace es leer de un campo, en el cual se almacena la ruta de una imagen ( en realidad se almacena el nombre del archivo de imagen ) , para luego poder visualizarla en un PictureBox

Por ejemplo, si el registro 25 tiene asociada una imagen, en un campo llamado Id_Imagen, se almacena también el número 25, y se copia en una carpeta ubicada en el App del proyecto, el archivo gráfico.

También , al cargar la imagen en el control Picture, la misma se adapta al control , dibujandola con el método PaintPicture a escala y en forma centrada, es decir si la imagen es mas grande que el tamaño del Picturebox, se redimensiona.

vista del formulario con los controles necesarios para el ejemplo

Para armar el ejemplo se necesitan los siguientes controles:

Un contol PictureBox : Picture1
Un control CommonDialog : CommonDialog1
7 Controles CommandButton: Command1(0): " Nuevo ", Command1(1): " Eliminar ". Command1(2): " Actualizar ". Command1(3): " Editar ". Command1(4): " Cancelar ". Command1(5): " Seleccionar Imagen ", y Command1(6) " Eliminar Imagen "
Cuatro Command llamados CmdNav. CmdNav(0): " Primer registro ". CmdNav(1): " Anterior registro ". CmdNav(2): " Siguiente registro ". CmdNav(3): " Ultimo registro ".
3 TextBox llamados txt_Field(0), txt_Field(1) y txt_Field(2)

Nota: La cantidad de textBox depende de los campos que se quieran visualizar de la tabla.

Luego a cada TextBox, en la propiedad DataField, especificarle el nombre del campo al cual estará asociado, por ejemplo si en el txtField(0) queremos visualizar el campo Email, colocar en el DataField del textbox dicho nombre de campo

La tabla necesita:

1 - Un campo de tipo Autonumérico incrementable llamada ID

vista de la tabla en modo diseño

2 - También necesita otro campo, de tipo Texto, llamado Id_Imagen y en las opciones del campo, especificar: Permitir longitud cero, colocar " Si ", y e valor predeterminado delñ campo colocar una cadena vacia: ""

3 - Agregar la referencia a Microsft Activex Data Object para poder utilizar ADO

Por último, en el FormLoad, especificar lo siguiente:

Indicar el Path de la base de datos cuando se abre la conexión

cn.Open ....

Indicar el comando SQL para el recordset

rst.Open "Select * FROM Contacto", cn, adOpenStatic, adLockOptimistic

Indicar el Nombre del campo que tiene el ID de imagen

Field_Img = "ID_Imagen"

Nota: el ejemplo se puede optimizar bastante, y aunque mientras lo hice no surgieron errores, puede obviamente que los tenga.

A continuación sigue el código fuente para el formulario, y luego el código fuente para colocar en un módulo bas, que tiene la función que dibuja con PaintPicture el gráfico en el PictureBox.

Código fuente en un formulario

Option Explicit Dim cn As Connection Dim rst As Recordset ' Primer registro, siguiente, etc... Private Sub cmdNav_Click(Index As Integer) ' Si hay registro activo sale If rst.BOF And rst.EOF Then Exit Sub Select Case Index Case 0 rst.MoveFirst Case 1 rst.MovePrevious If rst.BOF Then rst.MoveFirst Case 2 rst.MoveNext If rst.EOF Then rst.MoveLast Case 3 rst.MoveLast End Select ' Carga la imagen en el Picture Mostrar_Imagen End Sub Private Sub Command1_Click(Index As Integer) Select Case Index 'Agrega un nuevo registro Case 0 rst.AddNew Picture1.Cls 'Elimina el registro activo Case 1 If rst.EOF Or rst.BOF Then Exit Sub If MsgBox("Eliminar Registro", vbQuestion + vbYesNo) = vbNo Then Exit Sub Picture1.Cls 'Elimina el archivo de la carpeta de imagenes If rst(Field_Img) <> "" Then Call Kill(Carpeta_IMG & rst(Field_Img)) End If rst.Delete rst.MoveNext If rst.EOF Then On Error Resume Next rst.MoveLast End If 'Carga la imagen del registro activo Mostrar_Imagen Exit Sub ' Botón Actualizar los cambios en la base de datos Case 2 If Not rst.EOF And Not rst.BOF Then rst.Update Guardar_Imagen End If ' Cancela la atualización o edición del registro que se editando o añadiendo Case 3 If rst.EOF And rst.BOF Then Exit Sub rst.CancelUpdate If Not rst.BOF And Not rst.EOF Then Call Dibujar_Imagen(Picture1, Carpeta_IMG & rst(Field_Img)) End If 'Botón Editar el registro activo Case 4 Setear_botones Setear_TextBox Exit Sub 'Carga una imagen en el control Picture1 Case 5 With CommonDialog1 .DialogTitle = " Seleccionar imagen" .Filter = "BMP|*.bmp|JPEG|*.jpeg|GIF|*.gif|JPG|*.jpg|Todos|*.*" .ShowOpen If .FileName = "" Then Exit Sub Else ' Graba el nombre en el campo, el id de imagen _ que es el mismo que el campo Id rst(Field_Img) = rst!id ' ' se dibuja la imagen en el Picture Call Dibujar_Imagen(Picture1, .FileName) End If End With Exit Sub Case 6 ' Limpia la imagen del Picture y Elimina el id de _ imagen del registro actual de la base Picture1.Cls rst(Field_Img) = "" Exit Sub End Select Setear_botones Setear_TextBox ' Muestra la imagen Mostrar_Imagen End Sub Sub Guardar_Imagen() ' Si el campo Id_Imagen no está vacio ... If rst(Field_Img) <> "" And CommonDialog1.FileName <> "" Then ' Copia el archivo a la carpeta de imagen Call FileCopy(CommonDialog1.FileName, _ Carpeta_IMG & "\" & rst!id) '... si no, si el archivo está en lacarpeta lo elimina ElseIf Dir(Carpeta_IMG & "\" & rst!id) <> "" And rst(Field_Img) = "" Then Call Kill(Carpeta_IMG & rst!id) End If End Sub Private Sub Mostrar_Imagen() With rst ' Si no hay ningún registro activo sale If .EOF Or .BOF Then Exit Sub ' Si el registro no tiene una imagen asociada Limpia el Picture If .Fields(Field_Img) = "" Then Picture1.Cls Else ' Lee el archivo de imagen y lo dibuja en el Picture Call Dibujar_Imagen(Picture1, Carpeta_IMG & .Fields(Field_Img)) End If 'Me.Caption = "Registro N°: " & CStr(.AbsolutePosition) End With End Sub Private Sub Setear_TextBox() 'Bloquea y desbloquea los textbox Dim T As TextBox For Each T In Me.txt_Field T.Locked = Not T.Locked Next End Sub ' Habilita y deshabilita los CommandButton Private Sub Setear_botones() Dim i As Integer For i = 0 To Command1.Count - 1 Command1(i).Enabled = Not Command1(i).Enabled Next For i = 0 To cmdNav.Count - 1 cmdNav(i).Enabled = Not cmdNav(i).Enabled Next End Sub Private Sub Form_Unload(Cancel As Integer) On Error Resume Next If rst.State = adStateOpen Then rst.Close End If If Not rst Is Nothing Then Set rst = Nothing End If If cn.State = adStateOpen Then cn.Close End If If Not cn Is Nothing Then Set cn = Nothing End If End Sub Private Sub Form_Load() Dim Pathbd As String, cadena As String Dim T As TextBox Set cn = New Connection Pathbd = App.Path & "\personas.mdb" cadena = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Pathbd & _ ";Persist Security Info=False" cn.Open cadena Set rst = New Recordset rst.Open "Select * FROM Contacto", cn, adOpenStatic, adLockOptimistic ' Nombre del campo que tiene el ID de imagen Field_Img = "ID_Imagen" ' Path de la carpeta donde están las imagenes Carpeta_IMG = App.Path & "\img\" ' Si no existe la carpeta para guardar las imagen la crea If Dir(App.Path & "\img", vbDirectory) = "" Then MkDir App.Path & "\img" End If Command1(2).Enabled = False Command1(3).Enabled = False Command1(5).Enabled = False Command1(6).Enabled = False ' asigna el Datasource a los text Box For Each T In Me.txt_Field Set T.DataSource = rst Next 'Opcional: esto visualiza el Id del registro en un label 'Set lblID.DataSource = rst Setear_TextBox ' carga la imagen en el registro si es que tiene Mostrar_Imagen End Sub

Código fuente en un Módulo bas:

Option Explicit 'Variable para la imagen Private Pic As IPictureDisp 'Variables para la carpeta de imagenes _ y para el campo que tiene el Id de imagen Public Carpeta_IMG As String Public Field_Img As String 'Subrutina que dibuja el gráfico en el control Picture _ en forma centrada y a escala '******************************************************* Sub Dibujar_Imagen(Objeto As Object, Path_Imagen As String) On Error GoTo ErrSub Dim Pos_x As Single Dim Pos_y As Single Dim Ancho_IMG As Single Dim Alto_IMG As Single Dim Ancho_Obj As Single Dim Alto_Obj As Single Dim Old_Scale As Single Set Pic = LoadPicture(Path_Imagen) With Objeto .AutoRedraw = True .Cls Old_Scale = .ScaleMode .ScaleMode = vbPixels Ancho_IMG = .ScaleX(Pic.Width, vbHimetric, vbPixels) Alto_IMG = .ScaleY(Pic.Height, vbHimetric, vbPixels) Ancho_Obj = .ScaleWidth Alto_Obj = .ScaleHeight If Ancho_IMG > Ancho_Obj Then Alto_IMG = Alto_IMG * Ancho_Obj / Ancho_IMG Ancho_IMG = Ancho_Obj End If If Alto_IMG > Alto_Obj Then Ancho_IMG = Ancho_IMG * Alto_Obj / Alto_IMG Alto_IMG = Alto_Obj End If Pos_x = (Ancho_Obj - Ancho_IMG) / 2 Pos_y = (Alto_Obj - Alto_IMG) / 2 End With Objeto.PaintPicture Pic, Pos_x, Pos_y, Ancho_IMG, Alto_IMG Objeto.ScaleMode = Old_Scale Exit Sub 'Error ErrSub: If Err.Number = 76 Then Objeto.Cls Exit Sub Else MsgBox Err.Description, vbCritical End If End Sub

Nota: en este enlace hay un ejemplo para poder almacenar y recuperar imágenes en una base de datos , pero en este caso utilizando el objeto Stream de Ado

Buscar en Recursos vb