Cambiar de codigo de visual 6.0 a 2008 Quien por favor me auda a cambiar este codigo d visual basic 6.0 a visual basic 2008 por favor urgente... ayudenme
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
