CRUD em AdvPL – Parte 13

Introdução

Nos tópicos anteriores, funcionalidades e recursos foram adicionados ao programa de Agenda. Agora, vamos criar uma “casca” de acesso sobre este fonte, e futuras funcionalidades? Que tal uma aplicação com uma MAIN WINDOW?

Criando o AdvPLSuite

Vamos criar um fonte AdvPL, que vai criar uma WINDOW, ao invés de uma DIALOG. Como somente pode haver uma janela do tipo WINDOW na aplicação AdvPL, ela será a base para ter um Menu de Opções, para chamar os demais programas que serão publicados aqui no Blog, seguindo a linha do CRUD, com o programa Agenda. Segue abaixo o fonte ADVPLSUITE.PRW

#include "protheus.ch"

#define CALCSIZESAY( X ) (( X * 4 ) + 4)

// --------------------------------------------------------------
// Programa principal AdvPLSuite
//
// Autor Júlio Wittwer
// Data 28/10/2018
//
// Serve de Menu para os demais programas de exemplo do Blog 
// Primeiro programa acrescentado : U_AGENDA
// --------------------------------------------------------------

User Function AdvPLSuite()
Local oMainWnd
Local cTitle := "AdvPL Suite 1.00"
Local oFont

// Define Formato de data DD/MM/AAAA
SET DATE BRITISH
SET CENTURY ON

// Usa uma fonte Fixed Size
oFont := TFont():New('Courier new',,-14,.T.)

// Seta que esta é a fonte DEFAULT para Interface
SETDEFFONT(oFont)

DEFINE WINDOW oMainWnd FROM 0,0 to 768,1024 PIXEL ; 
TITLE (cTitle) COLOR CLR_WHITE, CLR_BLUE

// Monta o menu superior da aplicaçáo 
BuildMenu(oMainWnd)

// Executa rotina de entrada 
oMainWnd:bStart := {|| WndStart(oMainWnd) }

// Ativa a janela principal maximizada 
ACTIVATE WINDOW oMainWnd MAXIMIZED

Return


// --------------------------------------------------------------
// Montagem do Menu do AdvPLSuite 
// --------------------------------------------------------------
STATIC Function BuildMenu(oMainWnd)
Local oMenuBar
Local oTMenu1, oTMenu2

conout('BuildMenu - IN')

// Cria a barra superior de Menus da Aplicação na Janela Principal
oMenuBar := tMenuBar():New(oMainWnd)
oMenuBar:SetColor(CLR_BLACK,CLR_WHITE)

// Cria o menu de Programas e acrescenta os itens
oTMenu1 := TMenu():New(0,0,0,0,.T.,,oMainWnd,CLR_BLACK,CLR_WHITE)
oMenuBar:AddItem('Programas' , oTMenu1, .T.)

oTMenu1:Add(TMenuItem():New(oMainWnd,'&Agenda',,,,{||U_AGENDA()},,,,,,,,,.T.))
oTMenu1:Add(TMenuItem():New(oMainWnd,'Sai&r',,,,{||oMainWnd:End()},,,,,,,,,.T.))

// Cria o Menu de Ajuda e acrescenta Itens
oTMenu2 := TMenu():New(0,0,0,0,.T.,,oMainWnd,CLR_WHITE,CLR_BLACK)
oMenuBar:AddItem('Ajuda', oTMenu2, .T.)

oTMenu2:Add(TMenuItem():New(oMainWnd,'&TDN - AdvPL',,,,{||OpenURL("http://tdn.totvs.com/display/tec/AdvPL")},,,,,,,,,.T.))
oTMenu2:Add(TMenuItem():New(oMainWnd,'&Sobre',,,,{||HlpAbout()},,,,,,,,,.T.))

Return

// --------------------------------------------------------------
// Tela de inicialização -- Mensagem de Entrada
// --------------------------------------------------------------
STATIC Function WndStart(oMainWnd)
Local oDlg
Local cTitle
Local cMsg

cTitle := "Bem vindo ao AdvPL Suite 1.00"

DEFINE DIALOG oDlg TITLE (cTitle) ;
FROM 0,0 TO 100,400 ;
COLOR CLR_WHITE, CLR_RED PIXEL

@ 05,05 SAY "APPServer Build .... "+GetBuild() SIZE CALCSIZESAY(50),12 OF oDlg PIXEL 
@ 18,05 SAY "Smartclient Build .. "+GetBuild(.T.) SIZE CALCSIZESAY(50),12 OF oDlg PIXEL

cMsg := "SERVER "

If IsSrvUnix()
  cMsg += 'LINUX '
Else
  cMsg += 'WINDOWS '
Endif

if ISSRV64()
  cMsg += '64 BITS'
Else
  cMsg += '32 BITS'
Endif

@ 31,05 SAY cMsg SIZE CALCSIZESAY(50),12 OF oDlg PIXEL

ACTIVATE DIALOG oDlg CENTER

Return

// --------------------------------------------------------------
// Mensagem informativa sobre o autor
// --------------------------------------------------------------

STATIC Function HlpAbout()
MsgInfo("<html><center>AdvPL Suite V1.00<hr>Júlio Wittwer<br><b>Tudo em AdvPL</b>")
return

// --------------------------------------------------------------
// Encapsulamento de abertura de URL
// Abre a URL informada como parametro no navegador padrão
// da máquina onde está sendo executado o SmartClient
// --------------------------------------------------------------
STATIC Function OpenURL(cUrl)
shellExecute("Open", cUrl, "", "", 1 )
return

Após compilar este código, e executá-lo diretamente pelo SmartClient, chamando a função U_ADVPLSUITE, o resultado esperado é ser aberta uma janela na tela, com o título “AdvPL Suite 1.00“, com fundo azul, e dentro dela uma caixa de diálogo com fundo vermelho, mostrando algumas informações.

Suite - Splash

Após pressionar a tecla [ESC] ou clicar no “X” para encerrar o diálogo, vamos acessar o menu no canto superior esquerdo, e ir na opção Programas –> Agenda. A aplicação de agenda deve ser aberta na tela, centralizada.

Suite - Agenda

Reparem que a Agenda está com o alinhamento diferente dos botões de navegação, resolvi fazer uma alteração no LayOut dos painéis, foi fácil fazer isso e eu não precisei alterar nenhuma coordenada dos componentes de interface.

Os códigos atualizados do post atual e da agenda estão disponíveis para Download no GITHUB — https://github.com/siga0984/Blog/, pode entrar e baixar, compilar, alterar, etc!!!

Conclusão

Prevendo o crescimento da aplicação, agora já temos um “Menu” para acrescentar funcionalidades. Agenda será apenas uma delas, mas ao longo do tempo, novas serão inseridas e integradas. Aguardem as cenas do próximo capítulo.

Desejo novamente a todos TERABYTES DE SUCESSO 😀

Referências

 

 

 

Anúncios

CRUD em AdvPL – Parte 12,5

Introdução

No post anterior, foi inserido o recurso de inserir uma foro 3×4 para cada contato da agenda. Sabe o que faltou ? Sim, remover a foto! Tanto que nem compensa dizer que esta é a parte 13 do CRUD … risos … esta é a parte 12,5 😉

Ajustes na Rotina

Tão simples quanto isso, foi acrescentar o botão para remover a foto. A função alterada foi a ChgImage(). Antes de mais nada eu verifico se já tem uma foto para o contato atualmente posicionado. Caso exista, eu habilito o botão para apagar a foto atual. Caso a eliminação da foto seja confirmada, eu simplesmente gravo uma string em branco no campo IMAGE, limpo o arquivo de cache de visualização da pasta temporária, e mostro a foto padrão do sistema. Vejamos abaixo como ficou a rotina após estes ajustes, as partes inseridas ou alteradas estão em negrito.

STATIC Function ChgImage(oDlg,aBtns,aGets,oBmpFoto)
Local cTitle := 'Escolha uma imagem'
Local oDlgImg
Local cFile := space(50)
Local lOk := .F. , lErase := .F.
Local aFInfo
Local oGet1, oBtn1, oBtn2, oBtn3
Local cMemoImg := AGENDA->IMAGE

DEFINE DIALOG oDlgImg TITLE (cTitle) ;
  FROM 0,0 TO 120,425 PIXEL;
  FONT oDlg:oFont ; // Usa a mesma fonte do diálogo anterior 
  OF oDlg ; 
  COLOR CLR_BLACK, CLR_HBLUE

@ 05,05 GET oGet1 VAR cFile SIZE CALCSIZEGET(50),12 OF oDlgImg PIXEL

@ 25,05 BUTTON oBtn1 PROMPT "Buscar" SIZE 60,15 ;
  ACTION (BuscaFile(@cFile)) OF oDlgImg PIXEL

@ 25,70 BUTTON oBtn2 PROMPT "Ok" SIZE 60,15 ;
  WHEN File(alltrim(cFile)) ; 
  ACTION ( lOk := .T. , oDlgImg:End() ) OF oDlgImg PIXEL

