Olá pessoal…
Hoje irei mostrar como fazer uma integração no Protheus com WebCam, nativamente (sem uso de aplicações externas).
Primeiramente é necessário ter duas dlls (a escapi.dll e a imageload2.dll) dentro da pasta do smartclient, caso não tenha essas dll, basta fazer o download clicando abaixo (que também contém o código fonte utilizado):
Download do código fonte e dlls:
– Clique Aqui
Foi desenvolvido uma rotina, que através do mapeamento das unidades de webcam, é feita a integração com o Protheus, a função de usuário é a zPegaWeb(), e abaixo um print dela sendo utilizada no fórmulas do Protheus:
Tela principal da aplicação
A tela principal, mostra qual webcam será utilizada, e o caminho que será gerado a imagem (nome da imagem tem valor default como “IMAGEM WEB CAM”), para mostrar a imagem da WebCam, basta clicar em Abrir.
Abrindo a tela da WebCam
É mostrada uma tela com a imagem da pessoa, e com o título informando que é necessário pressionar o botão F2 para gravar a imagem, após pressionar o F2, é mostrado a imagem na tela principal da rotina.
Preview da imagem
Com isso a imagem é gerada no caminho temporário do Windows.
Imagem no diretório do Windows
Abaixo o código fonte utilizado:
//Bibliotecas
#INCLUDE "Protheus.ch"
#INCLUDE "RwMake.ch"
#INCLUDE "Topconn.ch"
#INCLUDE "TbiConn.ch"
//Constantes
#Define CLR_VERMELHO RGB(255,048,048) //Cor Vermelha
#Define CLR_AZUL RGB(058,074,119) //Cor Azul
//-----------------------------------------------------------------//
/*/{Protheus.doc} zPegaWeb
Função que gera uma imagem através de uma WebCam.
@author Daniel Atilio
@since 17/06/2014
@version 1.0
@param cNome, Caracter, Nome do arquivo que será gerado
@return aRet, Array contendo duas colunas (se a rotina foi confirmada e o nome full do arquivo gerado)
@example
u_zPegaWeb("IMAGEM")
@obs É necessário a utilização de duas dll (colocar dentro da /smartclient/), que são escapi.dll e imageload2.dll.
Para tirar fotos na tela da webcam é preciso pressionar a tecla F2.
@see https://terminaldeinformacao.com/advpl/
/*/
//-----------------------------------------------------------------//
User Function zPegaWeb(cNome)
Local cIdFile := "" //ID do arquivo (nome do parametro + "_NAO_SALVO"
Local cFileBmp := "" //Nome do arquivo com extensão jpg
Local cPathLoc := "" //Diretório local que será gerado o arquivo
Local nComboSel := 1 //Item selecionado do combo
Local cDispos := "" //Contém a lista de dispositivos
Local cTam := "" //Tamanho da tela apresentada
Local aItens := {} //Contém todos os dispositivos
Local oFontNeg := TFont():New("Tahoma") //Fonte Negrita
Local oFont := TFont():New("Tahoma") //Fonte Normal
Local oDlgWeb //Dialog
Local oGrpWeb, oGrpPre //Grupos da Dialog
Local oSayEsc, oSayCam, oSayF2 //Labels da Dialog
Local oCmbCams //Combo da Dialog
Local oGetCam, cGetCam := "" //Gets da Dialog
Local oBtnConf, oBtnCanc, oBtnAbre //Botões da Dialog
Private nRet := 0 //Retornos das execuções das dlls
Private aRet := {.F.,""} //Retorno [1] = Rotina Confirmada? ; [2] = Nome do arquivo
Private cPathFile := "" //Arquivo + diretório (ex.: C:\totvs\imagem.jpg)
Private nHandle //Guarda o ponteiro da abertura da dll
Private oBmpWeb //Bitmap que mostrará a foto na oDlgWeb
//Setando atributo
oFontNeg:Bold := .T.
//Criando um nome para o arquivo
Default cNome := "IMAGEM"
cIdFile := cNome+"_WEB_CAM"
cFileBmp := Alltrim(cIdFile)+".bmp"
cPathLoc := GetTempPath()
cPathFile := Upper(cPathLoc+cFileBmp)
cGetCam := cPathFile
//Iniciando controle para manipulação da dll
Begin Sequence
//Abrindo a DLL para
nHandle := ExecInDLLOpen("imageload2.DLL")
If nHandle == -1
MsgStop("Não foi possível carregar a DLL (imageload2).","Atenção")
Return
EndIf
//Obtém lista de webcams
nRet:=ExeDLLRun2( nHandle, 1, @cDispos)
cDispos := alltrim(cDispos)+alltrim(cDispos)
aItens := StrTokArr(cDispos, "|")
//Define a dimensão da captura (Largura|Altura)
cTam:= "0400|0400"
nRet:=ExeDLLRun2( nHandle, 3, @cTam)
//Título da Janela que será aberta com a imagem
cTitle := "WebCam (F2=Tira Foto)"
nRet:=ExeDLLRun2( nHandle, 4, @cTitle)
//Criando a janela
DEFINE MSDIALOG oDlgWeb TITLE "WebCam" FROM 000, 000 TO 545, 420 COLORS 0, 16777215 PIXEL
//Grupo WebCam
@ 000, 001 GROUP oGrpWeb TO 052, 208 PROMPT "WebCam: " OF oDlgWeb COLOR 0, 16777215 PIXEL
//Combo de escolha da webcam
@ 008, 008 SAY oSayEsc PROMPT "Escolha:" SIZE 025, 007 OF oDlgWeb COLORS CLR_AZUL FONT oFont PIXEL
@ 007, 051 MSCOMBOBOX oCmbCams VAR nComboSel ITEMS aItens SIZE 145, 010 OF oDlgWeb COLORS 0, 16777215 PIXEL
//Caminho da imagem
@ 020, 008 SAY oSayCam PROMPT "Caminho:" SIZE 025, 007 OF oDlgWeb COLORS CLR_AZUL FONT oFont PIXEL
@ 019, 051 MSGET oGetCam VAR cGetCam SIZE 144, 010 OF oDlgWeb COLORS 0, 16777215 READONLY PIXEL
//Label com observação
@ 044, 003 SAY oSayF2 PROMPT "Tecla para salvar imagem F2" SIZE 101, 007 OF oDlgWeb COLORS CLR_VERMELHO FONT oFontNeg PIXEL
//Botões
@ 038, 169 BUTTON oBtnConf PROMPT "Confirmar" SIZE 037, 012 OF oDlgWeb ACTION {|| aRet[1]:=.T.,oDlgWeb:End() } PIXEL
@ 038, 130 BUTTON oBtnCanc PROMPT "Cancelar" SIZE 037, 012 OF oDlgWeb ACTION {|| aRet[1]:=.F.,oDlgWeb:End() } PIXEL
@ 038, 091 BUTTON oBtnAbre PROMPT "Abrir" SIZE 037, 012 OF oDlgWeb ACTION {|| fCaptura(oCmbCams:nAt) } PIXEL
//Grupo Preview
@ 057, 001 GROUP oGrpPre TO 270, 210 PROMPT "Preview: " OF oDlgWeb COLOR 0, 16777215 PIXEL
@ 067, 006 BITMAP oBmpWeb SIZE 200, 200 OF oDlgWeb NOBORDER PIXEL
//Ativando a janela
ACTIVATE MSDIALOG oDlgWeb CENTERED
End
ExecInDLLClose(nHandle)
Return aRet
/*---------------------------------------------------------------------*
| Func: fCaptura |
| Autor: Daniel Atilio |
| Data: 17/06/2014 |
| Desc: Função para abrir a WebCam e gravar a foto |
| Obs.: / |
*---------------------------------------------------------------------*/
Static Function fCaptura(nAt)
Local cImgPadrao := ""
//Definindo o dispositvo que será usado
nRet:=ExeDLLRun2( nHandle, 2, @cValToChar(nAt-1))
//Exclui o arquivo
fErase(cPathFile)
//Abre tela de captura e define arquivo de imagem de saida
cImgPadrao := cPathFile
nRet := ExeDLLRun2( nHandle, 5, cImgPadrao )
//Altera a imagem para a dialog atualizar a cPathFile
oBmpWeb:Load(,"ok.png")
oBmpWeb:Refresh()
//Exibe imagem capturada
oBmpWeb:Load(,cPathFile)
oBmpWeb:Refresh()
//Se o arquivo existir, atualiza o retorno
If File(cPathFile)
aRet[2] := cPathFile
//Senão, deixa em branco
Else
aRet[2] := ""
EndIf
Return
Update – 10/07/2016
Pessoal, conforme sugestão do Jonathan, preparei um ponto de entrada e uma rotina de teste da webcam, para atualizar a SA1, o campo A1_BITMAP. Tive a ajuda do meu amigo Eurai, do Universo AdvPL.
//Bibliotecas
#Include "Protheus.ch"
/*------------------------------------------------------------------------------------------------------*
| P.E.: MA030BUT |
| Autor: Daniel Atilio |
| Data: 26/05/2016 |
| Desc: Adiciona opções no Ações Relacionadas no Cadastro de Clientes |
| Links: http://tdn.totvs.com/pages/releaseview.action?pageId=6784246 |
*------------------------------------------------------------------------------------------------------*/
User Function MA030BUT()
Local aArea := GetArea()
Local aBotao := {}
//Adicionando o botão no Ações Relacionadas
AADD(aBotao, {"NOTE", {|| u_zTstWeb()}, "* WebCam"})
RestArea(aArea)
Return aBotao
/*/{Protheus.doc} zTstWeb
Função desenvolvida para testar a utilização da rotina de WebCam atualizando a imagem no cadastro (Cliente)
@type function
@author Atilio
@since 26/05/2016
@version 1.0
/*/
User Function zTstWeb()
Local aArea := GetArea()
Local cNomeImg := "cliente_"+M->A1_COD
Local cNomeFim := ""
Local aRet := {}
Local oRepository
Local oDlg
Local lPut
Local nTamanImg := TamSX3('A1_BITMAP')[01]
Local nAtual := 0
Local oObjeto
Local oPai := GetWndDefault()
//Chama a rotina para gerar a imagem da WebCam
aRet := u_zPegaWeb(cNomeImg)
//Se a rotina foi confirmada
If aRet[1]
DEFINE MSDIALOG oDlg TITLE "Atualizando imagem do cliente" FROM 000, 000 TO 080, 100 PIXEL
//Criando o repositório de imagens
@ 000,000 REPOSITORY oRepository SIZE 0,0 OF oDlg
//Pegando a imagem
cNomeFim := Upper(AllTrim(aRet[2]))
cNomeFim := SubStr(cNomeFim, RAt("\", cNomeFim)+1, Len(cNomeFim))
cNomeFim := StrTran(cNomeFim, ".BMP", "")
cNomeFim := SubStr(cNomeFim, 1, nTamanImg)
//Se existir a imagem no repositório, exclui
If oRepository:ExistBmp(cNomeFim)
oRepository:DeleteBmp(cNomeFim)
EndIf
//Insere a imagem no repositório
lPut := .T.
oRepository:InsertBmp(aRet[2], cNomeFim, @lPut)
//Se deu certo a inserção
If lPut
M->A1_BITMAP := cNomeFim
//Percorre todos os campos da Enchoice
For nAtual := 1 to Len( oPai:aControls )
//Se não for do tipo objeto, pula
If ValType(oPai:aControls[nAtual]) != 'O'
Loop
Endif
//Pega o objeto
oObjeto := oPai:aControls[nAtual]
//Se for do tipo Imagem, atualiza a imagem
If oObjeto:ClassName() == 'FWIMAGEFIELD'
//Primeiro, é setado qualquer imagem, apenas para forçar o refresh, pois a imagem da webcam terá o mesmo nome
oObjeto:oImagem:cBMPFile := "ok.png"
oObjeto:Refresh()
//Agora é setado a imagem
oObjeto:oImagem:cBMPFile := aRet[2]
oObjeto:Refresh()
Endif
Next
//Atualiza a Enchoice
GetDRefresh()
EndIf
ACTIVATE MSDIALOG oDlg CENTERED ON INIT (oDlg:End())
EndIf
RestArea(aArea)
Return
Bom pessoal, por hoje é só.
Abraços e até a próxima.
muito legal, parabéns pelo seu ótimo trabalho!
Muito Obrigado Maria.
Abraços.
Prezado, agradeço pela criação da rotina e por ter divulgado.
Abraço!
Boa noite Rubem.
Muito obrigado.
Um grande abraço.
Cara parabéns!! Muito show de bola mesmo!
Como você desenvolveu ou obteve essas DLL’s??
Estudando aqui a implementação…
Abraços
Boa noite Caio.
Não me recordo com quem peguei, mas foi há um bom tempo atrás, quando tava implantando o cadastro de Visitantes do Protheus, e precisava dessas DLLs.
Muito Obrigado.
Um grande abraço.
Olá, estou tentando desenvolver uma rotina para controle de visitantes na portaria.
Gostei da sua rotina, mas não entendi como amarro essa imagem da webcam a um campo. Qual o tipo/tamanho precisa ser esse campo?
Boa tarde Mariene.
O cadastro de visitantes padrão do Protheus, já utiliza a webcam (desde que as dlls estejam dentro da pasta smartclient), e o campo tem que ser do tipo imagem (como PW_BITMAP), sendo que a imagem precisa apenas estar no repositório do Protheus.
Qualquer dúvida, estou a disposição.
Boa tarde,
Estou desenvolvendo uma rotina para controle entrada e saída caminhão por foto.
Gostei muito da sua rotina, mas também estou com a mesma duvida da Mariene, pois não entendi como amarro essa imagem da webcam a um campo, foi criado uma tabela Z03 e o campo Z03_BITMAP, no qual o sistema já entende que é para imagens, porém quando utilizo sua rotina o mesmo não grava a foto no campo ou repositório automaticamente, mas bate a foto e grava no temp do usuário e também já testei que grava no Banco de Dados PROTHEUS_REPOSIT.
Como você chama o programa da webcam é por setkey, botão, pe,…? ou tem alguma ideia para o meu problema, pois testei a mesma rotina no cadastro de visitante e cadastro de funcionário, porém acontece o mesmo problema de não gravar no repositório automaticamente.
Se puder me ajudar, desde já sou agradecido.
Grato,
Fernando Valadares
Boa noite Fernando.
Então, deve se setar qual é o repositório utilizado, por exemplo:
SetRepName("SIGAADV") // Arquivo do Repositório: SIGAADV.BMRDepois, declare o objeto repositório dentro do seu fonte:
Agora para inserir, basta utilizar o método InsertBmp:
lPut := .F. //Variável que controla se possível inserir a imagem no repositório cDiretor := "C:" //Pasta que contém a imagem cNome := "teste.bmp" //Arquivo imagem cNomeAlt := "teste" //Nome da imagem sem extensão //Inserindo a imagem no repoistório oRepository:InsertBmp( cDiretor + cNome , cNomeAlt , @lPut ) //Gravando o nome da imagem do repositório no campo de imagem RecLock("TAB", .F.) CAMPO := cNomeAlt TAB->(MsUnlock())A chamada da WebCam pode ser via ações relacionadas (ponto de entrada) ou via setkey, como preferir.
Qualquer dúvida, estou a disposição.
Abraços.
Boa tarde,
Excelente solução, tive que acoplar ao código inicial para funcionar, o mesmo gravou no repositório, porém estou com um problema, se caso já existir a imagem com o mesmo nome no repositório, o mesmo pergunta se deseja substituir e eu coloco que sim, então a imagem fica toda desconfigurada, então acabo tendo que ir no repositório deletar a imagem e começar do zero. Caso tenha alguma ideia de limpar a imagem do repositório antes de salvar a nova, isso solucionaria meu problema por completo.
Agradeço o retorno, ajudou muito.
Grato,
Fernando Valadares
Boa noite Fernando.
Você poderia verificar se a imagem já existe no repositório, se sim, pode renomeá-la ou pode sobrepor. Abaixo um trecho que verifique se a imagem existe no repositório.
Um grande abraço.
Bom dia,
Foi muito boa sua dica, fiz o programa, porem o DeleteBMP não funcionou, mas coloquei dentro da condição um delete na tabela PROTHEUS_REPOSIT, excluindo a foto desejada, nesse caso parou de dar o meu erro, solucionando assim o meu problema.
Gostaria de agradecer o seu retorno, pois foi de grande ajuda para o meu desenvolvimento.
Grato,
Fernando Valadares
Boa tarde.
Eu que agradeço.
Um grande abraço.
Bom dia Dan_Atilio, gostei muito das informações, ja consegui utilizar a rotina gravar no repositório e ja solucionei o problema de sobrescrever a imagem no repositório, eu estou utilizando a rotina pra colocar a foto no cadastro do cliente. faço a foto gravo no repositório e atualizo a variável M->A1_BITMAP mais não consegui fazer o refresh pra aparecer a foto para o usuário, somente aparece quando salvo e abro novamente o cadastro.
como vc conseguiu solucionar esse problema?, pois no seu video que vi funciona corretamente.
Boa tarde Jonathan, tudo bem?
Irei preparar um exemplo de disponibilizar, o vídeo é de um parceiro do Terminal de Informação, o Eurai do Universo Advpl.
Criando o exemplo, já entro em contato.
Abraços.
Isso funciona na versao 12.1.25?
Eu não cheguei a testar.
Porém, como a integração é feita via dll, eu acho que funciona sim.
Abraços.
Parabéns pela publicação! Bem detalhada!!!
Atilio, estava pesquisando sobre função pra cortar a imagem, após tirar a foto. Verifiquei que a classe TDrawer está descontinuada. Sabes informar a substituta dela quando se necessita cortar uma imagem?
Opa, obrigado pelo feedback Vicente.
Vixe jovem, eu desconheço se existe uma classe que substitua a TDrawer =/
Tentei procurar no inspetor de objetos, e procurar por drawer, mas encontrei apenas a geração de gráficos.
Daniel, boa tarde!
As DLL, na versão 12.1.33 o sistema não consegue ler as DLL, pois atualmente o protheus esta para 64 bits e a DLL ainda em 32 bits
Bom dia Valtencir, tudo joia?
De uns tempos pra cá, a TOTVS disponibiliza essas DLLs junto com o smartclient.exe no portal do cliente.
Basta você baixar o pacote do binário do smartclient, que as DLLs já estarão lá dentro.
Segue um link da TOTVS sobre o assunto: https://tdn.totvs.com/pages/viewpage.action?pageId=438299044
Abraços.
Olá Atilio, muito bom seu código, parabéns! Gostaria de tirar uma dúvida, hoje quando aperto o F2 o sistema apenas capta a imagem, mas a webcam ainda fica aberta, sabe se existe alguma forma de que no momento do F2 o sistema já capturar a imagem e fechar a tela da webcam? Tentei o setkey VK_F2 aqui, mas só chama depois de fechar a webcam através do X ou do Esc.
Obrigado.
Bom dia Thales, tudo joia?
É que esse F2 ele é acionado internamente na tratativa da DLL por isso o setkey é acionado depois.
Eu desconheço se exista outra tecla de atalho para capturar e em seguida fechar.
Depois vou pesquisar um pouco sobre, se você encontrar algo também, nos avise.
Um grande abraço.