VERSION 5.00
Begin VB.Form frmProducto 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Producto"
   ClientHeight    =   3105
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6390
   Icon            =   "frmProducto.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3105
   ScaleWidth      =   6390
   StartUpPosition =   2  'CenterScreen
   Begin VB.Frame Frame1 
      Caption         =   " Tipo de Producto "
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   675
      Left            =   90
      TabIndex        =   17
      Top             =   105
      Width           =   3930
      Begin VB.CheckBox chkCanje 
         Caption         =   "Canje"
         Height          =   285
         Left            =   210
         TabIndex        =   1
         Top             =   270
         Width           =   825
      End
      Begin VB.TextBox txtFichas 
         Alignment       =   1  'Right Justify
         Enabled         =   0   'False
         Height          =   315
         Left            =   2355
         TabIndex        =   3
         Text            =   "0"
         Top             =   240
         Width           =   885
      End
      Begin VB.CheckBox chkFicha 
         Caption         =   "Fichas"
         Height          =   285
         Left            =   1425
         TabIndex        =   2
         Top             =   270
         Width           =   825
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "fichas"
         Height          =   195
         Left            =   3330
         TabIndex        =   18
         Top             =   285
         Width           =   420
      End
   End
   Begin VB.Frame fraActivo 
      Caption         =   " Estado "
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   675
      Left            =   4215
      TabIndex        =   16
      Top             =   105
      Width           =   2085
      Begin VB.OptionButton optActivo 
         Caption         =   "Inactivo"
         Height          =   255
         Index           =   0
         Left            =   135
         TabIndex        =   4
         Top             =   270
         Width           =   915
      End
      Begin VB.OptionButton optActivo 
         Caption         =   "Activo"
         Height          =   255
         Index           =   1
         Left            =   1200
         TabIndex        =   5
         Top             =   270
         Width           =   810
      End
   End
   Begin VB.Frame fraUsuario 
      Height          =   1485
      Left            =   300
      TabIndex        =   15
      Top             =   795
      Width           =   5715
      Begin VB.CheckBox chkControl 
         Caption         =   "Control de Stock"
         Height          =   300
         Left            =   3210
         TabIndex        =   19
         Top             =   1050
         Width           =   2310
      End
      Begin VB.TextBox txtPUnitario 
         Alignment       =   1  'Right Justify
         Height          =   315
         Left            =   1140
         MaxLength       =   50
         TabIndex        =   9
         Top             =   1020
         Width           =   1650
      End
      Begin VB.TextBox txtCorta 
         Height          =   315
         IMEMode         =   3  'DISABLE
         Left            =   3885
         MaxLength       =   10
         TabIndex        =   7
         Top             =   225
         Width           =   1680
      End
      Begin VB.TextBox txtDescripcion 
         Height          =   315
         IMEMode         =   3  'DISABLE
         Left            =   1140
         MaxLength       =   50
         TabIndex        =   8
         Top             =   615
         Width           =   4425
      End
      Begin VB.TextBox txtCodigo 
         BackColor       =   &H00C0FFFF&
         Height          =   315
         Left            =   1140
         Locked          =   -1  'True
         MaxLength       =   15
         TabIndex        =   6
         Top             =   225
         Width           =   975
      End
      Begin VB.Label lblLabels 
         AutoSize        =   -1  'True
         Caption         =   "&Prec. Unit."
         Height          =   195
         Index           =   4
         Left            =   210
         TabIndex        =   14
         Top             =   1095
         Width           =   750
      End
      Begin VB.Label lblLabels 
         AutoSize        =   -1  'True
         Caption         =   "Descripción Corta"
         Height          =   195
         Index           =   2
         Left            =   2445
         TabIndex        =   13
         Top             =   285
         Width           =   1260
      End
      Begin VB.Label lblLabels 
         AutoSize        =   -1  'True
         Caption         =   "&Código"
         Height          =   195
         Index           =   0
         Left            =   465
         TabIndex        =   0
         Top             =   285
         Width           =   495
      End
      Begin VB.Label lblLabels 
         AutoSize        =   -1  'True
         Caption         =   "&Descripción"
         Height          =   195
         Index           =   1
         Left            =   120
         TabIndex        =   12
         Top             =   690
         Width           =   840
      End
   End
   Begin VB.CommandButton cmdEstandar 
      Caption         =   "&Aceptar"
      Default         =   -1  'True
      Height          =   390
      Index           =   0
      Left            =   3270
      TabIndex        =   10
      Top             =   2475
      Width           =   1335
   End
   Begin VB.CommandButton cmdEstandar 
      Cancel          =   -1  'True
      Caption         =   "&Cancelar"
      Height          =   390
      Index           =   1
      Left            =   4710
      TabIndex        =   11
      Top             =   2475
      Width           =   1335
   End