@ 25,135 BUTTON oBtn3 PROMPT "Apagar" SIZE 60,15 ;
  ACTION ( lErase := .T. , oDlgImg:End() ) OF oDlgImg PIXEL

if Empty(cMemoImg)
  // Se o contato nao tem foto, não mostra o
  // botão para apagar a foto 
  oBtn3:Hide()
Endif

ACTIVATE DIALOG oDlgImg CENTER

If lErase
  If MsgYEsNo("Este contato tem uma foto. Deseja apagá-la ?")
    DBSelectArea("AGENDA")
    If DbrLock(recno())
      AGENDA->IMAGE := ""
      DBRUnlock()
      // Limpa ultima imagem desse ID do cache temporário 
      CleanImg(AGENDA->ID)
      // Carrega a imagem default para limpar 
      // o cache do componente de imagem 
      oBmpFoto:Load(,"\temp\tmp_photo_3x4.img")
    Else
      // Nao conseguiu bloqueio do registro
      // Mostra a mensagem e permanece no modo de alteração
      MsgStop("Registro não pode ser alterado, está sendo usado por outro usuário")
    Endif
  Endif
ElseIF lOk
  cFile := alltrim(cFile)
  aFInfo := Directory(cFile)
  If len(aFInfo) > 0 
    If aFInfo[1][2] > ( 128 * 1024) // Até 128 KB
      MsgStop("Arquivo muito grande ("+str(aFInfo[1][2]/2014,8,2)+" KB)","Imagem maior que 128 KB")
      return 
    Endif
  Else
    MsgStop('Arquivo não encontrado',cFile)
    return 
  Endif
  
  // Chegou ate aqui, atualiza o campo memo 
  If !empty(cMemoImg)
    lOk := MsgYEsNo("Este contato já tem uma foto. Deseja substituí-la ?")
  Endif

  If lOk
    // Lê a imagem do disco 
    cMemoImg := ReadFile(cFile)
    If empty(cMemoImg)
      // Imagem vazia, houve falha na leitura 
      Return
    Endif
    DBSelectArea("AGENDA")
    If DbrLock(recno())
      // Troca conteudo da imagem no Banco de Dados 
      AGENDA->IMAGE := cMemoImg
      DBRUnlock()
      // Limpa ultima imagem desse ID do cache temporário 
      CleanImg(AGENDA->ID)
      // Carrega a imagem default para limpar 
      // o cache do componente de imagem 
      oBmpFoto:Load(,"\temp\tmp_photo_3x4.img")
      // Agora Mostra a nova imagem do contato 
      ShowImg(oBmpFoto)
      // E Avisa que a imagem foi trocada com sucesso 
      MsgInfo("Imagem atualizada.")
    Else
      // Nao conseguiu bloqueio do registro
      // Mostra a mensagem e permanece no modo de alteração
      MsgStop("Registro não pode ser alterado, está sendo usado por outro usuário")
    Endif
  Endif
Endif
Return

Aproveitei para aumentar o campo para informar o nome do arquivo para 50 caracteres, com apenas uma alteração nos parâmetros da função cGetFile(), podemos escolher uma imagem em uma pasta do disco onde o SmartClient está sendo executado, sem alterar mais nenhuma linha de código.

Conclusão

Agora sim a manutenção da imagem dos contatos está completa. Agora, vou voltar pra “prancheta” e ver o que mais dá pra incrementar na Agenda! Daqui a pouco eu atualizo o GIRHUB com o código atualizado.

Agradeço desde já a audiência, curtidas e comentários, e desejo a todos TERABYTES DE SUCESSO 😀

 

CRUD em AdvPL – Parte 12

Introdução

No post anterior, colocamos mais um botão na interface para enviar e-mail. Agora, vamos colocar uma foto 3×4 para cada contato da agenda.

Novo campo na base

Inicialmente, vamos criar um novo campo na tabela da Agenda, para armazenar a imagem. No caso, vamos usar um campo do tipo “M” Memo do AdvPL, que por default aceita armazenar e recuperar conteúdos binários (bytes de valor 0 a 255, inclusive bytes que não têm representação no CP1252 — usado pelo Protheus).

// Cria o array com os campos do arquivo 
aadd(aStru,{"ID" ,"C",06,0})
aadd(aStru,{"NOME" ,"C",50,0})
aadd(aStru,{"ENDER" ,"C",50,0})
aadd(aStru,{"COMPL" ,"C",20,0})
aadd(aStru,{"BAIRR" ,"C",30,0})
aadd(aStru,{"CIDADE","C",40,0})
aadd(aStru,{"UF" ,"C",02,0})
aadd(aStru,{"CEP" ,"C",08,0})

// Novos campos inseridos em 07/10
aadd(aStru,{"FONE1" ,"C",20,0})
aadd(aStru,{"FONE2" ,"C",20,0})
aadd(aStru,{"EMAIL" ,"C",40,0})

// Novos campos inseridos em 21/10
aadd(aStru,{"IMAGE" ,"M",10,0})

Lembrando que o fonte original possui uma implementação para, caso detectada alguma diferença na estrutura da tabela no momento da abertura, a aplicação automaticamente vai executar um TC_ALTER() para inserir o novo campo.

Inserindo a imagem padrão no programa

A partir desse momento, no espaço reservado da interface onde vamos mostrar a foto do contato da agenda, caso o contato ainda não tenha foto, vamos mostrar uma imagem de 120 x 160 pixels — razão 3×4 — com fundo branco, e o texto “Photo 3×4”. Foi relativamente simples montar esta imagem e salvá-la no formato PNG, ela ocupou míseros 1090 bytes — menos que 1KB.

Para passar a usar esta imagem no programa, podemos proceder de várias formas. Uma delas é distribuir a imagem junto do programa, criar uma pasta ou diretório chamado “images” (por exemplo) a partir do RootPath, e salvar a imagem nesta pasta.

Outra forma seria acrescentar a imagem dentro do Repositório de Objetos (RPO) da aplicação como um “resource”. E, de dentro do programa, fazer a carga deste resource diretamente como uma imagem.

Existe ainda a terceira forma, que seria criar um fonte AdvPL que fosse capaz de criar esta imagem. Esta é a forma mais interessante, e que foi adotada neste exemplo:

STATIC Function RAW3x4()
Local cRaw := ''
cRaw += HEx2Bin('89504E470D0A1A0A0000000D4948445200000078000000A00802000000486B3FC700000001735247')
cRaw += HEx2Bin('4200AECE1CE90000000467414D410000B18F0BFC61050000000970485973000012740000127401DE')
cRaw += HEx2Bin('661F78000003D749444154785EEDDC6D5AEA30140061F7D3F5B01FD7C37AD88F3760494E3E8A14CB')
cRaw += HEx2Bin('542E33BF34C4206F43451FEAC79721090D253494D0504243090D253494D0504243090D253494D050')
cRaw += HEx2Bin('4243090D253494D0504243090D253494D0504243090D253494D0504243090D253494D0504243090D')
cRaw += HEx2Bin('253494D0504243090D253494D0504243090D253494D0504243090D253494D0504243ED097D3A1E3E')
cRaw += HEx2Bin('BE9B3E4FF3D87FDB33A0B35F6C9AA6C3E7B1F23C7D4ED71B857EA0E2372A983E0DBA2C7C38CE43BB')
cRaw += HEx2Bin('8743A7AE8F5EE8DF15A0F3E33C1DA3FE3C2CF4EF1A41A7C2F0EC5A43A71F8D53FEBC3D9DCF9DD201')
cRaw += HEx2Bin('2BB352DF27FE3075F8F321558BFFBCCEE671D0C1A0874ECD1F96DADD980EC47C4BD794E72E4187E7')
cRaw += HEx2Bin('CC5DEB6CDEDFD8D1E302CE8F73AF77F5D38EBE779DCDC3CED1611B5D01EB079DF50B55910E7E69D7')
cRaw += HEx2Bin('5D4787ABA6CAC22DDBBA75B6ECB9D0C38A7E99181F5D19CEA3DD5927375C63117AE53A5B4643C747')
cRaw += HEx2Bin('31103DD70F2F4CBC14EE6D70046BE8B5EB6C19053DF8C570E971F7C36523F60623A03256CF5FBBCE')
cRaw += HEx2Bin('96713F0CFB7AD14BFDF0F2337EBC48195B82BE6F9D2D7B09E8B062AB30BCB332587F036BD7D9B297')
cRaw += HEx2Bin('808E4BA6C1F1AB85705FD57770993CFF2EB2729D2D7B0DE8F8AC1F57EFD07EF6F5F675EB6CD8AB40')
cRaw += HEx2Bin('9F89F2B26DFD2F749D67596AD53ADBF554E8F4EC9CC786A5676C9E18F7D1C270FA82157FA2389F0E')
cRaw += HEx2Bin('F2CC342D4EDAE14F1DCF80B6514243090D253494D0504243090D253494D0504243090D253494D050')
cRaw += HEx2Bin('4243090D253494D0504243090D253494D0504243090D253494D0504243090D253494D0504243ED07')
cRaw += HEx2Bin('7D7EEBECA1BA6276703DD123D56F806EDFFABB573B41DF7AE3FDEFDE0DDEAEFCDED0E1A280518F53')
cRaw += HEx2Bin('F70750E874A2086FB2AFE91F940E970AE40B9DDFFCD43128525FA1CB068D97979499D501A98683B9')
cRaw += HEx2Bin('D07501BAE08C06C7868DBED0C3D22B900CDAECD3B2A9E7F13C10A7759B5CE85CD8ACA1E6FAA954BD')
cRaw += HEx2Bin('A9F36711B04CC9A342E746D0E357D26153E7E2761EA10A9D1BEFE84B1D4E4B1D270CF7B8D00B9DAA')
cRaw += HEx2Bin('CBB17B9E463AECE71BC72BB43FF71F81BE14352B991EB3DC2CF4FA16A00365F8D348DED4ED6965D8')
cRaw += HEx2Bin('9B429FE99AABAFD3CB8978EE08300532D946F49B76F9ABF627FE6E37E89B957370993A8B850D1C5F')
cRaw += HEx2Bin('79B4097DE9E6D33DD084239255EFDBD442CFCDFFC921EEECFE7F3994E311B9EE9216FA5D131A4A68')
cRaw += HEx2Bin('28A1A18486121A4A6828A1A18486121A4A6828A1A18486121A4A6828A1A18486121A4A6828A1A184')
cRaw += HEx2Bin('86121A4A6828A1A18486121A4A6828A1A18486121A4A6828A1A18486121A4A6828A1A18486121A4A')
cRaw += HEx2Bin('6828A1A18486121A4A6828A1A18486121A4A6828A1A18486121AE9EBEB1FDCCEA468FA802AA60000')
cRaw += HEx2Bin('000049454E44AE426082')

