VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{F0D2F211-CCB0-11D0-A316-00AA00688B10}#1.0#0"; "MSDATLST.OCX"
Object = "{00025600-0000-0000-C000-000000000046}#5.2#0"; "crystl32.ocx"
Object = "{69F9D01E-F1DE-11D4-9536-002018603DA2}#7.0#0"; "ControlNumber.ocx"
Begin VB.Form FDocFreeHead 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Liberación de Documentos (08.056.00)"
   ClientHeight    =   3135
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   6765
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   ScaleHeight     =   3135
   ScaleWidth      =   6765
   Begin VB.Frame FraRango 
      Caption         =   "Rango [Fecha de Proceso]"
      Height          =   1095
      Left            =   600
      TabIndex        =   7
      Top             =   1920
      Width           =   2775
      Begin MSComCtl2.DTPicker dtpFechaProcFin 
         Height          =   315
         Left            =   1200
         TabIndex        =   9
         Top             =   720
         Width           =   1395
         _ExtentX        =   2461
         _ExtentY        =   556
         _Version        =   393216
         Format          =   71565313
         CurrentDate     =   37852
      End
      Begin MSComCtl2.DTPicker dtpFechaProc 
         Height          =   315
         Left            =   1200
         TabIndex        =   8
         Top             =   345
         Width           =   1395
         _ExtentX        =   2461
         _ExtentY        =   556
         _Version        =   393216
         Format          =   71565313
         CurrentDate     =   37693
      End
      Begin VB.Label Label2 
         Caption         =   "Fecha Final"
         Height          =   255
         Left            =   120
         TabIndex        =   17
         Top             =   720
         Width           =   1095
      End
      Begin VB.Label Label1 
         Caption         =   "Fecha Inicial"
         Height          =   255
         Left            =   120
         TabIndex        =   16
         Top             =   360
         Width           =   1215
      End
   End
   Begin VB.CommandButton cmdClave 
      Caption         =   "Genera Clave"
      Height          =   375
      Left            =   5400
      TabIndex        =   4
      Top             =   840
      Width           =   1215
   End
   Begin VB.CommandButton cmdBuscar 
      Enabled         =   0   'False
      Height          =   375
      Left            =   3330
      Picture         =   "0805600.frx":0000
      Style           =   1  'Graphical
      TabIndex        =   1
      ToolTipText     =   "Buscar"
      Top             =   240
      Width           =   375
   End
   Begin VB.TextBox txtCodigo 
      Height          =   285
      Left            =   1650
      MaxLength       =   10
      TabIndex        =   0
      Top             =   270
      Width           =   1575
   End
   Begin VB.CommandButton cmdBusAlmacen 
      Height          =   375
      Left            =   4920
      MouseIcon       =   "0805600.frx":0532
      MousePointer    =   99  'Custom
      Picture         =   "0805600.frx":0684
      Style           =   1  'Graphical
      TabIndex        =   3
      ToolTipText     =   "Buscar Almacén"
      Top             =   840
      Width           =   375
   End
   Begin VB.CommandButton cmdBusCliente 
      Height          =   375
      Left            =   5730
      MousePointer    =   99  'Custom
      Picture         =   "0805600.frx":0BB6
      Style           =   1  'Graphical
      TabIndex        =   6
      ToolTipText     =   "Buscar Tipo de Ingreso"
      Top             =   1410
      Width           =   375
   End
   Begin MiControl.CtrlNumber ctnMonto 
      Height          =   375
      Left            =   4500
      TabIndex        =   10
      Top             =   1950
      Width           =   1605
      _ExtentX        =   2831
      _ExtentY        =   661
      BackColor       =   -2147483643
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin Crystal.CrystalReport crDocFree 
      Left            =   6240
      Top             =   1440
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   348160
      PrintFileLinesPerPage=   60
   End
   Begin MSDataListLib.DataCombo dtcCliente 
      Height          =   315
      Left            =   1650
      TabIndex        =   5
      Top             =   1410
      Width           =   3975
      _ExtentX        =   7011
      _ExtentY        =   556
      _Version        =   393216
      Style           =   2
      Text            =   ""
   End
   Begin MSDataListLib.DataCombo dtcAlmacen 
      Height          =   315
      Left            =   1650
      TabIndex        =   2
      Top             =   840
      Width           =   3255
      _ExtentX        =   5741
      _ExtentY        =   556
      _Version        =   393216
      Style           =   2
      Text            =   ""
   End
   Begin VB.Label lblFechaProc 
      Caption         =   "Fecha Proceso"
      Height          =   465
      Left            =   720
      TabIndex        =   15
      Top             =   2160
      Width           =   735
   End
   Begin VB.Label lblCodigo 
      AutoSize        =   -1  'True
      Caption         =   "Código :"
      Height          =   195
      Left            =   600
      TabIndex        =   14
      Top             =   300
      Width           =   585
   End
   Begin VB.Label lblAlmacen 
      AutoSize        =   -1  'True
      Caption         =   "Almacen"
      Height          =   195
      Left            =   600
      TabIndex        =   13
      Top             =   840
      Width           =   615
   End
   Begin VB.Label lblDescripcion 
      AutoSize        =   -1  'True
      Caption         =   "Cliente :"
      Height          =   195
      Left            =   600
      TabIndex        =   12
      Top             =   1470
      Width           =   570
   End
   Begin VB.Label lblMonto 
      Caption         =   "Monto"
      Height          =   285
      Left            =   3630
      TabIndex        =   11
      Top             =   2010
      Width           =   675
   End
   Begin VB.Image Image1 
      Height          =   630
      Left            =   5760
      Picture         =   "0805600.frx":10E8
      Stretch         =   -1  'True
      Top             =   120
      Width           =   585
   End
