ajuda para dimensionar corretamente foto capturada da webcam

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

Sobre o problema 2
usandoaccess.com.br/dicas/foco-formulario-continuo-access.asp

Ivan,

Engraçado que eu já tinha visto essa dica, tinha tentado de várias maneiras, sem sucesso. Mas sua resposta me fez revisar os códigos que eu estava tentando e vi que estava usando de maneira incorreta. Executei as correções, e código citado ficou assim, ao clicar no botão "CAPTURAR":

Me.Requery

Dim rs
rs = Forms![CADASTRO DE CLIENTE].Bookmark
Forms![CADASTRO DE CLIENTE].Requery
Forms![CADASTRO DE CLIENTE].Bookmark = rs

Mágica! Funcionou perfeitamente!!!

Mas aí vi que qdo eu começo a fazer alterações no cadastro de certo cliente e depois clico no botão para chamar o formulário WEBCAM, acontece que qdo tiro a foto (que agora atualiza certinho no formulário de clientes) e clico no botão fechar (do formulário WEBCAM), aparece uma mensagem de conflito de gravação (informando que os dados já estavam sendo modificados por outro usuário anteriormente. E de fato era mesmo, já que eu havia modificado informações nesse cadastro antes de chamar a Webcam).

Mas aí contornei esse problema criando a rotina de "salvar os dados do formulário de cadastro de clientes ao clicar no botão que chama o formulário WEBCAM", assim, ao abrir o formulário WEBCAM, os dados anteriormente modificados desse clientes são salvos, evitando o risco de perdê-los, e o formulário WEBCAM trabalha sem haver alterações anteriores não salvas, evitando assim a mensagem. O código utilizado foi o mesmo do botão SALVAR: DoCmd.RunCommand acCmdSaveRecord

Ivan. Muito obrigado pela força!!!

Ivan,

Analisando melhor, percebi que não há necessidade de requery no meu formulário de cadastro de cliente. Percebi que se eu usar sua dica, acontece aquele pequeno delay, onde a gente percebe o formulário voltando para o primeiro registro e depois retornando para o atual.

Vou mostrar o código completo do botão capturar:

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))

Forms![CADASTRO DE CLIENTE].[IMG_FOTO].Picture = strImagens 'AQUI ESTÁ O SEGREDO DE ATUALIZAR A FOTO S/ USAR O REQUERY NO FORMULÁRIO

     
'actualiza dados form
Me.CAMINHO_FOTO = Mid(strImagens, InStrRev(strImagens, "\") + 1)


Me.Cmd4.Enabled = False
Me.Cmd5.Enabled = True
Me.LUZ.BackColor = RGB(200, 200, 200)

End Sub






Continuo com problema 1) sem solução. Caso alguém possa ajudar, agradeceria muito!

Creio que a solução esteja em editar a imagem capturada antes de salvá-la na pasta do projeto.

Alguém poderia me dizer o código para recortar essa imagem de 640X480 e deixá-la no tamanho escolhido sem alterar a proporção?

Praticamente resolvi o que precisava!!!

Preciso apenas que a webcam ao ser ativada, inicie já em 160x120. Não quero usar o botão para mudar isso, pois dá muito trabalho ter que acionar esse botão (de configurações de vídeo da webcam) toda vez que eu for capturar uma foto.


Aguardo a dica de algum amigo!!!

Boa tarde, Orlando.

Vc colocou nesse seu código uma rotina de erro pra uma mensagem caso não exista webcam instalada?

Obrigado.