Return cRaw

STATIC function HEx2Bin(cHex)
Local cBin := ''
For nI := 1 to len(cHex) STEP 2
  cBin += chr(__HEXTODEC(substr(cHex,nI,2)))
Next
Return cBin

Usando um WebSite que gera o código Hexadecimal dos bytes de um arquivo, eu gerei um “Dump” em hexadecimal da imagem no formato PNG, e criei um fonte AdvPL capaz de remontar a imagem a partir destas informações, convertendo os valores hexadecimais em pares, para chegar ao valor do Byte original, e somando estes bytes em uma variável do tipo caractere no AdvPL.

A função que faz a conversão é a Hex2Bin(), que usa internamente a função __HexToDec() do binário, que converte um valor em String hexadecimal para numérico (decimal).

Acrescentando a imagem na tela

Vamos aproveitar a área abaixo do botão “Sair” para colocar a foto do contato. Para isso, acrescentamos as seguintes linhas no código, logo abaixo da criação do botão “Sair” — lembrando de declarar a variável oBmpFoto como “Local” no fonte da STATIC Function doInit(oDlg)

@ 65,05 BUTTON oBtn5 PROMPT "Sair" SIZE 60,15 ;
  ACTION oDlg:End() OF oPanelMenu PIXEL

@ 90,05 BITMAP oBmpFoto OF oPanelMenu PIXEL 

oBmpFoto:nWidth := 120
oBmpFoto:nHeight := 160
oBmpFoto:lStretch := .T.

Agora, vamos passar a variável oBmpFoto como último parâmetro para todas as chamadas da STATIC Function ManAgenda()., inclusive na declaração desta função, recebendo o objeto no parâmetro nomeado oBmpFoto. E, por fim, acrescentar o botão para alterar a imagem 3×4 do contato atual, logo abaixo do botão “G-Mail”:

@ 125,05 BUTTON oBtnImg PROMPT "Foto 3x4" SIZE 60,15 ; 
  WHEN ( nMode == 4 ) ; // Editar foto disponivel apenas durante a consulta
  ACTION ChgImage(oDlg,aBtns,aGets,oBmpFoto) OF oPanelNav PIXEL
aadd(aBtns,oBtnImg) // [15] Foto 3x4

Lembram-se da função SetNavBtn(), que habilitavam ou desabilitavam os botões de navegação do lado direito da tela, fazendo um SetEnable() diretamente no painel, habilitando ou desabilitando todos os botões? Bem, como vamos poder ter alguns botões com controle de habilitação independente, a função foi alterada para atuar apenas do botão 7 ao 14:

STATIC Function SetNavBtn(aBtns,lEnable)
Local nI
For nI := 7 to 13
  aBtns[nI]:SetEnable(lEnable)
Next
Return

Disparando a atualização da imagem

Como os dados sobre o contato mostrado na tela é carregado pela função ReadRecord(), vamos inserir manualmente após cada chamada da função ReadRecord() a chamada da função ShowImg(), responsável por atualizar a foto na tela.

 // Atualiza na tela o conteudo do registro atual 
ReadRecord(aGets)

// Mostra a imagem do contato 
ShowImg(oBmpFoto)

E, finalmente, vamos a função que faz a mágica, a função ShowImg():

STATIC Function ShowImg(oBmpFoto)
Local cTmpPath
Local nH
Local cRAWImage 
Local cId

// Lê o campo memo com o conteudo da imagem 
// e o ID do contato da agenda 
cId       := AGENDA->ID
cRAWImage := AGENDA->IMAGE

If empty(cRawImage)
  // Contato sem imagem, cria um cache em disco da imagem padrão
  cId := 'photo_3x4'
  cTmpPath := "\temp\tmp_"
  cTmpPath += cID
  cTmpPath += ".img"
  if !file(cTmpPath)
    nH := fCreate(cTmpPath)
    // grava no disco o conteúdo binário da imagem 
    fWrite(nH,RAW3x4()) 
    fclose(nH)
  Endif
Else
  // Contato com imagem, cria um cache da imagem usando o ID do contato
  cTmpPath := "\temp\tmp_"
  cTmpPath += cID
  cTmpPath += ".img"
  if !file(cTmpPath)
    nH := fCreate(cTmpPath)
    fWrite(nH,cRawImage)
    fclose(nH)
  Endif
Endif
oBmpFoto:Load(,cTmpPath)
Return 

A função é relativamente simples, e ainda está sujeita a melhorias. Ela depende apenas da criação da pasta “\temp\” a partir do RootPath do ambiente, pois ela será usada exatamente para fins temporários. Por hora o componente tBitmap aceita realizar a carga de uma imagem do disco, ou de um RESOURCE compilado no RPO. Como o conteúdo binário da imagem foi gravado no banco de dados, ao ser recuperado precisamos criar um arquivo em disco para ser carregado.

Neste caso, lemos a imagem do Banco de Dados, e caso o arquivo em disco ainda não exista , ele é criado na hora usando o conteúdo da imagem, e o nome do arquivo usa o código identificador do contato, para não precisar ficar criando e apagando o mesmo arquivo várias vezes, também servindo de “Cache” para as fotos armazenadas nesta tabela.

Atribuindo uma imagem ao contato

Quase que eu esqueço do principal, a função ChgImage(), para permitir atribuir ou remover uma imagem a um contato. Vejamos:

STATIC Function ChgImage(oDlg,aBtns,aGets)
Local cTitle := 'Escolha uma imagem'
Local oDlgImg
Local cFile := space(40)
Local lOk := .F.
Local aFInfo

DEFINE DIALOG oDlgImg TITLE (cTitle) ;
  FROM 0,0 TO 120,415 PIXEL;
  FONT oDlg:oFont ;
  OF oDlg ; 
  COLOR CLR_BLACK, CLR_HBLUE

@ 05,05 GET oGet1 VAR cFile SIZE CALCSIZEGET(40),12 OF oDlgImg PIXEL

@ 25,05 BUTTON oBtn1 PROMPT "Buscar" SIZE 60,15 ;
  ACTION (BuscaFile(@cFile)) OF oDlgImg PIXEL

@ 25,85 BUTTON oBtn2 PROMPT "Ok" SIZE 60,15 ;
  WHEN empty(cFile) .or. File(alltrim(cFile))  ; 
  ACTION ( lOk := .T. , oDlgImg:End() ) OF oDlgImg PIXEL

ACTIVATE DIALOG oDlgImg CENTER

