Integração do Protheus com WebCam

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

Esses e outros códigos, estão disponíveis gratuitamente no nosso GitHub, acesse em github.com/dan-atilio/AdvPL.

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.

About Dan_Atilio

Analista e desenvolvedor de sistemas. Técnico em Informática pelo CTI da Unesp. Graduado em Banco de Dados pela Fatec Bauru. Entusiasta de soluções Open Source e blogueiro nas horas vagas. Autor do projeto Terminal de Informação, onde são postados tutoriais e notícias envolvendo o mundo da tecnologia.

17 comentários em “Integração do Protheus com WebCam

    1. 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.

  1. 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?

    1. 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.

  2. 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

    1. 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.

      1. 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

        1. 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.

        2. 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

  3. 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.

    1. 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.

Deixe uma resposta

%d blogueiros gostam disto: