VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MsComCtl.ocx"
Begin VB.Form frmCanje 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Canjes"
   ClientHeight    =   8280
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   10785
   Icon            =   "frmCanje.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   8280
   ScaleWidth      =   10785
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton cmdCanje 
      Caption         =   "&Canjes Realizados"
      Height          =   375
      Left            =   240
      TabIndex        =   5
      Top             =   7800
      Width           =   1575
   End
   Begin VB.CommandButton cmdSalir 
      Caption         =   "&Salir"
      Height          =   375
      Left            =   9360
      TabIndex        =   7
      Top             =   7800
      Width           =   1335
   End
   Begin VB.CommandButton cmdCliente 
      Caption         =   "&Ver Cliente"
      Height          =   375
      Left            =   7920
      TabIndex        =   6
      Top             =   7800
      Width           =   1335
   End
   Begin VB.Frame fraCanje 
      Caption         =   "Canje Tickets)"
      Height          =   2535
      Index           =   2
      Left            =   120
      TabIndex        =   23
      Top             =   5160
      Width           =   10575
      Begin VB.TextBox txtTicket 
         BackColor       =   &H80000013&
         Enabled         =   0   'False
         Height          =   315
         Left            =   9000
         TabIndex        =   34
         Top             =   1200
         Width           =   1215
      End
      Begin VB.CommandButton cmdGrabar 
         Caption         =   "&Grabar"
         Height          =   375
         Index           =   1
         Left            =   7560
         TabIndex        =   4
         Top             =   2040
         Width           =   1335
      End
      Begin VB.TextBox txtCantidadPremioTicket 
         Height          =   315
         Left            =   7560
         TabIndex        =   3
         Top             =   1200
         Width           =   1215
      End
      Begin VB.TextBox txtPremioTicket 
         BackColor       =   &H80000013&
         Enabled         =   0   'False
         Height          =   315
         Left            =   7560
         TabIndex        =   29
         Top             =   600
         Width           =   2895
      End
      Begin MSComctlLib.ListView lvwPremioTicket 
         Height          =   1815
         Left            =   120
         TabIndex        =   2
         Top             =   600
         Width           =   7335
         _ExtentX        =   12938
         _ExtentY        =   3201
         LabelEdit       =   1
         LabelWrap       =   -1  'True
         HideSelection   =   0   'False
         _Version        =   393217
         Icons           =   "imlPremio"
         SmallIcons      =   "imlPremio"
         ForeColor       =   -2147483640
         BackColor       =   -2147483643
         BorderStyle     =   1
         Appearance      =   1
         NumItems        =   0
      End
      Begin VB.Label lblLabels 
         Caption         =   "Tickets a canjear"
         Height          =   375
         Index           =   12
         Left            =   9000
         TabIndex        =   33
         Top             =   960
         Width           =   1455
      End
      Begin VB.Label lblLabels 
         Caption         =   "Cantidad"
         Height          =   375
         Index           =   10
         Left            =   7560
         TabIndex        =   30
         Top             =   960
         Width           =   1455
      End
      Begin VB.Label lblLabels 
         Caption         =   "Premio"
         Height          =   375
         Index           =   9
         Left            =   7560
         TabIndex        =   28
         Top             =   360
         Width           =   1455
      End
      Begin VB.Label lblLabels 
         Alignment       =   2  'Center
         BorderStyle     =   1  'Fixed Single
         Caption         =   "Premios por Ticket"
         Height          =   255
         Index           =   8
         Left            =   120
         TabIndex        =   27
         Top             =   360
         Width           =   7335
      End
   End
   Begin VB.Frame fraCanje 
      Caption         =   "Canje (Puntos)"
      Height          =   2535
      Index           =   1
      Left            =   120
      TabIndex        =   21
      Top             =   2560
      Width           =   10575
      Begin VB.TextBox txtPunto 
         BackColor       =   &H80000013&
         Enabled         =   0   'False
         Height          =   315
         Left            =   9000
         TabIndex        =   32
         Top             =   1200
         Width           =   1215
      End
      Begin VB.CommandButton cmdGrabar 
         Caption         =   "&Grabar"
         Height          =   375
         Index           =   0
         Left            =   7560
         TabIndex        =   1
         Top             =   2040
         Width           =   1335
      End
      Begin VB.TextBox txtCantidadPremioPunto 
         Height          =   315
         Left            =   7560
         TabIndex        =   0
         Top             =   1200
         Width           =   1215
      End
      Begin VB.TextBox txtPremioPunto 
         BackColor       =   &H80000013&
         Enabled         =   0   'False
         Height          =   315
         Left            =   7560
         TabIndex        =   25
         Top             =   600
         Width           =   2895
      End
      Begin MSComctlLib.ListView lvwPremioPunto 
         Height          =   1815
         Left            =   120
         TabIndex        =   8
         Top             =   600
         Width           =   7335
         _ExtentX        =   12938
         _ExtentY        =   3201
         LabelEdit       =   1
         LabelWrap       =   -1  'True
         HideSelection   =   0   'False
         _Version        =   393217
         Icons           =   "imlPremio"
         SmallIcons      =   "imlPremio"
         ForeColor       =   -2147483640
         BackColor       =   -2147483643
         BorderStyle     =   1
         Appearance      =   1
         NumItems        =   0
      End
      Begin VB.Label lblLabels 
         Caption         =   "Puntos a canjear"
         Height          =   375
         Index           =   11
         Left            =   9000
         TabIndex        =   31
         Top             =   960
         Width           =   1215
      End
      Begin VB.Label lblLabels 
         Caption         =   "Cantidad"
         Height          =   375
         Index           =   6
         Left            =   7560
         TabIndex        =   26
         Top             =   960
         Width           =   1455
      End
      Begin VB.Label lblLabels 
         Caption         =   "Premio"
         Height          =   375
         Index           =   5
         Left            =   7560
         TabIndex        =   24
         Top             =   360
         Width           =   1455
      End
      Begin VB.Label lblLabels 
         Alignment       =   2  'Center
         BorderStyle     =   1  'Fixed Single
         Caption         =   "Premios por Puntaje"
         Height          =   255
         Index           =   7
         Left            =   120
         TabIndex        =   22
         Top             =   360
         Width           =   7335
      End
   End
   Begin VB.Frame fraCanje 
      ForeColor       =   &H80000013&
      Height          =   2535
      Index           =   0
      Left            =   120
      TabIndex        =   10
      Top             =   0
      Width           =   7455
      Begin VB.TextBox txtTarjeta 
         BackColor       =   &H80000013&
         Enabled         =   0   'False
         Height          =   315
         Left            =   2040
         MaxLength       =   8
         TabIndex        =   16
         Top             =   1080
         Width           =   1215
      End
      Begin VB.TextBox txtNombres 
         BackColor       =   &H80000013&
         Enabled         =   0   'False
         Height          =   315
         Left            =   2040
         MaxLength       =   50
         TabIndex        =   14
         Top             =   720
         Width           =   5175
      End
      Begin VB.TextBox txtApellidos 
         BackColor       =   &H80000013&
         Enabled         =   0   'False
         Height          =   315
         Left            =   2040
         MaxLength       =   50
         TabIndex        =   12
         Top             =   360
         Width           =   5175
      End
      Begin VB.Label lblTickets 
         Alignment       =   1  'Right Justify
         Caption         =   "Tickets"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   5520
         TabIndex        =   20
         Top             =   1920
         Width           =   1455
      End
      Begin VB.Label lblLabels 
         Caption         =   "Tickets:"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Index           =   4
         Left            =   3840
         TabIndex        =   19
         Top             =   1920
         Width           =   855
      End
      Begin VB.Label lblPuntos 
         Alignment       =   1  'Right Justify
         Caption         =   "Puntos"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   1320
         TabIndex        =   18
         Top             =   1920
         Width           =   1455
      End
      Begin VB.Label lblLabels 
         Caption         =   "Puntos:"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Index           =   3
         Left            =   240
         TabIndex        =   17
         Top             =   1920
         Width           =   855
      End
      Begin VB.Label lblLabels 
         Caption         =   "Tarjeta Activa"
         Height          =   375
         Index           =   2
         Left            =   240
         TabIndex        =   15
         Top             =   1200
         Width           =   1455
      End
      Begin VB.Label lblLabels 
         Caption         =   "Nombres"
         Height          =   375
         Index           =   1
         Left            =   240
         TabIndex        =   13
         Top             =   840
         Width           =   1455
      End
      Begin VB.Label lblLabels 
         Caption         =   "Apellidos"
         Height          =   375
         Index           =   0
         Left            =   240
         TabIndex        =   11
         Top             =   480
         Width           =   1455
      End
   End
   Begin VB.Frame fraFoto 
      Height          =   2535
      Left            =   7800
      TabIndex        =   9
      Top             =   0
      Width           =   2895
      Begin VB.Image imgFoto 
         Height          =   2145
         Left            =   120
         Stretch         =   -1  'True
         Top             =   240
         Width           =   2640
      End
   End
   Begin MSComctlLib.ImageList imlPremio 
      Left            =   0
      Top             =   0
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   1
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmCanje.frx":0442
            Key             =   ""
         EndProperty
      EndProperty
   End