End
Attribute VB_Name = "FDocFreeHead"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit

Private LArrayDFree(1, 1) As Variant

Public pb_editar As Boolean
Public pb_agregar As Boolean
Public pb_primerregistro As Boolean
Public pb_ultimoregistro As Boolean

Public pbderecho_agregar As Boolean
Public pbderecho_consultar As Boolean
Public pbderecho_editar As Boolean
Public pbderecho_borrar As Boolean
Public pbderecho_imprimir As Boolean
Public pb_tiposcreen As String

Public GrecibeUbicacion As BookmarkEnum
Public GrecibeColumnaID As String
Public GrecibeColumnaOpcional As String
Public GrecibeColumnaOpcional2 As String
Public GrecibeColumnaOpcional3 As String
Public GrecibeColumnaOpcional4 As String
Public GrecibeColumnaOpcional5 As String


Public rs_Docfree As ADODB.Recordset
Public objDocFree As DB_OP_MANTENIMIENTOS.C_DOCFREEHEAD
Public objCliente As DB_MA_MANTENIMIENTOS.C_CLIENTE
Public objAlmacen As DB_INV_MANTENIMIENTOS.C_ALMACEN

Private Sub cmdBusAlmacen_Click()
    'Lineas que llaman al Formulario de Búsqueda
    
    Dim ArrayBusqueda(1 To 2, 1 To 3) As Variant
    ArrayBusqueda(1, 1) = "Siteid"
    ArrayBusqueda(1, 2) = "Código "
    ArrayBusqueda(1, 3) = 1000
    ArrayBusqueda(2, 1) = "Name"
    ArrayBusqueda(2, 2) = "Descripción "
    ArrayBusqueda(2, 3) = 4000
      
    FBusquedaCCobrar.GObtenerRegistros objAlmacen.ListarAlmacenesPorStatus(1), ArrayBusqueda, 2, 2
    FBusquedaCCobrar.Show vbModal
    
    If GrecibeUbicacion <> 0 Then
        dtcAlmacen.BoundText = GrecibeColumnaID
    End If
End Sub

