Controle de Caixa

Option Explicit
Dim RS As New ADODB.Recordset
Dim reccnt
Public Key As Integer

Private Sub mPopExit_Click()
Unload Me
End Sub

Private Sub cmdCancela_Click()
LimpaTela Me
Limpa
Lista
MostraTotal

cmdSalvar.Enabled = False
cmdNovo1.Enabled = True
cmdNovo2.Enabled = True
cmdExtrato.Enabled = True
lblCredito.Enabled = True
lblDebito.Enabled = True
txtControle.SetFocus
FLmLance(4).Enabled = False
End Sub

Private Sub cmdExtrato_Click()
FrmListaCaixaDiario.Show 1
End Sub

''' C R É D I T O S '''
Private Sub cmdNovo1_Click()
LimpaTela Me
RS.Open "CadCaxDia", CnSql, 1, 3
If (RS.RecordCount = 0) Then
txtControle = 1
Else
RS.MoveMax
txtControle.Text = RS.Fields("Controle") + 1
End If
RS.Close
MostraTotal
FLmLance(4).Enabled = True
txtDescricao.SetFocus
txtEmissao.Text = Date
cmdSalvar.Enabled = True
lblDebito.Enabled = False
txtDebito.Enabled = False
cmdNovo2.Enabled = False
End Sub

''' D É B I T O S '''
Private Sub cmdNovo2_Click()
LimpaTela Me
RS.Open "CadCaxDia", CnSql, 1, 3
If (RS.RecordCount = 0) Then
txtControle = 1
Else
RS.MoveMax
txtControle.Text = RS.Fields("Controle") + 1
End If
RS.Close
MostraTotal
FLmLance(4).Enabled = True
txtDescricao.SetFocus
txtEmissao.Text = Date
cmdSalvar.Enabled = True
lblCredito.Enabled = False
txtCredito.Enabled = False
cmdNovo1.Enabled = False
End Sub

Private Sub cmdSair_Click()
Unload Me
End Sub

Private Sub cmdSalvar_Click()
GravaDados
cmdExtrato.Enabled = True
cmdSalvar.Enabled = False
cmdNovo1.Enabled = True
cmdNovo2.Enabled = True
txtDescricao.SetFocus
cmdIncluir_Click
cmdCancela_Click
End Sub

Private Sub Form_Load()

Dim rec As New ADODB.Recordset
RS.Open "select Controle from CadCaxDia", CnSql, adOpenStatic, adLockOptimistic
lblContar.Caption = RS.RecordCount
RS.Close

cmdSalvar.Enabled = False

Lista
MostraTotal
FLmLance(4).Enabled = False

With cboMes
.AddItem "Janeiro"
.AddItem "Fevereiro"
.AddItem "Março"
.AddItem "Abril"
.AddItem "Maio"
.AddItem "Junho"
.AddItem "Julho"
.AddItem "Agosto"
.AddItem "Setembro"
.AddItem "Outubro"
.AddItem "Novembro"
.AddItem "Dezembro"
End With
End Sub

Private Sub Lista()

FG1.ColWidth(0) = 1000
FG1.ColWidth(1) = 1000
FG1.ColWidth(2) = 4350
FG1.ColWidth(3) = 1000
FG1.ColWidth(4) = 1250
FG1.ColWidth(5) = 1250

Dim SQL As String
Dim CaixaID As String

FG1.TextMatrix(0, 0) = "Controle N°:"
FG1.TextMatrix(0, 1) = "Emissão"
FG1.TextMatrix(0, 2) = "Descrição do Lançamento"
FG1.TextMatrix(0, 3) = "Documento"
FG1.TextMatrix(0, 4) = "Crédito R$"
FG1.TextMatrix(0, 5) = "Débito R$"

CaixaID = Chr$(39) & txtCaixaID & "%" & Chr(39)
SQL = "SELECT Controle, Emissao, Descricao, Doc, Credito, Debito FROM CadCaxDia WHERE CadCaxDia.Controle Like " & CaixaID & " ORDER BY Controle"

On Error Resume Next
With RS
.Open SQL, CnSql, adOpenForwardOnly, adLockReadOnly

Do Until .EOF
FG1.AddItem RS(0) & vbTab & RS(1) & vbTab & RS(2) & vbTab & RS(3) & vbTab & RS(4) & vbTab & RS(5)
.MoveNext
Loop
FG1.RemoveItem 1

