CADASTRO DE ALUNOS COM FOTO
Galera alguém tem algum projeto de cadastro de alunos com foto, procurei no vb mania mais não encontrei se tiver me mandem por favor rafael.dyas@gmail.com
valeu mesmo!!!
valeu mesmo!!!
Olha, só é vc gravar o caminho da foto no banco de dados.
pra carregar é só fazer assim
Picture1.Picture = LoadPicture(Rst("CaminhoFoto"))
pra carregar é só fazer assim
Picture1.Picture = LoadPicture(Rst("CaminhoFoto"))
rafel eu tenho , se quiser me adicionar no seu messeger, pode conversar ok.
da uma olhada Aqui
Suponhamos o seguinte:
TABELA:FotosCliente
CAMPOS:
CLIENTE INT
FOTO IMAGE
Use o seguinte:
ESPERO TER AJUDADO
TABELA:FotosCliente
CAMPOS:
CLIENTE INT
FOTO IMAGE
Use o seguinte:
Private Sub GravaFoto()
'INICIALIZA
Dim Qd As rdoQuery
Dim Rs As rdoResultset
Dim FileName As String
Dim DataFile As Integer, Fl As Long, Chunks As Integer
Dim Fragment As Integer, Chunk() As Byte, i As Integer
Dim sSql As String
sSql = ""
sSql = sSql & "SELECT "
sSql = sSql & " CLIENTE, "
sSql = sSql & " FOTO "
sSql = sSql & "FROM "
sSql = sSql & " FOTOSCLIENTE "
sSql = sSql & "WHERE "
sSql = sSql & " CLIENTE = " & txtCliente.Text
Set Qd = Banco.CreateQuery("FotosCliente", sSql)
'GRAVA FOTO
Set Rs = Qd.OpenResultset(rdOpenKeyset, _
rdConcurRowVer)
If Rs Is Nothing Or Rs.Updatable = False Then
ResetAmpulheta
Rs.Close
Set Qd = Nothing
MsgBox "Nao foi possivel gravar a foto do cliente!", vbCritical
Exit Sub
End If
If Rs.EOF Then
Rs.AddNew
Rs!Cliente = txtCliente.Text
Else
Rs.Edit
End If
DataFile = 1
Open FileName For Binary Access Read As DataFile
Fl = lOF(DataFile) ' Tamanho dos dados dentro do arquivo
If Fl = 0 Then Close DataFile: Exit Sub
Chunks = Fl ChunkSize
Fragment = Fl Mod ChunkSize
Rs!FOTO.AppendChunk Null
ReDim Chunk(Fragment)
Get DataFile, , Chunk()
Rs!FOTO.AppendChunk Chunk()
ReDim Chunk(ChunkSize)
For i = 1 To Chunks
Get DataFile, , Chunk()
Rs!FOTO.AppendChunk Chunk()
Next i
Close DataFile
Rs.Update
Rs.Close
Rem MsgBox "Foto gravada com sucesso!", vbExclamation
Set Qd = Nothing
end Sub
private sub CarregaFoto()
'INICIALIZA
Dim Qd As rdoQuery
Dim Rs As rdoResultset
Dim FileName As String
Dim DataFile As Integer, Fl As Long, Chunks As Integer
Dim Fragment As Integer, Chunk() As Byte, i As Integer
Dim sSql As String
Set Rs = Qd.OpenResultset(rdOpenKeyset, rdConcurRowVer)
If Rs Is Nothing Or Rs.Updatable = False Then
ResetAmpulheta
MsgBox "Nao foi possivel exibir a foto do cliente!", vbCritical
Rs.Close: Qd.Close
Set Qd = Nothing
Exit Sub
End If
If Rs.EOF Then
ResetAmpulheta
cmdLimparFoto_Click
Rem MsgBox "Nao existe nenhuma foto armazenada!", vbExclamation
Rs.Close: Qd.Close
Set Qd = Nothing
Exit Sub
End If
DataFile = 1
Kill App.Path & "\pictemp.tif" 'Deleta arquivo temporario de foto
Open App.Path & "\pictemp.tif" For Binary Access Write As DataFile
Fl = Rs!FOTO.ColumnSize
Chunks = Fl ChunkSize
Fragment = Fl Mod ChunkSize
ReDim Chunk(Fragment)
Chunk() = Rs!FOTO.GetChunk(Fragment)
Put DataFile, , Chunk()
For i = 1 To Chunks
ReDim Buffer(ChunkSize)
Chunk() = Rs!FOTO.GetChunk(ChunkSize)
Put DataFile, , Chunk()
Next i
Close DataFile
Rs.Close: Qd.Close
Set Qd = Nothing
FileName = App.Path & "\pictemp.tif"
If FileName = "" Then Exit Sub
Dim P As Single
Dim F As IPictureDisp
Set F = LoadPicture(FileName)
P = picFoto.Width / F.Width
If Int(F.Width * P) > picFoto.Width Then
P = picFoto.Height / F.Height
End If
If Int(F.Height * P) > picFoto.Height Then
P = picFoto.Height / F.Height
End If
picFoto.Cls
picFoto.PaintPicture F, 0, 0, F.Width * P, F.Height * P
end Sub
ESPERO TER AJUDADO
Tópico encerrado , respostas não são mais permitidas