Apostila completa de Visual Basic

Prévia do material em texto

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 
 3 
Sumário 
 
Capítulo 1 
Introdução.....................................................................................................................3 
 
Capítulo 2 
Objetivo........................................................................................................................5 
 
Capítulo 3 
Banco de Dados...........................................................................................................6 
1.1 Estruturas das Tabelas................................................................................7 
 
Capítulo 4 
Linguagem de Programação utilizada........................................................................10 
 2.1 Design (Formulários).................................................................................11 
 
Capítulo 5 
Melhorias no Sistema...............................................................................................219 
 
Capítulo 6 
Conclusão.................................................................................................................220 
 
Capítulo 7 
Referência Bibliográfica............................................................................................221 
 
 
 
 4 
Introdução 
 
a.ná.li.se 
(gr análysis) sf 1 Decomposição ou separação de um todo em seus elementos 
constituintes. 2 Exame ou estudo da natureza de uma coisa complexa ou 
determinação de suas feições essenciais, por esse método. 3 Psiq Psicanálise. 
Antôn (acepção 1): síntese. 
 
sis.te.ma 
(gr sýstema) sm 1 Conjunto de coisas ou partes de modo a formarem um todo 
complexo ou unitário. 2 Qualquer conjunto ou série de membros ou elementos 
correlacionados. 3 Hábito ou costume peculiar de cada criatura. 4 Anat Conjunto de 
órgãos compostos dos mesmos tecidos destinados a idênticas funções fisiológicas. 
5 Astr Grupo de corpos celestes associados e agindo em conjunto, segundo 
determinadas leis naturais. 6 Método, modo, forma, plano. 7 Conjunto das 
instituições políticas pelas quais é governado um Estado. 8 Inform Conjunto 
formado por um ou mais computadores, seus periféricos e os programas 
utilizados. Sistema Digestório (antes denominado aparelho digestivo), Anat: 
conjunto de órgãos que têm por função tornar os alimentos assimiláveis, aproveitar 
parte deles e expulsar a porção inútil. Sistema Nervoso, Anat: conjunto dos centros 
nervosos e de todos os nervos. Sistema Nervoso Autônomo: parte do sistema 
nervoso que inerva a musculatura cardíaca e controla secreções glandulares 
diversas. É dividido em dois grandes setores: o simpático e o parassimpático. 
 
Análise de sistemas 
Análise de sistemas é a atividade que tem como finalidade realizar 
estudos de processos a fim de encontrar o melhor e mais racional caminho para que 
a informação possa ser processada. O analista de sistemas estuda os diversos 
sistemas existentes entre hardwares (equipamento), softwares (programas) e o 
usuário final, seus comportamentos e aplicações, desenvolvendo a partir de então 
soluções que serão padronizadas e transcritas da forma que o computador possa 
executar. 
 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. 
 8 
1.1 Forma que será armazenado os dados, formação das tabelas e seus 
respectivos campos, onde armazenará os registros. 
 
� Clientes 
Nome do Campo Tipo de dados 
Cod_Cli Número 
Nome_Cli Texto 
Logradouro_Cli Texto 
Endereco_Cli Texto 
Bairro_Cli Texto 
Compl_Cli Texto 
Cidade_Cli Texto 
Cep_Cli Número 
Estado_Cli Texto 
DataNasc_Cli Data/Hora 
Sexo_Cli Texto 
Cpf_Cli Número 
Fone1_Cli Número 
Fone2_Cli Número 
Ramal_Cli Número 
Renda_Cli Número 
Email_Cli Texto 
 
� Compras 
Nome do Campo Tipo de dados 
Cod_Compra Número 
Nf_Compra Número 
CodPro_Compra Número 
Qtd_Compra Número 
CodFor_Compra Número 
Data_Compra Data/Hora 
 
 9 
� Fornecedores 
Nome do Campo Tipo de dados 
Cod_For Número 
Razao_ForTexto 
NomeFantasia_For Texto 
Logradouro_For Texto 
Endereco_For Texto 
Cidade_For Texto 
Bairro_For Texto 
Estado_For Texto 
Cep_For Número 
Compl_For Texto 
Fone1_For Número 
Fone2_For Número 
Ramal_For Número 
Fax_For Número 
Email_For Texto 
Repre_For Texto 
InscEstadual_For Número 
Cnpj_For Número 
 
� Funcionarios 
Nome do Campo Tipo de dados 
Cod_Fun Número 
Nome_Fun Texto 
Endereco_Fun Texto 
Logradouro_Fun Texto 
Bairro_Fun Texto 
Cidade_Fun Texto 
Compl_Fun Texto 
Cep_Fun Número 
Estado_Fun Texto 
Rg_Fun Número 
Cpf_Fun Número 
Sexo_Fun Texto 
DataNasc_Fun Data/Hora 
Fone1_Fun Número 
Fone2_Fun Número 
DataAdm_Fun Data/Hora 
EMail_Fun Texto 
Cargo_Fun Texto 
Fotografia_Fun Texto 
Nivel_Fun Texto 
Senha_Fun Texto 
 
 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. 
 13 
Public cnLoja As New ADODB.Connection 
Private rsLogon As New ADODB.Recordset 
Public Vnome As String 
 
Private Sub cmdCancelar_Click() 
End 
End Sub 
 
Private Sub cmdConfirmar_Click() 
Dim Vnivel, Vsenha As String 
 
If txtUsuario.Text = Empty Then 
 MsgBox "Digite o nome do Usuário!", vbOKOnly + vbInformation, "Aviso" 
 txtUsuario.SetFocus 
 Exit Sub 
End If 
 
If txtSenha.Text = Empty Then 
 MsgBox "Digite a Senha!", vbOKOnly + vbInformation, "Aviso" 
 txtSenha.SetFocus 
 Exit Sub 
End If 
 
Vnome = Chr(39) & txtUsuario.Text & Chr(39) 
Vsenha = Chr(39) & txtSenha.Text & Chr(39) 
rsLogon.Open "Select * from User_Sistema where Usuario_Sist=" & Vnome & "and 
Senha_Sist=" & Vsenha, cnLoja, adOpenKeyset, adLockOptimistic, adCmdText 
 
If rsLogon.RecordCount = 0 Then 
 MsgBox "Usuário ou Senha Inválida!", vbOKOnly + vbInformation, "Aviso" 
 txtUsuario.Text = "" 
 txtSenha.Text = "" 
 txtUsuario.SetFocus 
 rsLogon.Close 
 14 
 Exit Sub 
Else 
 frmSplashPrincipal.Show 
 Vnivel = rsLogon("Nivel_Sist") 
 Vnome = rsLogon("Usuario_Sist") 
 mdiPrincipal.stbMostra.Panels(1).Text = "Operador: " & Vnome 
 If Vnivel = "B" Then 
 With mdiPrincipal 
 .Gerenciar.Visible = False 
 End With 
 End If 
 
 If Vnivel = "C" Then 
 With mdiPrincipal 
 .Gerenciar.Visible = False 
 .Cadastro.Visible = False 
 End With 
 End If 
 
 Unload Me 
End If 
End Sub 
 
Private Sub Form_Load() 
cnLoja.ConnectionString = "Provider=microsoft.jet.oledb.4.0" 
cnLoja.Open "D:\MARCELO\Projeto VB Final2\Loja.mdb" 
 
lblData.Caption = Date 
lblHora.Caption = Time 
End Sub 
 
Private Sub Form_Unload(Cancel As Integer) 
If rsLogon.State = 1 Then 
 rsLogon.Close 
 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 
 
 18 
Private Sub AlterarSenha_Click() 
frmAlterarSenha.Show 
frmAlterarSenha.Left = 5000 
frmAlterarSenha.Top = 2000 
End Sub 
 
Private Sub CadClientes_Click() 
frmCadClientes.Show 
frmCadClientes.Left = 3000 
frmCadClientes.Top = 800 
End Sub 
 
Private Sub CadCompras_Click() 
frmCadCompras.Show 
frmCadCompras.Left = 3000 
frmCadCompras.Top = 1500 
End Sub 
 
Private Sub CadFornecedores_Click() 
frmCadFornecedores.Show 
frmCadFornecedores.Left = 2500 
frmCadFornecedores.Top = 50 
End Sub 
 
Private Sub CadFuncionarios_Click() 
frmCadFuncionarios.Show 
frmCadFuncionarios.Left = 2000 
frmCadFuncionarios.Top = 200 
End Sub 
 
Private Sub CadProdutos_Click() 
frmCadProdutos.Show 
frmCadProdutos.Left = 2500 
frmCadProdutos.Top = 1500 
 19 
End Sub 
 
Private Sub CadUsuario_Click() 
frmUserSistema.Show 
frmUserSistema.Left = 4000 
frmUserSistema.Top = 2000End Sub 
 
Private Sub ConClientes_Click() 
frmConClientes.Show 
frmConClientes.Top = 2000 
frmConClientes.Left = 2000 
End Sub 
 
Private Sub ConCompras_Click() 
frmConCompras.Show 
frmConCompras.Top = 2000 
frmConCompras.Left = 2000 
End Sub 
 
Private Sub ConFornecedores_Click() 
frmConFornecedores.Show 
frmConFornecedores.Top = 2000 
frmConFornecedores.Left = 800 
End Sub 
 
Private Sub ConFuncionario_Click() 
frmConFuncionarios.Show 
frmConFuncionarios.Top = 2000 
frmConFuncionarios.Left = 2000 
End Sub 
 
Private Sub ConProdutos_Click() 
frmConProdutos.Show 
 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 
 23 
frmTelaVenda.Left = 1500 
frmTelaVenda.Top = 700 
End Sub 
 
Sub CentraImagem() 
 Picture1.Cls 
 Picture1.Visible = True 
 Picture1.AutoRedraw = True 
 Picture1.BackColor = &H8000000C 
 Picture1.Height = Me.Height 
 Image1.Stretch = False 
 Image1.Top = Picture1.Height / 2 - Image1.Height / 2 
 Image1.Left = Picture1.Width / 2 - Image1.Width / 2 
 Picture1.PaintPicture Image1, Image1.Left, Image1.Top, Image1.Width, 
Image1.Height 
 mdiPrincipal.Picture = Picture1.Image 
 Picture1.Visible = False 
End Sub 
 
Sub EstendeImagem() 
 Picture1.Cls 
 Picture1.Visible = True 
 Picture1.AutoRedraw = True 
 Picture1.BackColor = &H8000000C 
 Picture1.Height = Me.Height 
 Image1.Stretch = True 
 Image1.Top = 0 
 Image1.Left = 0 
 Image1.Height = Picture1.Height 
 Image1.Width = Picture1.Width 
 Picture1.PaintPicture Image1, Image1.Left, Image1.Top, Image1.Width, 
Image1.Height 
 mdiPrincipal.Picture = Picture1.Image 
 Picture1.Visible = False 
 24 
End Sub 
 
Sub NormalImagem() 
 Picture1.Visible = True 
 Image1.Stretch = False 
 mdiPrincipal.Picture = Image1.Picture 
 Picture1.Visible = False 
End Sub 
 
Sub LadoaLadoImagem() 
 Dim wid As Single 
 Dim hgt As Single 
 Dim x As Single 
 Dim y As Single 
 Picture1.Visible = True 
 Picture1.AutoRedraw = True 
 Picture1.Height = Me.Height 
 Image1.Stretch = False 
 wid = Image1.Width 
 hgt = Image1.Height 
 y = 0 
 Do While y < Picture1.ScaleHeight 
 x = 0 
 Do While x < Picture1.ScaleWidth 
 Picture1.PaintPicture Image1, x, y, wid, hgt 
 x = x + wid 
 Loop 
 y = y + hgt 
 Loop 
 Picture1.Visible = False 
 mdiPrincipal.Picture = Picture1.Image 
End Sub 
 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 
 28 
 cmdExcluir.Enabled = False 
 cmdAlterar.Enabled = False 
 cmdPrimeiro.Enabled = False 
 cmdAnterior.Enabled = FalsecmdProximo.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 
 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 
 
 rsCadClientes.Delete 
 
If rsCadClientes.RecordCount = 0 Then 
 LimpaRegistro 
 29 
 cmdExcluir.Enabled = False 
 cmdAlterar.Enabled = False 
 cmdPrimeiro.Enabled = False 
 cmdAnterior.Enabled = False 
 cmdProximo.Enabled = False 
 cmdUltimo.Enabled = False 
 Else 
 rsCadClientes.MoveNext 
 If rsCadClientes.EOF Then 
 rsCadClientes.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 
 
If txtEndereco.Text = "" Then 
 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}" 
 33 
End If 
End Sub 
 
Private Sub Form_Load() 
 
rsCadClientes.Open "Clientes", mdiPrincipal.cnBiblioteca, adOpenKeyset, 
adLockOptimistic, adCmdTable 
 
If rsCadClientes.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 
lblContador.Caption = "Clientes Cadastrados: " & rsCadClientes.RecordCount 
End Sub 
 
Private Sub Form_Unload(Cancel As Integer) 
rsCadClientes.Close 
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 
 
 
 34 
Private Sub txtEmail_KeyPress(KeyAscii As Integer) 
KeyAscii = Asc(LCase(Chr(KeyAscii))) 
End Sub 
 
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 
txtRamal.Enabled = False 
txtData.Enabled = False 
cmbSexo.Enabled = False 
txtRenda.Enabled = False 
txtEmail.Enabled = False 
txtCPF.Enabled = False 
txtComplemento.Enabled = False 
End Sub 
Private Sub MostraRegistro() 
If Not IsNull(rsCadClientes("Cod_Cli")) Then 
 txtCodigo.Text = Format(rsCadClientes("Cod_Cli"), "00000") 
Else 
 txtCodigo.Text = Empty 
End If 
 
If Not IsNull(rsCadClientes("Nome_Cli")) Then 
 txtNome.Text = rsCadClientes("Nome_Cli") 
Else 
 txtNome.Text = Empty 
End If 
 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 
 38 
txtRamal.Enabled = True 
txtData.Enabled = True 
cmbSexo.Enabled = True 
txtRenda.Enabled = True 
txtEmail.Enabled = True 
txtCPF.Enabled = True 
txtComplemento.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 = "" 
txtFone2.Text = "" 
txtRamal.Text = "" 
txtData.Text = "" 
cmbSexo.Text = "" 
txtRenda.Text = "" 
txtEmail.Text = "" 
txtCPF.Text = "" 
txtComplemento.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))) 
 39 
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 
 
Private Sub txtNome_KeyPress(KeyAscii As Integer) 
KeyAscii = Asc(UCase(Chr(KeyAscii))) 
If InStr("0123456789<>|\;,.?/[{}]+=§-_)(*&%$#@!*", Chr(KeyAscii)) <> 0 Then 
 KeyAscii = 0 
End If 
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 txtRenda_KeyPress(KeyAscii As Integer) 
If (KeyAscii < Asc("0") Or KeyAscii > Asc("9") And KeyAscii <> 8) Then 
 KeyAscii = 0 
End If 
 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() 
 43 
Unload Me 
End Sub 
 
Private Sub cmdGravar_Click() 
If txtNF.Text = "" Then 
 MsgBox "O Nº da Nota Fiscal é obrigatório!", vbOKOnly + vbInformation, "Aviso" 
 txtNF.SetFocus 
 Exit Sub 
End If 
 
If txtCodPro.Text = "" Then 
 MsgBox "O Código do Produto é obrigatório!", vbOKOnly + vbInformation, "Aviso" 
 txtCodPro.SetFocus 
 Exit Sub 
End If 
 
If txtQtd.Text = "" Then 
 MsgBox "A Quantidade é obrigatório!", vbOKOnly + vbInformation, "Aviso" 
 txtQtd.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 
 
rsCadCompras("Cod_Compra") = txtCodigo.Text 
rsCadCompras("Nf_Compra") = txtNF.Text 
rsCadCompras("CodPro_Compra") = txtCodPro.Text 
rsCadCompras("Qtd_Compra") = txtQtd.Text 
rsCadCompras("CodFor_Compra") = txtCodFor.Text 
 44 
rsCadCompras("Data_Compra") = txtData.Text 
 
rsCadCompras.Update 
DesabilitaCampos 
MsgBox "Dados da Compra 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 rsCadCompras.RecordCount = 0 Then 
 rsCadCompras.AddNew 
 Vcodigo = 1 
 txtCodigo.Text = Format(Vcodigo, "00000") 
Else 
 rsCadCompras.MoveLast 
 Vcodigo = rsCadCompras("Cod_Compra") 
 Vcodigo = Vcodigo + 1 
 rsCadCompras.AddNew 
 LimpaRegistro 
 txtCodigo.Text = Format(Vcodigo, "00000") 
End If 
 
 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") 
 48 
Else 
txtData.Text = Empty 
End If 
 
End Sub 
Private Sub HabilitaCampos() 
txtNF.Enabled = True 
txtCodPro.Enabled = True 
txtQtd.Enabled = True 
txtCodFor.Enabled = True 
txtData.Enabled = True 
End Sub 
Private Sub LimpaRegistro() 
txtCodigo.Text = "" 
txtNF.Text = "" 
txtCodPro.Text = "" 
txtQtd.Text = "" 
txtCodFor.Text = "" 
txtData.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 txtCodPro_KeyPress(KeyAscii As Integer) 
If (KeyAscii < Asc("0") Or KeyAscii > Asc("9") And KeyAscii <> 8) Then 
 KeyAscii = 0 
End If 
End Sub 
 
Private Sub txtNF_KeyPress(KeyAscii As Integer) 
 49 
If (KeyAscii < Asc("0") Or KeyAscii > Asc("9") And KeyAscii <> 8) Then 
 KeyAscii = 0 
End If 
 
End Sub 
 
Private Sub txtQtd_KeyPress(KeyAscii As Integer) 
If (KeyAscii < Asc("0") Or KeyAscii > Asc("9") And KeyAscii <> 8) Then 
 KeyAscii = 0 
End If 
End Sub 
 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 
 53 
 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 
 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 
 
 rsCadFornecedores.Delete 
 
If rsCadFornecedores.RecordCount = 0 Then 
 LimpaRegistro 
 cmdExcluir.Enabled = False 
 cmdAlterar.Enabled = False 
 cmdPrimeiro.Enabled = False 
 cmdAnterior.Enabled = False 
 54 
 cmdProximo.Enabled = False 
 cmdUltimo.Enabled = False 
 Else 
 rsCadFornecedores.MoveNext 
 If rsCadFornecedores.EOF Then 
 rsCadFornecedores.MoveLast 
 End If 
 MostraRegistro 
 End If 
End If 
End Sub 
 
Private Sub cmdFechar_Click() 
Unload Me 
End Sub 
 
Private Sub cmdGravar_Click() 
If txtRazao.Text = "" Then 
 MsgBox "A RAZÃO SOCIAL é obrigatória!", vbOKOnly + vbInformation, "Aviso" 
 txtRazao.SetFocus 
 Exit Sub 
End If 
 
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 
 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.TextrsCadFornecedores("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 
 58 
 
Private Sub Form_KeyPress(KeyAscii As Integer) 
If KeyAscii = 13 Then 
 SendKeys "{tab}" 
End If 
End Sub 
 
Private Sub Form_Load() 
rsCadFornecedores.Open "Fornecedores", mdiPrincipal.cnBiblioteca, adOpenKeyset, 
adLockOptimistic, adCmdTable 
 
If rsCadFornecedores.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) 
rsCadFornecedores.Close 
End Sub 
 
Private Sub txtCNPJ_KeyPress(KeyAscii As Integer) 
If (KeyAscii < Asc("0") Or KeyAscii > Asc("9") And KeyAscii <> 8) Then 
 KeyAscii = 0 
End If 
End Sub 
 59 
 
Private Sub txtEmail_KeyPress(KeyAscii As Integer) 
KeyAscii = Asc(LCase(Chr(KeyAscii))) 
End Sub 
 
Private Sub DesabilitaCampos() 
txtRazao.Enabled = False 
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 
txtRamal.Enabled = False 
txtFax.Enabled = False 
txtRepresentante.Enabled = False 
txtInsc.Enabled = False 
txtEmail.Enabled = False 
txtCNPJ.Enabled = False 
txtComplemento.Enabled = False 
End Sub 
Private Sub MostraRegistro() 
If Not IsNull(rsCadFornecedores("Cod_For")) Then 
 txtCodigo.Text = Format(rsCadFornecedores("Cod_For"), "00000") 
Else 
 txtCodigo.Text = Empty 
End If 
 
If Not IsNull(rsCadFornecedores("Razao_For")) Then 
 txtRazao.Text = rsCadFornecedores("Razao_For") 
Else 
 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 
 63 
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 
txtRamal.Enabled = True 
txtFax.Enabled = True 
txtRepresentante.Enabled = True 
txtInsc.Enabled = True 
txtEmail.Enabled = True 
txtCNPJ.Enabled = True 
txtComplemento.Enabled = True 
End Sub 
Private Sub LimpaRegistro() 
txtCodigo.Text = "" 
txtRazao.Text = "" 
txtNome.Text = "" 
cmbLogradouro.Text = "" 
txtCEP.Text = "" 
txtEndereco.Text = "" 
txtBairro.Text = "" 
txtCidade.Text = "" 
txtEstado.Text = "" 
txtFone1.Text = "" 
txtFone2.Text = "" 
txtRamal.Text = "" 
txtFax.Text = "" 
txtRepresentante.Text = "" 
txtInsc.Text = "" 
txtEmail.Text = "" 
 64 
txtCNPJ.Text = "" 
txtComplemento.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 
 
Private Sub txtInsc_KeyPress(KeyAscii As Integer) 
If (KeyAscii < Asc("0") Or KeyAscii > Asc("9") And KeyAscii <> 8) Then 
 KeyAscii = 0 
End If 
End Sub 
 
 
 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 
 68 
 
Private Sub cmbSexo_KeyPress(KeyAscii As Integer) 
 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 
cmdIncluirFoto.Visible = True 
End Sub 
 
Private Sub cmdAnterior_Click() 
rsCadFuncionarios.MovePrevious 
If rsCadFuncionarios.BOF Then 
 rsCadFuncionarios.MoveFirst 
End If 
MostraRegistro 
End Sub 
 
Private Sub cmdCancelar_Click() 
rsCadFuncionarios.CancelUpdate 
 If rsCadFuncionarios.RecordCount = 0 Then 
 LimpaRegistro 
 69 
 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 
 cmdIncluirFoto.Visible = False 
 Else 
 MostraRegistro 
 cmdGravar.Enabled = False 
 cmdCancelar.Enabled = False 
 cmdIncluir.Enabled = True 
 cmdFechar.Enabled = True 
 cmdPrimeiro.Enabled = True 
 cmdAnterior.Enabled = True 
 cmdProximo.Enabled = True 
 cmdUltimo.Enabled = True 
 cmdAlterar.Enabled = True 
 cmdExcluir.Enabled = True 
 cmdIncluirFoto.Visible = False 
 End If 
DesabilitaCampos 
End Sub 
 
Private Sub cmdExcluir_Click() 
If MsgBox("Deseja excluir o cadastro?", vbYesNo + vbQuestion, "Atenção") = vbYes 
Then 
 
 rsCadFuncionarios.Delete 
 
 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 
 73 
 Vcodigo= rsCadFuncionarios("Cod_Fun") 
 Vcodigo = Vcodigo + 1 
 rsCadFuncionarios.AddNew 
 LimpaRegistro 
 txtCodigo.Text = Format(Vcodigo, "00000") 
End If 
 
HabilitaCampos 
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 
cmdIncluirFoto.Visible = True 
imgFoto.Picture = LoadPicture("") 
End Sub 
 
Private Sub cmdIncluirFoto_Click() 
Dim Vfiltro As String 
 
Foto = "" 
Vfiltro = "Arquivos BMP (*.BMP) (*.bmp) Todos Arquivos /*.*" 
CommonDialog1.Filter = Vfiltro 
CommonDialog1.DefaultExt = "BMP" 
CommonDialog1.ShowOpen 
Foto = CommonDialog1.FileName 
 
 If Not Foto = Empty Then 
 74 
 imgFoto.Picture = LoadPicture(Foto) 
 Else 
 imgFoto.Picture = LoadPicture("") 
 End If 
End Sub 
 
Private Sub cmdPrimeiro_Click() 
rsCadFuncionarios.MoveFirst 
MostraRegistro 
End Sub 
 
Private Sub cmdProximo_Click() 
rsCadFuncionarios.MoveNext 
If rsCadFuncionarios.EOF Then 
 rsCadFuncionarios.MoveLast 
End If 
MostraRegistro 
End Sub 
 
Private Sub cmdUltimo_Click() 
rsCadFuncionarios.MoveLast 
MostraRegistro 
End Sub 
 
Private Sub Form_KeyPress(KeyAscii As Integer) 
If KeyAscii = 13 Then 
 SendKeys "{tab}" 
End If 
End Sub 
 
Private Sub Form_Load() 
rsCadFuncionarios.Open "Funcionarios", mdiPrincipal.cnBiblioteca, adOpenKeyset, 
adLockOptimistic, adCmdTable 
 
 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 
 78 
txtCEP.Text = rsCadFuncionarios("Cep_Fun") 
Else 
txtCEP.Text = Empty 
End If 
 
If Not IsNull(rsCadFuncionarios("Estado_Fun")) Then 
txtEstado.Text = rsCadFuncionarios("Estado_Fun") 
Else 
txtEstado.Text = Empty 
End If 
 
If Not IsNull(rsCadFuncionarios("DataNasc_Fun")) Then 
txtDataNasc.Text = rsCadFuncionarios("DataNasc_Fun") 
Else 
txtDataNasc.Text = Empty 
End If 
 
If Not IsNull(rsCadFuncionarios("Sexo_Fun")) Then 
cmbSexo.Text = rsCadFuncionarios("Sexo_Fun") 
Else 
cmbSexo.Text = Empty 
End If 
 
If Not IsNull(rsCadFuncionarios("Cpf_Fun")) Then 
txtCPF.Text = rsCadFuncionarios("Cpf_Fun") 
Else 
txtCPF.Text = Empty 
End If 
 
If Not IsNull(rsCadFuncionarios("Fone1_Fun")) Then 
 txtFone1.Text = rsCadFuncionarios("Fone1_Fun") 
Else 
 txtFone1.Text = Empty 
End If 
 79 
 
If Not IsNull(rsCadFuncionarios("Fone2_Fun")) Then 
 txtFone2.Text = rsCadFuncionarios("Fone2_Fun") 
Else 
 txtFone2.Text = Empty 
End If 
 
If Not IsNull(rsCadFuncionarios("Rg_Fun")) Then 
 txtRG.Text = rsCadFuncionarios("Rg_Fun") 
Else 
 txtRG.Text = Empty 
End If 
 
If Not IsNull(rsCadFuncionarios("DataAdm_Fun")) Then 
 txtDataAdm.Text = rsCadFuncionarios("DataAdm_Fun") 
Else 
 txtDataAdm.Text = Empty 
End If 
 
If Not IsNull(rsCadFuncionarios("Email_Fun")) Then 
 txtEmail.Text = rsCadFuncionarios("Email_Fun") 
Else 
 txtEmail.Text = Empty 
End If 
 
If Not IsNull(rsCadFuncionarios("Cargo_Fun")) Then 
 txtCargo.Text = rsCadFuncionarios("Cargo_Fun") 
Else 
 txtCargo.Text = Empty 
End If 
 
If Not IsNull(rsCadFuncionarios("Fotografia_Fun")) Then 
 NomeFoto = rsCadFuncionarios("Fotografia_Fun") 
 imgFoto.Picture = LoadPicture(NomeFoto) 
 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 SubPrivate 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 
 83 
cmdAnterior.Enabled = False 
cmdProximo.Enabled = False 
cmdUltimo.Enabled = False 
End Sub 
 
Private Sub cmdAnterior_Click() 
rsCadProdutos.MovePrevious 
If rsCadProdutos.BOF Then 
 rsCadProdutos.MoveFirst 
End If 
MostraRegistro 
End Sub 
 
Private Sub cmdCancelar_Click() 
rsCadProdutos.CancelUpdate 
 If rsCadProdutos.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 
 84 
 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 
 
 rsCadProdutos.Delete 
 
If rsCadProdutos.RecordCount = 0 Then 
 LimpaRegistro 
 cmdExcluir.Enabled = False 
 cmdAlterar.Enabled = False 
 cmdPrimeiro.Enabled = False 
 cmdAnterior.Enabled = False 
 cmdProximo.Enabled = False 
 cmdUltimo.Enabled = False 
 Else 
 rsCadProdutos.MoveNext 
 If rsCadProdutos.EOF Then 
 rsCadProdutos.MoveLast 
 End If 
 MostraRegistro 
 End If 
End If 
End Sub 
 
Private Sub cmdFechar_Click() 
 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 
 88 
 SendKeys "{tab}" 
End If 
End Sub 
 
Private Sub Form_Load() 
rsCadProdutos.Open "Produtos", mdiPrincipal.cnBiblioteca, adOpenKeyset, 
adLockOptimistic, adCmdTable 
 
If rsCadProdutos.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) 
rsCadProdutos.Close 
End Sub 
 
Private Sub DesabilitaCampos() 
txtNome.Enabled = False 
txtDescricao.Enabled = False 
txtValor.Enabled = False 
txtCodFor.Enabled = False 
End Sub 
Private Sub MostraRegistro() 
If Not IsNull(rsCadProdutos("Cod_Pro")) Then 
 89 
 txtCodigo.Text = Format(rsCadProdutos("Cod_Pro"), "00000") 
Else 
 txtCodigo.Text = Empty 
End If 
 
If Not IsNull(rsCadProdutos("Nome_Pro")) Then 
 txtNome.Text = rsCadProdutos("Nome_Pro") 
Else 
 txtNome.Text = Empty 
End If 
 
If Not IsNull(rsCadProdutos("Desc_Pro")) Then 
txtDescricao.Text = rsCadProdutos("Desc_Pro") 
Else 
txtDescricao.Text = Empty 
End If 
 
 
If Not IsNull(rsCadProdutos("Valor_Pro")) Then 
txtValor.Text = Format(rsCadProdutos("Valor_Pro"), "currency") 
Else 
txtValor.Text = Empty 
End If 
 
If Not IsNull(rsCadProdutos("CodFor_Pro")) Then 
txtCodFor.Text = rsCadProdutos("CodFor_Pro") 
Else 
txtCodFor.Text = Empty 
End If 
 
End Sub 
Private Sub HabilitaCampos() 
txtNome.Enabled = True 
txtDescricao.Enabled = True 
 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