Private Sub cmdBuscar_Click()
    'Lineas que llaman al Formulario de Búsqueda
                                                
    Dim ArrayBusqueda(1 To 6, 1 To 3) As Variant
    
    ' SELECT D.DOCUMENTFREEID,C.CUSTNAME,SITE.NAME," & _
    " D.DATEPROCEINI , D.DATEPROCEFIN, D.FREETOTAL, D.SITEID, D.CUSTIDSS " & _

    ArrayBusqueda(1, 1) = "DOCUMENTFREEID"
    ArrayBusqueda(1, 2) = "Código "
    ArrayBusqueda(1, 3) = 1000
    ArrayBusqueda(2, 1) = "CUSTNAME"
    ArrayBusqueda(2, 2) = "Cliente "
    ArrayBusqueda(2, 3) = 2000
    ArrayBusqueda(3, 1) = "NAME"
    ArrayBusqueda(3, 2) = "Estación "
    ArrayBusqueda(3, 3) = 1300
    ArrayBusqueda(4, 1) = "DATEPROCEINI"
    ArrayBusqueda(4, 2) = "Fecha_Ini."
    ArrayBusqueda(4, 3) = 1000
    ArrayBusqueda(5, 1) = "DATEPROCEFIN"
    ArrayBusqueda(5, 2) = "Fecha_Fin."
    ArrayBusqueda(5, 3) = 1000
    ArrayBusqueda(6, 1) = "Freetotal"
    ArrayBusqueda(6, 2) = "Total "
    ArrayBusqueda(6, 3) = 1000
      
          
    FBusquedaCCobrar.GObtenerRegistros rs_Docfree, ArrayBusqueda, 6, 2
    FBusquedaCCobrar.Show vbModal
    If GrecibeUbicacion <> 0 And GrecibeUbicacion <= rs_Docfree.RecordCount Then
          rs_Docfree.AbsolutePosition = GrecibeUbicacion
          asigna_campos
          Call gestadoactualrs(Me, rs_Docfree)
          Call gactualiza_barra(Me)
    End If
  
  
End Sub

Private Sub cmdClave_Click()
If GVDATO(dtcAlmacen.BoundText) <> Empty Then
 Call GeneraNumeroDocumento
End If
End Sub

Private Sub dtcCliente_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyF2 Then
    cmdBusCliente_Click
End If
End Sub

Private Sub dtcCliente_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        dtpFechaProc.SetFocus
    End If
End Sub

Private Sub dtpFechaProc_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
    ctnMonto.SetFocus
End If
End Sub

Private Sub Form_Activate()

    Call gactualizaopcion(pbderecho_agregar, pbderecho_editar, pbderecho_borrar, pbderecho_imprimir)
    Call gactualiza_barra(Me)
    'lineas nuevas
    If pbderecho_consultar = False Then
        Unload Me
    End If
     
End Sub

Public Sub primer_registro()
    Call Gprimer_registro(Me, rs_Docfree)
    Call asigna_campos
End Sub

Public Sub ultimo_registro()
    Call Gultimo_registro(Me, rs_Docfree)
    Call asigna_campos
End Sub

Public Sub registro_anterior()
    Call Gregistro_anterior(Me, rs_Docfree)
    Call asigna_campos
End Sub
Public Sub registro_siguiente()
    Call Gregistro_siguiente(Me, rs_Docfree)
    Call asigna_campos
End Sub

Private Sub Form_Initialize()
    Call gHabilitarReg(Me, False)
End Sub

Private Sub Form_Load()
    'seguridad
    Call gseguridad(Me)
    
    If pbderecho_consultar Then
        Dim numreg As Long
        
        Me.Height = 3510
        Me.Top = 1300
        Me.Left = (Screen.Width - Me.Width) / 2
        
        
        ctnMonto.Enteros = 7
        ctnMonto.Decimales = GintDecResultado
        ctnMonto.ValorPorDefecto
        
        Set objDocFree = New DB_OP_MANTENIMIENTOS.C_DOCFREEHEAD
        Set objCliente = New DB_MA_MANTENIMIENTOS.C_CLIENTE
        Set objAlmacen = New DB_INV_MANTENIMIENTOS.C_ALMACEN
        Call obtener_datos
        Call CargaDataCombo(dtcCliente, objCliente.ListarClientesAyudaTPC, "CUSTIDSS", "CUSTNAME")
        Call CargaDataCombo(dtcAlmacen, objAlmacen.ListarAlmacenesPorStatus(1), "SiteId", "Name")
        
        dtpFechaProc.Value = GDatFechaProcesoVentas
        dtpFechaProcFin.Value = GDatFechaProcesoVentas

        
        Call asigna_campos
        
        pb_primerregistro = True
                       
        dtpFechaProc.Enabled = False
        dtpFechaProcFin.Enabled = False
        
    Else
        'Unload Me
        MsgBox ("No tiene Derechos de Consultar en este formulario"), vbCritical + vbDefaultButton1, "Mensaje"
    End If
    
End Sub
Public Sub borrar_registro()

On Error GoTo errhandler

If GVDATO(txtCodigo.Text) <> Empty Then

    objDocFree.EliminarDocFreeHead GstrSiteProce, txtCodigo.Text
    Call gborrar_Registro(Me, rs_Docfree, txtCodigo)
    Call Actualizar_Registro
End If

Exit Sub

errhandler:
    MsgBox MensajedeError(Err.Number, Err.Description), vbDefaultButton1 + vbCritical, "Error"

End Sub
Function valida_datos()

    If GVDATO(dtcAlmacen.BoundText) = Empty Then
        valida_datos = False
        MsgBox "Ingrese Almacen", vbInformation, "Error"
        dtcAlmacen.SetFocus
        Exit Function
    End If

    If GVDATO(txtCodigo.Text) = Empty Then
        valida_datos = False
        MsgBox "Ingrese Código de Documento", vbInformation, "Error"
        If txtCodigo.Enabled = True Then
           txtCodigo.SetFocus
        Else
           cmdClave.SetFocus
        End If
        
        Exit Function
    End If
   
    If GVDATO(dtcCliente.BoundText) = Empty Then
        valida_datos = False
        MsgBox "Ingrese Cliente", vbInformation, "Error"
        dtcCliente.SetFocus
        Exit Function
    End If
        
    If dtpFechaProc.Value < GDatFechaProcesoVentas Then
        valida_datos = False
        MsgBox "No se puede registrar un Documento con una fecha inferior a la fecha de Proceso de Ventas", vbInformation, "Error"
        dtpFechaProc.SetFocus
        Exit Function
    End If
        
    If GVDATO(ctnMonto.Text) = Empty Or GVDATO(ctnMonto.Text) <= 0 Then
        valida_datos = False
        MsgBox "Ingrese Monto", vbInformation, "Error"
        ctnMonto.SetFocus
        Exit Function
    End If
        
    valida_datos = True
End Function
Public Sub grabar_registro()

On Error GoTo errhandler
    If valida_datos() = True Then
        ' llamada al proc de grabacion
        
        If MsgBox("Seguro que desea Grabar los Cambios", vbYesNo + vbQuestion, "Mensaje") = vbYes Then
        
           LArrayDFree(1, 1) = dtpFechaProcFin.Value
           If pb_agregar Then
              objDocFree.AgregarDocFreeHead dtcAlmacen.BoundText, Trim(txtCodigo.Text), dtcCliente.BoundText, dtpFechaProc.Value, GFormatodeNumero(CDbl(ctnMonto.Text), GintDecResultado), GCUSERID, LArrayDFree
           Else
              objDocFree.ActualizarDocFreeHead dtcAlmacen.BoundText, Trim(txtCodigo.Text), dtcCliente.BoundText, dtpFechaProc.Value, GFormatodeNumero(CDbl(ctnMonto.Text), GintDecResultado), GCUSERID, LArrayDFree
           End If
        
           Call ggrabar_registro(Me)
           Actualizar_Registro
           cmdClave.Enabled = False
           cmdBusAlmacen.Enabled = False
        End If
        
    End If
Exit Sub
errhandler:
    MsgBox MensajedeError(Err.Number, Err.Description), vbDefaultButton1 + vbCritical, "Error"
     
End Sub
Public Sub Actualizar_Registro()
    'llamar al procedimiento de carga
    Call obtener_datos
    Call asigna_campos
    'MsgBox ("Registros Actualizados")
End Sub
Public Sub agregar_registro()
    Call gagregar_registro(Me, txtCodigo)
    txtCodigo.Enabled = False
    
    FraRango.Enabled = True
    dtpFechaProc.Enabled = True
    dtpFechaProcFin.Enabled = True
     
    
End Sub
Public Sub modificar_registro()
    
    Call gmodificar_registro(Me, txtCodigo)
    dtcAlmacen.Enabled = False
    cmdClave.Enabled = False
    cmdBusAlmacen.Enabled = False
    
    FraRango.Enabled = True
    dtpFechaProc.Enabled = True
    dtpFechaProcFin.Enabled = True
    
End Sub
Public Sub descartar_registro()
    ' Revertir cambios
    'adodc1.Recordset.CancelUpdate
    Call gdescartar_registro(Me)
    Call asigna_campos
End Sub

Sub obtener_datos()
    Set rs_Docfree = objDocFree.ListarDocFreesHead(GstrSiteProce)
End Sub

Sub salir_formulario()
    ' validar que no haya procesos pendientes
    ' si no hay problemas
    MDIFCcobrar.Toolbar1.Buttons(18).Caption = "Salir"    ' boton salir
    Unload Me
