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         =   "Form1"
   ClientHeight    =   2730
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   6765
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   ScaleHeight     =   2730
   ScaleWidth      =   6765
   Begin VB.CommandButton cmdBusAlmacen 
      Height          =   375
      Left            =   4800
      MouseIcon       =   "FDocFreeHead.frx":0000
      MousePointer    =   99  'Custom
      Picture         =   "FDocFreeHead.frx":0152
      Style           =   1  'Graphical
      TabIndex        =   10
      ToolTipText     =   "Buscar Almacén"
      Top             =   360
      Width           =   375
   End
   Begin VB.TextBox txtCodigo 
      Height          =   285
      Left            =   1650
      MaxLength       =   10
      TabIndex        =   4
      Top             =   870
      Width           =   1575
   End
   Begin VB.CommandButton cmdBuscar 
      Enabled         =   0   'False
      Height          =   375
      Left            =   3330
      Picture         =   "FDocFreeHead.frx":0684
      Style           =   1  'Graphical
      TabIndex        =   3
      ToolTipText     =   "Buscar"
      Top             =   840
      Width           =   375
   End
   Begin VB.CommandButton cmdBusCliente 
      Height          =   375
      Left            =   5730
      MousePointer    =   99  'Custom
      Picture         =   "FDocFreeHead.frx":0BB6
      Style           =   1  'Graphical
      TabIndex        =   2
      ToolTipText     =   "Buscar Tipo de Ingreso"
      Top             =   1410
      Width           =   375
   End
   Begin MiControl.CtrlNumber ctnMonto 
      Height          =   375
      Left            =   4500
      TabIndex        =   0
      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 MSComCtl2.DTPicker dtpFechaProc 
      Height          =   315
      Left            =   1650
      TabIndex        =   1
      Top             =   1950
      Width           =   1365
      _ExtentX        =   2408
      _ExtentY        =   556
      _Version        =   393216
      Format          =   50724865
      CurrentDate     =   37693
   End
   Begin Crystal.CrystalReport crDocFree 
      Left            =   4230
      Top             =   810
      _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            =   1680
      TabIndex        =   11
      Top             =   360
      Width           =   3135
      _ExtentX        =   5530
      _ExtentY        =   556
      _Version        =   393216
      Style           =   2
      Text            =   ""
   End
   Begin VB.Label lblAlmacen 
      AutoSize        =   -1  'True
      Caption         =   "Almacen"
      Height          =   195
      Left            =   600
      TabIndex        =   12
      Top             =   360
      Width           =   615
   End
   Begin VB.Label lblCodigo 
      AutoSize        =   -1  'True
      Caption         =   "Código :"
      Height          =   195
      Left            =   600
      TabIndex        =   9
      Top             =   900
      Width           =   585
   End
   Begin VB.Label lblDescripcion 
      AutoSize        =   -1  'True
      Caption         =   "Cliente :"
      Height          =   195
      Left            =   600
      TabIndex        =   8
      Top             =   1470
      Width           =   570
   End
   Begin VB.Label lblMonto 
      Caption         =   "Monto"
      Height          =   285
      Left            =   3630
      TabIndex        =   7
      Top             =   2010
      Width           =   675
   End
   Begin VB.Label lblFechaProc 
      Caption         =   "Fecha Proceso"
      Height          =   465
      Left            =   630
      TabIndex        =   6
      Top             =   1950
      Width           =   735
   End
   Begin VB.Image Image1 
      Height          =   630
      Left            =   5760
      Picture         =   "FDocFreeHead.frx":10E8
      Stretch         =   -1  'True
      Top             =   480
      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
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 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
      
    FBusquedasInv.GObtenerRegistros objAlmacen.ListarAlmacenesPorStatus(1), ArrayBusqueda, 2, 2
    FBusquedasInv.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 2, 1 To 3) As Variant
    ArrayBusqueda(1, 1) = "DOCUMENTFREEID"
    ArrayBusqueda(1, 2) = "Código "
    ArrayBusqueda(1, 3) = 1000
    ArrayBusqueda(2, 1) = "CUSTNAME"
    ArrayBusqueda(2, 2) = "Cliente "
    ArrayBusqueda(2, 3) = 4000
      
          
    FBusquedaCCobrar.GObtenerRegistros rs_Docfree, ArrayBusqueda, 2, 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 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
    cmddetalle.Enabled = True
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 = 3015
        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 asigna_campos
        
        pb_primerregistro = True
        cmddetalle.Enabled = True
    
    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
    
    If Not objDocFree.ListarDocumentosLiberados(GstrSiteProce, txtCodigo.Text, dtpFechaProc.Value).EOF Then
       MsgBox "No se puede Eliminar FP6, Tiene registros procesados ", vbDefaultButton1 + vbExclamation, "Advertencia"
       Exit Sub
    End If
    
    objDocFree.EliminarDocFree GstrSiteProce, txtCodigo.Text
    Call gborrar_Registro(Me, rs_Docfree, txtCodigo)
End If

Exit Sub

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

End Sub
Function valida_datos()
    If GVDATO(txtCodigo.Text) = Empty Then
        valida_datos = False
        MsgBox "Ingrese Código de Documento", vbInformation, "Error"
        txtCodigo.SetFocus
        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 pb_agregar Then
            objDocFree.AgregarDocFree GstrSiteProce, Trim(txtCodigo.Text), dtcCliente.BoundText, dtpFechaProc.Value, GFormatodeNumero(CDbl(ctnMonto.Text), GintDecResultado), GCUSERID
        Else
            objDocFree.ActualizarDocFree GstrSiteProce, Trim(txtCodigo.Text), dtcCliente.BoundText, dtpFechaProc.Value, GFormatodeNumero(CDbl(ctnMonto.Text), GintDecResultado), GCUSERID
        End If
        
        Call ggrabar_registro(Me)
        Actualizar_Registro
    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)
    
    Set DataGrid1.DataSource = objDocFree.ListarDocumentosLiberados(GstrSiteProce, txtCodigo.Text, dtpFechaProc.Value)
    DataGrid1.Refresh

End Sub
Public Sub modificar_registro()
    
    If Not objDocFree.ListarDocumentosLiberados(GstrSiteProce, txtCodigo.Text, dtpFechaProc.Value).EOF Then
       MsgBox "No se puede Modificar FP6, Tiene registros procesados ", vbDefaultButton1 + vbExclamation, "Advertencia"
       Exit Sub
    End If
    Call gmodificar_registro(Me, txtCodigo)
    
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.ListarDocFrees(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!DATEPROCE
        ctnMonto.Text = GFormatodeNumero(rs_Docfree!FREETOTAL, GintDecResultado)
        
        Set DataGrid1.DataSource = objDocFree.ListarDocumentosLiberados(GstrSiteProce, txtCodigo.Text, dtpFechaProc.Value)
        DataGrid1.Refresh
        
    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 Image1_Click()

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


