VERSION 5.00
Object = "{F0D2F211-CCB0-11D0-A316-00AA00688B10}#1.0#0"; "MSDATLST.OCX"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form FCostoPromedio 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Cálculo de Costo Promedio (95.115.00)"
   ClientHeight    =   3150
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6825
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   3150
   ScaleWidth      =   6825
   Begin MSComCtl2.DTPicker dtpAnio 
      Height          =   375
      Left            =   3645
      TabIndex        =   3
      Top             =   840
      Width           =   1050
      _ExtentX        =   1852
      _ExtentY        =   661
      _Version        =   393216
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      CustomFormat    =   "yyyy"
      Format          =   16777219
      UpDown          =   -1  'True
      CurrentDate     =   37651
   End
   Begin VB.ComboBox cmbMes 
      Height          =   315
      ItemData        =   "9511500.frx":0000
      Left            =   1125
      List            =   "9511500.frx":0028
      Style           =   2  'Dropdown List
      TabIndex        =   2
      Top             =   855
      Width           =   1365
   End
   Begin VB.CommandButton cmdSalir 
      Caption         =   "&Salir"
      Height          =   675
      Left            =   5130
      Picture         =   "9511500.frx":0090
      Style           =   1  'Graphical
      TabIndex        =   5
      Top             =   2070
      Width           =   1365
   End
   Begin VB.CommandButton cmdAceptar 
      Caption         =   "&Aceptar"
      Height          =   675
      Left            =   3780
      Picture         =   "9511500.frx":039A
      Style           =   1  'Graphical
      TabIndex        =   4
      Top             =   2070
      Width           =   1365
   End
   Begin VB.CommandButton cmdBusAlmacen 
      Height          =   375
      Left            =   4350
      MouseIcon       =   "9511500.frx":06A4
      MousePointer    =   99  'Custom
      Picture         =   "9511500.frx":07F6
      Style           =   1  'Graphical
      TabIndex        =   1
      ToolTipText     =   "Buscar Almacén"
      Top             =   225
      Width           =   375
   End
   Begin MSDataListLib.DataCombo dtcAlmacen 
      Height          =   315
      Left            =   1110
      TabIndex        =   0
      Top             =   225
      Width           =   3180
      _ExtentX        =   5609
      _ExtentY        =   556
      _Version        =   393216
      Style           =   2
      Text            =   ""
   End
   Begin MSComCtl2.Animation Animation1 
      Height          =   735
      Left            =   300
      TabIndex        =   9
      Top             =   2010
      Visible         =   0   'False
      Width           =   3240
      _ExtentX        =   5715
      _ExtentY        =   1296
      _Version        =   393216
      BackColor       =   -2147483644
      FullWidth       =   216
      FullHeight      =   49
   End
   Begin VB.Label lblCierre 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Left            =   5250
      TabIndex        =   12
      Top             =   1440
      Width           =   1185
   End
   Begin VB.Label Label2 
      Caption         =   "Ultimo Cierre"
      Height          =   225
      Left            =   4140
      TabIndex        =   11
      Top             =   1500
      Width           =   975
   End
   Begin VB.Image Image1 
      Height          =   480
      Left            =   5190
      Picture         =   "9511500.frx":0D28
      Top             =   180
      Width           =   480
   End
   Begin VB.Shape Shape1 
      Height          =   2940
      Left            =   210
      Top             =   90
      Width           =   6435
   End
   Begin VB.Label lblMensaje 
      Caption         =   "PROCESO DE GENERACION DE COSTO PROMEDIO BIMONETARIO"
      ForeColor       =   &H00800000&
      Height          =   375
      Left            =   330
      TabIndex        =   10
      Top             =   1470
      Width           =   3120
   End
   Begin VB.Label lblAnio 
      Caption         =   "Año"
      Height          =   285
      Left            =   2880
      TabIndex        =   8
      Top             =   840
      Width           =   465
   End
   Begin VB.Label lblMes 
      Caption         =   "Mes"
      Height          =   240
      Left            =   360
      TabIndex        =   7
      Top             =   900
      Width           =   780
   End
   Begin VB.Label lblAlmacen 
      AutoSize        =   -1  'True
      Caption         =   "Almacen"
      Height          =   195
      Left            =   360
      TabIndex        =   6
      Top             =   270
      Width           =   615
   End