.Close
End With
End Sub

Private Sub cmdIncluir_Click()

If (Key = 0) Then
Key = 1
Else
Key = Key + 1
End If
FG1.Rows = Key + 1
FG1.TextMatrix(Key, 0) = txtControle.Text
FG1.TextMatrix(Key, 1) = txtEmissao.Text
FG1.TextMatrix(Key, 2) = txtDescricao.Text
FG1.TextMatrix(Key, 3) = txtDoc.Text
FG1.TextMatrix(Key, 4) = txtCredito.Text
FG1.TextMatrix(Key, 5) = txtDebito.Text

End Sub

Public Sub MostraTotal()
RS.Open "CadCaxDia", CnSql, 1, 3
If (RS.RecordCount = 0) Then
txtTotal = 0
Else
RS.MoveMax
txtTotal.Text = RS.Fields("Total")
End If
RS.Close
End Sub

Private Sub GravaDados()

Dim adCmdPaciente As New ADODB.Command
Dim CaixaID As Long
Dim Resp As Byte

If Not TudoOK Then Exit Sub
Resp = MsgBox("Confirma Gravação de " & txtDoc & " em Controle de Caixa ?", vbYesNo + vbQuestion, "Salvar Dados")
If Resp = 7 Then Exit Sub

CaixaID = Val(txtCaixaID.Text)

With adCmdPaciente

    Set .ActiveConnection = CnSql
    .CommandType = adCmdText
    .Prepared = True

    If CaixaID > 0 Then

        .CommandText = "UPDATE CadCaxDia SET Descricao = ?, Credito = ?, Debito = ?, Mes = ?, Doc = ?, Banco = ?, Conta = ?, Total = ? Where CaixaID = " & CaixaID

        .Parameters.Append .CreateParameter("Descricao", adVarChar, adParamInput, 255)
        .Parameters.Append .CreateParameter("Credito", adVarChar, adParamInput, 15)
        .Parameters.Append .CreateParameter("Debito", adVarChar, adParamInput, 15)
        .Parameters.Append .CreateParameter("Mes", adVarChar, adParamInput, 15)
        .Parameters.Append .CreateParameter("Doc", adVarChar, adParamInput, 10)
        .Parameters.Append .CreateParameter("Banco", adVarChar, adParamInput, 25)
        .Parameters.Append .CreateParameter("Conta", adVarChar, adParamInput, 20)
        .Parameters.Append .CreateParameter("Total", adVarChar, adParamInput, 12)

        .Parameters("Descricao") = txtDescricao.Text
        .Parameters("Credito") = txtCredito.Text
        .Parameters("Debito") = txtDebito.Text
        .Parameters("Mes") = cboMes.Text
        .Parameters("Doc") = txtDoc.Text
        .Parameters("Banco") = txtBanco.Text
        .Parameters("Conta") = txtConta.Text
        .Parameters("Total") = txtTotal.Text

        .Execute

        If Err.Number <> 0 Then
        ' Da erro mais grava normal ?? 'MostraErro
        End If

        Else

        .CommandText = "INSERT INTO CadCaxDia (Controle, Descricao, Emissao, Credito, Debito, Mes, Doc, Banco, Conta, Total) Values (?, ?, ?, ?, ?, ?, ?, ?, ?, ?)"


        .Parameters.Append .CreateParameter("Controle", adVarChar, adParamInput, 30)
        .Parameters.Append .CreateParameter("Descricao", adVarChar, adParamInput, 55)
        .Parameters.Append .CreateParameter("Emissao", adDate, adParamInput)
        .Parameters.Append .CreateParameter("Credito", adVarChar, adParamInput, 12)
        .Parameters.Append .CreateParameter("Debito", adVarChar, adParamInput, 12)
        .Parameters.Append .CreateParameter("Mes", adVarChar, adParamInput, 15)
        .Parameters.Append .CreateParameter("Doc", adVarChar, adParamInput, 10)
        .Parameters.Append .CreateParameter("Banco", adVarChar, adParamInput, 25)
        .Parameters.Append .CreateParameter("Conta", adVarChar, adParamInput, 20)
        .Parameters.Append .CreateParameter("Total", adVarChar, adParamInput, 15)


        .Parameters("Controle") = txtControle.Text
        .Parameters("Descricao") = txtDescricao.Text
        .Parameters("Emissao") = Date
        .Parameters("Credito") = txtCredito.Text
        .Parameters("Debito") = txtDebito.Text
        .Parameters("Mes") = cboMes.Text
        .Parameters("Doc") = txtDoc.Text
        .Parameters("Banco") = txtBanco.Text
        .Parameters("Conta") = txtConta.Text
        .Parameters("Total") = txtTotal.Text

        .Execute

    If Err.Number <> 0 Then
    MostraErro
    End If
    End If