IF lOk
  cFile := alltrim(cFile)
  aFInfo := Directory(cFile)
  If len(aFInfo) > 0 
    If aFInfo[1][2] > ( 128 * 1024) // Até 128 KB
      MsgStop("Arquivo muito grande ("+str(aFInfo[1][2]/1024,8,2)+" KB)","Imagem maior que 128 KB")
      return 
    Endif
  Else
    MsgStop('Arquivo não encontrado',cFile)
    return 
  Endif
  // Chegou ate aqui, atualiza o campo memo 
  cMemoImg := AGENDA->IMAGE
  If !empty(cMemoImg)
    lOk := MsgYesNo("Este contato já tem uma foto. Deseja substituí-la ?")
  Endif
  If lOk
    // Lê a imagem do disco 
    cMemoImg := ReadFile(cFile)
    If empty(cMemoImg)
      Return
    Endif
    DBSelectArea("AGENDA")
    If DbrLock(recno())
      AGENDA->IMAGE := cMemoImg
      DBRUnlock() 
      MsgInfo("Imagem atualizada.")
    Else
      // Nao conseguiu bloqueio do registro
      // Mostra a mensagem e permanece no modo de alteração
      MsgStop("Registro não pode ser alterado, está sendo usado por outro usuário")
    Endif
  Endif
Endif
Return

A imagem escolhida não pode ter mais que 128 KB — é uma foto 3×4 de 120 x 160 pontos, e deve ser pequena para permitir recuperação e desenho de interface rápidos.

E, por final a função auxiliar ReadFile() que lê um arquivo binário do disco e retorna seu conteúdo em uma String AdvPL a seguir:

STATIC Function ReadFile(cFile)
Local cBuffer := ''
Local nH , nTam
nH := Fopen(cFile)
IF nH != -1
  nTam := fSeek(nH,0,2)
  fSeek(nH,0)
  cBuffer := space(nTam)
  fRead(nH,@cBuffer,nTam)
  fClose(nH)
Else
  MsgStop("Falha na abertura do arquivo ["+cFile+"]","FERROR "+cValToChar(Ferror()))
Endif
Return cBuffer

Pronto

Com tudo isso setado compile os fontes execute, teste,etc. Lembre-se de criar a pasta temp a partir do RootPAth do ambiente. Após entrar na Agenda e acessar a consulta, será mostrado o primeiro contato, com a imagem padrão.

Foto 1

Agora, clicamos no botão “Foto 3×4”, e será apresentada a caixa de diálogo abaixo:

Foto 2

No campo acima, você pode informar manualmente o caminho completo seguido do nome do arquivo de imagem a ser carregado — formatos BMP, PNG, JPG, TIFF — ou usar o botão “Buscar”

foto 3

O Botão de busca abre a interface acima, para escolhermos um arquivo de imagem a partir do RootPath do servidor. Após selecionar o arquivo desejado, clique no botão de confirmação — esse da esquerda com um  “v” vezinho verde. A caixa de diálogo de busca de arquivos será fechada, e o campo do formulário anterior será preenchido com o caminho e nome do arquivo escolhido.

foto 4

Agora, ao clicarmos no botão OK, a imagem será carregada e salva no campo memo chamado “IMAGE” do contato atualmente na tela. Em caso de sucesso, será mostrada a imagem abaixo:

Crud - Foto 6

Ao fechar esta caixa de diálogo, a nova foto atribuída ao contato é mostrada na tela.

foto 5.png

Ao usar os botões de navegação, cada contato posicionado mostrará a foto correspondente.

Conclusão

Não foi fácil chegar ao fim desta implementação, durante os testes vários comportamentos estranhos e ajustes foram necessários. Por exemplo, o componente BITMAP possui uma otimização, para evitar carregar o mesmo arquivo duas vezes. Quando eu resolvi trocar a foto, o arquivo temporário no disco precisava ser apagado e recriado, mas o fato dele usar o mesmo nome, fazia com que a foto não fosse recarregada. Contornei este comportamento simplesmente carregando a foto padrão antes de recarregar a nova foto após a alteração, além de criar o arquivo com a imagem default apenas uma vez na entrada da agenda, e criar uma função para apagar o arquivo do cache em disco ao inserir ou alterar uma foto. Nos próximos POSTS, vamos incrementar mais um pouco este programa !!!!

*** Não entre em pânico, entre no GITHUB e pegue a versão final deste fonte ***

Desejo a todos novamente TERABYTES DE SUCESSO 😀

Referências

 

CRUD em AdvPL – Parte 09

Introdução

Em cada post sobre o CRUD, vamos melhorando partes do código e acrescentando funcionalidade. Neste tópico, vamos acrescentar uma Busca de CEP na Internet, para fazer o preenchimento automático de alguns campos do endereço.

Botão de Consulta de CEP

Para disparar a busca, vamos aproveitar o valor preenchido no campo GET de CEP da Interface, adicionando um botão com o título “Buscar CEP”, porém vamos usar uma pré-validação do Botão — propriedade bWhen do Objeto, acessada pelo comando @…BUTTON através da instrução WHEN <condição>. Quando a expressão usada na condição do botão for verdadeira, o botão torna-se ativo. Caso contrário, ele é desativado. Vamos ao fonte:

(...)
@ 110,60 GET oGet8 VAR cCEP PICTURE "@R 99999-999" ;
   SIZE CALCSIZEGET(9),12 OF oPanelCrud PIXEL

// Habilita a busca de CEP com um botão do lado do GET
// O Botão somente está disponível caso o oGet8 ( campo CEP )
// estiver habilitado para edição
@ 110,110 BUTTON oBtnCEP PROMPT "Buscar CEP" SIZE 60,14 ;
   WHEN (oGet8:LACTIVE) ; 
   ACTION BuscaCEP(oDlg,aBtns,aGets) OF oPanelCrud PIXEL

// Novos campos inseridos em 07/10
(...)


Para que o botão de Busca de CEP somente esteja ativo quando o GET do CEP estiver ativo, usamos a propriedade lActive do objeto GET do CEP (oCep) como condição WHEN do botão.

Função BuscaCEP()

A função de busca de CEP vai verificar se o CEP digitado está completo, rodar uma segunda função para buscar os dados do endereço daquele CEP na Internet, e validar o retorno. Caso os dados sejam buscados com sucesso, o programa mostra os dados encontrados e pergunta se ele deve atualizar os campos de endereço do formulário com os dados obtidos. Vamos ao fonte:

/* ---------------------------------------------------
Botão para busca de CEP e preenchimento de campos 
de endereço automaticamente. 
--------------------------------------------------- */
Static Function BuscaCEP(oDlg,aBtns,aGets)
Local nPos , cCEP
Local cJsonCEP
Local oJsonObj
Local aJsonFields := {}
Local nRetParser := 0
Local oJHashMap
Local lOk
Local cCEPEnder := ''
Local cCEPBairro := ''
Local cCepCidade := ''
Local cCEPUF := ''
Local lCEPERRO := .F.

// Busca o campo CEP nos Gets e recupera o valor informado
nPos := ascan(aGets , {|x| x[1] == "CEP" } )
cCep := Eval(aGets[nPos][2]:bSetGet)
cCep := alltrim(cCep)

// Verifica se o valor informado está completo - 8 dígitos
IF len(cCEp) < 8
  MsgStop("Digite o número do CEP completo para a busca.","CEP Inválido ou incompleto")
  Return
Endif

// Busca o CEP usando uma API WEB
// Em caso de sucesso, a API retorna um JSON
// Em caso de falha, uam string vazia
cJsonCEP := WebGetCep(cCEP)

If !empty(cJsonCEP)
  // Caso o CEP tenha sido encontrado, chama o parser JSON
  oJsonObj := tJsonParser():New()
  // Faz o Parser da mensagem JSon e extrai para Array (aJsonfields)
  // e cria tambem um HashMap para os dados da mensagem (oJHM)
  lOk := oJsonObj:Json_Hash(cJsonCEP, len(cJsonCEP), @aJsonfields, @nRetParser, @oJHashMap)
  If ( !Lok )
    MsgStop(cJsonCEP,"Falha ao identificar CEP",cCEP)
  Else
    // Obtem o valor dos campos usando o Hashmap gerado
    HMGet(oJHashMap, "erro", @lCEPERRO)
    if lCEPERRO
      MsgStop("CEP Inexistente na Base de Dados","Falha ao buscar CEP "+cCEP)
    Else
      HMGet(oJHashMap, "logradouro", @cCEPEnder)
      HMGet(oJHashMap, "bairro", @cCEPBairro)
      HMGet(oJHashMap, "localidade", @cCepCidade)
      HMGet(oJHashMap, "uf", @cCEPUF)
      cCEPEnder := padr(upper(cCEPEnder) ,50)
      cCEPBairro := padr(upper(cCEPBairro),30)
      cCepCidade := padr(upper(cCepCidade),40)
      cCEPUF := padr(Upper(cCEPUF) ,2)

      IF MsgYesNo("Endereço ... "+cCEPEnder + chr(10) + ;
        "Bairro ..... "+cCEPBairro + chr(10) + ;
        "Cidade ..... "+cCEPCidade+ chr(10) + ;
        "Estado ..... "+cCepUF+ chr(10) + ;
        "Deseja atualizar o formulário com estes dados?","CEP encontrado")

        nPos := ascan(aGets , {|x| x[1] == "ENDER" } )
        Eval(aGets[nPos][2]:bSetGet , cCEPEnder )
        nPos := ascan(aGets , {|x| x[1] == "BAIRR" } )
        Eval(aGets[nPos][2]:bSetGet , cCEPBAirro )
        nPos := ascan(aGets , {|x| x[1] == "CIDADE" } )
        Eval(aGets[nPos][2]:bSetGet , cCepCidade )
        nPos := ascan(aGets , {|x| x[1] == "UF" } )
        Eval(aGets[nPos][2]:bSetGet , cCepUF )
      Endif
    Endif
  Endif
  // Limpa os objetos utilizados
  FreeObj(oJsonObj)
  FreeObj(oJHashMap)
