VERSION 5.00
Begin VB.Form frmTarjeta 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Tarjeta"
   ClientHeight    =   2505
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6765
   Icon            =   "frmTarjeta.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   2505
   ScaleWidth      =   6765
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton cmdEstandar 
      Cancel          =   -1  'True
      Caption         =   "&Cancelar"
      Height          =   375
      Index           =   1
      Left            =   5280
      TabIndex        =   5
      Top             =   2040
      Width           =   1335
   End
   Begin VB.CommandButton cmdEstandar 
      Caption         =   "&Aceptar"
      Default         =   -1  'True
      Height          =   375
      Index           =   0
      Left            =   3840
      TabIndex        =   4
      Top             =   2040
      Width           =   1335
   End
   Begin VB.Frame fraTarjeta 
      Height          =   1815
      Left            =   120
      TabIndex        =   6
      Top             =   120
      Width           =   6495
      Begin VB.Frame fraActivo 
         Height          =   855
         Left            =   3360
         TabIndex        =   10
         Top             =   720
         Width           =   2895
         Begin VB.OptionButton optActivo 
            Caption         =   "Inactivo"
            Height          =   255
            Index           =   0
            Left            =   240
            TabIndex        =   2
            Top             =   360
            Width           =   1215
         End
         Begin VB.OptionButton optActivo 
            Caption         =   "Activo"
            Height          =   255
            Index           =   1
            Left            =   1560
            TabIndex        =   3
            Top             =   360
            Width           =   1215
         End
      End
      Begin VB.TextBox txtFEmision 
         BackColor       =   &H80000013&
         Enabled         =   0   'False
         Height          =   315
         Left            =   1680
         TabIndex        =   9
         TabStop         =   0   'False
         Top             =   1200
         Width           =   1215
      End
      Begin VB.TextBox txtTarjeta 
         Height          =   315
         Left            =   1680
         MaxLength       =   8
         TabIndex        =   1
         Top             =   840
         Width           =   1215
      End
      Begin VB.Label lblLabels 
         Caption         =   " Fecha Emisión"
         Height          =   375
         Index           =   2
         Left            =   240
         TabIndex        =   8
         Top             =   1320
         Width           =   1455
      End
      Begin VB.Label lblLabels 
         Caption         =   " Nro. &Tarjeta"
         Height          =   375
         Index           =   0
         Left            =   240
         TabIndex        =   0
         Top             =   960
         Width           =   1455
      End
      Begin VB.Label lblCliente 
         Alignment       =   2  'Center
         Caption         =   "Cliente"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   120
         TabIndex        =   7
         Top             =   240
         Width           =   6255
      End
   End
End
Attribute VB_Name = "frmTarjeta"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public iEditar As Integer

Dim sTarjeta As String

Private Sub Form_Load()

  'Cargar formulario
  
  On Error GoTo LineaError

  Screen.MousePointer = vbHourglass
  
  InicializarForm
  
  Screen.MousePointer = vbDefault
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  Screen.MousePointer = vbDefault

End Sub

Private Sub InicializarForm()

  'Inicializa Form según opción

  On Error GoTo LineaError
  
  lblCliente.Caption = Trim(frmCliente.txtApellidos.Text) + " " + Trim(frmCliente.txtNombres.Text)
  
  Select Case iEditar
  
  Case kCMD_NUEVO
    Me.Caption = "Nueva Tarjeta"
    optActivo(kSI).Value = True
    txtFEmision.Text = Format(Date, "dd/mm/yyyy")
  
  Case kCMD_EDITAR
    Me.Caption = "Editar Tarjeta"
    TraerData
    
  Case kCMD_BORRAR
    Me.Caption = "Borrar Tarjeta"
    TraerData
    DeshabilitarControles
    
  Case kCMD_VER
    Me.Caption = "Tarjeta"
    TraerData
    DeshabilitarControles
    
  End Select
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub TraerData()

  'Trae la data de la tabla Tarjeta
  
  On Error GoTo LineaError

  Dim sSQL As String
  Dim ADORS As ADODB.Recordset
  
  sSQL = "SELECT * FROM Tarjeta " + _
         "WHERE TRIM(nTarjNumb) = TRIM('$')"
  sSQL = VBsprintf(sSQL, frmCliente.lvwTarjeta.SelectedItem.Text)
  
  If oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then
  
    If Not ADORS.EOF Then
      
      sTarjeta = LeerCampo(ADORS!nTarjNumb)
      txtTarjeta.Text = sTarjeta
      txtFEmision.Text = LeerCampo(ADORS!dEmisDate)
      
      If LeerCampo(ADORS!cTarjActi) <> kSI Then
        optActivo(kNO).Value = True
      Else
        optActivo(kSI).Value = True
      End If
      
    End If
    
  End If
  
  Set ADORS = Nothing
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
End Sub

Private Sub DeshabilitarControles()

  'Deshabilita controles
  
  On Error GoTo LineaError

  Call DeshabilitarControl(txtTarjeta, True)
  Call DeshabilitarControl(optActivo(kNO), False)
  Call DeshabilitarControl(optActivo(kSI), False)
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
End Sub

Private Sub txtTarjeta_KeyPress(KeyAscii As Integer)
  
  'Valida q solo se ingresen números (valores enteros)
  
  On Error GoTo LineaError
  
  Call ValidKeyPress(KeyAscii, kVKP_NUMERIC_INTEGER_ONLY)
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
End Sub

Private Sub cmdEstandar_Click(Index As Integer)

  'Permite descargar el formulario, previamente haciendo cambios o no en
  'la tabla Tarjeta
  
  On Error GoTo LineaError

  Screen.MousePointer = vbHourglass
  
  Select Case Index
  
  Case kCMD_ACEPTAR
        
    If iEditar = kCMD_VER Then
      Unload Me
      GoTo Salir
    End If
  
    If ValidarData Then
    
      If ActualizarTabla Then
    
        ActualizarLista
        frmCliente.IconosDesactivados txtTarjeta.Text
        frmCliente.ManejarControles
        Call frmCliente.lvwTarjeta_Click
          
        Unload Me
        
      End If
      
    End If
  
  Case kCMD_CANCELAR
  
    Unload Me
    
  End Select
  
  GoTo Salir
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
Salir:
  Screen.MousePointer = vbDefault

End Sub

Private Function ValidarData() As Boolean

  'Valida que la información ingresada sea correcta y completa
  
  On Error GoTo LineaError

  ValidarData = False
  
  If Trim(txtTarjeta.Text) = "" Then
    MsgBox "Ingresar Tarjeta", vbOKOnly + vbInformation
    txtTarjeta.SetFocus
    Exit Function
  End If
  
  txtTarjeta.Text = LPad(Trim(txtTarjeta.Text), 8, "0")
  
  ValidarData = True
  
  Exit Function
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Function