Lista
End With
Set adCmdPaciente = Nothing
End Sub

Public Sub MostraDadosCheque()
Dim rsPaciente As New ADODB.Recordset
Dim SQL As String

Dim CaixaID As Long
CaixaID = Val(txtCaixaID.Text)
On Error Resume Next

SQL = "SELECT Controle, Descricao, Emissao, Credito, Debito, Mes, Doc, Total From CadCaxDia Where CaixaID=" & CaixaID

rsPaciente.Open SQL, CnSql, adOpenForwardOnly, adLockReadOnly

txtControle = rsPaciente(0)
txtDescricao = rsPaciente(1)
txtEmissao = rsPaciente(2)
txtCredito = rsPaciente(3)
txtDebito = rsPaciente(4)
cboMes = rsPaciente(5)
txtDoc = rsPaciente(6)
txtTotal = rsPaciente(7)

MostraTotal

rsPaciente.Close
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim Resp As Byte
Resp = MsgBox("Fechar Formulário !", vbQuestion + vbYesNo, " Sisnews Sistemas")
If Resp = 7 Then Cancel = True
MDISisnews.StatusBar.Panels(2).Text = "Menu Principal do Sistema"
End Sub

Private Sub txtDescricao_GotFocus()
SelecionaTexto txtDescricao
End Sub
Private Sub txtDescricao_LostFocus()
If Trim(txtDescricao.Text <> "") Then
txtDescricao.Text = Maiuscula(txtDescricao.Text)
End If
End Sub

Private Sub txtCredito_GotFocus()
SelecionaTexto txtCredito
End Sub
Private Sub txtCredito_LostFocus()
txtCredito.Text = Format$(txtCredito.Text, "0.00")
If Len(txtCredito.Text) <= 0 Then
MsgBox "Informe Valor do Crédito ! ", vbMagenta, " Sisnews Sistemas "
txtCredito.SetFocus
Else
txtTotal.Text = Format$(CCur(txtTotal.Text) + CCur(txtCredito.Text), "##,##0.00")
End If
End Sub

Private Sub txtDebito_GotFocus()
SelecionaTexto txtCredito
End Sub
Private Sub txtDebito_LostFocus()
txtDebito.Text = Format$(txtDebito.Text, "0.00")
If Len(txtDebito.Text) <= 0 Then
MsgBox "Informe Valor do Débito ! ", vbMagenta, " Sisnews Sistemas "
txtDebito.SetFocus
Else
txtTotal.Text = Format$(CCur(txtTotal.Text) - CCur(txtDebito.Text), "##,##0.00")
End If
End Sub

Private Sub cboMes_Change()
SelecionaTexto cboMes
End Sub
Private Sub cboMes_LostFocus()
If Len(cboMes.Text) <= 0 Then
MsgBox "Informe Mês de Lançamento ! ", vbMagenta, " Sisnews Sistemas "
Else
End If
End Sub

Private Sub txtDoc_GotFocus()
SelecionaTexto txtDoc
End Sub
Private Sub txtDoc_KeyPress(KeyAscii As Integer)
SoNumeros KeyAscii
End Sub
Private Sub txtDoc_LostFocus()
If Len(txtDoc.Text) <= 0 Then
MsgBox "Informe o Número do documento ! ", vbMagenta, " Sisnews Sistemas "
txtDoc.SetFocus
Else
End If
End Sub

Private Sub Limpa()
Dim i As Long
FG1.Redraw = False
For i = FG1.Rows - 1 To 2 Step -1
FG1.RemoveItem (i)
Next
FG1.Redraw = True
End Sub

'DADOS OBRIGATÓRIOS PARA SALVAR

Private Function TudoOK() As Boolean

If txtDescricao.Text = "" Then
MsgBox "Informe a descriçao. ", vbExclamation, " Registro Cancelado "
txtDescricao.SetFocus

Else: TudoOK = True
End If
End Function