Endif
Return

A função WebGetCep() recebe como parâmetro o CEP a ser pesquisado, em formato cartactere. Ela será a responsável bor buscar o CEP na Internet, usando a API oferecida pelo site viacep.com.br — vide deetalhes nas referências no final desse post.

Em caso de indisponibilidade do serviço, a função WebGetCep() deve retornar uma string vazia. Caso contrário, ela retorna uma string em formato JSON, que modemos parsear usando uma classe nativa do AdvPL, que retorna um objeto HashMap, para acelerar a busca pelas informações desejadas. Como a API já tem um formato pré-definido de retorno, basta procurarmos as condições que nos interessam.

Função WebGetCep()

Essa aqui é a responsável pela “mágica” — a chamada da API WEB disponível através de um método GET em HTTP, usando a função HttpGet() do AdvPL, e tratando um possível retorno de erro. Vamos ao código:

STATIC Function WebGetCep(cCEP)
Local cUrl , cJsonRet
Local nCode , cMsg := ''
// Montando a URL de pesquisa
cUrl := 'http://viacep.com.br/ws/'+cCEP+'/json/'
// Buscando o CEP
cJsonRet := httpget(cUrl)
// Verificando retorno 
If empty(cJsonRet)
  nCode := HTTPGETSTATUS(@cMsg)
  MsgStop(cMsg+" ( HTTP STATUS = "+cValToChar(nCode)+" )","Falha na Busca de CEP")
Endif
Return cJsonRet

A função é bem simples, a requisição também, e o tratamento de erro mais ainda. Caso a requisição volte um conteúdo vazio, pode ser uma indisponibilidade do serviço ou da conexão com a internet, seja o que for, o status de erro é recuperado pela função HttpGetStatus().

Busca de CEP funcionando

Primeiro entramos na agenda, acionamos a consulta, mostramos um registro desejado e clicamos em “Alterar” :

CRUD - Busca CEP 1.png

Feito isso, vamos digitar um CEP, por exemplo 18603-730, e clicamos no botão “Buscar CEP”. Caso a busca de CEP tenha sido executada com sucesso, devemos ver na tela a seguinte mensagem:

CRUD - Busca CEP 2

Vamos confirmar a operação, clicando em “Yes”, e vamos ver como ficou a tela com os dados do contato — os dados destacados em vermelho foram alterados.

CRUD - Busca CEP 3

Agora, basta clicar em “Salvar” para persistir as alterações deste contato no Banco de Dados.  😀

Conclusão

Com um fonte modularizado, fica fácil acrescentar novas funcionalidades sem ter que virar o código original do avesso.  Nos próximos posts, vamos começar a separar o processamento dos dados, e tentar deixar as funcionalidades do código mais dinâmicas.

Agradeço novamente a audiência, e desejo a todos TERABYTES DE SUCESSO !!!

Referências

 

CRUD em AdvPL – Parte 08

Introdução

Prontos para mais um capítulo da novela do CRUD? Neste post vamos fazer algumas alterações no layout dos componentes, e acrescentar as funcionalidades de busca indexada por ID e NOME e mudança de ordem de consulta. O fonte completo está disponível no GITHUB, link disponível no final do post.

Alteração da disposição dos componentes

Os botões de navegação “Primeiro”, “Anterior”, “Próximo” e “Último”, que antes eram dispostos horizontalmente na parte de baixo do formulário de campos da Agenda, serão remanejados para a direita do formulário, verticalmente, e com o espaço que ganhamos, vamos acrescentar mais alguns botões.

Crud V2 Consulta

Para isso ser feito de forma simples, primeiro criamos um painel a mais na caixa de diálogo, e colocamos seu alinhamento à direita.

@ 0,0 MSPANEL oPanelNav OF oDlg SIZE 70,600 COLOR CLR_WHITE,CLR_GRAY
oPanelNav:ALIGN := CONTROL_ALIGN_RIGHT

Agora, todos os botões de navegação, inclusive os novos botões de consulta e ordem, são acrescentados neste painel. Praticamente aproveitamos todas as coordenadas dos botões do menu de opções do painel esquerdo, afinal as coordenadas dos componentes são sempre relativas à coordenada 0,0 (canto superior esquerdo) do seu container — no caso um objeto tPanel.

// Cria os Botões de Navegação Livre
@ 05,05 BUTTON oBtnFirst PROMPT "Primeiro" SIZE 60,15 ;
  ACTION ManAgenda(oDlg,aBtns,aGets,7,@nMode) OF oPanelNav PIXEL
aadd(aBtns,oBtnFirst) // [7] Primeiro

@ 020,05 BUTTON oBtnPrev PROMPT "Anterior" SIZE 60,15 ;
  ACTION ManAgenda(oDlg,aBtns,aGets,8,@nMode) OF oPanelNav PIXEL
aadd(aBtns,oBtnPrev) // [8] Anterior

@ 35,05 BUTTON oBtnNext PROMPT "Próximo" SIZE 60,15 ;
  ACTION ManAgenda(oDlg,aBtns,aGets,9,@nMode) OF oPanelNav PIXEL
aadd(aBtns,oBtnNext) // [9] Proximo

@ 50,05 BUTTON oBtnLast PROMPT "Último" SIZE 60,15 ;
  ACTION ManAgenda(oDlg,aBtns,aGets,10,@nMode) OF oPanelNav PIXEL
aadd(aBtns,oBtnLast) // [10] Último

@ 65,05 BUTTON oBtnPesq PROMPT "Pesquisa" SIZE 60,15 ;
  ACTION ManAgenda(oDlg,aBtns,aGets,11,@nMode) OF oPanelNav PIXEL
aadd(aBtns,oBtnPesq) // [11] Pesquisa

@ 80,05 BUTTON oBtnOrd PROMPT "Ordem" SIZE 60,15 ;
  ACTION ManAgenda(oDlg,aBtns,aGets,12,@nMode) OF oPanelNav PIXEL
aadd(aBtns,oBtnOrd) // [12] Ordem

A função ManAgenda() agora passa a receber as ações 11 (Pesquisa) e 12 (Ordem). Logo, teremos que implementar estas ações. Mas antes tem uma parte do código que podemos simplificar.

Escondendo os botões de navegação

Na versão anterior do programa Agenda, os botões de navegação eram criados a partir do painel de visualização e edição de registros da agenda (oPanelCrud), e para esconder ou mostrar os botões de navegação, era necessário endereçar cada botão individualmente. Dessa forma, o fonte de ligar e desligar os botões de navegação ficaria assim:

// -------------------------------------------------
// Habilita ou desabilita os botões de navegação
// -------------------------------------------------
STATIC Function SetNavBtn(aBtns,lEnable)
IF lEnable
  aBtns[7]:Show() // Primeiro
  aBtns[8]:Show() // Anterior
  aBtns[9]:Show() // Proximo
  aBtns[10]:Show() // Ultimo
  aBtns[11]:Show() // Pesquisa
  aBtns[12]:Show() // Ordem
Else
  aBtns[7]:Hide() // Primeiro
  aBtns[8]:Hide() // Anterior
  aBtns[9]:Hide() // Proximo
  aBtns[10]:Hide() // Ultimo
  aBtns[11]:Hide() // Pesquisa
  aBtns[12]:Hide() // Ordem
Endif
Return

Agora, que os botões de navegação estão dentro de um painel, podemos simplesmente esconder ou mostrar o painel de navegação inteiro, apenas com uma instrução. E nós não precisamos sequer passar o objeto do Painel como parâmetro, veja a nova função abaixo:

STATIC Function SetNavBtn(aBtns,lEnable)
Local oPanel := aBtns[7]:oParent 
If lEnable
  oPanel:Show()
Else
  oPanel:Hide()
Endif
Return

Desta forma, pegamos o objeto apenas do sétimo botão — botão “Primeiro” — e através dele pegamos o objeto do componente onde ele foi criado usando a propriedade oParent. Assim, conseguimos esconder e mostrar o painel inteiro — e automaticamente todos os componentes criados dentro dele.