End
Attribute VB_Name = "frmCanje"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim sCliente As String
Dim sTarjeta As String
Dim sCodigo As String

Private Sub Form_Load()

  'Carga el formulario
  
  On Error GoTo LineaError

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

Private Sub ConfigurarColumnas()

  'Configura las columnas de las listas lvwPremioPunto, lvwPremioTicket
  
  On Error GoTo LineaError

  Dim aColumnTitle() As String
  Dim aColumnWidth() As Single
  Dim aColumnAlign() As Integer
  
  ReDim aColumnTitle(2) As String
  ReDim aColumnWidth(2) As Single
  ReDim aColumnAlign(2) As Integer

  aColumnTitle(0) = "Premio"
  aColumnTitle(1) = "Puntos Req."
  
  aColumnWidth(0) = 0.7
  aColumnWidth(1) = 0.2
  
  aColumnAlign(0) = lvwColumnLeft
  aColumnAlign(1) = lvwColumnRight
    
  Call oListAdmin.InicializarLista(lvwPremioPunto, aColumnTitle, _
                                   aColumnWidth, aColumnAlign, lvwReport)
                                   
  ReDim aColumnTitle(3) As String
  ReDim aColumnWidth(3) As Single
  ReDim aColumnAlign(3) As Integer

  aColumnTitle(0) = "Premio"
  aColumnTitle(1) = "Stock"
  aColumnTitle(2) = "Tickets Req."
  
  aColumnWidth(0) = 0.5
  aColumnWidth(1) = 0.2
  aColumnWidth(2) = 0.2
  
  aColumnAlign(0) = lvwColumnLeft
  aColumnAlign(1) = lvwColumnRight
  aColumnAlign(2) = lvwColumnRight
    
  Call oListAdmin.InicializarLista(lvwPremioTicket, aColumnTitle, _
                                   aColumnWidth, aColumnAlign, lvwReport)
                                   
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub InicializarForm()

  'Inicializa el Form
  
  On Error GoTo LineaError
  
  TraerDataCliente
  LlenarListaPremioPunto
  LlenarListaPremioTicket
  ManejarControles
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
End Sub

