Ver Mensaje Individual
  #4 (permalink)  
Antiguo 16/05/2008, 17:27
tuchy
 
Fecha de Ingreso: febrero-2006
Mensajes: 124
Antigüedad: 18 años, 3 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