Podemos também, ao invés de esconder e mostrar o painel, podemos desabilitar o painel, de modo que o painel e seus componentes fiquem visíveis, mas não possam ser acionados. Neste caso, o fonte ficaria assim:

STATIC Function SetNavBtn(aBtns,lEnable)
Local oPanel := aBtns[7]:oParent
oPanel:SetEnable(lEnable)
Return

Definindo a ordem de consulta

Quando entramos na opção de consulta, a aplicação troca a ordem de navegação da tabela — usando a função DbSetOrder() — para ordem alfabética pelo nome do contato da agenda, usando o índice criado a partir do campo NOME. Quando confirmamos a inclusão de um novo registro, a ordem pode ser alterada para ID, caso seja necessário determinar o último número registrado na Agenda para incrementar e gerar o próximo ID.

Neste momento, vamos criar um recurso para permitir mudar por nossa conta a ordem de navegação da tabela em modo de consulta, mas antes precisamos mostrar em algum lugar qual a ordem que está sendo utilizada atualmente.

Painéis e alinhamentos

Vamos criar um painel superior, dentro da área usada para os campos do formulário, e dentro dele vamos colocar a informação da ordem em uso. Vamos aproveitar a possibilidade de criar um painel dentro de outro, para criar um painel central, onde hoje é criado o painel para CRUD, e dentro desse painel central, colocamos um painel com alinhamento superior, para colocar a informação sobre a ordenação do arquivo, e na área que sobrou, colocamos o painel do CRUD. A implementação ficaria dessa forma:

@ 0,0 MSPANEL oPanelMenu OF oDlg SIZE 70,600 COLOR CLR_WHITE,CLR_GRAY
oPanelMenu:ALIGN := CONTROL_ALIGN_LEFT

@ 0,0 MSPANEL oPanelNav OF oDlg SIZE 70,600 COLOR CLR_WHITE,CLR_GRAY
oPanelNav:ALIGN := CONTROL_ALIGN_RIGHT

@ 0,0 MSPANEL oPanelCenter OF oDlg SIZE 700,600 COLOR CLR_WHITE,CLR_LIGHTGRAY
oPanelCenter:ALIGN := CONTROL_ALIGN_ALLCLIENT

@ 0,0 MSPANEL oPanelOrd OF oPanelCenter SIZE 100,20 COLOR CLR_WHITE,CLR_BLUE
oPanelOrd:ALIGN := CONTROL_ALIGN_TOP

@ 0,0 MSPANEL oPanelCrud OF oPanelCenter SIZE 700,600 COLOR CLR_WHITE,CLR_LIGHTGRAY
oPanelCrud:ALIGN := CONTROL_ALIGN_ALLCLIENT

Reparem que os painéis oPanelCrud e oPanelOrd são criados a partir do oPanelCenter, que pega todo o espaço da DIALOG que sobrou depois de alinhar o painel oPanelMenu à esquerda e o oPanelNav a direita.

Se você pensar bem, criar um painel superior para mostrar a ordem de índice … não é um tiro de canhão para matar uma mosca ? Não necessariamente, afinal para eu criar este objeto TSAY na parte superior, dentro do painel do CRUD, seria necessário realinhar todos os componentes mais pra baixo, para abrir espaço para este TSAY. Da forma que foi feita, eu não precisei alterar nenhuma coordenada, apenas criei a sequência de painéis, e se amanhã eu achar que a ordem fica mais legal em baixo, basta eu mudar o alinhamento do painel, simples assim.

Mostrando a ordem de consulta atual

Dentro do painel oPanelOrd, vamos colocar um componente visual para informar a ordenação atual de consulta do arquivo. Neste caso, vamos usar um objeto tSay:

// Mostra Ordenação atual do arquivo de agenda
@ 5,5 SAY oSayOrd PROMPT " " SIZE 100,12 COLOR CLR_WHITE,CLR_BLUE OF oPanelOrd PIXEL
oSayOrd:SetText("Ordem .... "+ AGENDA->(IndexKey()))

Na abertura do programa, a tabela AGENDA é aberta com o ALIAS “AGENDA”, então para simplificar a implementação, eu apenas seto o texto do objeto tSay para colocar a chave de índice da ordem atual da tabela, obtida com a função IndexKey(). Logo, a nova tela de abertura da Agenda deve ficar assim:

Crud V2 Entrada

As trocas de ordem do arquivo são feitas dentro da função ManAgenda(), mas o componente de interface que mostra a ordem é um Objeto TSay, que não é passado como parâmetro. Logo, vamos passar ele como um novo parâmetro para a função ManAgenda(), e atualizá-lo quando necessário, usando a mesma fórmula anteriormente usada, mas sendo executada para pegar o estado atual.

Mudando a Ordem

Pensando novamente em solução SIMPLES, a ação do botão “Ordem” deve apenas trocar a ordem para ID ou NOME. Existem inúmeras formas de se fazer isso, porém como o objetivo é ser simples, e são apenas 2 ordens para escolher, eu optei pela implementação mais simples:

(...)
ElseIf nAction == 12 // Troca de Ordem
   IF ChangeOrd(oDlg)
      // Se a ordem foi trocada 
      // Atualiza texto com a chave do indice em uso 
      oSayOrd:SetText("Ordem .... "+ AGENDA->(IndexKey()))
   Endif
Else 
(...)

E, para permitir a escolha, a nova função ChangeOrd()

Static Function ChangeOrd(oDlg)
Local nOrdAtu := AGENDA->(IndexOrd())
Local nNewOrd := 0
If nOrdAtu == 1 
  If MsgYesNo("Deseja alterar para ordem de NOME ?")
    nNewOrd := 2
  Endif
Else
  If MsgYesNo("Deseja alterar para ordem de ID ?")
    nNewOrd := 1
  Endif
Endif
if ( nNewOrd > 0 ) 
  AGENDA->(DBSETORDER(nNewOrd))
  Return .T.
Endif
return .F.

Implementando a Busca sobre o índice

E, para finalizar, vamos fazer a busca rápida sobre o índice, na ação 11. Para isso, vamos perguntar ao operador do programa, o que ele procura. A ordem de busca usada será a ordem atual. Primeiro, dentro da função ManAgenda(), vamos inserir a execução da ação 11 — Pesquisa.

(...)
ElseIf nAction == 11 // Pesquisa Indexada

   // Realiza a busca pelo índice atual 
   PesqIndeX(oDlg)

   // Atualiza na tela o conteúdo do registro atual 
   ReadRecord(aGets)

Else
(...)

Agora, vamos implementar a funcionalidade de busca, acrescentando as duas funções abaixo:

STATIC Function PesqIndeX(oDlgParent)
Local oDlgPesq 
Local cTitle
Local cStrBusca
Local nTamanho
Local nRecSave 
Local lFound := .F.
Local cIndexFld := AGENDA->(Indexkey())
Local oGet1 , oBtn1

// Monta titulo da janela de pesquisa
cTitle := 'Pesquisa por '+ cIndexFld

// Guarda numero do registro atual 
nRecSave := AGENDA->(Recno())

If indexord() == 1 // Campo ID
  nTamanho := 6
  cStrBusca := space(nTamanho)
  cPicture := "@9"
ElseIf indexord() == 2 // Campo NOME
  nTamanho := 50
  cStrBusca := space(nTamanho)
  cPicture := "@!"
Endif

DEFINE DIALOG oDlgPesq TITLE (cTitle) ;
   FROM 0,0 TO 120,415 PIXEL;
   OF oDlgParent ; 
   COLOR CLR_BLACK, CLR_LIGHTGRAY

@ 05,05 GET oGet1 VAR cStrBusca PICTURE (cPicture) SIZE CALCSIZEGET(nTamanho) ,12 OF oDlgPesq PIXEL

@ 25,05 BUTTON oBtn1 PROMPT "Buscar" SIZE 60,15 ;
   ACTION IIF( SeekAgenda(cIndexFld,cStrBusca) , (lFound := .T. , oDlgPesq:End()) , oGet1:SetFocus() ) OF oDlgPesq PIXEL

ACTIVATE DIALOG oDlgPesq CENTER

If !lFound
   // Nao achou, volta ao registro antes da busca 
   AGENDA->(dbgoto(nRecSave))
Endif

Return

// Ajusta o valor informado na tela de acordo com o campo / indice 
// para fazer a busca corretamente
STATIC Function SeekAgenda(cIndexFld,cStrBusca)
IF cIndexFld == 'ID'
   cStrBusca := strzero(val(cStrBusca),6)
ElseIF cIndexFld == 'NOME'
   cStrBusca := alltrim(cStrBusca)
Endif
If !DbSeek(cStrBusca)
   MsgStop("Informação não encontrada.","Busca por ["+cStrBusca+"]")
   Return .F.
Endif
return .T.

Funcionamento e considerações

A função de busca utilizada  — DBSeek() — vai posicionar no primeiro registro que satisfazer a chave informada. No caso no NOME, pode ser informado apenas uma ou mais primeiras letras do nome, e se houver um nome que comece com estas letras, ele será o registro que vai ser trazido na tela.