Private Sub TraerDataCliente()

  'Traer Data del Cliente seleccionado
  
  On Error GoTo LineaError
  
  Dim sSQL As String
  Dim ADORS As ADODB.Recordset
  
  Dim sRutaFoto As String
  Dim iPos As Integer
  
  sCliente = Mid(frmPrincipal.lvwCliente.SelectedItem.Key, 2)
  
  sSQL = "SELECT * FROM Cliente WHERE cClieCode = $"
  sSQL = VBsprintf(sSQL, sCliente)
  
  If oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then

    If Not ADORS.EOF Then
    
      sTarjeta = frmPrincipal.lvwCliente.SelectedItem.SubItems(2)
    
      txtApellidos.Text = LeerCampo(ADORS!sClieApel)
      txtNombres.Text = LeerCampo(ADORS!sClieName)
      txtTarjeta.Text = sTarjeta
      lblPuntos.Caption = Format(LeerCampo(ADORS!nPuntCant), "##,##0")
      lblTickets.Caption = Format(LeerCampo(ADORS!nTickCant), "##,##0")

      sRutaFoto = LeerCampo(ADORS!sClieRout)

      If sRutaFoto <> "" Then

        If Dir(sRutaFoto) = "" Then

          iPos = InStrRev(sRutaFoto, "\")

          If iPos > 0 Then
            sRutaFoto = App.Path + IIf(Right(App.Path, 1) = "\", "", "\") + kDIR_FOTOS + Mid(sRutaFoto, iPos + 1)
          End If

        End If

        If Dir(sRutaFoto) <> "" Then
          imgFoto.Picture = LoadPicture(sRutaFoto)
        End If

      End If
               
    End If

  End If
  
  Set ADORS = Nothing

  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub LlenarListaPremioPunto()

  'Llena la lista PremioPunto
  
  On Error GoTo LineaError

  Dim sSQL As String
  Dim ADORS As ADODB.Recordset
  
  Dim itemX As ListItem
  
  lvwPremioPunto.ListItems.Clear
  
  sSQL = "SELECT * " + _
         "FROM Premio_Punto " + _
         "WHERE cPremActi = $ AND " + _
         "nPuntCant <= $ " + _
         "ORDER BY sPremDesc"
  sSQL = VBsprintf(sSQL, kSI, Format(lblPuntos.Caption, "####0"))
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
  
  Do While Not ADORS.EOF
  
    Set itemX = lvwPremioPunto.ListItems.Add(, "k" + LeerCampo(ADORS!cPremCode), LeerCampo(ADORS!sPremDesc))
    itemX.SubItems(1) = Format(LeerCampo(ADORS!nPuntCant), "##,##0")
    
    itemX.Icon = 1
    itemX.SmallIcon = 1
    
    ADORS.MoveNext
    
  Loop
  
  Call lvwPremioPunto_Click
    
  GoTo Salir
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
Salir:
  Set ADORS = Nothing

End Sub

Private Sub LlenarListaPremioTicket()

  'Llena la lista PremioTicket
  
  On Error GoTo LineaError

  Dim sSQL As String
  Dim ADORS As ADODB.Recordset
  
  Dim itemX As ListItem
  
  lvwPremioTicket.ListItems.Clear
  
  sSQL = "SELECT * " + _
         "FROM Premio_Ticket " + _
         "WHERE cPremActi = $ AND " + _
         "nTickCant <= $ " + _
         "ORDER BY sPremDesc"
  sSQL = VBsprintf(sSQL, kSI, Format(lblTickets.Caption, "####0"))
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
  
  Do While Not ADORS.EOF
  
    Set itemX = lvwPremioTicket.ListItems.Add(, "k" + LeerCampo(ADORS!cPremCode), LeerCampo(ADORS!sPremDesc))
    itemX.SubItems(1) = Format(LeerCampo(ADORS!nPremStoc), "##,##0")
    itemX.SubItems(2) = Format(LeerCampo(ADORS!nTickCant), "##,##0")
    
    itemX.Icon = 1
    itemX.SmallIcon = 1
    
    ADORS.MoveNext
    
  Loop
  
  Call lvwPremioTicket_Click
    
  GoTo Salir
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
Salir:
  Set ADORS = Nothing

End Sub

Public Sub ManejarControles()

  'Maneja el uso de los controles

  On Error GoTo LineaError

  Call DeshabilitarControl(txtCantidadPremioPunto, True)
  Call DeshabilitarControl(txtCantidadPremioTicket, True)
  Call DeshabilitarControl(cmdGrabar(kPUNTO), False)
  Call DeshabilitarControl(cmdGrabar(kTICKET), False)
  
  If lvwPremioPunto.ListItems.Count > 0 Then
    lvwPremioPunto.SelectedItem.EnsureVisible
    Call HabilitarControl(txtCantidadPremioPunto, True)
    Call HabilitarControl(cmdGrabar(kPUNTO), False)
  End If
    
  If lvwPremioTicket.ListItems.Count > 0 Then
    lvwPremioTicket.SelectedItem.EnsureVisible
    Call HabilitarControl(txtCantidadPremioTicket, True)
    Call HabilitarControl(cmdGrabar(kTICKET), False)
  End If
  
  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub lvwPremioPunto_Click()

  'Muestra item seleccionado en el texto

  On Error GoTo LineaError
  
  txtPremioPunto.Text = ""
  
  If lvwPremioPunto.ListItems.Count > 0 Then
  
    txtPremioPunto.Text = lvwPremioPunto.SelectedItem.Text
    CalcularCantidad (kPUNTO)
    
    On Error Resume Next
    txtCantidadPremioPunto.SetFocus
    
  End If
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub lvwPremioPunto_KeyDown(KeyCode As Integer, Shift As Integer)

  On Error GoTo LineaError

  Call lvwPremioPunto_Click
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub lvwPremioPunto_KeyUp(KeyCode As Integer, Shift As Integer)

  On Error GoTo LineaError

  Call lvwPremioPunto_Click
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub lvwPremioPunto_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)

  'Ordenar Según la columna seleccionada
  
  On Error GoTo LineaError

  If ColumnHeader.Index = 2 Then
  
    Call APISort(lvwPremioPunto, ColumnHeader.Index, _
                 gbytLVW_SORT_VALUE)
                 
  Else
  
    Call APISort(lvwPremioPunto, ColumnHeader.Index, _
                 gbytLVW_SORT_DEFAULT)
                 
  End If
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
End Sub

Private Sub lvwPremioTicket_Click()

  'Muestra item seleccionado en el texto

  On Error GoTo LineaError
  
  txtPremioTicket.Text = ""
  
  If lvwPremioTicket.ListItems.Count > 0 Then
  
    txtPremioTicket.Text = lvwPremioTicket.SelectedItem.Text
    CalcularCantidad (kTICKET)
    
    On Error Resume Next
    txtCantidadPremioTicket.SetFocus
    
  End If
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub lvwPremioTicket_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)

  'Ordenar Según la columna seleccionada
  
  On Error GoTo LineaError

  If ColumnHeader.Index = 2 Or ColumnHeader.Index = 3 Then
  
    Call APISort(lvwPremioTicket, ColumnHeader.Index, _
                 gbytLVW_SORT_VALUE)
                 
  Else
  
    Call APISort(lvwPremioTicket, ColumnHeader.Index, _
                 gbytLVW_SORT_DEFAULT)
                 
  End If
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
End Sub

