Prezados amigos,
Tenho um sistema desenvolvido em access para cadastro de clientes. Recentemente implementei o recurso para captura de foto do cliente pela webcam. Funciona assim: no "formulário de cadastro de cliente" existem todas as informações do cliente e um controle tipo "imagem" nas dimensões aprox. de 2,5 x 3 cm, para exibição da foto, com um botão embaixo que chama outro formulário denominado "Webcam".
O formulário "Webcam" contém um campo tipo subformulário (que tem como objeto de origem outro formulário) para exibição da imagem gerada pela webcam, e possui as dimensões 3x o tamanho do controle de 2,5 x 3 cm. Além dos botões de ligar e desligar a webcam,..., e capturar.
Meus problemas são 2:
1) Com o formulário "Webcam" com a câmera ativa, a imagem foca o rosto do cliente direitinho. Porém, quando clico no botão capturar, a imagem capturada, que é salva numa pasta do projeto, é bem maior do que a delimitada pelo subformulário, assim, essa imagem é exibida no formulário de cadastro de cliente totalmente fora do esperado. Vejam as fotos acima!
A solução para este problema, creio que está em descobrir uma forma de tirar um print sreen do subformulário, diminuir a resolução dessa imagem em 3x e exibir no campo 2,5 x 3 cm do formulário de cadastro de cliente. Mas não sei como fazer.
2) Ao clicar no botão "capturar" consegui fazer a imagem ser atualizada no BD, no entanto não consegui que ela fosse atualizada no campo 2,5 x 3 cm do formulário de cadastro de cliente. Até consigo, usando o cmdo Requery, mas o formulário vai para o primeiro registro e eu gostaria que ficasse no registro atual.
Lembrando que não entendo muito de programação, sou apenas um amador.
Se alguém puder ajudar, fico extremamente agradecido.
Seguem os códigos utilizados no formulário "Webcam":
Option Compare Database
Option Explicit
Const WS_CHILD As Long = &H40000000
Const WS_VISIBLE As Long = &H10000000
Const WM_USER As Long = &H400
Const WM_CAP_START As Long = WM_USER
Const WM_CAP_DRIVER_CONNECT As Long = WM_CAP_START + 10
Const WM_CAP_DRIVER_DISCONNECT As Long = WM_CAP_START + 11
Const WM_CAP_SET_PREVIEW As Long = WM_CAP_START + 50
Const WM_CAP_SET_PREVIEWRATE As Long = WM_CAP_START + 52
Const WM_CAP_FILE_SAVEDIB As Long = WM_CAP_START + 25
Const WM_CAP_GRAB_FRAME As Long = WM_CAP_START + 60
Const WM_CAP_EDIT_COPY As Long = WM_CAP_START + 10
Const WM_CAP_DLG_VIDEOSOURCE As Long = WM_CAP_START + 42
Const WM_CAP_STOP As Long = WM_CAP_START + 68
Const WM_CAP_SEQUENCE As Long = WM_CAP_START + 62
Const WM_CAP_FILE_SET_CAPTURE_FILEA As Long = WM_CAP_START + 20
Const WM_CAP_SEQUENCE_NOFILE As Long = WM_CAP_START + 63
Const WM_CAP_SET_OVERLAY As Long = WM_CAP_START + 51
Const WM_CAP_SET_CALLBACK_STATUSA As Long = WM_CAP_START + 3
Const WM_CAP_SET_CALLBACK_FRAME As Long = WM_CAP_START + 5
Const WM_CAP_SET_SCALE As Long = WM_CAP_START + 53
Private Declare PtrSafe Function capCreateCaptureWindowA _
Lib "avicap32.dll" _
(ByVal lpszWindowName As String, ByVal dwStyle As Long _
, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long _
, ByVal nHeight As Long, ByVal hWndParent As LongPtr _
, ByVal nID As Long) As Long
Private Declare PtrSafe Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long _
, ByVal wParam As Long, ByRef lParam As Any) As Long
Dim hCap As LongPtr
Function GetSavePath() As String
Dim f As Object 'FileDialog
Set f = Application.FileDialog(2) 'msoFileDialogSaveAs
If f.Show <> 0 Then GetSavePath = f.SelectedItems(1)
End Function
Private Sub BTfechar_Click()
DoCmd.Close
End Sub
Private Sub Cmd1_Click()
hCap = capCreateCaptureWindowA("", WS_CHILD Or WS_VISIBLE, -40, -8, 320, 240, PicWebCam.Form.hwnd, 0)
If hCap <> 0 Then
Call SendMessage(hCap, WM_CAP_DRIVER_CONNECT, 0, 0)
Call SendMessage(hCap, WM_CAP_SET_SCALE, True, 0)
Call SendMessage(hCap, WM_CAP_SET_PREVIEWRATE, 66, 0&)
Call SendMessage(hCap, WM_CAP_SET_PREVIEWRATE, 30, 0)
Call SendMessage(hCap, WM_CAP_SET_PREVIEW, 1, 0)
Me.Cmd1.Enabled = False
Me.Cmd2.Enabled = True
Me.Cmd3.Enabled = True
Me.Cmd4.Enabled = True
Me.LUZ.BackColor = RGB(34, 177, 76)
End If
End Sub
Private Sub Cmd2_Click()
Dim temp As Long
temp = SendMessage(hCap, WM_CAP_DRIVER_DISCONNECT, 0&, 0&)
Me.Cmd1.Enabled = True
Me.Cmd2.Enabled = False
Me.Cmd3.Enabled = False
Me.Cmd4.Enabled = False
Me.Cmd5.Enabled = False
Me.LUZ.BackColor = RGB(237, 28, 36)
End Sub
Private Sub Cmd3_Click()
Dim temp As Long
temp = SendMessage(hCap, WM_CAP_DLG_VIDEOSOURCE, 0&, 0&)
End Sub
Private Sub Cmd4_Click()
Dim sFileName, strImagens As String
sFileName = Me.Nº_DO_RE_CBM & ".jpg"
Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(False), 0&)
strImagens = Application.CurrentProject.Path & "\FOTO\" & Me.Nº_DO_RE_CBM & ".jpg"
Call SendMessage(hCap, WM_CAP_FILE_SAVEDIB, 0&, ByVal CStr(strImagens))
Me.Cmd4.Enabled = False
Me.Cmd5.Enabled = True
Me.LUZ.BackColor = RGB(200, 200, 200)
End Sub
Private Sub Cmd5_Click()
Dim sFileName, strImagens As String
sFileName = Me.Nº_DO_RE_CBM & ".jpg"
'caminho destino e nome para copia de arquivo das imagens
strImagens = Application.CurrentProject.Path & "\FOTO\" & Me.Nº_DO_RE_CBM & ".jpg"
'apagar arquivo
Kill strImagens
'limpar caminho da foto
Me.CAMINHO_FOTO.Value = ""
Cmd2_Click
Cmd1_Click
End Sub
Private Sub Form_Load()
Me.Cmd3.Enabled = False
Me.Cmd4.Enabled = False
Me.Cmd5.Enabled = False
End Sub