
16/05/2008, 17:27
|
| | Fecha de Ingreso: febrero-2006
Mensajes: 124
Antigüedad: 19 años, 2 meses Puntos: 0 | |
Respuesta: un pequeño problema mas...
Código:
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
End If
' Si el registro no tiene una imagen asociada Limpia el Picture
If .Fields(Field_Img) = "" Or .Fields(Field_Img) = 0 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 Imprimir()
Dim rsFicha As ADODB.Recordset
Set rsFicha = New Recordset
rsFicha.Open "Select * FROM clientes Where Id=" & lblID.Caption, cn, adOpenStatic, adLockReadOnly
If rsFicha.RecordCount > 0 Then
Set DataReport1.DataSource = rsFicha
With DataReport1
If rsFicha!id_Imagen <> "" Then
.Sections.Item("Sección1").Controls("lblSinFoto").Visible = False
Set .Sections.Item("Sección1").Controls("rptImagen").Picture = Picture1.Image
Else
.Sections.Item("Sección1").Controls("lblSinFoto").Visible = True
End If
DataReport1.Show
End With
Else
MsgBox "No hay registro para imprimir ", vbInformation
End If
End Sub
Private Sub Command2_Click()
Call Imprimir
End Sub
Private Sub Command4_Click()
Dim r As Long
r = InputBox("Introduce Apellido")
rst.Recordset.FindFirst "DNI='" & r & "'"
End Sub
Private Sub Command6_Click()
Dim r As Long
r = InputBox("Introduce Apellido")
rst.Recordset.FindFirst "DNI='" & r & "'"
End Sub
Private Sub Command7_Click()
Dim r As Long
r = InputBox("Introduce DNI")
rst.Recordset.FindFirst "DNI='" & r & "'"
End Sub
Private Sub Command8_Click()
Dim r As Long
r = InputBox("Introduce Número")
rst.Recordset.FindFirst "Numero='" & r & "'"
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
If Not rst Is Nothing Then
If rst.State = adStateOpen Then rst.Close
Set rst = Nothing
End If
If Not cn Is Nothing Then
If cn.State = adStateOpen Then cn.Close
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 & "\db1.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 clientes Order by Apellido", 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
If rst.RecordCount > 0 Then
Call cmdNormal
Else
Call cmdSinRegistros
End If
Set txt_Field(0).DataSource = rst
Set txt_Field(1).DataSource = rst
Set txt_Field(2).DataSource = rst
Set txt_Field(3).DataSource = rst
Set txt_Field(4).DataSource = rst
Set txt_Field(5).DataSource = rst
Set txt_Field(6).DataSource = rst
Set txt_Field(7).DataSource = rst
Set txt_Field(8).DataSource = rst
Set txt_Field(9).DataSource = rst
txt_Field(0).DataField = "Nombre"
txt_Field(1).DataField = "Apellido"
txt_Field(2).DataField = "Telefono"
txt_Field(3).DataField = "Dni"
txt_Field(4).DataField = "Direccion"
txt_Field(5).DataField = "Email"
txt_Field(6).DataField = "Obra social"
txt_Field(7).DataField = "Poblacion"
txt_Field(8).DataField = "Notas"
txt_Field(9).DataField = "Numero"
'Opcional: esto visualiza el Id del registro en un label
Set lblID.DataSource = rst
lblID.DataField = "Id"
Call Setear_TextBox
' carga la imagen en el registro si es que tiene
Call Mostrar_Imagen
End Sub
Sub cmdNormal()
DeshabilitarTodosCmd
Command1(0).Enabled = True
Command1(1).Enabled = True
Command1(3).Enabled = True
End Sub
Sub cmdSinRegistros()
DeshabilitarTodosCmd
Command1(0).Enabled = True
End Sub
Sub cmdEditar()
DeshabilitarTodosCmd
Command1(2).Enabled = True
Command1(4).Enabled = True
Command1(5).Enabled = True
Command1(6).Enabled = True
End Sub
Sub CmdNuevo()
DeshabilitarTodosCmd
Command1(2).Enabled = True
Command1(4).Enabled = True
Command1(5).Enabled = True
Command1(6).Enabled = True
End Sub
Sub DeshabilitarTodosCmd()
Command1(0).Enabled = False
Command1(1).Enabled = False
Command1(2).Enabled = False
Command1(3).Enabled = False
Command1(4).Enabled = False
Command1(5).Enabled = False
Command1(6).Enabled = False
End Sub
Private Sub mnuImprimir_Click()
Call Imprimir
End Sub
Private Sub mnuVerTodo_Click()
With Form2
Set .MSHFlexGrid1.DataSource = rst
.Show vbModal
End With
End Sub
|