End
Attribute VB_Name = "frmProducto"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public iEditar As Integer

Private Sub chkCanje_Click()
  If chkCanje.Value = 1 Then
    txtPUnitario.Enabled = False
    txtPUnitario.Text = "0"
  Else
    txtPUnitario.Enabled = True
  End If
End Sub

Private Sub chkFicha_Click()
   If chkFicha.Value = 1 Then
     txtFichas.Enabled = True
     txtFichas.Text = 1
   Else
     txtFichas.Enabled = False
     txtFichas.Text = 0
   End If
End Sub

Private Sub Form_Load()

  'Cargar formulario
  
  On Error GoTo LineaError

  Screen.MousePointer = vbHourglass
  
  'LlenarCombo
  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

  Select Case iEditar
  
  Case kCMD_NUEVO
    Me.Caption = "Nuevo Producto"
    optActivo(kSI).Value = True
    Call NuevoCodigo
  
  Case kCMD_EDITAR
    Me.Caption = "Editar Producto"
    'If iEditar = kCMD_EDITAR And frmProductoLista.lvwProducto.SelectedItem.Text = psProducto_Descripcion Then Call DeshabilitarControl(dcbPerfil, True)
    TraerData
    DeshabilitarControles False
  
  Case kCMD_BORRAR
    Me.Caption = "Borrar Producto"
    TraerData
    DeshabilitarControles True
    
  Case kCMD_VER
    Me.Caption = "Producto"
    TraerData
    DeshabilitarControles True
    
  End Select
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub TraerData()

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

  Dim sSQL As String
  Dim adors As ADODB.Recordset
  
  sSQL = "SELECT * FROM Producto " + _
         "WHERE cProdCode = $ AND cAlmaCode ='$'"
  sSQL = VBsprintf(sSQL, frmProductoLista.lvwProducto.SelectedItem.Text, kPAR_ALMACEN)
  
  If oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, adors) Then
  
    If Not adors.EOF Then
      
      txtCodigo.Text = LeerCampo(adors!cProdCode)
      txtDescripcion.Text = LeerCampo(adors!sProdDesc)
      txtCorta.Text = LeerCampo(adors!sProdDescCrta)
      txtPUnitario.Text = Format(LeerCampo(adors!nProdPrecUnit), "###,###,###,####.00")
      If LeerCampo(adors!cProdFlagFicha) = 1 Then
        chkFicha.Value = 1
        txtFichas.Enabled = True
        txtFichas.Text = LeerCampo(adors!cProdFichaCant)
      Else
        chkFicha.Value = 0
        txtFichas.Enabled = False
        txtFichas.Text = 0
      End If
      
      If LeerCampo(adors!cProdFlagCanje) = 1 Then
        chkCanje.Value = 1
      Else
        chkCanje.Value = 0
      End If
      
      If LeerCampo(adors!cProdFlagControl) = 1 Then
        chkControl.Value = 1
      Else
        chkControl.Value = 0
      End If
      
      If LeerCampo(adors!cProdEstd) <> "1" Then
        optActivo(0).Value = True
      Else
        optActivo(1).Value = True
      End If
      
    End If
    
  End If
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
End Sub