Caso a informação não seja encontrada, será exibida uma mensagem, e o programa retorna para a tela de entrada de valor de busca, para você alterar o valor informado ou digitar um valor novo. Caso o registro seja encontrado, a janela fecha sozinha, e o registro encontrado é trazido na tela.

Conclusão

Daqui a pouco esse CRUD vira um produto … e ainda têm muito mais para ser explorado. Quer a versão atualizada desse código ? Acesse o GITHUB na URL https://github.com/siga0984/Blog e faça download do arquivo AGENDA.PRW — devidamente atualizado. Basta compilar, e chamar a função U_AGENDA diretamente no SmartClient.

Referências

 

CRUD em AdvPL – Parte 07

Introdução

Continuando a sequência de posts relacionados ao CRUD em Advpl, onde criamos um exemplo de programa de Agenda, nesse post vamos olhar mais de perto a geração do ID na inclusão de dados da Agenda, como o ERP Microsiga usa sequenciadores nas tabelas de dados, e como podemos fazer um sequenciador em memória para a Agenda.

Interface de Inclusão – Gerador de ID

Passando rapidamente o olho no fonte, ela parece em ordem. Os identificadores de registro (ID) da Agenda são criados protegidos por um semáforo (ou MUTEX), sempre pegamos o último registro usando o índice por ID — Ordem 1 — e acrescentamos uma unidade. Perfeito, certo ?

Não é bem assim. Ao excluir um registro da agenda usando a aplicação, o registro é marcado para deleção — através da função DbDelete() — e devido ao filtro para ignorar registros marcados para deleção nas operações de busca e navegação da tabela — ligado no inicio da aplicação com o comando SET DELETED ON —  o registro marcado para exclusão não é mais visível nas consultas.  Como o primeiro contato com ID 000004 está deletado — ou marcado para deleção — no momento que eu vou inserir um novo contato, a rotina de geração de ID pega o último registro ATIVO da tabela — estamos desconsiderando deletados — lê o valor do registro, e incrementa uma unidade — gerando novamente o ID 000004.

Podemos arrumar isso de uma forma bem simples, apenas desligando o filtro para ignorar registros deletados — usando o comando SET DELETED OFF — e no final da rotina, depois de gerar o novo número, ligar o filtro novamente.

Como a numeração sequencial é feita no ERP ?

Imagine cada inserção feita em uma tabela com um campo com sequência incremental, precisar ir no Banco de Dados, posicionar e ler o último registro para gerar o próximo identificador da sequência ? É um desperdício de requisições, além de ser necessário um MUTEX bloqueando a inserção até ela ser concluída.

Para contornar isso, foram criadas no ERP duas tabelas de controle e reserva de sequência, chamadas de SXE e SXF. A idéia é simples, uma controla todos os registros de sequenciadores do ERP, e a outra controla as reservas de sequência — um processo pode reservar uma sequência para uso, e não confirmar o uso da sequência, então ela torna-se disponível para a próxima inserção, evitando intervalos vazios ou “buracos” nas sequências.

A implementação e a ideia são excelentes, porém com o aumento do número de tabelas do ERP, e todos os sequenciadores sendo controlados pelo mesmo arquivo, a quantidade de acesso a disco por processos concorrentes usando as sequências poderia gerar filas de acesso ao disco no sistema operacional, deixando o sistema lento.

Para resolver isso, o mecanismo de sequenciamento e reserva de sequências foi transferido para dentro do Servidor de Licenças do ERP, onde as sequências são controladas em memória, sem acesso a disco. Com isso, apenas a primeira geração do registro de controle da sequência precisa fazer um acesso a disco, ir no final da tabela, ler o último código, e criar o registro de sequenciamento. A partir de então, usando as mesmas funções de encapsulamento disponibilizadas pelo Framework AdvPL do ERP, as próximas requisições de um novo identificador da sequência são feitas para o Servidor de Licenças, de forma muito rápida, evitando acesso a disco desnecessário, e como todo o controle de sequenciamento é feito na memória, o tempo que a lista permanece bloqueada para a geração do identificador é ridículo.

Construindo um sequenciador para a Agenda

Partindo ainda da premissa que o programa de AGENDA será executado por hora apenas por um servidor de aplicação, podemos usar por exemplo uma variável global para guardar o último número gerado da agenda, e quando for realizada uma inclusão, resgatamos o número da memória, acrescentamos uma unidade, e atualizamos a variável global. Dessa forma, mesmo com múltiplas threads, cada uma delas ficará bloqueada para gerar um novo identificador por um tempo ínfimo, e a sequência sempre fica na memória, enquanto o servidor estiver no ar. Vamos ver como ficaria a função GetNewID() usando essa abordagem:

 

STATIC Function GetNewID()
Local cLastID,cNewId
Local nRetry := 0
While !GlbNmLock("AGENDA_ID")
   // Espera máxima de 1 segundo, 20 tentativas 
   // com intervalos de 50 milissegundos 
   nRetry++
   If nRetry > 20
      return ""
   Endif
   Sleep(50)
Enddo
cLastID := GetGlbValue("AGENDA_SEQ")
If Empty(cLastID) 
  // Somente busco na Tabela se eu nao tenho o valor na memoria
  DBSelectArea("AGENDA")
  DbsetOrder(1)
  DBGobottom()
  cLastId := AGENDA->ID
Endif
cNewId := StrZero( val(cLastID) + 1 , 6 )
PutGlbValue("AGENDA_SEQ",cNewID)
GlbNmUnlock("AGENDA_ID")
Return cNewId

Reparem como o fonte ficou praticamente do mesmo tamanho que era antes, porém agora seu comportamento está muito — muito mesmo — mais optimizado. Na primeira execução do programa, a variável global AGENDA_SEQ não existe em memória, logo a aplicação busca o último registro do banco de dados. Caso a global já exista, o valor do último ID utilizado é recuperado da memória. Então, criamos o novo ID, atualizamos a variável global de memória com este valor, soltamos o bloqueio nomeado obtido, e retornamos o número para a rotina de inserção.

Diferença de Tempo

Fazendo um teste de inserção usando uma função de teste sem interface, no meu ambiente consegui inserir 10 mil registros em pouco mais de 10 segundos — aproximadamente 1000 registros por segundo — inserindo apenas ID e um nome aleatório. Usando a rotina de geração de ID proposta, lendo os valores da memória, o tempo baixou de 10,5 s. para 5,5 s. — praticamente duas vezes mais rápido. Segue abaixo a função de testes utilizada:

User Function TesteAg1()
Local nI, nTimer
OpenAgenda()
nTimer := seconds()
For nI := 1 to 10000
  cNewId := GetNewID()
  dbappend()
  agenda->ID := cNewId
  agenda->NOME := cvaltochar(str(seconds()*1000))
  DBRUnlock()
Next
conout("Tempo de Insert = "+str(seconds()-nTimer,12,3)+' s.')
return

Esta função foi acrescentada ao fonte AGENDA.PRW, e executada de modo direto. Como a função OpenAgenda() não depende de nada, podemos chamá-la diretamente no nosso teste, para abrir a tabela de AGENDA e usá-la diretamente. Caso você querida fazer o teste comparativo, recomendo renomear a função original GetNewID() para GetNewId1(), inserir a nova como GetNewId2(), e chavear isso no programa de testes, rodando uma vez com dada função para verificar a diferença de tempo.

Restrição Operacional

Naturalmente, devido ao escopo da variável de memória global ser apenas a instância atual do serviço atual do Protheus Server, este tipo de semáforo em memória somente poderia ser usado por exemplo em um ambiente com balanceamento de carga — e consequentemente múltiplos serviços — caso este controle fosse centralizado em um serviço dedicado, e os demais serviços consumissem estas funções fazendo chamadas remotas (RPC Nativo do AdvPL, por exemplo).

Conclusão

Por hora, nada mais a acrescentar. Ao testar a agenda, já encontrei outros pontos que precisam de ajustes, vamos deixar as conclusões para o próximo post.

Desejo a todos novamente TERABYTES de SUCESSO 😀

Referências

 

CRUD em AdvPL – Parte 06

Introdução

Neste post, vamos dar uma incrementada na Agenda, acrescentando 3 novos campos —  FONE1, FONE2 e EMAIL — fazendo mínimas alterações no código, e alterando a estrutura da tabela AGENDA no Banco de Dados.

Inserindo novos campos na Agenda

Pode parecer complicado, mas algumas partes do programa Agenda.PRW já foram criadas pensando em haver mudanças ou novas implementações. Para acrescentarmos mais campos na tabela de Agenda, vamos aproveitar a função separada de criação da tabela e índices, para também verificar e alterar a estrutura da tabela atual caso ela já exista sem estar com nas novas colunas.

Primeira parte – Interface