Private Sub lvwPremioTicket_KeyDown(KeyCode As Integer, Shift As Integer)

  On Error GoTo LineaError

  Call lvwPremioTicket_Click
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub lvwPremioTicket_KeyUp(KeyCode As Integer, Shift As Integer)

  On Error GoTo LineaError

  Call lvwPremioTicket_Click
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub CalcularCantidad(iIndex As Integer)

  On Error GoTo LineaError

  If iIndex = kPUNTO Then
  
    If Trim(txtCantidadPremioPunto.Text) = "" Or lvwPremioPunto.ListItems.Count = 0 Then Exit Sub

    If IsNumeric(txtCantidadPremioPunto.Text) And IsNumeric(lvwPremioPunto.SelectedItem.SubItems(1)) Then
      txtPunto.Text = Format(CLng(txtCantidadPremioPunto.Text) * CLng(lvwPremioPunto.SelectedItem.SubItems(1)), "##,###")
    Else
      txtPunto.Text = ""
    End If
    
  Else
  
    If Trim(txtCantidadPremioTicket.Text) = "" Or lvwPremioTicket.ListItems.Count = 0 Then Exit Sub
  
    If IsNumeric(txtCantidadPremioTicket.Text) And IsNumeric(lvwPremioTicket.SelectedItem.SubItems(2)) Then
      txtTicket.Text = Format(CLng(txtCantidadPremioTicket.Text) * CLng(lvwPremioTicket.SelectedItem.SubItems(2)), "##,###")
    Else
      txtTicket.Text = ""
    End If
  
  End If
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
End Sub

