VERSION 5.00
Begin VB.Form frmReporteX 
   Caption         =   "Form2"
   ClientHeight    =   11130
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   10065
   LinkTopic       =   "Form2"
   ScaleHeight     =   11130
   ScaleWidth      =   10065
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox txtTexto 
      BeginProperty Font 
         Name            =   "Courier New"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   10170
      Left            =   135
      MultiLine       =   -1  'True
      TabIndex        =   0
      Text            =   "frmReporteX.frx":0000
      Top             =   120
      Width           =   8130
   End
End
Attribute VB_Name = "frmReporteX"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Form_Load()
  On Error GoTo LineaError

  Screen.MousePointer = vbHourglass
  
  Dim sSQL As String
  Dim ADOrs As ADODB.Recordset
  Dim i As Long, j As Long
  Dim iInicio As Long, iFin As Long
  Dim sTecla1 As String, sTecla2 As String, sTecla3 As String
    
  Dim nTipoCambio As Double
  Dim nTotal As Double
  Dim nTotalItems As Long
  Dim nTotalPrecUnit As Double
  Dim nTotalTransac As Double
  Dim nPrecTransac As Double
  Dim nSubTotal As Double
  Dim nPorcTotal As Double
  Dim nItems As Long
  Dim nPrecUnit As Double
  Dim nPrecUnitOrig As Double
  Dim sProdDescCrta As String
  Dim sTeclDesc As String
  Dim sTexto As String
  Dim sUsuario As String
  Dim iCodOper As Long
  Dim sFecha As String
  
  'Montos por transaccion - Numero transac
  Dim iCashMont As Double, iCashNume As Long 'Transaccion Cash
  Dim iVoucMont As Double, iVoucNume As Long 'Transaccion Voucher
  Dim iDolaMont As Double, iDolaNume As Long 'Transaccion Dolares
  Dim iAnulMont As Double, iAnulNume As Long 'Transaccion Anulado
  Dim iPagoMont As Double, iPagoNume As Long 'Transaccion Pago
  Dim iVOPOMont As Double, iVOPONume As Long 'Transaccion VO-POSTN
  
  'Captura la mayor transaccion de las permitidas
  sSQL = " SELECT MAX(cOperCode) AS maximo FROM Operacion" & _
         " WHERE cOperFlagAbierto= 1 "
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADOrs) Then GoTo Salir
  
  If ADOrs.RecordCount = 1 Then
    If IsNull(ADOrs("maximo")) Then
      iCodOper = 1
    Else
      iCodOper = LeerCampo(ADOrs("maximo")) + 1
    End If
  End If
  sFecha = Format(Now(), "DD/MM/YYYY hh:mm")
  Set ADOrs = Nothing
  
  'Inserta esta operacion
  sSQL = "INSERT INTO OPERACION (cOperCode, cUserDesc, dOperFech, cOperTipo) " + _
         "VALUES" + _
         "($, '$', '$', $)"
  sSQL = VBsprintf(sSQL, CStr(iCodOper), psUsuario_Descripcion, sFecha, 10) '10 = Reporte X
  If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo Salir
    
  'Captura el tipo de cambio
  sSQL = " SELECT nTipoCambMont FROM Tipo_Cambio" & _
         " WHERE FORMAT(dTipoCambFech, 'yyyy/mm/dd') = '" & Format(CStr(Now()), "yyyy/mm/dd") & "'"

  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADOrs) Then GoTo Salir
  If ADOrs.RecordCount <> 1 Then
    MsgBox "Para registrar ventas en dólares debe registrar el tipo de cambio"
    nTipoCambio = 0
  Else
    nTipoCambio = LeerCampo(ADOrs("nTipoCambMont"))
  End If
  
  'Calcula Totales
  
  sSQL = " SELECT SUM(O.nProdCant) AS TotItem, SUM(O.nProdCant * O.nProdPrecUnit) AS TotMonto" & _
         " FROM (ConfiguracionTeclado AS C INNER JOIN Producto as P ON C.cProdCode = P.cProdCode)" & _
         " INNER JOIN Operacion AS O ON P.cProdCode = O.cProdCode" & _
         " WHERE FORMAT(O.dOperFech, 'yyyy/mm/dd') = '" & Format(CStr(Now()), "yyyy/mm/dd") & "'" & _
         " AND cOperFlagAbierto= 1 "
  
  nTotal = 0
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADOrs) Then GoTo Salir
  Do While Not ADOrs.EOF
    nTotalItems = LeerCampo(ADOrs("TotItem"))
    nTotal = LeerCampo(ADOrs("TotMonto"))
    ADOrs.MoveNext
  Loop
  nTotalPrecUnit = nTotal / nTotalItems
  
  'Captura Cabecera
  Call CabeceraImpresion
  
  sTexto = ""
  For i = 0 To UBound(sCabecera) - 1
    sTexto = sTexto + Right("              " + sCabecera(i), Int(Len(sCabecera(i)) / 2) + 14) + vbCrLf
  Next
  sTexto = sTexto + vbCrLf + vbCrLf
  
  
  'PRIMER BLOQUE
  sTexto = sTexto + "===========================" + vbCrLf
  sTexto = sTexto + "X1 CHECK                 10" + vbCrLf
  sTexto = sTexto + "===========================" + vbCrLf
  sTexto = sTexto + "TOTAL     " + Right("                 *" + Format(CStr(nTotalItems), "###,###,##0.00"), 17) + vbCrLf
  sTexto = sTexto + "          " + Right("                 *" + Format(CStr(nTotal), "###,###,##0.00"), 17) + vbCrLf
  sTexto = sTexto + "AV./ITEM  " + Right("                 *" + Format(CStr(nTotalPrecUnit), "###,###,##0.00"), 17) + vbCrLf
  sTexto = sTexto + "===========================" + vbCrLf
    
  'txtTexto.Text = sTexto
    
  'Barre cada una de las teclas de producto
  sSQL = " SELECT C.cTeclCode, C.sTeclDesc, P.sProdDescCrta, MAX(P.nProdPrecUnit) AS nProdPrecUnit," & _
         " SUM(O.nProdCant) AS TotItem, SUM(O.nProdCant * O.nProdPrecUnit) AS TotMonto" & _
         " FROM (ConfiguracionTeclado AS C INNER JOIN Producto as P ON C.cProdCode = P.cProdCode)" & _
         " INNER JOIN Operacion AS O ON P.cProdCode = O.cProdCode" & _
         " WHERE FORMAT(O.dOperFech, 'yyyy/mm/dd') = '" & Format(CStr(Now()), "yyyy/mm/dd") & "'" & _
         " AND cOperFlagAbierto= 1 " & _
         " GROUP BY C.cTeclCode, C.sTeclDesc, P.sProdDescCrta" & _
         " ORDER BY 1"

  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADOrs) Then GoTo Salir
  'sTexto = ""
  Do While Not ADOrs.EOF
    nItems = LeerCampo(ADOrs("TotItem"))
    nSubTotal = LeerCampo(ADOrs("TotMonto"))
    nPrecUnit = nSubTotal / nItems
    nPrecUnitOrig = LeerCampo(ADOrs("nProdPrecUnit"))
    sProdDescCrta = LeerCampo(ADOrs("sProdDescCrta"))
    sTeclDesc = LeerCampo(ADOrs("sTeclDesc"))
    nPorcTotal = (nSubTotal * 100) / nTotal
    
    sTexto = sTexto + "---------------------------" + vbCrLf
    sTexto = sTexto + Left(sTeclDesc + "          ", 10) + Right("                 @" + Format(CStr(nPrecUnitOrig), "###,###,##0.00"), 17) + vbCrLf
    sTexto = sTexto + Left(sProdDescCrta + "          ", 10) + Right("                 *" + Format(CStr(nItems), "###,###,##0.00"), 17) + vbCrLf
    sTexto = sTexto + Right("          " + Format(CStr(nPorcTotal), "###,###,##0.00") + "%", 10) + Right("                 *" + Format(CStr(nSubTotal), "###,###,##0.00"), 17) + vbCrLf
    sTexto = sTexto + "  AV./ITEM" + Right("                 *" + Format(CStr(nPrecUnit), "###,###,##0.00"), 17) + vbCrLf
    ADOrs.MoveNext
  Loop
  
  'SEGUNDO BLOQUE
  sTexto = sTexto + "===========================" + vbCrLf
  sTexto = sTexto + "X1 CHECK                 20" + vbCrLf
  sTexto = sTexto + "===========================" + vbCrLf
  sTexto = sTexto + "TOTAL     " + Right("                 *" + Format(CStr(nTotalItems), "###,###,##0.00"), 17) + vbCrLf
  sTexto = sTexto + "          " + Right("                 *" + Format(CStr(nTotal), "###,###,##0.00"), 17) + vbCrLf
  sTexto = sTexto + "AV./ITEM  " + Right("                 *" + Format(CStr(nTotalPrecUnit), "###,###,##0.00"), 17) + vbCrLf
  
  'Captura el total de transacciones por tipo
  sSQL = " SELECT cOperTipo, SUM(nProdCant ) AS TotItem, SUM(nProdCant * nProdPrecUnit) AS TotMonto" & _
         " FROM Operacion" & _
         " WHERE FORMAT(dOperFech, 'yyyy/mm/dd') = '" & Format(CStr(Now()), "yyyy/mm/dd") & "'" & _
         " AND cOperTipo in (1,2,3,5)" & _
         " GROUP BY cOperTipo" & _
         " ORDER BY 1"

  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADOrs) Then GoTo Salir
  nTotalTransac = 0
  Do While Not ADOrs.EOF
    nItems = LeerCampo(ADOrs("TotItem"))
    nSubTotal = LeerCampo(ADOrs("TotMonto"))
    Select Case LeerCampo(ADOrs("cOperTipo"))
      Case 1
        iCashMont = LeerCampo(ADOrs("TotMonto"))
        iCashNume = LeerCampo(ADOrs("TotItem"))
        sTexto = sTexto + "   CASH/TL" + Right("        " + "000000" + CStr(nItems) + "   ", 17) + vbCrLf
        sTexto = sTexto + "          " + Right("                 *" + Format(CStr(nSubTotal), "###,###,##0.00"), 17) + vbCrLf
        nTotalTransac = nTotalTransac + nItems
      Case 2
        iVoucMont = LeerCampo(ADOrs("TotMonto"))
        iVoucNume = LeerCampo(ADOrs("TotItem"))
        sTexto = sTexto + "   VOUCHER" + Right("        " + "000000" + CStr(nItems) + "   ", 17) + vbCrLf
        sTexto = sTexto + "          " + Right("                 *" + Format(CStr(nSubTotal), "###,###,##0.00"), 17) + vbCrLf
        nTotalTransac = nTotalTransac + nItems
      Case 3
        iDolaMont = LeerCampo(ADOrs("TotMonto"))
        iDolaNume = LeerCampo(ADOrs("TotItem"))
        sTexto = sTexto + "   EFECT.$" + Right("        " + "000000" + CStr(nItems) + "   ", 17) + vbCrLf
        sTexto = sTexto + "          " + Right("                 *" + Format(CStr(nSubTotal), "###,###,##0.00"), 17) + vbCrLf
        nTotalTransac = nTotalTransac + nItems
      Case 5
        iPagoMont = LeerCampo(ADOrs("TotMonto"))
        iPagoNume = LeerCampo(ADOrs("TotItem"))
    End Select
    ADOrs.MoveNext
  Loop
  nPrecTransac = nTotal / nTotalTransac
  sTexto = sTexto + "  NET-TOTL" + Right("        " + "000000" + CStr(nTotalTransac) + "   ", 17) + vbCrLf
  sTexto = sTexto + "          " + Right("                 *" + Format(CStr(nTotal), "###,###,##0.00"), 17) + vbCrLf
  sTexto = sTexto + "  AV./TRAN" + Right("                 *" + Format(CStr(nPrecTransac), "###,###,##0.00"), 17) + vbCrLf + vbCrLf
  
  'AQUI VA LO DEL PAGO Y TRANSACCIONES ANULADAS
  '--------------------------------------------
  sSQL = " SELECT 0 AS Tran, SUM(nProdCant ) AS TotItem, SUM(nProdCant * nProdPrecUnit) AS TotMonto" & _
         " FROM Operacion" & _
         " WHERE FORMAT(dOperFech, 'yyyy/mm/dd') = '" & Format(CStr(Now()), "yyyy/mm/dd") & "'" & _
         "   AND cOperFlagAnula=1" & _
         "   AND cOperCodeAnula=0" & _
         "   AND cOperFlagAbierto= 1 " & _
         " UNION" & _
         " SELECT 1 AS Tran, SUM(nProdCant ) AS TotItem, SUM(nProdCant * nProdPrecUnit) AS TotMonto" & _
         " FROM Operacion" & _
         " WHERE FORMAT(dOperFech, 'yyyy/mm/dd') = '" & Format(CStr(Now()), "yyyy/mm/dd") & "'" & _
         "   AND cOperFlagAnula=1" & _
         "   AND cOperCodeAnula<>0" & _
         "   AND cOperFlagAbierto= 1 " & _
         " ORDER BY 1"

  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADOrs) Then GoTo Salir
  nTotalTransac = 0
  Do While Not ADOrs.EOF
    Select Case LeerCampo(ADOrs("Tran"))
      Case 0 'Anula productos
        iAnulMont = Val(LeerCampo(ADOrs("TotMonto")))
        iAnulNume = Val(LeerCampo(ADOrs("TotItem")))
      Case 1 'Anula Transacciones
        iVOPOMont = Val(LeerCampo(ADOrs("TotMonto")))
        iVOPONume = Val(LeerCampo(ADOrs("TotItem")))
    End Select
    ADOrs.MoveNext
  Loop
    
  If iPagoMont > 0 Then 'Existe Pago
    sTexto = sTexto + "PAGO      " + Right("        " + "000000" + CStr(iPagoNume) + "   ", 14) + "   " + vbCrLf
    sTexto = sTexto + "          " + Right("                 *" + Format(CStr(iPagoMont), "###,###,##0.00"), 17) + vbCrLf
  End If
     
  If iCashNume > 0 Then 'Existe Pago
    sTexto = sTexto + "CASH-DRW  " + Right("                 *" + Format(CStr(iCashMont), "###,###,##0.00"), 17) + vbCrLf
  End If
  
  If iVoucNume > 0 Then 'Existe Pago
    sTexto = sTexto + "VOUCHER   " + Right("                 *" + Format(CStr(iVoucMont), "###,###,##0.00"), 17) + vbCrLf
  End If
  
  If iDolaNume > 0 Then 'Existe Pago
    sTexto = sTexto + "EFECT.$   " + Right("                 *" + Format(CStr(iDolaMont), "###,###,##0.00"), 17) + vbCrLf
  End If
  
  If iAnulNume > 0 Then 'Existe Pago
    sTexto = sTexto + "ANULADO   " + Right("        " + "000000" + CStr(iAnulNume) + "   ", 14) + "   " + vbCrLf
    sTexto = sTexto + "          " + Right("                 *" + Format(CStr(iAnulMont), "###,###,##0.00"), 17) + vbCrLf
  End If
  
  If iVOPONume > 0 Then 'Existe Pago
    sTexto = sTexto + "VO-POSTN  " + Right("        " + "000000" + CStr(iVOPONume) + "   ", 14) + "   " + vbCrLf
    sTexto = sTexto + "          " + Right("                 *" + Format(CStr(iVOPOMont), "###,###,##0.00"), 17) + vbCrLf
  End If
     
  sTexto = sTexto + vbCrLf
  
  'TERCER BLOQUE
  sTexto = sTexto + "===========================" + vbCrLf
  sTexto = sTexto + "X1 CHECK                 30" + vbCrLf
  sTexto = sTexto + "===========================" + vbCrLf
  sTexto = sTexto + "TOTAL     " + Right("                 *" + Format(CStr(nTotalItems), "###,###,##0.00"), 17) + vbCrLf
  sTexto = sTexto + "          " + Right("                 *" + Format(CStr(nTotal), "###,###,##0.00"), 17) + vbCrLf
  sTexto = sTexto + "AV./TRAN  " + Right("                 *" + Format(CStr(nPrecTransac), "###,###,##0.00"), 17) + vbCrLf
  sTexto = sTexto + "===========================" + vbCrLf
  
  'Captura totales por usuario
  sSQL = " SELECT cUserDesc, SUM(nProdCant ) AS TotItem, SUM(nProdCant * nProdPrecUnit) AS TotMonto" & _
         " FROM Operacion" & _
         " WHERE FORMAT(dOperFech, 'yyyy/mm/dd') = '" & Format(CStr(Now()), "yyyy/mm/dd") & "'" & _
         " AND cOperFlagAbierto= 1 " & _
         " GROUP BY cUserDesc" & _
         " ORDER BY 1"

  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADOrs) Then GoTo Salir
  nTotalTransac = 0
  Do While Not ADOrs.EOF
    nItems = LeerCampo(ADOrs("TotItem"))
    nSubTotal = LeerCampo(ADOrs("TotMonto"))
    sUsuario = LeerCampo(ADOrs("cUserDesc"))
    nPorcTotal = (nSubTotal * 100) / nTotal
    nPrecTransac = nSubTotal / nItems
    
    sTexto = sTexto + Left(sUsuario + "          ", 10) + Right("        " + "000000" + CStr(nItems) + "   ", 17) + vbCrLf
    sTexto = sTexto + Right("          " + Format(CStr(nPorcTotal), "###,###,##0.00") + "%", 10) + Right("                 *" + Format(CStr(nSubTotal), "###,###,##0.00"), 17) + vbCrLf
    sTexto = sTexto + "  AV./TRAN" + Right("                 *" + Format(CStr(nPrecTransac), "###,###,##0.00"), 17) + vbCrLf
    sTexto = sTexto + "---------------------------" + vbCrLf
    ADOrs.MoveNext
  Loop
  
  sTexto = sTexto + vbCrLf
  sTexto = sTexto + " " + Left(psUsuario_Descripcion, 10) + " " 'Usuario: 10 + 1
  sTexto = sTexto + Format(CStr(Now()), "hh:mm") + " " 'Hora: 6 + 1
  sTexto = sTexto + Right("000000" + CStr(iCodOper), 6) 'Codigo Transaccion: 6
    
  txtTexto.Text = txtTexto.Text + sTexto
  
  Printer.Print sTexto
  Printer.Print " "
  Printer.Print " "
  Printer.EndDoc
    
  Screen.MousePointer = vbDefault
  
  GoTo Salir
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  Screen.MousePointer = vbDefault

Salir:
  Set ADOrs = Nothing
  
End Sub