Private Function ActualizarTabla() As Boolean

  'Inserta/Actualiza/Elimina el registro de Usuario
  
  On Error GoTo LineaError

  Dim sSQL As String
  Dim bConnFlag As Boolean
     
  ActualizarTabla = False
  
  ADOCnn.BeginTrans
  bConnFlag = True
    
  Select Case iEditar
  
  Case kCMD_NUEVO
  
    If Not VerificarTarjeta Then GoTo LineaError1
    If Not DesactivarTarjetas Then GoTo LineaError1
  
    sSQL = "INSERT INTO Tarjeta (cClieCode, nTarjNumb, cTarjActi, dEmisDate, sUserDesc) " + _
           "VALUES ($, '$', $, '$', '$')"
    sSQL = VBsprintf(sSQL, frmCliente.sCodigo, _
           Trim(txtTarjeta.Text), _
           IIf(optActivo(kSI).Value, kSI, kNO), _
           Format(Now, "yyyy/mm/dd hh:mm"), _
           psUsuario_Descripcion)
  
  Case kCMD_EDITAR
  
    If Not VerificarTarjeta Then GoTo LineaError1
    If Not DesactivarTarjetas Then GoTo LineaError1
  
    sSQL = "UPDATE Tarjeta SET nTarjNumb = '$', " + _
           "cTarjActi = $ " + _
           "WHERE TRIM(nTarjNumb) = TRIM('$')"
    sSQL = VBsprintf(sSQL, Trim(txtTarjeta.Text), _
           IIf(optActivo(kSI).Value, kSI, kNO), _
           sTarjeta)
  
  Case kCMD_BORRAR
  
    sSQL = "DELETE * FROM Tarjeta " + _
           "WHERE TRIM(nTarjNumb) = TRIM('$')"
    sSQL = VBsprintf(sSQL, sTarjeta)
  
  End Select
  
  If oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then
    ADOCnn.CommitTrans
    bConnFlag = False
    ActualizarTabla = True
  Else
    GoTo LineaError1
  End If
  
  Exit Function
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
LineaError1:
  If bConnFlag Then ADOCnn.RollbackTrans
  
End Function

Private Function VerificarTarjeta() As Boolean

  'Verifica si ya existe la tarjeta

  On Error GoTo LineaError
  
  Dim sSQL As String
  Dim ADORS As ADODB.Recordset
  
  VerificarTarjeta = False

  If iEditar = kCMD_NUEVO Or (iEditar = kCMD_EDITAR And Trim(txtTarjeta.Text) <> Trim(sTarjeta)) Then
    
    sSQL = "SELECT * FROM Tarjeta WHERE TRIM(nTarjNumb) = TRIM('$')"
    sSQL = VBsprintf(sSQL, txtTarjeta.Text)
    
    If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
    
    If Not ADORS.EOF Then
      MsgBox "Nro. de Tarjeta ya se encuentra registrado en la Base de datos", vbOKOnly + vbInformation
      GoTo Salir
    End If
    
  End If
  
  VerificarTarjeta = True
  
  GoTo Salir
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
Salir:
  Set ADORS = Nothing

End Function

Private Function DesactivarTarjetas() As Boolean

  'Desactiva tarjetas del cliente

  On Error GoTo LineaError
  
  Dim sSQL As String
  
  DesactivarTarjetas = False
  
  If optActivo(kSI).Value Then
    
    sSQL = "UPDATE Tarjeta SET cTarjActi = $ WHERE cClieCode = $"
    sSQL = VBsprintf(sSQL, kNO, frmCliente.sCodigo)
    
    If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then Exit Function
    
  End If
  
  DesactivarTarjetas = True
  
  Exit Function
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Function


Private Sub ActualizarLista()

  'Actualiza la lista de frmCliente

  On Error GoTo LineaError
  
  Dim itemX As ListItem
  
  Select Case iEditar
  
  Case kCMD_NUEVO, kCMD_EDITAR
  
    If iEditar = kCMD_NUEVO Then
      Set itemX = frmCliente.lvwTarjeta.ListItems.Add(, , Trim(txtTarjeta.Text))
      itemX.SubItems(1) = Format(Now, "dd/mm/yyyy hh:mm")
      itemX.SubItems(2) = psUsuario_Descripcion
    Else
      Set itemX = frmCliente.lvwTarjeta.SelectedItem
      itemX.Text = Trim(txtTarjeta.Text)
    End If
    
    If optActivo(kSI).Value Then
      itemX.Icon = 1
      itemX.SmallIcon = 1
    Else
      itemX.Icon = 2
      itemX.SmallIcon = 2
    End If
    
    itemX.Selected = True
    
  Case kCMD_BORRAR
  
    frmCliente.lvwTarjeta.ListItems.Remove (frmCliente.lvwTarjeta.SelectedItem.Index)
    
  End Select
      
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
End Sub


