VERSION 5.00
Begin VB.Form frmPago 
   Caption         =   "Pago - Monto a retirar"
   ClientHeight    =   2010
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   3840
   Icon            =   "frmPago.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   2010
   ScaleWidth      =   3840
   StartUpPosition =   1  'CenterOwner
   Begin VB.PictureBox Picture1 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   495
      Left            =   240
      Picture         =   "frmPago.frx":08D2
      ScaleHeight     =   495
      ScaleWidth      =   615
      TabIndex        =   5
      Top             =   120
      Width           =   615
   End
   Begin VB.CommandButton cmdAceptar 
      Caption         =   "&Aceptar"
      Height          =   435
      Left            =   525
      TabIndex        =   2
      Top             =   1500
      Width           =   1185
   End
   Begin VB.CommandButton cmdSalir 
      Cancel          =   -1  'True
      Caption         =   "&Salir"
      Height          =   435
      Left            =   2115
      TabIndex        =   3
      Top             =   1500
      Width           =   1185
   End
   Begin VB.TextBox txtMonto 
      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            =   2160
      MaxLength       =   8
      TabIndex        =   1
      Top             =   960
      Width           =   1560
   End
   Begin VB.Label Label2 
      Alignment       =   2  'Center
      BackColor       =   &H8000000E&
      Caption         =   "RECAUDACIONES DE CAJA"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H8000000D&
      Height          =   495
      Left            =   1320
      TabIndex        =   4
      Top             =   120
      Width           =   1935
   End
   Begin VB.Shape Shape1 
      BackStyle       =   1  'Opaque
      Height          =   735
      Left            =   -120
      Top             =   0
      Width           =   3975
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "Monto a retirar:"
      BeginProperty Font 
         Name            =   "Courier New"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   105
      TabIndex        =   0
      Top             =   1005
      Width           =   1920
   End
End
Attribute VB_Name = "frmPago"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim iTotal As Double
Private Sub txtMonto_KeyPress(KeyAscii As Integer)
  On Error GoTo LineaError
  Call ValidKeyPress(KeyAscii, kVKP_NUMERIC_ONLY)
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
End Sub

Private Sub txtMonto_LostFocus()
   Dim iCantidad As Double
   Dim iPUnitario As Double
   If Trim(txtMonto.Text) = "" Then txtMonto.Text = "0"
   
   txtMonto.Text = Format(Trim(txtMonto.Text), "###,###,###,##0.00")
End Sub

