Integração do Protheus com WebCam

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

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

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

Preview da imagem

Com isso a imagem é gerada no caminho temporário do Windows.

Imagem no diretó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.

Dan (Daniel Atilio)
Cristão de ramificação protestante. Especialista em Engenharia de Software pela FIB, graduado em Banco de Dados pela FATEC Bauru e técnico em informática pelo CTI da Unesp. Entusiasta de soluções Open Source e blogueiro nas horas vagas. Autor e mantenedor do portal Terminal de Informação.

25 Responses

  1. Maria disse:

    muito legal, parabéns pelo seu ótimo trabalho!

  2. Rubem Cerqueira disse:

    Prezado, agradeço pela criação da rotina e por ter divulgado.

    Abraço!

  3. Caio Augusto disse:

    Cara parabéns!! Muito show de bola mesmo!
    Como você desenvolveu ou obteve essas DLL’s??
    Estudando aqui a implementação…
    Abraços

    • Dan_Atilio disse:

      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.

  4. Mariene disse:

    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?

    • Dan_Atilio disse:

      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.

  5. Fernando Valadares disse:

    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

    • Dan_Atilio disse:

      Boa noite Fernando.
      Então, deve se setar qual é o repositório utilizado, por exemplo:

      SetRepName("SIGAADV")   // Arquivo do Repositório: SIGAADV.BMR

      Depois, declare o objeto repositório dentro do seu fonte:

      @ 000,000 REPOSITORY oRepository SIZE 0,0 OF oDlg

      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.

      • Fernando Valadares disse:

        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

        • Dan_Atilio disse:

          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.

          //Verifica se existe a imagem no repositório
          if oRepository:ExistBmp(cGetCod)
          	//oRepository:DeleteBmp(cGetCod)
          endif
          

          Um grande abraço.

        • Fernando Valadares disse:

          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

        • Dan_Atilio disse:

          Boa tarde.
          Eu que agradeço.
          Um grande abraço.

  6. Jonathan Wermouth disse:

    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.

    • Dan_Atilio disse:

      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.

  7. David J G Paiva disse:

    Isso funciona na versao 12.1.25?

  8. Vicente disse:

    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?

  9. Valtencir disse:

    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

  10. Thales disse:

    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.

  1. 9 de abril de 2019

    […] link -> terminaldeinformacao.com contém o tutorial de como usar; fonte e […]

Deixe uma resposta

Terminal de Informação