End
Attribute VB_Name = "FCostoPromedio"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' Se retiraron los Fuentes de la red el 24/04/2003
' EDGAR MARTIN CANCHO RUIZ
' CALCULO DEL COSTO PROMEDIO

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 pbderecho_anular As Boolean
Public pbderecho_emitir As Boolean
Public pb_tiposcreen As String
 
Public GrecibeUbicacion As BookmarkEnum
Public GrecibeColumnaID As String
Public GrecibeColumnaOpcional As String

Private objAlmacen As DB_INV_MANTENIMIENTOS.C_ALMACEN
Private objCorrelativo As DB_CORRELATIVO.C_Correlativos
Private objProceso As DB_UT_MANTENIMIENTOS.C_PROCESOS
Private objSetup As UTIL_SETUP.C_SETUP


Dim lngCorrelativo As Long

Dim strDiaInicio As String
Dim strDiaFin As String
Dim strMes As String
Dim strMesH As String
Dim strAnio As String

Dim strUltimoCierre As String

Dim strCat As String
Dim strMonedaExtranjera As String



Private Sub cmdAceptar_Click()
On Error GoTo trataerror

    Screen.MousePointer = 11
    'Image1.Visible = False
    
    strUltimoCierre = objSetup.ObtenerUltimoCierre
    lblCierre.Caption = strUltimoCierre
    
    lngCorrelativo = objCorrelativo.ObtenerCorrelativo(GCUSERID)
    strDiaInicio = "01"
    strDiaFin = numdias(cmbMes.ListIndex + 1, Year(dtpAnio.Value))
    If cmbMes.ListIndex < 9 Then
        strMes = "0" + CStr(cmbMes.ListIndex + 1)
        strMesH = "0" + CStr(cmbMes.ListIndex)
    Else
        strMes = CStr(cmbMes.ListIndex + 1)
        strMesH = Right("0" + CStr(cmbMes.ListIndex), 2)
    End If
    strAnio = CStr(dtpAnio.Year)
    strCat = "''" 'Si alguna vez se
    
    If ValidaCierre = 0 Then
        MsgBox "No se puede realizar el cálculo de Costo Promedio de un mes que ya ha sido cerrado", vbExclamation, "Imposible realizar Cálculo de Costo Promedio"
        Screen.MousePointer = 0
        Exit Sub
    Else
        If ValidaCierre = 2 Then
            MsgBox "Debe Procesar antes los meses anterioes", vbExclamation, "Imposible realizar Cálculo de Costo Promedio"
            Screen.MousePointer = 0
            Exit Sub
        End If
    End If
    
    Animation1.Open GstrReportesVta & "Proceso.avi"
    Animation1.Visible = True
    Animation1.Play
    lblMensaje.Caption = "Generando Costo Promedio en Moneda Base"
    lblMensaje.Refresh
    'objProceso
    objProceso.CalcularCostoPromedio lngCorrelativo, GstrCodMonedaBase, strDiaInicio, strDiaFin, strMes, _
                                    strMesH, strAnio, DtcAlmacen.BoundText, strCat, 0, 1
    
    lblMensaje.Caption = "Generando Costo Promedio en Moneda Extranjera"
    lblMensaje.Refresh
    
    objProceso.CalcularCostoPromedio lngCorrelativo, strMonedaExtranjera, strDiaInicio, strDiaFin, strMes, _
                                    strMesH, strAnio, DtcAlmacen.BoundText, strCat, 0, 1

    Animation1.AutoPlay = False
    Animation1.Stop
    Animation1.Visible = False
    Screen.MousePointer = 0
    Me.Hide
    MsgBox "Proceso realizado con éxito", vbInformation, "Costo Promedio"
    Unload Me
    Exit Sub
trataerror:
    Screen.MousePointer = 0
    Me.Hide
    MsgBox MensajedeError(Err.Number, Err.Description), vbDefaultButton1 + vbCritical, "Advertencia"
    Unload Me