Private Sub LimpiarControles(iIndex As Integer)

  'Limpia los controles

  On Error GoTo LineaError

  If iIndex = kPUNTO Then
  
    txtCantidadPremioPunto.Text = ""
    txtPunto.Text = ""
  
  Else
  
    txtCantidadPremioTicket.Text = ""
    txtTicket.Text = ""
  
  End If
  
  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation


End Sub

Private Sub txtCantidadPremioPunto_Change()

  'Identifica cuantos puntos utiliza

  On Error GoTo LineaError

  CalcularCantidad (kPUNTO)
  
  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub txtCantidadPremioPunto_KeyPress(KeyAscii As Integer)

  'Valida q se ingrese solo valores numéricos (enteros)

  On Error GoTo LineaError

  Call ValidKeyPress(KeyAscii, kVKP_NUMERIC_INTEGER_ONLY)

  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub txtCantidadPremioPunto_LostFocus()

  'Formatea el texto
  
  On Error GoTo LineaError
  
  txtCantidadPremioPunto.Text = Format(txtCantidadPremioPunto.Text, "##,##0")
  
  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
End Sub

Private Sub txtCantidadPremioTicket_Change()

  'Identifica cuantos puntos utiliza

  On Error GoTo LineaError

  CalcularCantidad (kTICKET)
  
  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub txtCantidadPremioTicket_KeyPress(KeyAscii As Integer)

  'Valida q se ingrese solo valores numéricos (enteros)

  On Error GoTo LineaError

  Call ValidKeyPress(KeyAscii, kVKP_NUMERIC_INTEGER_ONLY)

  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub txtCantidadPremioTicket_LostFocus()

  'Formatea el texto
  
  On Error GoTo LineaError
  
  txtCantidadPremioTicket.Text = Format(txtCantidadPremioTicket.Text, "##,##0")
  
  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