End Sub

Sub asigna_campos() ' falta decidir si va ha ser public o private
    If rs_Docfree.RecordCount <> 0 Then
        dtcAlmacen.BoundText = rs_Docfree!SITEID
        txtCodigo.Text = rs_Docfree!DOCUMENTFREEID
        dtcCliente.BoundText = rs_Docfree!CUSTIDSS
        dtpFechaProc.Value = rs_Docfree!DATEPROCEINI
        dtpFechaProcFin.Value = rs_Docfree!DATEPROCEFIN
        ctnMonto.Text = GFormatodeNumero(rs_Docfree!FREETOTAL, GintDecResultado)
    End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If pb_editar Then
        If MsgBox("Desea Cancelar los Cambios", vbYesNo, "Esta Modificando un registro") = vbNo Then
            Cancel = True
        Else
            Call gdesactiva_barra
        End If
    Else
        Call gdesactiva_barra
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set objDocFree = Nothing
    Set rs_Docfree = Nothing
    Set objAlmacen = Nothing
End Sub


Private Sub txtCodigo_KeyPress(KeyAscii As Integer)
    KeyAscii = GBloqueaCaracter(KeyAscii)
    If KeyAscii = 13 Then
        dtcCliente.SetFocus
    End If
End Sub

Sub imprimir()
    crDocFree.ReportFileName = GstrReportesVta + "rpt_DocumentoLibre.rpt"
    crDocFree.WindowTitle = "Reporte de Documento Libre"
    crDocFree.Formulas(1) = "formusuario=stringvar strusuario; strusuario:='" & GCUSERID & "'"
    crDocFree.Formulas(2) = "formscreen=stringvar strscreen; strscreen:='01.117.00'"
    crDocFree.Formulas(3) = "formNDMonto=" & GintDecResultado
    
    crDocFree.StoredProcParam(0) = GstrSiteProce
    crDocFree.StoredProcParam(1) = txtCodigo.Text
    
    crDocFree.WindowState = crptMaximized
    crDocFree.WindowShowPrintSetupBtn = True
    crDocFree.Action = 1
    
End Sub

'Private Sub txtDescripcion_KeyPress(KeyAscii As Integer)
 '   KeyAscii = GBloqueaCaracter(KeyAscii)
'End Sub

Public Sub CargaDataCombo(objDataCombo As DataCombo, rsSource As Recordset, istrCampo1 As String, istrCampo2 As String)

    Set objDataCombo.DataSource = rsSource
    objDataCombo.DataField = istrCampo2
    Set objDataCombo.RowSource = rsSource
    objDataCombo.ListField = istrCampo2
    objDataCombo.BoundColumn = istrCampo1
    
    If Not rsSource.EOF Then
        objDataCombo.BoundText = rsSource.Fields(istrCampo2)
    End If

End Sub

Private Sub cmdBusCliente_Click()
    'Lineas que llaman al Formulario de Búsqueda
    
    Dim ArrayBusqueda(1 To 2, 1 To 3) As Variant
    ArrayBusqueda(1, 1) = "CUSTIDSS"
    ArrayBusqueda(1, 2) = "Código "
    ArrayBusqueda(1, 3) = 1500
    ArrayBusqueda(2, 1) = "CUSTNAME"
    ArrayBusqueda(2, 2) = "Nombre "
    ArrayBusqueda(2, 3) = 4000
      
    FBusquedaCCobrar.GObtenerRegistros objCliente.ListarClientesAyudaTPC, ArrayBusqueda, 2, 2
    FBusquedaCCobrar.Show vbModal
    
    If GrecibeUbicacion <> 0 Then
        dtcCliente.BoundText = GrecibeColumnaID
    End If
    
End Sub

Private Function GeneraNumeroDocumento() As String
Randomize    ' Initialize random-number generator.
Dim strAleatorio As String
strAleatorio = ""

While Len(strAleatorio) = 0
    strAleatorio = Trim(dtcAlmacen.BoundText) & Right("0000000" & Int((99999999 * Rnd) + 1), 8)

    If Not objDocFree.VerificaClave(dtcAlmacen.BoundText, strAleatorio) Then
        txtCodigo.Text = strAleatorio
    Else
        strAleatorio = ""
    End If
Wend


End Function