End Sub

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
      
    FBusquedasUt.GObtenerRegistros objAlmacen.ListarAlmacenesPorStatus(1), ArrayBusqueda, 2, 2
    FBusquedasUt.Show vbModal
    
    If GrecibeUbicacion <> 0 Then
        DtcAlmacen.BoundText = GrecibeColumnaID
    End If
End Sub

Private Sub cmdSalir_Click()
    Unload Me
End Sub

Private Sub cmdsalir_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
    cmdSalir_Click
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
        Exit Sub
    End If
    strUltimoCierre = objSetup.ObtenerUltimoCierre
    lblCierre.Caption = strUltimoCierre
End Sub
Public Sub actualizar_registro()
End Sub

Public Sub primer_registro()
End Sub
Public Sub ultimo_registro()
End Sub
Public Sub registro_anterior()
End Sub
Public Sub registro_siguiente()
End Sub

Private Sub Form_Load()
    'seguridad
    Call gseguridad(Me)
    
    If pbderecho_consultar Then

    Set objAlmacen = New DB_INV_MANTENIMIENTOS.C_ALMACEN
    Set objCorrelativo = New DB_CORRELATIVO.C_Correlativos
    Set objProceso = New DB_UT_MANTENIMIENTOS.C_PROCESOS
    Set objSetup = New UTIL_SETUP.C_SETUP
    Call CargaDataCombo(DtcAlmacen, objAlmacen.ListarAlmacenesPorStatus(1), "SiteId", "Name")
    
    cmbMes.ListIndex = CInt(Month(Now)) - 1
    strMonedaExtranjera = objSetup.ObtenerMonedaExtranjera(GstrCodMonedaBase)
    strUltimoCierre = objSetup.ObtenerUltimoCierre
    DtcAlmacen.BoundText = GstrSiteProce
    pb_primerregistro = True
    lblCierre.Caption = strUltimoCierre
    'lineas nuevas
    Else
        'Unload Me
        MsgBox ("No tiene Derechos de Consultar en este formulario"), vbCritical + vbDefaultButton1, "Mensaje"
    End If
    
    Me.Top = 1300
    Me.Left = (Screen.Width - Me.Width) / 2
    
     
End Sub

Private Sub Salir()
    Unload Me
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 objAlmacen = Nothing
    Set objCorrelativo = Nothing
    Set objProceso = Nothing
    Set objSetup = Nothing
End Sub

Public Sub salir_formulario()
    Unload Me
End Sub

Public Sub CargaDataCombo(objDataCombo As DataCombo, rsSource As ADODB.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

Public Function numdias(MES As Integer, anio As Long) As Integer
 Select Case MES
   Case 1
      numdias = 31
   Case 2
      If (anio Mod 4) = 0 Then
       numdias = 29
      Else
       numdias = 28
      End If
   Case 3
      numdias = 31
   Case 4
      numdias = 30
   Case 5
      numdias = 31
   Case 6
      numdias = 30
   Case 7
      numdias = 31
   Case 8
      numdias = 31
   Case 9
      numdias = 30
   Case 10
      numdias = 31
   Case 11
      numdias = 30
   Case 12
      numdias = 31
 End Select
End Function

Private Function ValidaCierre() As Integer
Dim strAnioCerrado As String
Dim strMesCerrado As String
Dim strAnioPorCerrar As String
Dim strMesPorCerrar As String

    strAnioCerrado = Mid(strUltimoCierre, 1, 4)
    strMesCerrado = Mid(strUltimoCierre, 5, 2)
    
    If strMesCerrado = "12" Then
        strMesPorCerrar = "01"
        strAnioPorCerrar = CStr(CInt(Mid(strUltimoCierre, 1, 4)) + 1)
    Else
        strMesPorCerrar = Right("0" + CStr(CInt(strMesCerrado) + 1), 2)
        strAnioPorCerrar = strAnioCerrado
    End If
    
    
    If (CInt(strMes) <= CInt(strMesCerrado)) And (CInt(strAnio) <= CInt(strAnioCerrado)) Then
        ValidaCierre = 0
    Else
        If (CInt(strMes) = CInt(strMesPorCerrar)) And (CInt(strAnio) = CInt(strAnioPorCerrar)) Then
            ValidaCierre = 1
        Else
            ValidaCierre = 2
        End If
    End If

End Function