Acrescentar os novos campos na interface é a parte mais simples. Criamos novos objetos de GET, colocamos eles nos Arrays de controle, criamos as posições de interface, aumentamos 50 pixels na altura da janela, deslocamos todos os botões de navegação, confirmar e voltar 50 pixels para baixo, e declaramos as variáveis a serem usadas. Como a passagem de parâmetros para as funções de controle sempre passam o Array com os objetos GET, nenhuma passagem de parâmetros adicional foi necessária.

Local cFone1 := Space(20)
Local cFone2 := Space(20)
Local cEmail := Space(40)
// Novos campos inseridos em 07/10
@ 125,60 GET oGet9 VAR cFone1 PICTURE "@!" SIZE CALCSIZEGET(20),12 OF oPanelCrud PIXEL
@ 140,60 GET oGetA VAR cFone2 PICTURE "@!" SIZE CALCSIZEGET(20),12 OF oPanelCrud PIXEL
@ 155,60 GET oGetB VAR cEMAIL PICTURE "@!" SIZE CALCSIZEGET(40),12 OF oPanelCrud PIXEL
// Novos campos inseridos em 07/10
aadd( aGets , {"FONE1" , oGet9 , space(20) } )
aadd( aGets , {"FONE2" , oGetA , space(20) } )
aadd( aGets , {"EMAIL" , oGetB , space(40) } )

Segunda parte – tabela AGENDA

O programa trabalha com uma tabela de dados criada em um Banco de Dados relacional acessado pelo DBAccess. Originalmente estes campos não existiam na tabela, não há alteração, apenas acrescentar campos novos. Para esta tarefa, vamos usar a função TCAlter(), e mexer apenas na função de criação e abertura da tabela AGENDA — no nosso caso, a função OpenAgenda(), vide novo fonte abaixo:

STATIC Function OpenAgenda()
Local nH
Local cFile := "AGENDA"
Local aStru := {}
Local aDbStru := {}
Local nRet

// Conecta com o DBAccess configurado no ambiente
nH := TCLink()

If nH < 0
  MsgStop("DBAccess - Erro de conexao "+cValToChar(nH))
  QUIT
Endif


// Cria o array com os campos do arquivo 

aadd(aStru,{"ID" ,"C",06,0})
aadd(aStru,{"NOME" ,"C",50,0})
aadd(aStru,{"ENDER" ,"C",50,0})
aadd(aStru,{"COMPL" ,"C",20,0})
aadd(aStru,{"BAIRR" ,"C",30,0})
aadd(aStru,{"CIDADE","C",40,0})
aadd(aStru,{"UF" ,"C",02,0})
aadd(aStru,{"CEP" ,"C",08,0})

// Novos campos inseridos em 07/10
aadd(aStru,{"FONE1" ,"C",20,0})
aadd(aStru,{"FONE2" ,"C",20,0})
aadd(aStru,{"EMAIL" ,"C",40,0})

If !tccanopen(cFile)

  // Se o arquivo nao existe no banco, cria
  DBCreate(cFile,aStru,"TOPCONN")

Else

  // O Arquivo já existe, vamos comparar as estruturas
  USE (cFile) ALIAS (cFile) EXCLUSIVE NEW VIA "TOPCONN"
  aDbStru := DBStruct()
  USE

  If len(aDbStru) <> len(aStru)
    // O tamanho está diferente ? 
    // Vamos alterar a estrutura da tabela
    // informamos a estrutura atual, e a estrutura esperada
    If !TCAlter(cFile,aDbStru,aStru)
      MsgSTop(tcsqlerror(),"Falha ao alterar a estrutura da AGENDA")
      QUIT
    Endif
    MsgInfo("Estrutura do arquivo AGENDA atualizada.")
  Endif

Endif

If !tccanopen(cFile,cFile+'_UNQ')
  // Se o Indice único da tabela nao existe, cria 
  USE (cFile) ALIAS (cFile) EXCLUSIVE NEW VIA "TOPCONN"
  nRet := TCUnique(cFile,"ID")
  If nRet < 0 
    MsgSTop(tcsqlerror(),"Falha ao criar índice único")
    QUIT
  Endif
  USE
EndIf

If !tccanopen(cFile,cFile+'1')
  // Se o Indice por ID nao existe, cria
  USE (cFile) ALIAS (cFile) EXCLUSIVE NEW VIA "TOPCONN"
  INDEX ON ID TO (cFile+'1')
  USE
EndIf

If !tccanopen(cFile,cFile+'2')
  // Se o indice por nome nao existe, cria
  USE (cFile) ALIAS (cFile) EXCLUSIVE NEW VIA "TOPCONN"
  INDEX ON NOME TO (cFile+'2')
  USE
EndIf

// Abra o arquivo de agenda em modo compartilhado
USE (cFile) ALIAS AGENDA SHARED NEW VIA "TOPCONN"

If NetErr()
  MsgStop("Falha ao Abrir a Agenda em modo compartilhado.")
  QUIT
  Return .F. 
Endif

// Liga o filtro para ignorar registros deletados 
SET DELETED ON

// Abre os indices, seleciona ordem por ID
// E Posiciona no primeiro registro 
DbSetIndex(cFile+'1')
DbSetIndex(cFile+'2')
DbSetOrder(1)
DbGoTop()

Return .T.

Novo comportamento do fonte

A parte nova e interessante é avaliar a estrutura da tabela caso ela já exista. Usamos a função DBStruct() após abrir a tabela para verificar qual é a estrutura atual da tabela no Banco de Dados. E, na memória, verificamos o tamanho desta estrutura com o array aStru, que contém a lista de campos com a estrutura atual (nova) da tabela.

Caso os arrays estejam diferentes, a tabela existente no SGDB precisa de alteração para contemplar os novos campos. Neste caso, com a tabela FECHADA, chamamos a função TCAlter(), informando o nome da tabela a ser alterada, o array com a estrutura atual da tabela segundo o banco de dados, e o array com a nova estrutura.

Internamente, a função TCAlter() vai verificar as diferenças entre as estruturas — que no caso serão apenas a adição de novos campos — e o DBAccess vai definir a sequência de operações que serão submetidas ao Banco de Dados para acrescentar estas colunas,

Logo, no primeiro acesso ao fonte, as estruturas estarão diferentes, e o programa vai executar a TCAlter() para inserir os novos campos. Em uma segunda execução, as estruturas já terão o mesmo tamanho, e esta operação não será mais necessária.

Demais proteções

Ainda faltam no fonte algumas proteções básicas, como por exemplo:

  • Proteger a rotina de abertura de tabela com um MUTEX, para evitar que dois processos tentem ao mesmo tempo fazer a criação ou alteração da tabela, bem como a criação dos índices.
  • Proteger as tentativas de abertura de modo EXCLUSIVE da tabela para manutenção, verificando após cada tentativa se a tabela foi realmente aberta, verificando o retorno da função NETERR(), ou verificando o alias atual usando a função ALIAS().

Outros tipos de alteração estrutural

A função TCAlter() apenas repassa a tabela e as estruturas ao DBAccess, que avalia de acordo com o tipo do banco de dados em uso quais as etapas necessárias para fazer a tabela partir da estrutura atual para chegar na nova estrutura informada. A comparação entre as estruturas é feita baseado no nome do campo, e identifica os seguintes casos:

  1. Inclusão de novo campo — o campo existe no segundo array mas não existe no primeiro.
  2. Alteração de tipo de campo — o campo existe nos dois arrays, mas o tipo do campo está diferente. A troca de tipo de um campo numérico inteiro (sem decimais) para caractere realiza internamente a conversão dos dados, sem haver perda do conteúdo. Qualquer outra troca de tipo será tratada internamente como se a coluna fosse eliminada e criada novamente com o tipo novo, com seu conteúdo vazio (default).
  3. Alteração de tamanho de campo — o campo existe nos dois arrays, mas o tamanho foi aumentado ou diminuído — alguns bancos de dados não suportam que uma operação destas seja feita diretamente, principalmente a redução do tamanho do campo. Nestes casos, o DBAccess internamente realiza uma sequencia de etapas — de acordo com o banco de dados eu uso — para no final do processo conseguir fazer a alteração mantendo os dados originais da coluna. Em alguns bancos, pode ser necessário que o DBAccess faça um BACKUP interno da tabela, crie ela novamente com a nova estrutura, e importe novamente os dados da tabela de Backup no formato adequado.
  4. Exclusão da coluna – o campo existe no primeiro Array, mas não existe no segundo.

Conclusão

O programa de CRUD já está ficando mais esperto do que a sua primeira versão, e ainda existem muitas possibilidades de melhoria. Não há melhor aprendizado do que ter um bom programa de exemplo nas mãos, e entender por quê ele precisa evoluir, e como podemos fazer isso. Aguardem mais surpresas e recursos nos próximos posts do CRUD.

Desejo novamente a todos TERABYTES de SUCESSO !!!!

Referências