Private Sub DeshabilitarControles(bTodoFlag As Boolean)

  'Deshabilita controles
  
  On Error GoTo LineaError

  Call DeshabilitarControl(txtCodigo, True)
  
  If bTodoFlag Then
    Call DeshabilitarControl(txtDescripcion, True)
    Call DeshabilitarControl(txtCorta, True)
    Call DeshabilitarControl(txtPUnitario, True)
    Call DeshabilitarControl(chkFicha, True)
    Call DeshabilitarControl(txtFichas, True)
    Call DeshabilitarControl(chkCanje, True)
    Call DeshabilitarControl(chkControl, True)
    Call DeshabilitarControl(optActivo(0), False)
    Call DeshabilitarControl(optActivo(1), False)
  End If
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
End Sub

Private Sub txtDescripcion_KeyPress(KeyAscii As Integer)
  
  'Convierte cada caracter digitado a mayúsculas
  
  On Error GoTo LineaError
  
  Call ValidKeyPress(KeyAscii, kVKP_UPPER_CASE)
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
End Sub

Private Sub txtCorta_KeyPress(KeyAscii As Integer)
  
  'Convierte cada caracter digitado a mayúsculas
  
  On Error GoTo LineaError
  
  Call ValidKeyPress(KeyAscii, kVKP_UPPER_CASE)
  
  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 Usuario
  
  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
          frmProductoLista.ManejarControles
          Call frmProductoLista.lvwProducto_Click
      End If
        Unload Me
    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 chkCanje.Value = 1 Then
    If chkFicha.Value = 0 Then
      MsgBox "Debe indicar el número de fichas equivalentes"
      Exit Function
    End If
  End If
  
  If chkFicha.Value = 1 Then
    If txtFichas.Text < 1 Or Not IsNumeric(txtFichas.Text) Then
      MsgBox "Debe ingresar el número de fichas"
      Exit Function
    End If
  End If
  
  If Trim(txtDescripcion.Text) = "" Then
    MsgBox "Ingresar Nombre de Producto", vbOKOnly + vbInformation
    txtDescripcion.SetFocus
    Exit Function
  End If
  
  If Trim(txtCorta.Text) = "" Then
    MsgBox "Ingresar Descripción Corta de Producto", vbOKOnly + vbInformation
    txtCorta.SetFocus
    Exit Function
  End If
  
  If Trim(txtPUnitario.Text) = "" Then
    MsgBox "Ingresar PRecio Unitario del Producto", vbOKOnly + vbInformation
    txtPUnitario.SetFocus
    Exit Function
  End If
  
  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
     
  ActualizarTabla = False
  
  Select Case iEditar
  
  Case kCMD_NUEVO
  
    sSQL = "INSERT INTO Producto (cAlmaCode, cProdCode, sProdDesc, sProdDescCrta, nProdPrecUnit, cProdEstd, cProdFlagFicha, cProdFichaCant, cProdFlagCanje, cProdFlagControl) " + _
           "VALUES ('$', $, '$', '$', $, $, $, $, $, $)"
    sSQL = VBsprintf(sSQL, kPAR_ALMACEN, ReemplazarComilla(Trim(txtCodigo.Text)), _
           ReemplazarComilla(Trim(txtDescripcion.Text)), _
           ReemplazarComilla(Trim(txtCorta.Text)), _
           ReemplazarComilla(Format(txtPUnitario.Text, "###,###,###0.00")), _
           IIf(optActivo(1).Value, 1, 0), _
           IIf(chkFicha.Value = 1, 1, 0), _
           ReemplazarComilla(txtFichas.Text), _
           IIf(chkCanje.Value = 1, 1, 0), _
           IIf(chkControl.Value = 1, 1, 0))
           
  Case kCMD_EDITAR
  
    sSQL = "UPDATE Producto SET sProdDesc = '$', " + _
           "sProdDescCrta = '$', nProdPrecUnit = $, cProdEstd = $, " + _
           "cProdFlagFicha = $, cProdFichaCant = $, cProdFlagCanje = $, " + _
           "cProdFlagControl = $ " + _
           "WHERE cProdCode = $ AND cAlmaCode = '$'"
    sSQL = VBsprintf(sSQL, ReemplazarComilla(Trim(txtDescripcion.Text)), _
           Trim(txtCorta.Text), _
           ReemplazarComilla(Format(txtPUnitario.Text, "###,###,###0.00")), _
           IIf(optActivo(1).Value, 1, 0), _
           IIf(chkFicha.Value = 1, 1, 0), _
           ReemplazarComilla(txtFichas.Text), _
           IIf(chkCanje.Value = 1, 1, 0), _
           IIf(chkControl.Value = 1, 1, 0), _
           Trim(txtCodigo.Text), kPAR_ALMACEN)
  
  Case kCMD_BORRAR
  
    sSQL = "DELETE * FROM Producto " + _
           "WHERE cProdCode = $ and cAlmaCode ='" & kPAR_ALMACEN & "'"
    sSQL = VBsprintf(sSQL, Trim(txtCodigo.Text))
  
  End Select
  
  If oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then ActualizarTabla = True
  
  Exit Function
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
End Function