End Sub

Private Sub cmdGrabar_Click(Index As Integer)

  'Inserta Canje

  On Error GoTo LineaError

  Dim sSQL As String
  Dim ADORS As ADODB.Recordset
  
  Screen.MousePointer = vbHourglass
  
  If Not ValidarData(Index) Then GoTo Salir
  If Not ActualizarTabla(Index) Then GoTo Salir
  
  If Index = kPUNTO Then
    lblPuntos.Caption = Format(CLng(lblPuntos.Caption) - CLng(txtPunto.Text), "##,##0")
    frmPrincipal.lvwCliente.SelectedItem.SubItems(4) = lblPuntos.Caption
    LlenarListaPremioPunto
    LimpiarControles (kPUNTO)
  Else
    lblTickets.Caption = Format(CLng(lblTickets.Caption) - CLng(txtTicket.Text), "##,##0")
    frmPrincipal.lvwCliente.SelectedItem.SubItems(5) = lblTickets.Caption
    LlenarListaPremioTicket
    LimpiarControles (kTICKET)
  End If
  
  ManejarControles
  
  GoTo Salir

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
Salir:
  Set ADORS = Nothing
  Screen.MousePointer = vbDefault
  
End Sub

Private Function ValidarData(iIndex As Integer) As Boolean

  'Valida que la información ingresada sea correcta y completa
  
  On Error GoTo LineaError
  
  ValidarData = False
  
  If iIndex = kPUNTO Then
  
    If Trim(txtCantidadPremioPunto.Text) = "" Then
      MsgBox "Ingresar Cantidad", vbOKOnly + vbInformation
      txtCantidadPremioPunto.SetFocus
      Exit Function
    End If
    
    If CLng(txtCantidadPremioPunto.Text) > CLng(lvwPremioPunto.SelectedItem.SubItems(1)) Then
      MsgBox "Cantidad no disponible", vbOKOnly + vbInformation
      txtCantidadPremioPunto.SetFocus
      Exit Function
    End If
    
    If IsNumeric(txtPunto.Text) Then
    
      If CLng(txtPunto.Text) > CLng(lblPuntos.Caption) Then
        MsgBox "Cantidad ingresada requiere " + Format(txtPunto.Text, "##,##0") + " puntos. Puntos disponibles: " + lblPuntos.Caption, vbOKOnly + vbInformation
        txtCantidadPremioPunto.SetFocus
        Exit Function
      End If
      
    Else
    
      MsgBox "Valor no válido", vbOKOnly + vbInformation
      txtCantidadPremioPunto.SetFocus
      Exit Function
      
    End If
    
  End If
    
  If iIndex = kTICKET Then
  
    If Trim(txtTicket.Text) = "" Then
      MsgBox "Ingresar Cantidad", vbOKOnly + vbInformation
      txtCantidadPremioTicket.SetFocus
      Exit Function
    End If
    
    If CLng(txtCantidadPremioTicket.Text) > CLng(lvwPremioTicket.SelectedItem.SubItems(1)) Then
      MsgBox "Cantidad no disponible", vbOKOnly + vbInformation
      txtCantidadPremioTicket.SetFocus
      Exit Function
    End If
    
    If IsNumeric(txtTicket.Text) Then
    
      If CLng(txtTicket.Text) > CLng(lblTickets.Caption) Then
        MsgBox "Cantidad ingresada requiere " + Format(txtTicket.Text, "##,##0") + " tickets. Tickets disponibles: " + lblTickets.Caption, vbOKOnly + vbInformation
        txtCantidadPremioTicket.SetFocus
        Exit Function
      End If
      
    Else
    
      MsgBox "Valor no válido", vbOKOnly + vbInformation
      txtCantidadPremioTicket.SetFocus
      Exit Function
      
    End If
      
  End If
  
  ValidarData = True
  
  Exit Function
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Function

