Baixe Curso Completo Visual Basic e outras Notas de estudo em PDF para Engenharia Têxtil, somente na Docsity! MAMMA À postilandoecom O maior Site de apostilas da Internet Visual Basic Autor: Marcelo de Oliveira Rodrigues 2 Software de gerenciamento Nilted Modas_Moda Infanto Juvenil Aluno: Marcelo de Oliveira Rodrigues Colégio: EMEFEP “Prof. Virgulina Marcondes de Moura Fázzeri” COTECA – APARECIDA/SP 5 Os profissionais da área geram softwares (programas), que são executados em hardwares (equipamentos) operados por usuários (indivíduos), preparados e treinados em procedimentos operacionais padronizados, dotados de conhecimentos do software e hardware para seu trabalho. A partir de então a análise de sistemas é uma profissão, cujas responsabilidades concentram-se na análise do sistema e na administração de sistemas computacionais. Cabe a este profissional parte da organização, implantação e manutenção de aplicativos e redes de computadores, ou seja, o analista de sistemas é o responsável pelo levantamento de informações sobre uma empresa a fim de utilizá-las no desenvolvimento de um sistema para a mesma ou para o levantamento de uma necessidade específica do cliente para desenvolver este programa especifico com base nas informações colhidas. O profissional geralmente possui conhecimento adquirido em faculdades de Ciência da computação, Análise de sistemas, Processamento de dados e Programação, Informática, Sistemas de informação ou outras disciplinas similares mas, a ausência de restrições para o exercício do cargo permite que profissionais capacitados de outras áreas ou mesmo que não possuem educação superior cumprir este papel nas empresas. Como é uma ênfase, o foco e o núcleo de trabalho estão voltados para Administração, levando em conta a área tecnológica em que irá auxiliar. O analista de sistemas deve servir como um tradutor entre as necessidades do usuário e o programa a ser desenvolvido pelo programador. Para isto, deve ter conhecimento abrangente da área de negócio na qual o sistema será desenvolvido, a fim de que possa implementar corretamente as regras de negócio. Atualmente o curso de Análise de Sistemas foi substituído por Sistemas de Informação. 6 Objetivo Desenvolver um projeto de desenvolvimento de software para gerenciar uma loja, iniciando pela análise do sistema, projeto do sistema e programação, na execução e finalização do programa para possível implantação futura. 7 Banco de Dados Bancos de dados (ou bases de dados) são conjuntos de registros dispostos em estrutura regular que possibilita a reorganização dos mesmos e produção de informação. Um banco de dados normalmente agrupa registros utilizáveis para um mesmo fim. Um banco de dados é usualmente mantido e acessado por meio de um software conhecido como Sistema Gerenciador de Banco de Dados (SGBD). Normalmente um SGBD adota um modelo de dados, de forma pura, reduzida ou estendida. Muitas vezes o termo banco de dados é usado como sinônimo de SGDB. O modelo de dados mais adotado hoje em dia é o modelo relacional, onde as estruturas têm a forma de tabelas, compostas por linhas e colunas. Especificação do Banco de dados Utilizado: Microsoft Office Access; Ficha Técnica: Microsoft Office Access Desenvolvedor Microsoft Última versão: 12.0.4518.1014 (6 de novembro de 2006) Sistema Op. Microsoft Windows Gênero: SRABD Licença: Licença proprietária Website: Access Home Page - Microsoft Office Online Ele permite o desenvolvimento rápido de aplicações que envolvem tanto a modelagem e estrutura de dados como também a interface a ser utilizada pelos usuários. O desenvolvimento da estrutura de dados se dá de forma muito intuitiva, bastando que o desenvolvedor possua conhecimentos básicos em modelagem de dados e lógica de programação. Programadores relativamente inexperientes e usuários determinados podem usá-lo para construir aplicações simples, sem a necessidade de utilizar ferramentas desconhecidas. 10 Produtos Nome do Campo Tipo de dados Cod_Pro Número Nome_Pro Texto Desc_Pro Texto Valor_Pro Unidade Monetária CodFor_Pro Número User_Sistema Nome do Campo Tipo de dados CodUser_Sist Número Usuario_Sist Texto Senha_Sist Texto Nivel_Sist Texto Vendas Nome do Campo Tipo de dados Cod_Vend Número CodCli_Vend Número NomeCli_Vend Texto Funcionario_Vend Texto Data_Vend Data/Hora Vendas_Detalhes Nome do Campo Tipo de dados Cod_VendDet Número Item_VendDet Número CodVend_VendDet Número CodPro_VendDet Número DescPro_VendDet Texto Qtd_VendDet Número Preco_VendDet Unidade Monetária SubTotal_VendDet Unidade Monetária FormaPag_Vend Texto Total_VendDet Unidade Monetária 11 Especificação geral: Programa desenvolvido em Visual Basic; Visual Basic O Visual Basic é uma linguagem de programação produzida pela empresa Microsoft, e é parte integrante do pacote Microsoft Visual Studio. Sua versão mais recente faz parte do pacote Visual Studio .NET, voltada para aplicações .Net. Sua versão anterior fez parte do Microsoft Visual Studio 6.0, ainda muito utilizado atualmente. Um aperfeiçoamento do BASIC, a linguagem é dirigida por eventos (event driven), e possui também um ambiente de desenvolvimento integrado (IDE - Integrated Development Environment) totalmente gráfico, facilitanto enormemente a construção da interface das aplicações (GUI - Graphical User Interface), daí o nome "Visual". Em suas primeiras versões, o Visual Basic não permitia acesso a bancos de dados, sendo portanto, voltado apenas para iniciantes, mas devido ao sucesso entre as empresas - que faziam uso de componentes adicionais fabricados por terceiros para acesso a dados - a linguagem logo adotou tecnologias como DAO, RDO, e ADO, também da Microsoft, permitindo fácil acesso a bases de dados. Mais tarde foi adicionada também a possibilidade de criação de controles ActiveX, e, com a chegada do Visual Studio .NET, o Visual Basic se tornou uma linguagem totalmente orientada a objetos. 12 2.1 Design das telas utilizadas pelos usuários (Formulários) Design (em alguns casos projeto ou projecto) é um esforço criativo relacionado à configuração, concepção, elaboração e especificação de um artefato. Esse esforço normalmente é orientado por uma intenção ou objetivo, ou para a solução de um problema. O termo deriva, originalmente, de designare, palavra em latim, sendo mais tarde adaptado para o inglês design. Houve uma série de tentativas de tradução do termo, mas os possíveis nomes como projética industrial que acabaram em desuso. Segui a baixo as telas e seus respectivos códigos para o devido funcionamento. Os Usuários do Sistema devem se logar, para iniciarem a utilização do mesmo. 15 End If End Sub Private Sub Timer1_Timer() lblHora.Caption = Time End Sub Momento onde estão sendo carregadas todas as informações relacionadas ao Banco de dados e permissões dos usuários. Private Sub tmrSplash_Timer() pbbarra2.Value = pbbarra2.Value + 20 If pbbarra2.Value = 100 Then pbbarra1.Value = 25 pbbarra2.Value = 0 lblPross.Caption = "Preparando a Aplicação" End If 16 If pbbarra1.Value = 25 Then pbbarra2.Value = pbbarra2.Value + 20 End If If pbbarra2.Value = 100 Then pbbarra1.Value = 50 pbbarra2.Value = 0 lblPross.Caption = "Carregando Banco de Bados" End If If pbbarra1.Value = 50 Then pbbarra2.Value = pbbarra2.Value + 20 End If If pbbarra2.Value = 100 Then pbbarra1.Value = 75 pbbarra2.Value = 0 lblPross.Caption = "Carregando a Aplicação" End If If pbbarra1.Value = 75 Then pbbarra2.Value = pbbarra2.Value + 20 End If If pbbarra2.Value = 100 Then pbbarra1.Value = 100 lblPross.Caption = "Processo Concluído" mdiPrincipal.Show Unload Me End If End Sub 17 Tela Principal, nela estão disponíveis todas as ferramentas para uso dos usuários. Public cnBiblioteca As New ADODB.Connection Private Sub Ajuda_Click() With CommonDialog1 .HelpContext = "0001" .HelpCommand = cdlHelpContext .ShowHelp End With End Sub 20 frmConProdutos.Top = 2000 frmConProdutos.Left = 2000 End Sub Private Sub ConUsuario_Click() frmConUsuarios.Show frmConUsuarios.Left = 4000 frmConUsuarios.Top = 2000 End Sub Private Sub FazerLogoff_Click() If MsgBox("Deseja realmente fazer Logoff?", vbYesNo + vbQuestion, "Logoff") = vbYes Then frmLogon.cnLoja.Close Unload Me frmLogon.Show End If End Sub Private Sub Fim_Click() If MsgBox("Deseja realmente sair?", vbYesNo + vbQuestion, "Aviso") = vbYes Then End End If End Sub Private Sub fundo_Click() frmPlanoFundo.Show frmPlanoFundo.Top = 2000 frmPlanoFundo.Left = 4000 End Sub Private Sub MDIForm_Load() CommonDialog1.HelpFile = App.HelpFile stbMostra.Panels(5) = Time 21 cnBiblioteca.ConnectionString = "Provider=microsoft.jet.oledb.4.0" cnBiblioteca.Open "D:\MARCELO\Projeto VB Final2\Loja.mdb" End Sub Private Sub MDIForm_Unload(Cancel As Integer) cnBiblioteca.Close End Sub Private Sub SobreSist_Click() frmAbout.Show frmAbout.Top = 600 frmAbout.Left = 3000 End Sub Private Sub Timer1_Timer() stbMostra.Panels(5) = Time End Sub Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button) If Button.Key = "Calendario" Then frmCalendario.Show frmCalendario.Top = 2000 frmCalendario.Left = 2000 ElseIf Button.Key = "Calculadora" Then frmCalculadora.Show frmCalculadora.Top = 2000 frmCalculadora.Left = 6000 ElseIf Button.Key = "Bloco" Then frmEditor.Show frmEditor.Top = 900 frmEditor.Left = 3000 ElseIf Button.Key = "Agenda" Then frmSplash.Show frmSplash.Top = 3000 22 frmSplash.Left = 5000 ElseIf Button.Key = "Sair" Then If MsgBox("Deseja realmente sair do sistema?", vbYesNo + vbQuestion, "Aviso") = vbYes Then End End If End If End Sub Private Sub UtiAgenda_Click() frmSplash.Show frmSplash.Top = 3000 frmSplash.Left = 5000 End Sub Private Sub UtiBloco_Click() frmEditor.Show frmEditor.Top = 900 frmEditor.Left = 3000 End Sub Private Sub Uticalc_Click() frmCalculadora.Show frmCalculadora.Top = 2500 frmCalculadora.Left = 2500 End Sub Private Sub UtiCalendario_Click() frmCalendario.Show frmCalendario.Top = 2000 frmCalendario.Left = 2000 End Sub Private Sub Venda_Click() frmTelaVenda.Show 25 Tela onde é inserido dados cadastrais dos clientes, podendo também alterá-los e excluir os devidos cadastros. Private rsCadClientes As New ADODB.Recordset Private Const CB_FINDSTRING As Long = &H14C Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hWnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ lParam As Any) As Long Public Function Combo_AutoCompletar(xCombo As ComboBox, ByVal xKeyAscii As Long, Optional ByVal xUpperCase As Boolean = True) As Long Dim lngFind As Long, intPos As Long, intLength As Long, tStr As String 26 With xCombo If xKeyAscii = 8 Then If .SelStart = 0 Then Exit Function .SelStart = .SelStart - 1 .SelLength = Len(.Text) .SelText = vbNullString Else intPos = .SelStart tStr = .Text .SelText = (Chr$(xKeyAscii)) End If lngFind = SendMessage(.hWnd, CB_FINDSTRING, 0, ByVal .Text) If lngFind = -1 Then .Text = tStr .SelStart = intPos .SelLength = (Len(.Text) - intPos) Combo_AutoCompletar = xKeyAscii Else intPos = .SelStart intLength = Len(.List(lngFind)) - Len(.Text) .SelText = .SelText & Right$(.List(lngFind), intLength) .SelStart = intPos .SelLength = intLength End If End With End Function Private Sub cmbLogradouro_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) KeyAscii = Combo_AutoCompletar(cmbLogradouro, KeyAscii) End Sub Private Sub cmbSexo_KeyPress(KeyAscii As Integer) 27 If InStr("0123456789<>|\;,.?/[{}]+=§-_)(*&%$#@!*", Chr(KeyAscii)) <> 0 Then KeyAscii = 0 End If KeyAscii = Asc(UCase(Chr(KeyAscii))) KeyAscii = Combo_AutoCompletar(cmbSexo, KeyAscii) End Sub Private Sub cmdAlterar_Click() HabilitaCampos txtNome.SetFocus cmdIncluir.Enabled = False cmdFechar.Enabled = False cmdCancelar.Enabled = True cmdAlterar.Enabled = False cmdGravar.Enabled = True cmdExcluir.Enabled = False cmdPrimeiro.Enabled = False cmdAnterior.Enabled = False cmdProximo.Enabled = False cmdUltimo.Enabled = False End Sub Private Sub cmdAnterior_Click() rsCadClientes.MovePrevious If rsCadClientes.BOF Then rsCadClientes.MoveFirst End If MostraRegistro End Sub Private Sub cmdCancelar_Click() rsCadClientes.CancelUpdate If rsCadClientes.RecordCount = 0 Then LimpaRegistro 30 MsgBox "O ENDEREÇO é obrigatório!", vbOKOnly + vbInformation, "Aviso" txtEndereco.SetFocus Exit Sub End If If txtCidade.Text = "" Then MsgBox "A CIDADE é obrigatório!", vbOKOnly + vbInformation, "Aviso" txtCidade.SetFocus Exit Sub End If If txtEstado.Text = "" Then MsgBox "O ESTADO é obrigatório!", vbOKOnly + vbInformation, "Aviso" txtEstado.SetFocus Exit Sub End If rsCadClientes("Cod_Cli") = txtCodigo.Text rsCadClientes("Nome_Cli") = txtNome.Text rsCadClientes("Logradouro_Cli") = cmbLogradouro.Text rsCadClientes("Endereco_Cli") = txtEndereco.Text rsCadClientes("Bairro_Cli") = txtBairro.Text rsCadClientes("Compl_Cli") = txtComplemento.Text rsCadClientes("Cidade_Cli") = txtCidade.Text rsCadClientes("Cep_Cli") = txtCEP.Text rsCadClientes("Estado_Cli") = txtEstado.Text rsCadClientes("DataNasc_Cli") = txtData.Text rsCadClientes("Sexo_Cli") = cmbSexo.Text rsCadClientes("Cpf_Cli") = txtCPF.Text rsCadClientes("Fone1_Cli") = txtFone1.Text rsCadClientes("Fone2_Cli") = txtFone2.Text rsCadClientes("Ramal_Cli") = txtRamal.Text rsCadClientes("Renda_Cli") = txtRenda.Text rsCadClientes("Email_Cli") = txtEmail.Text 31 rsCadClientes.Update DesabilitaCampos MsgBox "Dados do Cliente salvos com sucesso!!!", vbOKOnly + vbInformation, "Aviso" cmdCancelar.Enabled = False cmdIncluir.Enabled = True cmdFechar.Enabled = True cmdGravar.Enabled = False cmdPrimeiro.Enabled = True cmdAnterior.Enabled = True cmdProximo.Enabled = True cmdUltimo.Enabled = True cmdAlterar.Enabled = True cmdExcluir.Enabled = True End Sub Private Sub cmdIncluir_Click() Dim Vcodigo As Integer If rsCadClientes.RecordCount = 0 Then rsCadClientes.AddNew Vcodigo = 1 txtCodigo.Text = Format(Vcodigo, "00000") Else rsCadClientes.MoveLast Vcodigo = rsCadClientes("Cod_Cli") Vcodigo = Vcodigo + 1 rsCadClientes.AddNew LimpaRegistro txtCodigo.Text = Format(Vcodigo, "00000") End If HabilitaCampos 32 txtNome.SetFocus cmdCancelar.Enabled = True cmdFechar.Enabled = False cmdIncluir.Enabled = False cmdGravar.Enabled = True cmdPrimeiro.Enabled = False cmdAnterior.Enabled = False cmdProximo.Enabled = False cmdUltimo.Enabled = False cmdExcluir.Enabled = False cmdAlterar.Enabled = False End Sub Private Sub cmdPrimeiro_Click() rsCadClientes.MoveFirst MostraRegistro End Sub Private Sub cmdProximo_Click() rsCadClientes.MoveNext If rsCadClientes.EOF Then rsCadClientes.MoveLast End If MostraRegistro End Sub Private Sub cmdUltimo_Click() rsCadClientes.MoveLast MostraRegistro End Sub Private Sub Form_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then SendKeys "{tab}" 35 If Not IsNull(rsCadClientes("Logradouro_Cli")) Then cmbLogradouro.Text = rsCadClientes("Logradouro_Cli") Else cmbLogradouro.Text = Empty End If If Not IsNull(rsCadClientes("Endereco_Cli")) Then txtEndereco.Text = rsCadClientes("Endereco_Cli") Else txtEndereco.Text = Empty End If If Not IsNull(rsCadClientes("Bairro_Cli")) Then txtBairro.Text = rsCadClientes("Bairro_Cli") Else txtBairro.Text = Empty End If If Not IsNull(rsCadClientes("Compl_Cli")) Then txtComplemento.Text = rsCadClientes("Compl_Cli") Else txtComplemento.Text = Empty End If If Not IsNull(rsCadClientes("Cidade_Cli")) Then txtCidade.Text = rsCadClientes("Cidade_Cli") Else txtCidade.Text = Empty End If If Not IsNull(rsCadClientes("Cep_Cli")) Then txtCEP.Text = rsCadClientes("Cep_Cli") Else 36 txtCEP.Text = Empty End If If Not IsNull(rsCadClientes("Estado_Cli")) Then txtEstado.Text = rsCadClientes("Estado_Cli") Else txtEstado.Text = Empty End If If Not IsNull(rsCadClientes("DataNasc_Cli")) Then txtData.Text = rsCadClientes("DataNasc_Cli") Else txtData.Text = Empty End If If Not IsNull(rsCadClientes("Sexo_Cli")) Then cmbSexo.Text = rsCadClientes("Sexo_Cli") Else cmbSexo.Text = Empty End If If Not IsNull(rsCadClientes("Cpf_Cli")) Then txtCPF.Text = rsCadClientes("Cpf_Cli") Else txtCPF.Text = Empty End If If Not IsNull(rsCadClientes("Fone1_Cli")) Then txtFone1.Text = rsCadClientes("Fone1_Cli") Else txtFone1.Text = Empty End If If Not IsNull(rsCadClientes("Fone2_Cli")) Then 37 txtFone2.Text = rsCadClientes("Fone2_Cli") Else txtFone2.Text = Empty End If If Not IsNull(rsCadClientes("Ramal_Cli")) Then txtRamal.Text = rsCadClientes("Ramal_Cli") Else txtRamal.Text = Empty End If If Not IsNull(rsCadClientes("Renda_Cli")) Then txtRenda.Text = rsCadClientes("Renda_Cli") Else txtRenda.Text = Empty End If If Not IsNull(rsCadClientes("Email_Cli")) Then txtEmail.Text = rsCadClientes("Email_Cli") Else txtEmail.Text = Empty End If End Sub Private Sub HabilitaCampos() txtNome.Enabled = True cmbLogradouro.Enabled = True txtCEP.Enabled = True txtEndereco.Enabled = True txtBairro.Enabled = True txtCidade.Enabled = True txtEstado.Enabled = True txtFone1.Enabled = True txtFone2.Enabled = True 40 End Sub Private Sub txtRenda_LostFocus() txtRenda.Text = Format(txtRenda.Text, "Currency") End Sub Private rsCadCompras As New ADODB.Recordset Private Sub cmdAlterar_Click() HabilitaCampos txtNF.SetFocus cmdIncluir.Enabled = False cmdFechar.Enabled = False cmdCancelar.Enabled = True cmdAlterar.Enabled = False cmdGravar.Enabled = True cmdExcluir.Enabled = False cmdPrimeiro.Enabled = False 41 cmdAnterior.Enabled = False cmdProximo.Enabled = False cmdUltimo.Enabled = False End Sub Private Sub cmdAnterior_Click() rsCadCompras.MovePrevious If rsCadCompras.BOF Then rsCadCompras.MoveFirst End If MostraRegistro End Sub Private Sub cmdCancelar_Click() rsCadCompras.CancelUpdate If rsCadCompras.RecordCount = 0 Then LimpaRegistro cmdExcluir.Enabled = False cmdAlterar.Enabled = False cmdPrimeiro.Enabled = False cmdAnterior.Enabled = False cmdProximo.Enabled = False cmdUltimo.Enabled = False cmdIncluir.Enabled = True cmdFechar.Enabled = True cmdCancelar.Enabled = False cmdGravar.Enabled = False Else MostraRegistro cmdGravar.Enabled = False cmdCancelar.Enabled = False cmdIncluir.Enabled = True cmdFechar.Enabled = True cmdPrimeiro.Enabled = True 42 cmdAnterior.Enabled = True cmdProximo.Enabled = True cmdUltimo.Enabled = True cmdAlterar.Enabled = True cmdExcluir.Enabled = True End If DesabilitaCampos End Sub Private Sub cmdExcluir_Click() If MsgBox("Deseja excluir o cadastro?", vbYesNo + vbQuestion, "Atenção") = vbYes Then rsCadCompras.Delete If rsCadCompras.RecordCount = 0 Then LimpaRegistro cmdExcluir.Enabled = False cmdAlterar.Enabled = False cmdPrimeiro.Enabled = False cmdAnterior.Enabled = False cmdProximo.Enabled = False cmdUltimo.Enabled = False Else rsCadCompras.MoveNext If rsCadCompras.EOF Then rsCadCompras.MoveLast End If MostraRegistro End If End If End Sub Private Sub cmdFechar_Click() 45 HabilitaCampos txtNF.SetFocus cmdCancelar.Enabled = True cmdFechar.Enabled = False cmdIncluir.Enabled = False cmdGravar.Enabled = True cmdPrimeiro.Enabled = False cmdAnterior.Enabled = False cmdProximo.Enabled = False cmdUltimo.Enabled = False cmdExcluir.Enabled = False cmdAlterar.Enabled = False End Sub Private Sub cmdPrimeiro_Click() rsCadCompras.MoveFirst MostraRegistro End Sub Private Sub cmdProximo_Click() rsCadCompras.MoveNext If rsCadCompras.EOF Then rsCadCompras.MoveLast End If MostraRegistro End Sub Private Sub cmdUltimo_Click() rsCadCompras.MoveLast MostraRegistro End Sub Private Sub Form_KeyPress(KeyAscii As Integer) 46 If KeyAscii = 13 Then SendKeys "{tab}" End If End Sub Private Sub Form_Load() rsCadCompras.Open "Compras", mdiPrincipal.cnBiblioteca, adOpenKeyset, adLockOptimistic, adCmdTable If rsCadCompras.RecordCount > 0 Then MostraRegistro Else cmdExcluir.Enabled = False cmdAlterar.Enabled = False cmdPrimeiro.Enabled = False cmdAnterior.Enabled = False cmdProximo.Enabled = False cmdUltimo.Enabled = False End If DesabilitaCampos End Sub Private Sub Form_Unload(Cancel As Integer) rsCadCompras.Close End Sub Private Sub DesabilitaCampos() txtNF.Enabled = False txtCodPro.Enabled = False txtQtd.Enabled = False txtCodFor.Enabled = False txtData.Enabled = False End Sub 47 Private Sub MostraRegistro() If Not IsNull(rsCadCompras("Cod_Compra")) Then txtCodigo.Text = Format(rsCadCompras("Cod_Compra"), "00000") Else txtCodigo.Text = Empty End If If Not IsNull(rsCadCompras("Nf_Compra")) Then txtNF.Text = rsCadCompras("Nf_Compra") Else txtNF.Text = Empty End If If Not IsNull(rsCadCompras("CodPro_Compra")) Then txtCodPro.Text = rsCadCompras("CodPro_Compra") Else txtCodPro.Text = Empty End If If Not IsNull(rsCadCompras("Qtd_Compra")) Then txtQtd.Text = rsCadCompras("Qtd_Compra") Else txtQtd.Text = Empty End If If Not IsNull(rsCadCompras("CodFor_Compra")) Then txtCodFor.Text = rsCadCompras("CodFor_Compra") Else txtCodFor.Text = Empty End If If Not IsNull(rsCadCompras("Data_Compra")) Then txtData.Text = rsCadCompras("Data_Compra") 50 Private rsCadFornecedores As New ADODB.Recordset Option Explicit Private Const CB_FINDSTRING As Long = &H14C Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hWnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ lParam As Any) As Long Public Function Combo_AutoCompletar(xCombo As ComboBox, ByVal xKeyAscii As Long, Optional ByVal xUpperCase As Boolean = True) As Long 51 Dim lngFind As Long, intPos As Long, intLength As Long, tStr As String With xCombo If xKeyAscii = 8 Then If .SelStart = 0 Then Exit Function .SelStart = .SelStart - 1 .SelLength = Len(.Text) .SelText = vbNullString Else intPos = .SelStart tStr = .Text .SelText = (Chr$(xKeyAscii)) ' .SelText = IIf(xUpperCase, _ ' UCase$(Chr$(xKeyAscii)), _ ' LCase$(Chr$(xKeyAscii))) End If lngFind = SendMessage(.hWnd, CB_FINDSTRING, 0, ByVal .Text) If lngFind = -1 Then .Text = tStr .SelStart = intPos .SelLength = (Len(.Text) - intPos) Combo_AutoCompletar = xKeyAscii Else intPos = .SelStart intLength = Len(.List(lngFind)) - Len(.Text) .SelText = .SelText & Right$(.List(lngFind), intLength) .SelStart = intPos .SelLength = intLength End If End With End Function Private Sub cmbLogradouro_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) 52 KeyAscii = Combo_AutoCompletar(cmbLogradouro, KeyAscii) End Sub Private Sub cmdAlterar_Click() HabilitaCampos txtRazao.SetFocus cmdIncluir.Enabled = False cmdFechar.Enabled = False cmdCancelar.Enabled = True cmdAlterar.Enabled = False cmdGravar.Enabled = True cmdExcluir.Enabled = False cmdPrimeiro.Enabled = False cmdAnterior.Enabled = False cmdProximo.Enabled = False cmdUltimo.Enabled = False End Sub Private Sub cmdAnterior_Click() rsCadFornecedores.MovePrevious If rsCadFornecedores.BOF Then rsCadFornecedores.MoveFirst End If MostraRegistro End Sub Private Sub cmdCancelar_Click() rsCadFornecedores.CancelUpdate If rsCadFornecedores.RecordCount = 0 Then LimpaRegistro cmdExcluir.Enabled = False cmdAlterar.Enabled = False cmdPrimeiro.Enabled = False cmdAnterior.Enabled = False 55 If txtEndereco.Text = "" Then MsgBox "O ENDEREÇO é obrigatório!", vbOKOnly + vbInformation, "Aviso" txtEndereco.SetFocus Exit Sub End If If txtCidade.Text = "" Then MsgBox "A CIDADE é obrigatório!", vbOKOnly + vbInformation, "Aviso" txtCidade.SetFocus Exit Sub End If If txtEstado.Text = "" Then MsgBox "O ESTADO é obrigatório!", vbOKOnly + vbInformation, "Aviso" txtEstado.SetFocus Exit Sub End If rsCadFornecedores("Cod_For") = txtCodigo.Text rsCadFornecedores("Razao_For") = txtRazao.Text rsCadFornecedores("NomeFantasia_For") = txtNome.Text rsCadFornecedores("Logradouro_For") = cmbLogradouro.Text rsCadFornecedores("Endereco_For") = txtEndereco.Text rsCadFornecedores("Bairro_For") = txtBairro.Text rsCadFornecedores("Compl_For") = txtComplemento.Text rsCadFornecedores("Cidade_For") = txtCidade.Text rsCadFornecedores("Cep_For") = txtCEP.Text rsCadFornecedores("Estado_For") = txtEstado.Text rsCadFornecedores("Cnpj_For") = txtCNPJ.Text rsCadFornecedores("Fone1_For") = txtFone1.Text rsCadFornecedores("Fone2_For") = txtFone2.Text rsCadFornecedores("Ramal_For") = txtRamal.Text rsCadFornecedores("Fax_For") = txtFax.Text 56 rsCadFornecedores("Email_For") = txtEmail.Text rsCadFornecedores("Repre_For") = txtRepresentante.Text rsCadFornecedores("InscEstadual_For") = txtInsc.Text rsCadFornecedores.Update DesabilitaCampos MsgBox "Informações do Fornecedor salvos com sucesso!!!", vbOKOnly + vbInformation, "Aviso" cmdCancelar.Enabled = False cmdIncluir.Enabled = True cmdFechar.Enabled = True cmdGravar.Enabled = False cmdPrimeiro.Enabled = True cmdAnterior.Enabled = True cmdProximo.Enabled = True cmdUltimo.Enabled = True cmdAlterar.Enabled = True cmdExcluir.Enabled = True End Sub Private Sub cmdIncluir_Click() Dim Vcodigo As Integer If rsCadFornecedores.RecordCount = 0 Then rsCadFornecedores.AddNew Vcodigo = 1 txtCodigo.Text = Format(Vcodigo, "00000") Else rsCadFornecedores.MoveLast Vcodigo = rsCadFornecedores("Cod_For") Vcodigo = Vcodigo + 1 rsCadFornecedores.AddNew LimpaRegistro txtCodigo.Text = Format(Vcodigo, "00000") 57 End If HabilitaCampos txtRazao.SetFocus cmdCancelar.Enabled = True cmdFechar.Enabled = False cmdIncluir.Enabled = False cmdGravar.Enabled = True cmdPrimeiro.Enabled = False cmdAnterior.Enabled = False cmdProximo.Enabled = False cmdUltimo.Enabled = False cmdExcluir.Enabled = False cmdAlterar.Enabled = False End Sub Private Sub cmdPrimeiro_Click() rsCadFornecedores.MoveFirst MostraRegistro End Sub Private Sub cmdProximo_Click() rsCadFornecedores.MoveNext If rsCadFornecedores.EOF Then rsCadFornecedores.MoveLast End If MostraRegistro End Sub Private Sub cmdUltimo_Click() rsCadFornecedores.MoveLast MostraRegistro End Sub 60 txtRazao.Text = Empty End If If Not IsNull(rsCadFornecedores("NomeFantasia_For")) Then txtNome.Text = rsCadFornecedores("NomeFantasia_For") Else txtNome.Text = Empty End If If Not IsNull(rsCadFornecedores("Logradouro_For")) Then cmbLogradouro.Text = rsCadFornecedores("Logradouro_For") Else cmbLogradouro.Text = Empty End If If Not IsNull(rsCadFornecedores("Endereco_For")) Then txtEndereco.Text = rsCadFornecedores("Endereco_For") Else txtEndereco.Text = Empty End If If Not IsNull(rsCadFornecedores("Bairro_For")) Then txtBairro.Text = rsCadFornecedores("Bairro_For") Else txtBairro.Text = Empty End If If Not IsNull(rsCadFornecedores("Compl_For")) Then txtComplemento.Text = rsCadFornecedores("Compl_For") Else txtComplemento.Text = Empty End If 61 If Not IsNull(rsCadFornecedores("Cidade_For")) Then txtCidade.Text = rsCadFornecedores("Cidade_For") Else txtCidade.Text = Empty End If If Not IsNull(rsCadFornecedores("Cep_For")) Then txtCEP.Text = rsCadFornecedores("Cep_For") Else txtCEP.Text = Empty End If If Not IsNull(rsCadFornecedores("Estado_For")) Then txtEstado.Text = rsCadFornecedores("Estado_For") Else txtEstado.Text = Empty End If If Not IsNull(rsCadFornecedores("Fax_For")) Then txtFax.Text = rsCadFornecedores("Fax_For") Else txtFax.Text = Empty End If If Not IsNull(rsCadFornecedores("Repre_For")) Then txtRepresentante.Text = rsCadFornecedores("Repre_For") Else txtRepresentante.Text = Empty End If If Not IsNull(rsCadFornecedores("Cnpj_For")) Then txtCNPJ.Text = rsCadFornecedores("Cnpj_For") Else txtCNPJ.Text = Empty 62 End If If Not IsNull(rsCadFornecedores("Fone1_For")) Then txtFone1.Text = rsCadFornecedores("Fone1_For") Else txtFone1.Text = Empty End If If Not IsNull(rsCadFornecedores("Fone2_For")) Then txtFone2.Text = rsCadFornecedores("Fone2_For") Else txtFone2.Text = Empty End If If Not IsNull(rsCadFornecedores("Ramal_For")) Then txtRamal.Text = rsCadFornecedores("Ramal_For") Else txtRamal.Text = Empty End If If Not IsNull(rsCadFornecedores("InscEstadual_For")) Then txtInsc.Text = rsCadFornecedores("InscEstadual_For") Else txtInsc.Text = Empty End If If Not IsNull(rsCadFornecedores("Email_For")) Then txtEmail.Text = rsCadFornecedores("Email_For") Else txtEmail.Text = Empty End If End Sub Private Sub HabilitaCampos() txtRazao.Enabled = True 65 Private Sub txtNome_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) End Sub Private Sub txtRamal_KeyPress(KeyAscii As Integer) If (KeyAscii < Asc("0") Or KeyAscii > Asc("9") And KeyAscii <> 8) Then KeyAscii = 0 End If End Sub Private Sub txtRazao_KeyPress(KeyAscii As Integer) If InStr("0123456789<>|\;,.?/[{}]+=§-_)(*&%$#@!*", Chr(KeyAscii)) <> 0 Then KeyAscii = 0 End If KeyAscii = Asc(UCase(Chr(KeyAscii))) End Sub Private Sub txtRepresentante_KeyPress(KeyAscii As Integer) If InStr("0123456789<>|\;,.?/[{}]+=§-_)(*&%$#@!*", Chr(KeyAscii)) <> 0 Then KeyAscii = 0 End If KeyAscii = Asc(UCase(Chr(KeyAscii))) End Sub 66 Private rsCadFuncionarios As New ADODB.Recordset Public Foto As String Private Const CB_FINDSTRING As Long = &H14C Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hWnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ lParam As Any) As Long Public Function Combo_AutoCompletar(xCombo As ComboBox, ByVal xKeyAscii As Long, Optional ByVal xUpperCase As Boolean = True) As Long Dim lngFind As Long, intPos As Long, intLength As Long, tStr As String With xCombo 67 If xKeyAscii = 8 Then If .SelStart = 0 Then Exit Function .SelStart = .SelStart - 1 .SelLength = Len(.Text) .SelText = vbNullString Else intPos = .SelStart tStr = .Text .SelText = (Chr$(xKeyAscii)) ' .SelText = IIf(xUpperCase, _ ' UCase$(Chr$(xKeyAscii)), _ ' LCase$(Chr$(xKeyAscii))) End If lngFind = SendMessage(.hWnd, CB_FINDSTRING, 0, ByVal .Text) If lngFind = -1 Then .Text = tStr .SelStart = intPos .SelLength = (Len(.Text) - intPos) Combo_AutoCompletar = xKeyAscii Else intPos = .SelStart intLength = Len(.List(lngFind)) - Len(.Text) .SelText = .SelText & Right$(.List(lngFind), intLength) .SelStart = intPos .SelLength = intLength End If End With End Function Private Sub cmbLogradouro_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) KeyAscii = Combo_AutoCompletar(cmbLogradouro, KeyAscii) End Sub 70 If rsCadFuncionarios.RecordCount = 0 Then LimpaRegistro cmdExcluir.Enabled = False cmdAlterar.Enabled = False cmdPrimeiro.Enabled = False cmdAnterior.Enabled = False cmdProximo.Enabled = False cmdUltimo.Enabled = False Else rsCadFuncionarios.MoveNext If rsCadFuncionarios.EOF Then rsCadFuncionarios.MoveLast End If MostraRegistro End If End If End Sub Private Sub cmdFechar_Click() Unload Me End Sub Private Sub cmdGravar_Click() If txtNome.Text = "" Then MsgBox "O NOME é obrigatório!", vbOKOnly + vbInformation, "Aviso" txtNome.SetFocus Exit Sub End If If txtCEP.Text = "" Then MsgBox "O CEP é obrigatório!", vbOKOnly + vbInformation, "Aviso" txtCEP.SetFocus Exit Sub End If 71 If txtEndereco.Text = "" Then MsgBox "O ENDEREÇO é obrigatório!", vbOKOnly + vbInformation, "Aviso" txtEndereco.SetFocus Exit Sub End If If txtCidade.Text = "" Then MsgBox "A CIDADE é obrigatório!", vbOKOnly + vbInformation, "Aviso" txtCidade.SetFocus Exit Sub End If If txtEstado.Text = "" Then MsgBox "O ESTADO é obrigatório!", vbOKOnly + vbInformation, "Aviso" txtEstado.SetFocus Exit Sub End If rsCadFuncionarios("Cod_Fun") = txtCodigo.Text rsCadFuncionarios("Nome_Fun") = txtNome.Text rsCadFuncionarios("Logradouro_Fun") = cmbLogradouro.Text rsCadFuncionarios("Endereco_Fun") = txtEndereco.Text rsCadFuncionarios("Bairro_Fun") = txtBairro.Text rsCadFuncionarios("Compl_Fun") = txtComplemento.Text rsCadFuncionarios("Cidade_Fun") = txtCidade.Text rsCadFuncionarios("Cep_Fun") = txtCEP.Text rsCadFuncionarios("Estado_Fun") = txtEstado.Text rsCadFuncionarios("RG_Fun") = txtRG.Text rsCadFuncionarios("DataNasc_Fun") = txtDataNasc.Text rsCadFuncionarios("Sexo_Fun") = cmbSexo.Text rsCadFuncionarios("Cpf_Fun") = txtCPF.Text rsCadFuncionarios("Fone1_Fun") = txtFone1.Text rsCadFuncionarios("Fone2_Fun") = txtFone2.Text 72 rsCadFuncionarios("DataAdm_Fun") = txtDataAdm.Text rsCadFuncionarios("Cargo_Fun") = txtCargo.Text rsCadFuncionarios("Email_Fun") = txtEmail.Text If Not (Foto = "") Then rsCadFuncionarios("Fotografia_Fun") = Foto End If rsCadFuncionarios.Update DesabilitaCampos MsgBox "Dados do Funcionário salvos com sucesso!!!", vbOKOnly + vbInformation, "Aviso" cmdCancelar.Enabled = False cmdIncluir.Enabled = True cmdFechar.Enabled = True cmdGravar.Enabled = False cmdPrimeiro.Enabled = True cmdAnterior.Enabled = True cmdProximo.Enabled = True cmdUltimo.Enabled = True cmdAlterar.Enabled = True cmdExcluir.Enabled = True cmdIncluirFoto.Visible = False End Sub Private Sub cmdIncluir_Click() Dim Vcodigo As Integer If rsCadFuncionarios.RecordCount = 0 Then rsCadFuncionarios.AddNew Vcodigo = 1 txtCodigo.Text = Format(Vcodigo, "00000") Else rsCadFuncionarios.MoveLast 75 If rsCadFuncionarios.RecordCount > 0 Then MostraRegistro Else cmdExcluir.Enabled = False cmdAlterar.Enabled = False cmdPrimeiro.Enabled = False cmdAnterior.Enabled = False cmdProximo.Enabled = False cmdUltimo.Enabled = False End If DesabilitaCampos End Sub Private Sub Form_Unload(Cancel As Integer) rsCadFuncionarios.Close End Sub Private Sub txtCargo_KeyPress(KeyAscii As Integer) If InStr("0123456789<>|\;,.?/[{}]+=§-_)(*&%$#@!*", Chr(KeyAscii)) <> 0 Then KeyAscii = 0 End If KeyAscii = Asc(UCase(Chr(KeyAscii))) End Sub Private Sub txtCPF_KeyPress(KeyAscii As Integer) If (KeyAscii < Asc("0") Or KeyAscii > Asc("9") And KeyAscii <> 8) Then KeyAscii = 0 End If End Sub Private Sub txtEmail_KeyPress(KeyAscii As Integer) KeyAscii = Asc(LCase(Chr(KeyAscii))) End Sub 76 Private Sub DesabilitaCampos() txtNome.Enabled = False cmbLogradouro.Enabled = False txtCEP.Enabled = False txtEndereco.Enabled = False txtBairro.Enabled = False txtCidade.Enabled = False txtEstado.Enabled = False txtFone1.Enabled = False txtFone2.Enabled = False txtRG.Enabled = False txtDataNasc.Enabled = False txtDataAdm.Enabled = False cmbSexo.Enabled = False txtEmail.Enabled = False txtCPF.Enabled = False txtComplemento.Enabled = False txtCargo.Enabled = False End Sub Private Sub MostraRegistro() Dim NomeFoto As String If Not IsNull(rsCadFuncionarios("Cod_Fun")) Then txtCodigo.Text = Format(rsCadFuncionarios("Cod_Fun"), "00000") Else txtCodigo.Text = Empty End If If Not IsNull(rsCadFuncionarios("Nome_Fun")) Then txtNome.Text = rsCadFuncionarios("Nome_Fun") Else txtNome.Text = Empty 77 End If If Not IsNull(rsCadFuncionarios("Logradouro_Fun")) Then cmbLogradouro.Text = rsCadFuncionarios("Logradouro_Fun") Else cmbLogradouro.Text = Empty End If If Not IsNull(rsCadFuncionarios("Endereco_Fun")) Then txtEndereco.Text = rsCadFuncionarios("Endereco_Fun") Else txtEndereco.Text = Empty End If If Not IsNull(rsCadFuncionarios("Bairro_Fun")) Then txtBairro.Text = rsCadFuncionarios("Bairro_Fun") Else txtBairro.Text = Empty End If If Not IsNull(rsCadFuncionarios("Compl_Fun")) Then txtComplemento.Text = rsCadFuncionarios("Compl_Fun") Else txtComplemento.Text = Empty End If If Not IsNull(rsCadFuncionarios("Cidade_Fun")) Then txtCidade.Text = rsCadFuncionarios("Cidade_Fun") Else txtCidade.Text = Empty End If If Not IsNull(rsCadFuncionarios("Cep_Fun")) Then 80 Else NomeFoto = Empty imgFoto.Picture = LoadPicture("") End If End Sub Private Sub HabilitaCampos() txtNome.Enabled = True cmbLogradouro.Enabled = True txtCEP.Enabled = True txtEndereco.Enabled = True txtBairro.Enabled = True txtCidade.Enabled = True txtEstado.Enabled = True txtFone1.Enabled = True txtFone2.Enabled = True txtRG.Enabled = True txtDataNasc.Enabled = True txtDataAdm.Enabled = True cmbSexo.Enabled = True txtEmail.Enabled = True txtCPF.Enabled = True txtComplemento.Enabled = True txtCargo.Enabled = True End Sub Private Sub LimpaRegistro() txtCodigo.Text = "" txtNome.Text = "" cmbLogradouro.Text = "" txtCEP.Text = "" txtEndereco.Text = "" txtBairro.Text = "" txtCidade.Text = "" txtEstado.Text = "" txtFone1.Text = "" 81 txtFone2.Text = "" txtRG.Text = "" txtDataNasc.Text = "" txtDataAdm.Text = "" cmbSexo.Text = "" txtEmail.Text = "" txtCPF.Text = "" txtComplemento.Text = "" txtCargo.Text = "" End Sub Private Sub txtBairro_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) End Sub Private Sub txtCidade_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) End Sub Private Sub txtComplemento_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) End Sub Private Sub txtEndereco_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) End Sub Private Sub txtEstado_KeyPress(KeyAscii As Integer) If InStr("0123456789<>|\;,.?/[{}]+=§-_)(*&%$#@!*", Chr(KeyAscii)) <> 0 Then KeyAscii = 0 End If KeyAscii = Asc(UCase(Chr(KeyAscii))) End Sub 82 Private Sub txtNome_KeyPress(KeyAscii As Integer) If InStr("0123456789<>|\;,.?/[{}]+=§-_)(*&%$#@!*", Chr(KeyAscii)) <> 0 Then KeyAscii = 0 End If KeyAscii = Asc(UCase(Chr(KeyAscii))) End Sub Private rsCadProdutos As New ADODB.Recordset Private Sub cmdAlterar_Click() HabilitaCampos txtNome.SetFocus cmdIncluir.Enabled = False cmdFechar.Enabled = False cmdCancelar.Enabled = True cmdAlterar.Enabled = False cmdGravar.Enabled = True cmdExcluir.Enabled = False cmdPrimeiro.Enabled = False 85 Unload Me End Sub Private Sub cmdGravar_Click() If txtNome.Text = "" Then MsgBox "O NOME é obrigatório!", vbOKOnly + vbInformation, "Aviso" txtNome.SetFocus Exit Sub End If If txtDescricao.Text = "" Then MsgBox "A DESCRIÇÃO é obrigatória!", vbOKOnly + vbInformation, "Aviso" txtDescricao.SetFocus Exit Sub End If If txtValor.Text = "" Then MsgBox "O VALOR é obrigatório!", vbOKOnly + vbInformation, "Aviso" txtValor.SetFocus Exit Sub End If If txtCodFor.Text = "" Then MsgBox "O Código do Fornecedor é obrigatório!", vbOKOnly + vbInformation, "Aviso" txtCodFor.SetFocus Exit Sub End If rsCadProdutos("Cod_Pro") = txtCodigo.Text rsCadProdutos("Nome_Pro") = txtNome.Text rsCadProdutos("Desc_Pro") = txtDescricao.Text rsCadProdutos("Valor_Pro") = txtValor.Text rsCadProdutos("CodFor_Pro") = txtCodFor.Text 86 rsCadProdutos.Update DesabilitaCampos MsgBox "Dados do Produto salvos com sucesso!!!", vbOKOnly + vbInformation, "Aviso" cmdCancelar.Enabled = False cmdIncluir.Enabled = True cmdFechar.Enabled = True cmdGravar.Enabled = False cmdPrimeiro.Enabled = True cmdAnterior.Enabled = True cmdProximo.Enabled = True cmdUltimo.Enabled = True cmdAlterar.Enabled = True cmdExcluir.Enabled = True End Sub Private Sub cmdIncluir_Click() Dim Vcodigo As Integer If rsCadProdutos.RecordCount = 0 Then rsCadProdutos.AddNew Vcodigo = 1 txtCodigo.Text = Format(Vcodigo, "00000") Else rsCadProdutos.MoveLast Vcodigo = rsCadProdutos("Cod_Pro") Vcodigo = Vcodigo + 1 rsCadProdutos.AddNew LimpaRegistro txtCodigo.Text = Format(Vcodigo, "00000") End If HabilitaCampos 87 txtNome.SetFocus cmdCancelar.Enabled = True cmdFechar.Enabled = False cmdIncluir.Enabled = False cmdGravar.Enabled = True cmdPrimeiro.Enabled = False cmdAnterior.Enabled = False cmdProximo.Enabled = False cmdUltimo.Enabled = False cmdExcluir.Enabled = False cmdAlterar.Enabled = False End Sub Private Sub cmdPrimeiro_Click() rsCadProdutos.MoveFirst MostraRegistro End Sub Private Sub cmdProximo_Click() rsCadProdutos.MoveNext If rsCadProdutos.EOF Then rsCadProdutos.MoveLast End If MostraRegistro End Sub Private Sub cmdUltimo_Click() rsCadProdutos.MoveLast MostraRegistro End Sub Private Sub Form_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then 90 txtValor.Enabled = True txtCodFor.Enabled = True End Sub Private Sub LimpaRegistro() txtCodigo.Text = "" txtNome.Text = "" txtDescricao.Text = "" txtValor.Text = "" txtCodFor.Text = "" End Sub Private Sub txtCodFor_KeyPress(KeyAscii As Integer) If (KeyAscii < Asc("0") Or KeyAscii > Asc("9") And KeyAscii <> 8) Then KeyAscii = 0 End If End Sub Private Sub txtDescricao_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) End Sub Private Sub txtNome_KeyPress(KeyAscii As Integer) If InStr("0123456789<>|\;,.?/[{}]+=§-_)(*&%$#@!*", Chr(KeyAscii)) <> 0 Then KeyAscii = 0 End If KeyAscii = Asc(UCase(Chr(KeyAscii))) End Sub Private Sub txtValor_KeyPress(KeyAscii As Integer) If (KeyAscii < Asc("0") Or KeyAscii > Asc("9") And KeyAscii <> 8) Then KeyAscii = 0 End If End Sub 91 Private Sub txtValor_LostFocus() txtValor.Text = Format(txtValor.Text, "currency") End Sub Private Vfrase As String Private rsConClientes As New ADODB.Recordset Private Sub cboTipo_Click() txtParametro.Text = "" fgConsultaCli.Clear With fgConsultaCli .ColWidth(0) = 800 .ColWidth(1) = 3500 .ColWidth(2) = 3500 .ColWidth(3) = 2000 .ColWidth(4) = 800 .Rows = 1 .TextArray(0) = "Código" .TextArray(1) = "Nome" 92 .TextArray(2) = "Endereço" .TextArray(3) = "Cidade" .TextArray(4) = "Estado" End With If cboTipo.Text = "Todos" Then txtParametro.Enabled = False Else txtParametro.Enabled = True End If End Sub Private Sub fgConsultaCli_DblClick() If fgConsultaCli.Row = 0 Then Exit Sub End If frmCadClientes.Show frmCadClientes.Left = 3000 frmCadClientes.Top = 800 End Sub Private Sub fgConsultaCli_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) If fgConsultaCli.Rows > 1 Then If fgConsultaCli.Row <> fgConsultaCli.MouseRow And fgConsultaCli.MouseRow > 0 Then fgConsultaCli.Col = 0 fgConsultaCli.Row = fgConsultaCli.MouseRow fgConsultaCli.ColSel = fgConsultaCli.Cols - 1 End If End If End Sub 95 End If VConNome = Chr(39) & CStr(txtParametro.Text) & "'" fgConsultaCli.Clear Vfrase = "Select * from Clientes Where Nome_Cli LIKE" & VConNome Set rsConClientes = mdiPrincipal.cnBiblioteca.Execute(Vfrase) EncheGrid If rsConClientes.BOF = True And rsConClientes.EOF = True Then 'cliente não cadastrado MsgBox "Cliente Não Cadastrado!", vbInformation, "Atenção" txtParametro.Text = "" 'fecha a conexão rsConClientes.Close End If ElseIf cboTipo.Text = "Todos" Then Vfrase = "Select * from Clientes order by Nome_Cli" Set rsConClientes = mdiPrincipal.cnBiblioteca.Execute(Vfrase) ' chama a funcao que preenche o grid EncheGrid If rsConClientes.BOF = True And rsConClientes.EOF = True Then 'cliente não cadastrado MsgBox "Não há Cliente Cadastrado!", vbInformation, "Atenção" txtParametro.Text = "" 'fecha a conexão rsConClientes.Close End If End If ElseIf Button.Key = "Nova" Then fgConsultaCli.Clear cboTipo.Text = "Escolha o tipo de Consulta" 96 txtParametro.Text = "" With fgConsultaCli .ColWidth(0) = 800 .ColWidth(1) = 3500 .ColWidth(2) = 3500 .ColWidth(3) = 2000 .ColWidth(4) = 800 .Rows = 1 .TextArray(0) = "Código" .TextArray(1) = "Nome" .TextArray(2) = "Endereço" .TextArray(3) = "Cidade" .TextArray(4) = "Estado" End With cboTipo.SetFocus End If End Sub Private Sub EncheGrid() ' forma o cabeçalho do fexgrid With fgConsultaCli .ColWidth(0) = 800 .ColWidth(1) = 3500 .ColWidth(2) = 3500 .ColWidth(3) = 2000 .ColWidth(4) = 800 .Rows = 1 .TextArray(0) = "Código" .TextArray(1) = "Nome" .TextArray(2) = "Endereço" .TextArray(3) = "Cidade" .TextArray(4) = "Estado" End With 97 Do While Not rsConClientes.EOF fgConsultaCli.AddItem rsConClientes("Cod_Cli") & Chr(9) & rsConClientes("Nome_Cli") & Chr(9) & rsConClientes("Endereco_Cli") & Chr(9) & rsConClientes("Cidade_Cli") & Chr(9) & rsConClientes("Estado_Cli") rsConClientes.MoveNext Loop End Sub Private Sub txtParametro_KeyPress(KeyAscii As Integer) If cboTipo.Text = "Por Código" Then If (KeyAscii < Asc("0") Or KeyAscii > Asc("9") And KeyAscii <> 8) Then KeyAscii = 0 End If End If If cboTipo.Text = "Por Nome" Then If InStr("0123456789<>|\;,.?/[{}]+=§-_)(*&%$#@!*", Chr(KeyAscii)) <> 0 Then KeyAscii = 0 End If End If End Sub