VERSION 5.00
Begin VB.Form frmReimpresion 
   Caption         =   "Imprimir"
   ClientHeight    =   6360
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5520
   LinkTopic       =   "Form1"
   ScaleHeight     =   6360
   ScaleWidth      =   5520
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.CheckBox chkAlterno 
      Caption         =   "&O/C, NC , PADE,  PADV"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   285
      Left            =   150
      TabIndex        =   9
      Top             =   810
      Width           =   2175
   End
   Begin VB.TextBox txtTransaccion 
      Alignment       =   2  'Center
      BeginProperty Font 
         Name            =   "Courier New"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   360
      Left            =   2955
      TabIndex        =   8
      Top             =   765
      Visible         =   0   'False
      Width           =   1230
   End
   Begin VB.TextBox txtTexto 
      Appearance      =   0  'Flat
      BeginProperty Font 
         Name            =   "Courier New"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   4470
      Left            =   120
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   7
      Top             =   1215
      Width           =   5250
   End
   Begin VB.CommandButton cmdImprimir 
      Caption         =   "&Imprimir"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   435
      Left            =   1065
      TabIndex        =   6
      Top             =   5790
      Width           =   1185
   End
   Begin VB.CommandButton cmdSalir 
      Cancel          =   -1  'True
      Caption         =   "&Salir"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   435
      Left            =   2715
      TabIndex        =   5
      Top             =   5805
      Width           =   1185
   End
   Begin VB.CommandButton cmdBuscar 
      Appearance      =   0  'Flat
      Caption         =   "&Buscar"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   555
      Left            =   4335
      Picture         =   "frmReimpresion.frx":0000
      Style           =   1  'Graphical
      TabIndex        =   4
      Top             =   195
      Width           =   735
   End
   Begin VB.TextBox txtserie 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   405
      Left            =   1620
      TabIndex        =   3
      Top             =   330
      Width           =   675
   End
   Begin VB.TextBox txtnumero 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   405
      Left            =   2415
      TabIndex        =   2
      Top             =   330
      Width           =   1770
   End
   Begin VB.TextBox txtsupervisor 
      Alignment       =   2  'Center
      BeginProperty Font 
         Name            =   "Courier New"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   360
      Left            =   4200
      MaxLength       =   6
      TabIndex        =   1
      Top             =   5925
      Visible         =   0   'False
      Width           =   1230
   End
   Begin VB.TextBox txttipo 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   405
      Left            =   795
      TabIndex        =   0
      Top             =   0
      Visible         =   0   'False
      Width           =   675
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "&Documento:"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   165
      TabIndex        =   12
      Top             =   405
      Width           =   1245
   End
   Begin VB.Label Label2 
      Caption         =   "&Serie"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00C00000&
      Height          =   255
      Left            =   1650
      TabIndex        =   11
      Top             =   45
      Width           =   765
   End
   Begin VB.Label txtnumeri 
      Caption         =   "&Número"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00C00000&
      Height          =   255
      Left            =   2670
      TabIndex        =   10
      Top             =   45
      Width           =   975
   End
End
Attribute VB_Name = "frmReimpresion"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim iTipoVenta As Integer '1:Normal 2:Voucher 3:Dolares 4:Transaccion Anulada
Dim nTipoCambio As Double
Dim dFechaOperacion As Date
Dim Producto() As tProducto 'Almacena los datos de cada producto que se va registrando
Dim nProducto As Long 'Cantidad de productos por transaccion
Dim sTarjeta As String 'Tarjeta del Cliente
Dim sUsuario As String 'Usuario que registor transaccion
Dim sTexto0 As String 'Bloques para la impresion
Dim sTexto1 As String 'Bloques para la impresion
Dim sTexto2 As String 'Bloques para la impresion
Dim sTexto3 As String 'Bloques para la impresion

Dim iEfectivo As Double, iVuelto As Double
Dim lstarjeta As String
Dim ldtFecha As Date
Dim lTotal As Double
Dim Busq1 As Boolean
 
Public bAcceso As Boolean
'sw Add 19/06/2009
Public IdLocal As String

Private Sub chkAlterno_Click()
If chkAlterno.Value = 1 Then
   txttipo.Text = ""
   txtnumero.Text = ""
   txtserie.Text = ""
   Busca_operparalela
   Buscar
   'txtTransaccion.Visible = True
Else
   Busca_operacion
   'txtTransaccion.Visible = False
End If
End Sub
Private Sub chkAlterno_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    If chkAlterno.Value = 1 Then
       chkAlterno.Value = 0
    Else
       chkAlterno.Value = 1
    End If
End If
End Sub