Private Sub ActualizarLista()

  'Actualiza la lista de frmusuarioLista

  On Error GoTo LineaError
  
  Dim itemX As ListItem
  
  Select Case iEditar
  
  Case kCMD_NUEVO, kCMD_EDITAR
  
    If iEditar = kCMD_NUEVO Then
      Set itemX = frmProductoLista.lvwProducto.ListItems.Add(, , Trim(txtCodigo.Text))
    Else
      Set itemX = frmProductoLista.lvwProducto.SelectedItem
      itemX.Text = Trim(txtCodigo.Text)
    End If
    
    itemX.SubItems(1) = LeerCampo(txtDescripcion.Text)
    itemX.SubItems(2) = LeerCampo(txtCorta.Text)
    itemX.SubItems(3) = Format(LeerCampo(txtPUnitario.Text), "###,###,###,####.00")
    If chkFicha.Value = 1 Then
      itemX.SubItems(4) = "Ficha"
    End If
    If chkCanje.Value = 1 Then
      itemX.SubItems(4) = "Canje"
    End If
    
    If chkControl.Value = 1 Then
      itemX.SubItems(5) = "SI"
    Else
      itemX.SubItems(5) = "NO"
    End If
    
    If optActivo(1).Value Then
      itemX.Icon = 1
      itemX.SmallIcon = 1
    Else
      itemX.Icon = 2
      itemX.SmallIcon = 2
    End If
    
    itemX.Selected = True
    
  Case kCMD_BORRAR
  
    frmProductoLista.lvwProducto.ListItems.Remove (frmProductoLista.lvwProducto.SelectedItem.Index)
    
  End Select
      
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
End Sub

Private Sub txtPUnitario_LostFocus()
  'Formatea el texto
  
  On Error GoTo LineaError
  
  txtPUnitario.Text = Format(txtPUnitario.Text, "###,###,##0.00")
  
  Exit Sub

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

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

Private Sub txtFichas_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 NuevoCodigo()

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

  Dim sSQL As String
  Dim adors As ADODB.Recordset
  Dim iCodigo As Long
  
  sSQL = "SELECT MAX(cProdCode) AS CODIGO FROM Producto where cAlmaCode='" & kPAR_ALMACEN & "'"
  
  If oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, adors) Then
  
    If Not adors.EOF Then
      If LeerCampo(adors("CODIGO")) = "" Or IsNull(LeerCampo(adors("CODIGO"))) Then
        iCodigo = 1
      Else
        iCodigo = LeerCampo(adors("CODIGO")) + 1
      End If
      txtCodigo.Text = iCodigo
    End If
  End If
  GoTo Salir
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
Salir:
  Set adors = Nothing
  
End Sub