Private Sub cmdaceptar_Click()
  On Error GoTo LineaError
  
  Dim sSQL As String
  Dim ADORS As ADODB.Recordset
  Dim i As Long, j As Long, iCodOper As Long
  Dim sFecha As String
  Dim sTexto As String
  Dim iSigno As Integer
  Dim iFlagTipo As Integer
  Dim iTipoVenta As Integer
  Dim iOpcion As Integer
  
  iTotal = val(Replace(txtMonto, ",", ""))
  
  If Not VerificaSaldo Then
    iOpcion = MsgBox("No cuenta con saldo suficiente para realizar esta operación ¿Desea continuar?", vbCritical + vbDefaultButton2 + vbYesNo)
    If iOpcion = 7 Then GoTo Salir
  Else
    iOpcion = MsgBox("Se registrará un retiro de " & txtMonto.Text & Chr(13) & " ¿Desea continuar?", vbCritical + vbDefaultButton2 + vbYesNo)
    If iOpcion = 7 Then GoTo Salir
  End If
  
  '-------------------
  '-- Registra Pago --
  '-------------------
  'sSQL = " SELECT MAX(cOperCode) AS maximo FROM Operacion" & _
         " WHERE cOperFlagAbierto=1"
  sSQL = " SELECT MAX(cOperCode) AS maximo FROM Operacion"
         
  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
   
     'SE OBTIENE FECHA DEL SISTEMA DE LA BASE DE DATOS DE SQL - version 2.0.5
   
   Dim cnFECHASQL As ADODB.Connection
   Dim sqlFECHASIS As String
   Dim rsFEchaSis As ADODB.Recordset
      
   If oDBAdmin.AbrirBD(cnFECHASQL, psConnectString, False) = True Then
     
     sqlFECHASIS = "select convert(varchar,getdate(),120) as fechasis"
     If oDBAdmin.EjecutarConsulta(cnFECHASQL, sqlFECHASIS, rsFEchaSis) = True Then
         
         If rsFEchaSis!fechasis <> "" Then
             sFecha = rsFEchaSis!fechasis
         End If

     Else
         'no pudo abrir el rs: que consulte al access
         'MsgBox "No se pudo obtener la fecha, hay problemas de conexión de la red con la Base de Datos Principal", vbOKOnly + vbExclamation, "Aviso"
         sFecha = Format(Now(), "DD/MM/YYYY hh:mm")
         'Unload Me
     End If

     Set cnFECHASQL = Nothing

   Else
     'no pudo conectarse al sql: que consulte al access
      'MsgBox "No se pudo obtener la fecha, hay problemas de conexión de la red con la Base de Datos Principal", vbOKOnly + vbExclamation, "Aviso"
      sFecha = Format(Now(), "DD/MM/YYYY hh:mm")
      'Unload Me
   End If
   
   'FIN FECHA DEL SISTEMA DE LA BASE DE DATOS DE SQL


  'sFecha = Format(Now(), "DD/MM/YYYY hh:mm")

  Set ADORS = Nothing
  
  iTipoVenta = 5 'Codigo del Pago
  
  sSQL = "INSERT INTO OPERACION (cOperCode, cUserDesc, nProdCant, nProdPrecUnit, dOperFech, cOperTipo, cCajaCodi, cTurnoCodi) " + _
         "VALUES" + _
         "($, '$', $, $, '$', $, '$', '$')"
  sSQL = VBsprintf(sSQL, CStr(iCodOper), psUsuario_Descripcion, 1, CStr(iTotal), sFecha, CStr(iTipoVenta), kPAR_CAJA, kPAR_TURNO)
  If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo Salir
    
  '------------------------
  '-- Captura Parámetros --
  '------------------------
  Call CabeceraImpresion
  
  sTexto = ""
  printer.FontSize = 8 ' 11
  printer.FontName = "Courier New"
  For i = 0 To UBound(sCabecera) - 1
    sTexto = sTexto + Right("              " + sCabecera(i), Int(Len(sCabecera(i)) / 2) + 14) + vbCrLf
  Next
  sTexto = sTexto + vbCrLf + vbCrLf
  
  '--------------------
  '-- Manda Imprimir --
  '--------------------
  sTexto = sTexto + "      " + Format(CStr(Now()), "DD/MM/YYYY (DDD)")
  printer.Print sTexto
    
  'Ancho de linea = 27
     
  'Total del Pago
  sTexto = vbCrLf + "PAGO     " + Right("              *" + Format(CStr(iTotal), "###,###,##0.00"), 15)
  
  printer.FontSize = 9 '12
  printer.FontBold = True
  printer.Print sTexto
    
  printer.Print " "
  
  sTexto = ""
  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
  printer.FontSize = 8 ' 11
  printer.FontBold = False
  printer.Print sTexto
  printer.Print " "
  printer.Print " "
  printer.EndDoc
  'Printer.KillDoc
  
  MsgBox "Se ha registrado un retiro por " & txtMonto.Text & "."
  
  Unload Me
  
  GoTo Salir
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  Screen.MousePointer = vbDefault

Salir:
  Set ADORS = Nothing
  
End Sub

Private Sub cmdsalir_Click()
  Unload Me
End Sub

Function VerificaSaldo() As Boolean
  On Error GoTo LineaError
  
  Dim sSQL As String
  Dim ADORS As ADODB.Recordset
  Dim ADORS2 As ADODB.Recordset
  
  VerificaSaldo = False
  sSQL = " SELECT SUM(nProdCant*nProdPrecUnit) AS Monto" & _
         " FROM Operacion" & _
         " WHERE cOperFlagAbierto=1" & _
         " AND cOperTipo=1"
         
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
  
 sSQL = " SELECT SUM(nMontoSoles) AS Monto" & _
         " FROM OperacionParalela " & _
         " WHERE cOperFlagAbierto=1" & _
         " AND cOperCodeAnul=0 "

If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS2) Then GoTo Salir
  
  If (ADORS.RecordCount = 1 Or ADORS2.RecordCount = 1) Then
    If val("0" & (ADORS("Monto"))) + val("0" & (ADORS2("Monto"))) > 0 And val("0" & (ADORS("Monto"))) + val("0" & (ADORS2("Monto"))) >= iTotal Then
      VerificaSaldo = True
    End If
  End If

  GoTo Salir
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  Screen.MousePointer = vbDefault

Salir:
  Set ADORS = Nothing
  
End Function