Private Function ActualizarTabla(iIndex As Integer) As Boolean

  'Inserta el registro de Canje_Punto/Canje_Ticket

  On Error GoTo LineaError

  Dim sSQL As String
  Dim ADORS As ADODB.Recordset

  Dim bConnFlag As Boolean

  ActualizarTabla = False

  sSQL = "SELECT MAX(cCanjCode) AS Codigo FROM $ " + _
         "WHERE cClieCode = $"
  sSQL = VBsprintf(sSQL, IIf(iIndex = kPUNTO, "Canje_Punto", "Canje_Ticket"), sCliente)
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo LineaError1

  sCodigo = "1"

  If Not ADORS.EOF Then

    If LeerCampo(ADORS!Codigo) <> "" Then
      sCodigo = CStr(ADORS!Codigo + 1)
    End If

  End If

  Set ADORS = Nothing
  
  ADOCnn.BeginTrans
  bConnFlag = True

  If iIndex = kPUNTO Then
  
    sSQL = "INSERT INTO Canje_Punto (cClieCode, cCanjCode, nTarjNumb, " + _
           "nPuntCant, sUserDesc, dCanjDate, cPremCode, nPremCant) " + _
           "VALUES($, $, '$', $, '$', '$', $, $)"
    sSQL = VBsprintf(sSQL, sCliente, sCodigo, sTarjeta, _
           Format(txtPunto.Text, "####0"), _
           ReemplazarComilla(psUsuario_Descripcion), Format(Now, "yyyy/mm/dd hh:mm"), _
           Mid(lvwPremioTicket.SelectedItem.Key, 2), _
           Format(txtCantidadPremioPunto.Text, "####0"))

    If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo LineaError1

    sSQL = "UPDATE Cliente SET nPuntCant = nPuntCant - $, " + _
           "dUltTDate = '$', cTranCode = $ " + _
           "WHERE cClieCode = $"
    sSQL = VBsprintf(sSQL, Format(txtPunto.Text, "####0"), _
           Format(Date, "yyyy/mm/dd"), _
           kTRAN_CANJEA_PUNTOS, _
           sCliente)
           
  Else
  
    sSQL = "INSERT INTO Canje_Ticket (cClieCode, cCanjCode, nTarjNumb, " + _
           "nTickCant, sUserDesc, dCanjDate, cPremCode, nPremCant) " + _
           "VALUES($, $, '$', $, '$', '$', $, $)"
    sSQL = VBsprintf(sSQL, sCliente, sCodigo, sTarjeta, _
           Format(txtTicket.Text, "####0"), _
           ReemplazarComilla(psUsuario_Descripcion), Format(Now, "yyyy/mm/dd hh:mm"), _
           Mid(lvwPremioTicket.SelectedItem.Key, 2), _
           Format(txtCantidadPremioTicket.Text, "####0"))

    If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo LineaError1

    sSQL = "UPDATE Cliente SET nTickCant = nTickCant - $, " + _
           "dUltTdate = '$', cTranCode = $ " + _
           "WHERE cClieCode = $"
    sSQL = VBsprintf(sSQL, Format(txtTicket.Text, "####0"), _
           Format(Date, "yyyy/mm/dd"), _
           kTRAN_CANJEA_TICKETS, _
           sCliente)
           
    If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo LineaError1
    
    sSQL = "UPDATE Premio_Ticket SET nPremStoc = nPremStoc - $ " + _
           "WHERE cPremCode = $"
    sSQL = VBsprintf(sSQL, Format(txtCantidadPremioTicket.Text, "####0"), _
           Mid(lvwPremioTicket.SelectedItem.Key, 2))
        
  End If

  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:
  Set ADORS = Nothing
  If bConnFlag Then ADOCnn.RollbackTrans
  
End Function

Private Sub cmdCanje_Click()

  'Invoca al formulario CanjeLista
  
  On Error GoTo LineaError
  
  frmCanjeLista.Show vbModal
  
  LlenarListaPremioPunto
  LlenarListaPremioTicket
  ManejarControles
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub cmdCliente_Click()

  'Invoca al formulario Cliente
  
  On Error GoTo LineaError
  
  frmCliente.iEditar = kCMD_VER
  frmCliente.Show vbModal
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub cmdSalir_Click()

  'Descargar Form

  On Error GoTo LineaError

  Unload Me

  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub
