SALVAR IMAGEM DO PICTUREBOX EM BANCO DE DADOS

Citação:

Dim pic As PictureBox
Dim zz1 As Variant
Dim zz2 As Variant
Dim BaseDeDados As Database
Dim Gastos As Recordset
Private Sub BtnAnterior_Click()
Gastos.MovePrevious
If Gastos.BOF = True Then
MsgBox [Ô]Você ja está no último registro![Ô], vbInformation, [Ô]Atenção[Ô]
Gastos.MoveNext
End If
AtualizaFormulário
End Sub
Private Sub btnincluir_Click()
txtData.Enabled = True
txtData.Text = [Ô][Ô]
cmdOK.Enabled = True
txtnumero.Enabled = True
txtnumero.Text = [Ô][Ô]
txtvalor.Enabled = True
txtvalor.Text = [Ô][Ô]
txtdata2.Enabled = True
txtdata2.Text = [Ô][Ô]
txtnomecliente.Enabled = True
txtnomecliente.Text = [Ô][Ô]
txtnomefunc.Enabled = True
txtnomefunc.Text = [Ô][Ô]
btnsalvar.Enabled = True
BtnProximo.Enabled = False
BtnAnterior.Enabled = False
btnlocalizar.Enabled = False
cmdexcluir.Enabled = True
btnincluir.Enabled = False
txtData.SetFocus
Gastos.AddNew
End Sub

Private Sub BtnProximo_Click()
Gastos.MoveNext
If Gastos.EOF = True Then
MsgBox [Ô]Você ja está no último registro![Ô], vbInformation, [Ô]Atenção[Ô]
Gastos.MovePrevious
End If
AtualizaFormulário
End Sub

Private Sub btnsalvar_Click()
txtData.Enabled = False
cmdOK.Enabled = False
txtnumero.Enabled = False
txtvalor.Enabled = False
txtdata2.Enabled = False
txtnomecliente.Enabled = False
txtnomefunc.Enabled = False
btnsalvar.Enabled = False
BtnProximo.Enabled = True
BtnAnterior.Enabled = True
btnlocalizar.Enabled = True
cmdexcluir.Enabled = True
btnincluir.Enabled = True
AtualizaCampos
Gastos.Update
Unload Me
Frm_SalvaGastos.Show
End Sub
Private Sub cmdexcluir_Click()
If MsgBox([Ô]Confirma Exclusão de Registro ?[Ô], vbYesNo) = vbYes Then
Gastos.Delete
BtnAnterior_Click
End If
End Sub
Private Sub cmdOK_Click()
GeraCodBar39 txtData, 20
End Sub
Private Sub Form_Load()
Set pic = PicBarCode
zz1 = Split([Ô]0,1,2,3,4,5,6,7,8,9,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,-,.,SP,$,/,+,%,*[Ô], [Ô],[Ô])
zz2 = Split([Ô]111221211,211211112,112211112,212211111,111221112,211221111,112221111,111211212,211211211, _112211211,211112112,112112112,212112111,111122112,211122111,112122111,111112212,211112211,112112211, _111122211,211111122,112111122,212111121,111121122,211121121,112121121,111111222,211111221,112111221, _111121221,221111112,122111112,222111111,121121112,221121111,122121111,121111212,221111211,122111211, _121212111,121211121,121112121,111212121,121121211[Ô], [Ô],[Ô])
GeraCodBar39 txtData, 20

Set BaseDeDados = OpenDatabase(App.Path & [Ô]\ControleGastos.MDB[Ô])
Set Gastos = BaseDeDados.OpenRecordset([Ô]Gastos[Ô], dbOpenTable)
Gastos.Index = [Ô]IndNota[Ô]

If Gastos.EOF = False Then
AtualizaFormulário
End If

End Sub

Private Sub Image1_Click()
Unload Me
FrmTelaInicial.Show
End Sub
Private Sub txtvalor_LostFocus()
txtvalor = Format(txtvalor.Text, [Ô]currency[Ô])
End Sub
Private Sub GeraCodBar39(X As String, Sclr As Integer)
Dim bc4(0 To 20) As String
Dim barchar As String
Dim barcolor As String
Dim bs As Single
Dim bwn As Single
Dim ac As Integer
Dim s As Integer
Dim bct As Integer
Dim bcl As Integer
ac = 1
pic.Cls
bc4(ac - 1) = [Ô]121121211[Ô]
For bct = 1 To Len(X)
barchar = Mid(X, bct, 1)
If barchar = [Ô] [Ô] Then barchar = [Ô]SP[Ô]
For s = 0 To UBound(zz1)
If UCase(barchar) = zz1(s) Then
bc4(ac) = zz2(s)
ac = ac + 1
Exit For
End If
Next s
Next bct
bc4(ac) = [Ô]121121211[Ô]
bs = 200
pic.DrawWidth = 1
For bct = 0 To ac
X = bc4(bct)
barcolor = vbBlack
For s = 1 To Len(X)
bwn = (Val(Mid(X, s, 1))) * Sclr
For bcl = 1 To bwn
pic.Line (bs + bcl, 100)-Step(0, 1200), barcolor
Next bcl
If barcolor = vbBlack Then barcolor = vbWhite Else barcolor = vbBlack
bs = bs + bwn
Next s
For bcl = 1 To Sclr
pic.Line (bs + bcl, 100)-Step(0, 1200), vbWhite
Next bcl
bs = bs + bcl
Next bct
pic.FontSize = 16: pic.CurrentX = 200: pic.CurrentY = 1400: pic.Print UCase(txtData)
End Sub

Private Function AtualizaCampos()
Gastos([Ô]caminho[Ô]) = txtData
Gastos([Ô]NumeroNota[Ô]) = txtnumero
Gastos([Ô]ValorNota[Ô]) = txtvalor
Gastos([Ô]Data[Ô]) = txtdata2
Gastos([Ô]NomeCliente[Ô]) = txtnomecliente
Gastos([Ô]NomeFuncionario[Ô]) = txtnomefunc
End Function

Private Function AtualizaFormulário()
txtData = Gastos([Ô]caminho[Ô])
txtnumero = Gastos([Ô]NumeroNota[Ô])
txtvalor = Gastos([Ô]ValorNota[Ô])
txtdata2 = Gastos([Ô]Data[Ô])
txtnomecliente = Gastos([Ô]NomeCliente[Ô])
txtnomefunc = Gastos([Ô]NomeFuncionario[Ô])
End Function