Private Sub cmdImprimir_Click()
  On Error GoTo LineaError
  Dim p As Integer
  If chkAlterno.Value = 0 Then
    ConfiguraImpresora kPAR_IMPRESORA
    p = 1
  Else
    ConfiguraImpresora kPAR_IMPRESORA_ALTERNA
    p = 2
  End If
  
  If p = 1 Then
  Select Case KImpresora
    Case 1
        Call CortePapel(txtTexto.Text, p)
    Case 0
        printer.Print txtTexto.Text
        printer.Print " "
        printer.Print " "
        printer.EndDoc
    End Select
  Else
    Select Case KImpresoraALT
    Case 1
         Call CortePapel(txtTexto.Text, p)
    Case 0
        printer.Print txtTexto.Text
        printer.Print " "
        printer.Print " "
        printer.EndDoc
  End Select
  End If
  GoTo Salir
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  Screen.MousePointer = vbDefault

Salir:
  Me.cmdImprimir.Enabled = False
End Sub

Private Sub cmdBuscar_Click()
  BuscarDocumento
End Sub

Private Sub cmdsalir_Click()
Unload Me
End Sub

Private Sub Form_Load()
  Busq1 = True
  Busca_operacion
  Busq1 = False
End Sub

Private Sub txtnumero_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
  BuscarDocumento
End If
End Sub
Private Sub txtNumero_KeyPress(KeyAscii As Integer)
 On Error GoTo LineaError
  Call ValidKeyPress(KeyAscii, kVKP_NUMERIC_INTEGER_ONLY)
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
End Sub

Private Sub txtnumero_LostFocus()
  If Trim(txtnumero.Text) <> Empty Then BuscarDocumento
End Sub

Private Sub txtserie_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
   BuscarDocumento
End If
End Sub

Private Sub txtTransaccion_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
  Buscar
End If
End Sub

Private Sub txtTransaccion_KeyPress(KeyAscii As Integer)
  On Error GoTo LineaError
  Call ValidKeyPress(KeyAscii, kVKP_NUMERIC_INTEGER_ONLY)
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
End Sub
Private Sub Buscar()
 On Error GoTo LineaError
 
  Dim sSql As String
  Dim adoRS As ADODB.Recordset
  Dim i As Long, j As Long
  Dim iTransaccion As Long
  
  If Not IsNumeric(txtTransaccion.Text) Then GoTo Salir
  iTransaccion = CLng(txtTransaccion.Text)
  
  If chkAlterno.Value = 0 Then
    'Normal
    sSql = " SELECT count(*) as TOTAL" & _
           " FROM Operacion" & _
           " WHERE cOperCode =$ " & _
           " and cdoctipo in ('02', '01')"
  Else
    'Alterno
    sSql = " SELECT count(*) as TOTAL" & _
           " FROM OperacionParalela" & _
           " WHERE cOperCode =$" & _
           " AND cEstado ='1' AND cDoctipo in ('10', '11', '12', '13') "
  End If
  
  sSql = VBsprintf(sSql, CStr(iTransaccion))
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSql, adoRS) Then GoTo Salir
  
  If chkAlterno.Value = 0 Then
    'Normal
    sSql = " SELECT O.cOperCode, O.cUserDesc, O.nTarjNumb, O.cProdCode, O.cAlmaCode, O.nProdCant, O.nProdPrecUnit," & _
           " O.dOperFech, O.cOperTipo, O.cOperFlagAnula, P.sProdDesc, P.sProdDescCrta, 0 AS nDscto, O.nServicio" & _
           " FROM Operacion AS O INNER JOIN Producto AS P ON O.cProdCode = P.cProdCode " & _
           " WHERE O.cOperCode =$ ORDER BY O.cOperID"
  Else
    'Alterno
    sSql = " SELECT O.cOperCode, O.cUserDesc, O.nTarjNumb, O.dOperFech, O.cOperTipo," & _
           " O.cOperCodeRela, O.nVueltoSoles, O.nEfectivoSoles, B.cAlmaCode, B.cProdCode, B.nProdCant," & _
           " B.nProdPrecUnit, B.nDscto, B.sProdDescCrta, B.nServicio" & _
           " FROM OperacionParalela AS O LEFT JOIN" & _
           " (SELECT A.cOperCode, A.cProdCode, A.nProdCant, A.nProdPrecUnit, A.nDscto," & _
           " P.sProdDescCrta, A.cAlmaCode, A.nServicio FROM OperacionParalelaProducto as A INNER JOIN Producto AS P" & _
           " ON A.cProdCode = P.cProdCode ) AS B ON O.cOperCode = B.cOperCode" & _
           " WHERE O.cOperCode = $ AND O.cEstado IN ('1')"
  End If
  
  sSql = VBsprintf(sSql, CStr(iTransaccion))

  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSql, adoRS) Then GoTo Salir
  
  If adoRS.RecordCount < 1 Then
    If Not Busq1 Then
      MsgBox "El número de transacción no existe."
    End If
    txtTexto.Text = ""
    txtTransaccion.Text = ""
    GoTo Salir
  End If
  
  If chkAlterno.Value = 0 Then
    'Normal
    If LeerCampo(adoRS("cOperTipo")) <> "1" And LeerCampo(adoRS("cOperTipo")) <> "2" And _
      LeerCampo(adoRS("cOperTipo")) <> "3" Then
      MsgBox "No es una transacción de venta."
      GoTo Salir
    End If
  Else
    'Alterno
    iVuelto = LeerCampo(adoRS("nVueltoSoles"))
    iEfectivo = LeerCampo(adoRS("nEfectivoSoles"))
    
    If LeerCampo(adoRS("cOperTipo")) = 24 Then
      MsgBox "Esta es una transacción de liquidación. No puede ser anulada"
      Me.cmdImprimir.Enabled = False
      GoTo Salir
    End If
  End If
  
  nProducto = adoRS.RecordCount
  iTipoVenta = LeerCampo(adoRS("cOperTipo"))
  dFechaOperacion = LeerCampo(adoRS("dOperFech"))
  sTarjeta = LeerCampo(adoRS("nTarjNumb"))
  sUsuario = LeerCampo(adoRS("cUserDesc"))
  
  ReDim Producto(nProducto)
  i = 1
  Do While Not adoRS.EOF
    Producto(i).Almacen = LeerCampo(adoRS("cAlmaCode"))
    Producto(i).Codigo = IIf(LeerCampo(adoRS("cProdCode")) = "", 0, LeerCampo(adoRS("cProdCode")))
    Producto(i).nombre = LeerCampo(adoRS("sProdDescCrta"))
    Producto(i).Cant = IIf(LeerCampo(adoRS("nProdCant")) = "", 0, LeerCampo(adoRS("nProdCant")))
    Producto(i).PUnit = IIf(LeerCampo(adoRS("nProdPrecUnit")) = "", 0, LeerCampo(adoRS("nProdPrecUnit")))
    Producto(i).Dscto = IIf(LeerCampo(adoRS("nDscto")) = "", 0, LeerCampo(adoRS("nDscto")))
    Producto(i).Serv = LeerCampo(adoRS("nServicio"))
    adoRS.MoveNext
    i = i + 1
  Loop
  
  Call CapturaTipoCambio
  Call MuestraTransaccion
  
  GoTo Salir
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  Screen.MousePointer = vbDefault

Salir:
  Set adoRS = Nothing
End Sub

Sub MuestraTransaccion()
  On Error GoTo LineaError
  
  Dim rsNC As ADODB.Recordset, adoRS As ADODB.Recordset
  Dim iTotal As Double, iSubTotal As Double, iTotItems As Double, iDscto As Double
  Dim iPagoAdelantado As Double, iSubTotalDscto As Double, iTotalDscto As Double, iServicio As Double
  Dim i As Integer
  Dim sFecha As String
  Dim sTexto As String
  Dim iSigno As Integer
  Dim iFlagTipo As Integer
  Dim sSql As String
  Dim iTransaccion As Long
  Dim smoneda As String
  Dim blnfactura As Boolean
  
  Dim j As Long, iCodOper As Long
  Dim iMontoDolares  As Double
  Dim nImporte As Double, nPuntos As Double, nPtosImp As Double
  Dim iTipoVentaMod As Integer
  Dim Texto_imprimir As String
  Dim intPuntosAcumulados As Long
  Dim iPuntos As Long
  Dim IGV_1 As Double
  Dim cDocCodigo As Long
  Dim cDocSerie As String
  Dim cdocTipo As String
  Dim cRuc As String
  Dim isubtotal_1 As Double
  Dim toti As Double
  
  smoneda = ""
  sTexto0 = ""
  sTexto1 = ""
  sTexto2 = ""
  sTexto3 = ""
  
  blnfactura = False
  iTransaccion = Replace(txtTransaccion.Text, ",", "")
    
  Call CabeceraImpresion
    
  If chkAlterno.Value = 0 Then
    For i = 0 To UBound(sCabecera) - 1
    If Not Trim(sCabecera(i)) = "" Then
      sTexto = sTexto + Right(Space(60) + sCabecera(i), Int(Len(Space(40) + sCabecera(i)) / 2)) + vbCrLf
    End If
   Next
   sSql = "Select * FROM Operacion WHERE cOperCode= " + Str(iTransaccion)
 Else
   sSql = "Select * FROM OperacionParalela WHERE cOperCode= " + Str(iTransaccion)
 End If
 
 If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSql, adoRS) Then GoTo Salir
 If Not adoRS.EOF Then
   lstarjeta = LeerCampo(adoRS!nTarjNumb)
   ldtFecha = LeerCampo(adoRS!dOperFech)
   If chkAlterno.Value = 0 Then
   blnfactura = (LeerCampo(adoRS!cRuc) <> "")
   End If
 Else
   lstarjeta = ""
 End If
       
  'Linea de Datos del Socio
 'If Not lstarjeta = "" Then
 '   sTexto = sTexto + vbCrLf + " COD.TARJ.: " + lstarjeta + " "
 '   If Not blnfactura = True Then
 '       sTexto = sTexto + vbCrLf + " NOMBRE: " + LeerCampo(ADORS!vDescClie) + vbCrLf
 '   End If
 'Else
 '   If Not blnfactura = True And Trim(LeerCampo(ADORS!vDescClie)) <> "" Then
 '       sTexto = sTexto + vbCrLf + " NOMBRE: " + UCase(Trim(LeerCampo(ADORS!vDescClie))) + vbCrLf
 '   End If
 ' End If
  
  If blnfactura = True Then
    sTexto = sTexto + vbCrLf + " NOMBRE: " & "----------------------------"
    sTexto = sTexto + vbCrLf + "         " & "----------------------------"
    sTexto = sTexto + vbCrLf + " RUC Cliente: " & Trim(LeerCampo(adoRS!cRuc)) + vbCrLf
  End If
  
  If Not blnfactura = True Then
    sTexto = sTexto + vbCrLf + " TICKET NRO: " & LeerCampo(adoRS!cDocSerie) & "-" & Right("000000" & CStr(LeerCampo(adoRS!cDocCodigo)), 6) & " NS:" & kSERIE_DISCO_DURO
  Else
    sTexto = sTexto + vbCrLf + " TICKET NRO: " & LeerCampo(adoRS!cDocSerie) & "-" & Right("000000" & CStr(LeerCampo(adoRS!cDocCodigo)), 6) & " NS:" & kSERIE_DISCO_DURO
  End If
  
  'Printer.Print sTexto
  Texto_imprimir = Texto_imprimir + vbCrLf + sTexto
  sTexto = ""
    
  'Cabecera segun tipo de venta
  Select Case iTipoVenta
    Case 2 'Voucher
      sTexto = "VOUCHER"
      sTexto = Right(Space(60) + sTexto, Int(Len(Space(40) + sTexto) / 2)) + vbCrLf
    Case 3 'Dolares
      sTexto = "U$(TC: " + Format(CStr(nTipoCambio), "###,##0.00") + ")"
      sTexto = Right(Space(60) + sTexto, Int(Len(Space(40) + sTexto) / 2)) + vbCrLf
    Case 4 'Anula Productos
      sTexto = "ANULA PROD"
      sTexto = Right(Space(60) + sTexto, Int(Len(Space(40) + sTexto) / 2)) + vbCrLf
      
    Case 20 'O/C
      sTexto = "O/C"
      sTexto = Right(Space(60) + sTexto, Int(Len(Space(40) + sTexto) / 2)) + vbCrLf
    Case 21 'NC
      sTexto = "N/C"
      sTexto = Right(Space(60) + sTexto, Int(Len(Space(40) + sTexto) / 2)) + vbCrLf
    Case 22 'PADE
      sTexto = "PADE"
      sTexto = Right(Space(60) + sTexto, Int(Len(Space(40) + sTexto) / 2)) + vbCrLf
    Case 23 'PADV
      sTexto = "PADV"
      sTexto = Right(Space(60) + sTexto, Int(Len(Space(40) + sTexto) / 2)) + vbCrLf
    Case 24 'LIQ
      sTexto = "LIQPAD"
      sTexto = Right(Space(60) + sTexto, Int(Len(Space(40) + sTexto) / 2)) + vbCrLf
      
  End Select
  
  If LeerCampo(adoRS!nMontoDolares) > 0 Then
        sTexto = "U$(TC: " + Format(CStr(nTipoCambio), "###,##0.00") + ")"
        sTexto = Right(Space(60) + sTexto, Int(Len(Space(40) + sTexto) / 2)) + vbCrLf
  End If
  
  Texto_imprimir = Texto_imprimir + vbCrLf + sTexto
  sTexto = ""
  
  'Ancho de linea = 27
  Dim PUnit As Double
  iSubTotal = 0
  iTotal = 0
  iTotItems = 0
  iServicio = 0
  
  sTexto = sTexto + "Producto           Cant. Precio SubTot." + vbCrLf
  sTexto = sTexto + "---------------------------------------" + vbCrLf
  
  For i = 1 To nProducto
    If blnfactura = True Then
            iSubTotal = Producto(i).Cant * Producto(i).PUnit / (1 + kIGV + kPAR_PORCSERV * (IIf(Producto(i).Serv = "SI", 1, 0)) / 100)
            sTexto = sTexto + Left(Producto(i).nombre + Space(18), 18) & _
                    " " + Right(Space(7) & CStr(Producto(i).Cant), 4) & _
                    " " + Right(Space(6) & Format(CStr(Producto(i).PUnit), "###,###,##0.00"), 6) & _
                    " " + Right(Space(7) & Format(CStr(Producto(i).PUnit * Producto(i).Cant), "###,###,##0.00"), 7) + vbCrLf
            iTotal = iTotal + iSubTotal
            iTotItems = iTotItems + Producto(i).Cant
    Else
            If (Producto(i).Serv = "SI") Then
                iSubTotal = Producto(i).Cant * Producto(i).PUnit / (1 + kIGV + kPAR_PORCSERV * (IIf(Producto(i).Serv = "SI", 1, 0)) / 100)
                isubtotal_1 = Producto(i).Cant * Producto(i).PUnit
                toti = (kPAR_PORCSERV * iSubTotal * IIf(Producto(i).Serv = "SI", 1, 0)) / 100
                IGV_1 = isubtotal_1 - iSubTotal - toti
                PUnit = Producto(i).PUnit / (1 + kIGV + kPAR_PORCSERV * (IIf(Producto(i).Serv = "SI", 1, 0)) / 100)
            Else
                IGV_1 = 0
                iSubTotal = Producto(i).Cant * Producto(i).PUnit
                PUnit = Producto(i).PUnit
                'isubtotal_1 = isubtotal_1 + Producto(i).Cant * Producto(i).PUnit * kIGV
            End If
            
            PUnit = (iSubTotal + IGV_1) / Producto(i).Cant
            
            sTexto = sTexto + Left(Producto(i).nombre + Space(18), 18) & _
                    " " + Right(Space(7) & CStr(Producto(i).Cant), 4) & _
                    " " + Right(Space(6) & Format(CStr(Producto(i).PUnit), "###,###,##0.00"), 6) & _
                    " " + Right(Space(7) & Format(CStr(Producto(i).PUnit * Producto(i).Cant), "###,###,##0.00"), 7) + vbCrLf
                    
'                If (Producto(i).Serv = "SI") Then
'                     sTexto = sTexto + " " + Right(Space(7) & Format(CStr(iSubTotal + IGV_1), "###,###,##0.00"), 7) + vbCrLf
'                Else
'                    sTexto = sTexto + " " + Right(Space(7) & Format(CStr(iSubTotal), "###,###,##0.00"), 7) + vbCrLf
'                End If
             iTotal = iTotal + iSubTotal
             iTotItems = iTotItems + Producto(i).Cant
    End If
  
    If blnfactura = True Then
        iServicio = iServicio + (kPAR_PORCSERV * iSubTotal * IIf(Producto(i).Serv = "SI", 1, 0)) / 100
      Else
        'iServicio = iServicio + (kPAR_PORCSERV * (Producto(i).PUnit / (1 + kIGV)) * Producto(i).Cant * (IIf(Producto(i).Serv = "SI", 1, 0)) / 100)
        If (Producto(i).Serv = "SI") Then
                iServicio = iServicio + (kPAR_PORCSERV * iSubTotal * IIf(Producto(i).Serv = "SI", 1, 0)) / 100
               Else
                iServicio = iServicio + (kPAR_PORCSERV * (Producto(i).PUnit / (1 + kIGV)) * Producto(i).Cant * (IIf(Producto(i).Serv = "SI", 1, 0)) / 100)
        End If
    End If
  Next
  
  'Añade el % de servicio al total
  iTotal = iTotal + iServicio
  
  sTexto = sTexto + "---------------------------------------"
    
  'Printer.Print sTexto
  Texto_imprimir = Texto_imprimir + vbCrLf + sTexto
  sTexto = ""
  
  Dim iTotalVenta As Double
  Dim nServicio As Double
  iTotalVenta = 0
  For i = 1 To nProducto
    nServicio = Producto(i).Cant * (Producto(i).PUnit / (1 + kIGV)) * (val(kPAR_PORCSERV) * IIf(Producto(i).Serv = "SI", 1, 0)) / 100
    iSubTotal = Producto(i).Cant * Producto(i).PUnit '+ nServicio
    iTotalVenta = iTotalVenta + iSubTotal
  Next
  
  'Total segun tipo de venta
  Select Case iTipoVenta
    Case 1, 2 'Normal, Voucher
        If blnfactura = True Then
            sTexto = Left(" VALOR VTA" + Space(23), 23) + Right(Space(15) + Format(CStr(iTotal - iServicio), "###,###,##0.00"), 15) + vbCrLf
            'sTexto = sTexto + Left(" IGV" + Space(23), 23) + Right(Space(15) + Format(CStr((iTotal - iSubTotal - iServicio) * kIGV), "###,###,##0.00"), 15) + vbCrLf
            IGV_1 = (iTotalVenta - val(Format(CStr(iTotal), "###,###,##0.00")))
            sTexto = sTexto + Left(" IGV" + Space(23), 23) + Right(Space(15) + Format(CStr(IGV_1), "###,###,##0.00"), 15) + vbCrLf
            If iServicio > 0 Then
                sTexto = sTexto + Left(" SERVICIO" + Trim(CStr(kPAR_PORCSERV)) + " %" + Space(23), 23) + Right(Space(15) + Format(CStr(iServicio), "###,###,##0.00"), 15) + vbCrLf
            End If
            'sTexto = sTexto + Left(" TOTAL" + Space(23), 23) + Right(Space(15) + Format(CStr(iTotal + (iTotal - iServicio) * kIGV), "###,###,##0.00"), 15) + vbCrLf
            sTexto = sTexto + Left(" TOTAL" + Space(23), 23) + Right(Space(15) + Format(CStr(IGV_1 + val(Format(CStr(iTotal), "###,###,##0.00"))), "###,###,##0.00"), 15) + vbCrLf
        Else
            If iTipoVenta = 1 Then
                sTexto = Left(" VALOR VTA." + Space(20), 23) + Right(Space(15) + Format(CStr(iTotal), "###,###,##0.00"), 15)
            Else
                sTexto = Left(" VOUCHER" + Space(23), 23) + Right(Space(15) + Format(CStr(iTotal), "###,###,##0.00"), 15)
            End If
        End If
    
    Case 4 'Anula Productos
      sTexto = " CASH/TL  " + Right("                    " + Format(CStr(iTotal), "###,###,##0.00"), 20)
    Case 5, 1 'Efectivo
    
    If blnfactura = True Then
          sTexto = Left(" VALOR VTA" + Space(23), 23) + Right(Space(15) + Format(CStr(iTotal - iServicio), "###,###,##0.00"), 15) + vbCrLf
          'sTexto = sTexto + Left(" IGV" + Space(23), 23) + Right(Space(15) + Format(CStr((iTotal - iSubTotal - iServicio) * kIGV), "###,###,##0.00"), 15) + vbCrLf
          IGV_1 = (iTotalVenta - val(Format(CStr(iTotal), "###,###,##0.00")))
          
          
          sTexto = sTexto + Left(" IGV" + Space(23), 23) + Right(Space(15) + Format(CStr(IGV_1), "###,###,##0.00"), 15) + vbCrLf
          If iServicio > 0 Then
            sTexto = sTexto + Left(" SERVICIO" + Trim(CStr(kPAR_PORCSERV)) + " %" + Space(23), 23) + Right(Space(15) + Format(CStr(iServicio), "###,###,##0.00"), 15) + vbCrLf
          End If
          'sTexto = sTexto + Left(" TOTAL" + Space(23), 23) + Right(Space(15) + Format(CStr(iTotal + (iTotal - iServicio) * kIGV), "###,###,##0.00"), 15) + vbCrLf
          sTexto = sTexto + Left(" TOTAL" + Space(23), 23) + Right(Space(15) + Format(CStr(IGV_1 + val(Format(CStr(iTotal), "###,###,##0.00"))), "###,###,##0.00"), 15) + vbCrLf
      Else
          IGV_1 = (iTotalVenta - val(Format(CStr(iTotal), "###,###,##0.00")))
          sTexto = Left(" VALOR VTA" + Space(23), 23) + Right(Space(15) + Format(CStr(IGV_1 + iTotal), "###,###,##0.00"), 15) + vbCrLf
          If iServicio > 0 Then
            sTexto = sTexto + Left(" SERVICIO" + Trim(CStr(kPAR_PORCSERV)) + " %" + Space(23), 23) + Right(Space(15) + Format(CStr(iServicio), "###,###,##0.00"), 15) + vbCrLf
          End If
      End If
      
'      If LeerCampo(ADORS!nMontoSoles) <> 0 Then
'        sTexto = sTexto + Left(" EFECTIVO(S/)" + Space(23), 23) + Right(Space(15) + Format(CStr(LeerCampo(ADORS!nMontoSoles)), "###,###,##0.00"), 15) + vbCrLf
'      End If
'      If LeerCampo(ADORS!nMontoDolares) <> 0 Then
'        sTexto = sTexto + Left(" EFECTIVO(U$)" + Space(23), 23) + Right(Space(15) + Format(CStr(LeerCampo(ADORS!nMontoDolares)), "###,###,##0.00"), 15) + vbCrLf
'      End If
'      If LeerCampo(ADORS!nVueltoSoles) <> 0 Then
'        sTexto = sTexto + Left(" VUELTO(S/)" + Space(23), 23) + Right(Space(15) + Format(CStr(LeerCampo(ADORS!nVueltoSoles)), "###,###,##0.00"), 15) + vbCrLf
'      End If
'      If LeerCampo(ADORS!nVueltoDolares) <> 0 Then
'        sTexto = sTexto + Left(" VUELTO(U$)" + Space(23), 23) + Right(Space(15) + Format(CStr(LeerCampo(ADORS!nVueltoDolares)), "###,###,##0.00"), 15)
'      End If
  End Select
  
  printer.FontSize = 9 '12
  printer.FontBold = True
  Texto_imprimir = Texto_imprimir + vbCrLf + sTexto
  sTexto = ""
  
  sTexto = Left(" ITEM" + Space(23), 23) + Right(Space(15) + Format(CStr(iTotItems), "###,##0.00"), 15)
  Select Case iTipoVenta
    Case 4 'Anula Productos
      sTexto = sTexto + vbCrLf + "VO-POSTN"
  End Select
  
  Texto_imprimir = Texto_imprimir + vbCrLf + sTexto + vbCrLf
  
  sTexto = ""
  
  nImporte = iTotalVenta
  iPuntos = Int(nImporte / lReglaPuntoImporte) * lReglaPuntoCantidad
  
  If lstarjeta <> "" Then
    'sw Add 19/06/2009, era solo >>> intPuntosAcumulados = ObtenerPuntosAcumulados(lstarjeta)
    intPuntosAcumulados = ObtenerPuntosAcumulados(lstarjeta, IdLocal)
    If (intPuntosAcumulados) >= 0 And iPuntos > 0 And intPuntosAcumulados <> -1 Then
      sTexto = sTexto & " UD. ACUMULO: " & iPuntos & " PUNTOS" & vbCrLf
      sTexto = sTexto & " TIENE ACUMULADO: " & IIf(intPuntosAcumulados < 0, "**", intPuntosAcumulados) & " PUNTOS" & vbCrLf & vbCrLf
    End If
  End If
  
  'sTexto = ""
  sTexto = sTexto + Space(9) + Format(CStr(adoRS!dOperFech), "(DDD) DD/MM/YYYY ") + Format(CStr(adoRS!dOperFech), "hh:mm") + vbCrLf 'Hora: 6 + 1
  sTexto = sTexto + Space(3) + Left(LeerCampo(adoRS!cUserDesc), 10) + " " 'Usuario: 10 + 1
  sTexto = sTexto + Space(1) + "Cj:" + LeerCampo(adoRS!cCajaCodi) + "  T:" + LeerCampo(adoRS!cTurnoCodi)
  sTexto = sTexto + Space(1) + "v" & App.Major & "." & App.Minor & "." & App.Revision
  sTexto = sTexto + vbCrLf + vbCrLf + "   " + kPIE_TICKET
  
  printer.FontSize = 8 '11
  printer.FontBold = False
'  '-----------Eliminado para corte de papel--------
'
'  Texto_imprimir = Texto_imprimir + vbCrLf + sTexto
'  Select Case KImpresora
'    Case 1
'        Call CortePapel(Texto_imprimir, 1, CStr(iTransaccion))
'    Case 0
'        Printer.Print Texto_imprimir
'        Printer.Print " "
'        Printer.Print " "
'        Printer.EndDoc
'  End Select
  
  smoneda = ""
  
  Texto_imprimir = Texto_imprimir + vbCrLf + sTexto + vbCrLf
  
  sTexto2 = sTexto2 + sTexto
    
  sTexto = "ITEM     " + Right(Space(28) & "*" + Format(CStr(iTotItems), "###,##0.00"), 29)
    
  sTexto2 = sTexto2 + vbCrLf + sTexto + vbCrLf
    
  sTexto = ""
  
  sTexto = sTexto + Space(10) & "Documento:" + txtserie.Text + "-" + Right("0000000" & Trim(txtnumero.Text), 7) + vbCrLf
  sTexto3 = sTexto3 + vbCrLf + sTexto
  
  'txtTexto.Text = sTexto0 + vbCrLf + sTexto1 + vbCrLf + sTexto2 + vbCrLf + sTexto3
  txtTexto.Text = Texto_imprimir
'  If iTipoVenta = 3 Then iTipoVenta = 1
lTotal = CDbl(iTotal)
  
 GoTo Salir
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  Screen.MousePointer = vbDefault
Salir:
  Set adoRS = Nothing
  'Teclasel = 0
End Sub

Sub CapturaTipoCambio()
  On Error GoTo LineaError
  Dim sSql As String
  Dim adoRS As ADODB.Recordset
  
  'Captura el tipo de cambio
  sSql = " SELECT nTipoCambMont FROM Tipo_Cambio" & _
         " WHERE FORMAT(dTipoCambFech, 'yyyy/mm/dd') = '" & Format(CStr(dFechaOperacion), "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"
  Else
    nTipoCambio = LeerCampo(adoRS("nTipoCambMont"))
  End If
  
  Screen.MousePointer = vbDefault
  
  GoTo Salir
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  Screen.MousePointer = vbDefault

Salir:
  Set adoRS = Nothing
End Sub

Private Sub txtTransaccion_LostFocus()
  Buscar
End Sub

Public Sub BuscarDocumento()
Dim sSql As String
Dim adoRS As ADODB.Recordset
Dim xwhere As String
xwhere = " "
If Trim(txtserie.Text) <> Empty Then
    xwhere = " And cdocSerie like '" & Trim(txtserie.Text) & "'"
End If
If Trim(txtnumero.Text) <> Empty Then
    xwhere = xwhere & " And cDocCodigo like '" & Trim(txtnumero.Text) & "'"
End If
If chkAlterno.Value = 0 Then
sSql = "Select distinct cdocTipo, cdocSerie, cDocCodigo, cOpercode " & _
          " from Operacion " & _
          " Where " & _
          " cOperFlagAnula = 0  " & xwhere
Else
sSql = "Select distinct cdocTipo, cdocSerie, cDocCodigo, cOpercode " & _
          " from OperacionParalela " & _
          " Where " & _
          " cestado='1' " & xwhere
End If
If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSql, adoRS) Then GoTo Salir
If adoRS.RecordCount > 0 Then
   If adoRS.RecordCount = 1 Then
      txttipo.Text = LeerCampo(adoRS!cdocTipo)
      txtserie.Text = LeerCampo(adoRS!cDocSerie)
      txtnumero.Text = LeerCampo(adoRS!cDocCodigo)
      txtTransaccion.Text = "0" & (adoRS!cOpercode)
      Buscar
   Else
        
   End If
   Me.cmdImprimir.Enabled = True
Else
   MsgBox "No existen coincidencias para el documento"
   txtTexto.Text = ""
   txtTransaccion.Text = ""
   Me.cmdImprimir.Enabled = False
End If

Set adoRS = Nothing

Salir:

End Sub

Public Sub Busca_operparalela()
  Dim sSql As String
  Dim adoRS As ADODB.Recordset
  Dim llMax As Long
  sSql = "SELECT max(cOperCode) AS MAX FROM OperacionParalela " & _
        " WHERE " & _
        " (cOperCodeAnul = 0 OR cOperTipo=3 ) " & _
        " AND cEstado = '1' "
      
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSql, adoRS) Then GoTo Salir
  llMax = val("0" & adoRS!max)
        
  sSql = "Select cOpercode, cdocTipo, cdocserie, cDocCodigo " & _
        " from Operacionparalela " & _
        " Where cOperCode = " & CStr(llMax)
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSql, adoRS) Then GoTo Salir
  
  If adoRS.RecordCount > 0 Then
    txttipo.Text = LeerCampo(adoRS!cdocTipo)
    txtserie.Text = LeerCampo(adoRS!cDocSerie)
    txtnumero.Text = LeerCampo(adoRS!cDocCodigo)
    txtTransaccion.Text = "0" & (adoRS!cOpercode)
    Buscar
  End If
  Set adoRS = Nothing
  
Salir:
  
End Sub

Public Sub Busca_operacion()
  Dim sSql As String
  Dim adoRS As ADODB.Recordset
  Dim llMax As Long
  
  sSql = " SELECT MAX(cOpercode) as max " & _
        "  FROM Operacion " & _
        "  WHERE cDocTipo in ('02', '01') "
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSql, adoRS) Then GoTo Salir
  If adoRS.RecordCount > 0 Then
    llMax = val("0" & adoRS!max)
    If llMax > 0 Then
      'sw To SQL Server add >>> IdLocal
      sSql = "SELECT  cdocTipo, cdocSerie, cDocCodigo, cOpercode, IdLocal FROM Operacion WHERE cOperCode= " & Str(llMax)
      If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSql, adoRS) Then GoTo Salir
      txttipo.Text = LeerCampo(adoRS!cdocTipo)
      txtserie.Text = LeerCampo(adoRS!cDocSerie)
      txtnumero.Text = LeerCampo(adoRS!cDocCodigo)
      txtTransaccion.Text = "0" & (adoRS!cOpercode)
      'sw To SQL Server add >>> IdLocal
      If Trim(IdLocal) = "" Then
        If Not IsNull(adoRS!IdLocal) Then
          IdLocal = adoRS!IdLocal
        End If
      End If
      Buscar
    End If
  End If
  'End If
  Set adoRS = Nothing
  
Salir:
  
End Sub
