BlackTDN :: Customizando a interface de Login no Protheus e by You

A publicação “BlackTDN :: By You e sua nova tela de login”  de nosso amigo OBona deu o que falar e, em função disso, esse que a muito não vos escreve resolveu criar uma versão onde será possível personalizar, “por completo”, a tela de login no Protheus/by You.

Considerando que OBona já havia “mapeado, identificado e customizado” as imagens peguei-as emprestadas para o exemplo que se segue:

O primeiro passo para a customização “total” da interface de login do Protheus/by You será implementar o “Ponto de Entrada” ChgPrDir (Diretório de impressão). Usaremos esse PE juntamente como programa U_FindMsObject.prg (apresentado pela primeira vez em: Protheus :: ADVPL : The Container : Presents Pandora's box).

Diferente do exemplo proposto por OBona, que substitui, durante o processo de compilação, as imagens padrões do sistema (excluindo-as) por imagens customizadas (com o mesmo nome) este novo exemplo mantém, no RPO, as imagens padrões adicionando novas imagens customizadas que serão substituídas em tempo de execução.

Além da substituição das imagens este novo exemplo procura substituir todos os textos e ações relacionadas por novos textos e novas ações.

Ao que interessa. O código:

O Primeiro programa que veremos será o U_ChgPrDir.prg. Ele é quem fará a chamada ao programa customizado StaticCall(BTDNCustomLogin,CustomLogin) para a “customização da tela de login”.

   1: #ifdef TOTVS

   2:     #include "totvs.ch"

   3: #else

   4:     #include "protheus.ch"

   5: #endif    

   6: #include "tryException.ch"

   7: /*

   8:     Programa : U_ChgPrDir.prg

   9:     Função   : U_ChgPrDir

  10:     Autor    : Marinaldo de Jesus [http://www.blacktdn.com.br]

  11:     Data     : 07/09/2012

  12:     Uso      : Tratamento customizado para o Diretório de Gravação de Relatórios

  13:     Sintaxe  : Ponto de Entrada ChgPrDir

  14:     Obs.     : Caso não Possua o PE ChgPrDir compilado em seu ambiente, retire o

  15:                comentário (*) das linhas abaixo antes de compilar este fonte.

  16: */

  17: *User Function ChgPrDir()

  18: *Return(StaticCall(U_ChgPrDir,ChgPrDir))

  19:  

  20: /*

  21:     Programa : U_ChgPrDir.prg

  22:     Função   : ChgPrDir

  23:     Autor    : Marinaldo de Jesus [http://www.blacktdn.com.br]

  24:     Data     : 07/09/2012

  25:     Uso      : Tratamento customizado para o Diretório de Gravação de Relatórios

  26:     Sintaxe  : StaticCall(U_ChgPrDir,ChgPrDir)

  27:                Execute a partir do Ponto de Entrada U_ChgPrDir.

  28:                Ex.:

  29:                User Function ChgPrDir()

  30:                Return(StaticCall(U_ChgPrDir,ChgPrDir))

  31: */

  32: Static Function ChgPrDir()

  33:     Local cRelDir := IF( ( Type( "__RELDIR" ) == "C" ) , __RELDIR , NIL )

  34:     /*    

  35:       Obs.: O PE ChgPrDir normalmente utilizado para alterar o diretório

  36:             para gravação dos relatórios será utilizado, também,    caso 

  37:             faca referencia a este programa, a personalizar a tela    de

  38:             login do by You substituindo as imagens padrões por  imagens

  39:             customizadas.

  40:    */

  41:    StaticCall(BTDNCustomLogin,CustomLogin) //Tratamento para Login Customizado

  42: Return( cRelDir )

  43:  

  44: Static Function __Dummy( lRecursa )

  45:     Local oException

  46:     TRYEXCEPTION

  47:         lRecursa := .F.

  48:         IF !( lRecursa )

  49:             BREAK

  50:         EndIF

  51:         lRecursa    := __Dummy( .F. )

  52:         ChgPrDir()

  53:         SYMBOL_UNUSED( __cCRLF )

  54:     CATCHEXCEPTION USING oException

  55:     ENDEXCEPTION

  56: Return( lRecursa )

Seguido pelo programa U_FindMsObject.prg (que contem a função para Retornar Array com os Objetos conforme cMsClassName)

   1: #ifdef TOTVS

   2:     #include "totvs.ch"

   3: #else

   4:     #include "protheus.ch"

   5: #endif    

   6: #include "tryException.ch"

   7: /*/

   8:     Programa : U_FindMsObject.prg

   9:     Funcao   : FindMsObject

  10:     Autor    : Marinaldo de Jesus [http://www.blacktdn.com.br]

  11:     Data     : 26/06/2011

  12:     Uso      : Retornar Array com os Objetos conforme cMsClassName

  13:     Sintaxe  : StaticCall( U_FindMsObject , FindMsObject , cMsClassName , oWnd )

  14: /*/

  15: Static Function FindMsObject( cMsClassName , oWnd )

  16:  

  17:     Local aMsObject  := {}

  18:  

  19:     Local oException

  20:     

  21:     TRYEXCEPTION

  22:     

  23:         DEFAULT oWnd := GetWndDefault()

  24:         

  25:         IF !( ValType( oWnd ) == "O" )

  26:             BREAK

  27:         EndIF

  28:         

  29:         IF !( ValType( cMsClassName ) == "C" )

  30:             BREAK

  31:         EndIF

  32:  

  33:         cMsClassName := Upper( cMsClassName )

  34:         aMsObject    := FindObject( @oWnd , @cMsClassName )

  35:         AddObj( @oWnd , @cMsClassName , @aMsObject )

  36:  

  37:     ENDEXCEPTION

  38:     

  39: Return( aMsObject )

  40:  

  41: /*/

  42:     Funcao  : FindObject

  43:     Autor   : Marinaldo de Jesus

  44:     Data    : 26/06/2011

  45:     Uso     : Retornar Array com os Objetos conforme cMsClassName

  46:     Sintaxe : FindObject( @oWnd , @cMsClassName , @aMsObject )

  47: /*/

  48: Static Function FindObject( oWnd , cMsClassName , aMsObject )

  49:     

  50:     Local aChild

  51:     Local aControls

  52:  

  53:     Local nChild

  54:     Local nChilds

  55:     Local nControl

  56:     Local nControls

  57:     

  58:     Local oChild

  59:  

  60:     DEFAULT aMsObject := {}

  61:     

  62:     BEGIN SEQUENCE

  63:  

  64:         aControls    := oWnd:aControls

  65:  

  66:         IF ( aControls == NIL )

  67:             AddObj( @oWnd , @cMsClassName , @aMsObject )

  68:             oChild := oWnd:oWnd

  69:             IF !( oChild == NIL )

  70:                 AddObj( @oChild , @cMsClassName , @aMsObject )

  71:                 FindObject( @oChild , @cMsClassName , @aMsObject )    

  72:             EndIF    

  73:             BREAK

  74:         EndIF

  75:  

  76:         nControls    := Len( aControls )

  77:         For nControl := 1 To nControls

  78:             oChild := aControls[ nControl ]

  79:             IF ( oChild == NIL )

  80:                 Loop

  81:             EndIF

  82:             AddObj( @oChild , @cMsClassName , @aMsObject )

  83:             TRYEXCEPTION

  84:                 aChild    := oChild:aControls 

  85:                 IF !( aChild == NIL )

  86:                     nChilds := Len( aChild )

  87:                     For nChild := 1 To nChilds

  88:                         oChild := aChild[ nChild ]

  89:                         IF !( oChild == NIL )

  90:                             IF ( oChild == NIL )

  91:                                 Loop

  92:                             EndIF

  93:                             AddObj( @oChild , @cMsClassName , @aMsObject )

  94:                             FindObject( @oChild , @cMsClassName , @aMsObject )    

  95:                         EndIF    

  96:                     Next nChild

  97:                 EndIF        

  98:             ENDEXCEPTION

  99:         Next nControl

 100:  

 101:         oChild := oWnd:oWnd

 102:         IF !( oChild == NIL )

 103:             AddObj( @oChild , @cMsClassName , @aMsObject )

 104:             FindObject( @oChild , @cMsClassName , @aMsObject )    

 105:         EndIF    

 106:  

 107:     END SEQUENCE

 108:  

 109: Return( aMsObject )

 110:  

 111: /*/

 112:     Programa : U_FindMsObject.prg

 113:     Funcao   : AddObj

 114:     Autor    : Marinaldo de Jesus [http://www.blacktdn.com.br]

 115:     Data     : 26/06/2011

 116:     Uso      : Adicionar o Objeto 

 117:     Sintaxe  : AddObj( @oObj , @cMsClassName , @aMsObject )

 118: /*/

 119: Static Function AddObj( oObj , cMsClassName , aMsObject )

 120:  

 121:     Local cClassName    := Upper( oObj:ClassName() )

 122:     

 123:     Local lAddObj        := .F.

 124:  

 125:     IF ( cClassName == cMsClassName )

 126:         IF ( lAddObj := ( aScan( aMsObject , { |oFind| ( oFind == oObj ) } ) == 0 ) )

 127:             aAdd( aMsObject , oObj )

 128:         EndIF

 129:     EndIF

 130:  

 131: Return( lAddObj )

 132:  

 133: /*/

 134:     Programa : U_FindMsObject.prg

 135:     Funcao   : GetOctlFocus

 136:     Autor    : Marinaldo de Jesus [http://www.blacktdn.com.br]

 137:     Data     : 26/06/2011

 138:     Uso      : Retorna o Objeto Ativo

 139:     Sintaxe  : GetOctlFocus( @oWnd )

 140: /*/

 141: Static Function GetOctlFocus( oWnd )

 142:  

 143:     Local oCtlFocus

 144:  

 145:     TRYEXCEPTION

 146:     

 147:         DEFAULT oWnd := GetWndDefault()

 148:         

 149:         IF !( ValType( oWnd ) == "O" )

 150:             BREAK

 151:         EndIF

 152:  

 153:         oCtlFocus    := oWnd:oCtlFocus

 154:  

 155:     ENDEXCEPTION

 156:  

 157: Return( oCtlFocus )

 158:  

 159: Static Function __Dummy( lRecursa )

 160:     Local oException

 161:     TRYEXCEPTION

 162:         DEFAULT lRecursa := .F.

 163:         IF !( lRecursa )

 164:             BREAK

 165:         EndIF

 166:         FindMsObject()

 167:         FindObject()

 168:         AddObj()

 169:         GetOctlFocus()

 170:         lRecursa := __Dummy( .F. )

 171:     CATCHEXCEPTION USING oException

 172:     ENDEXCEPTION

 173: Return( lRecursa )

e, finalmente, BTDNCustomLogin.prg (Tela de Login Customizada no TOTVS/Protheus)

   1: #ifdef TOTVS

   2:     #include "totvs.ch"

   3: #else

   4:     #include "protheus.ch"

   5: #endif    

   6: #include "tryException.ch"

   7: /*

   8:     Programa : BTDNCustomLogin.prg

   9:     Funcao   : CustomLogin

  10:     Autor    : Marinaldo de Jesus [http://www.blacktdn.com.br]

  11:     Data     : 07/09/2012

  12:     Uso      : Tela de Login Customizada no TOTVS/Protheus

  13: */

  14: Static Procedure CustomLogin()

  15:     

  16:     Local aCustom        := Array(0)

  17:  

  18:     Local aMsObj

  19:     

  20:     Local cFind

  21:     Local cReplace

  22:     Local cbSource

  23:     Local cClassName

  24:     Local cMemberName

  25:     

  26:     Local oObj

  27:     Local nObj

  28:     

  29:     Local nW

  30:     Local nX

  31:     Local nY

  32:     

  33:     aAdd(aCustom,{"TSAY","cCaption" ,"Fale com nosso suporte"                 ,"http://www.blacktdn.com.br"})

  34:     aAdd(aCustom,{"TSAY","blClicked","HTTP://WWW.TOTVS.COM/SUPORTE/MICROSIGA" ,"HTTP://WWW.BLACKTDN.COM.BR"})

  35:  

  36:     aAdd(aCustom,{"TSAY","cCaption" ,"Perfil"                ,Space(Len("Perfil"))})

  37:     aAdd(aCustom,{"TSAY","cCaption" ,"Segurança"             ,Space(Len("Segurança"))})

  38:     aAdd(aCustom,{"TSAY","cCaption" ,"Mobilidade"            ,Space(Len("Mobilidade"))})

  39:     aAdd(aCustom,{"TSAY","cCaption" ,"Produtividade"         ,Space(Len("Produtividade"))})

  40:     aAdd(aCustom,{"TSAY","cCaption" ,"Integração"            ,Space(Len("Integração"))})

  41:     aAdd(aCustom,{"TSAY","cCaption" ,"Rede de Empresas"      ,Space(Len("Rede de Empresas"))})

  42:     aAdd(aCustom,{"TSAY","cCaption" ,"<br>o <b>by You</b>"   ,"<b> BlackTDN</b>"})

  43:     aAdd(aCustom,{"TSAY","cCaption" ,"Clique aqui"           ,"<br>Clique aqui"})

  44:     aAdd(aCustom,{"TSAY","blClicked","{|| FWBYLEARNMORE() }" ,"{||SHELLEXECUTE('OPEN','HTTP://WWW.BLACKTDN.COM.BR','','',5)}"})

  45:     

  46:     aAdd(aCustom,{"TBITMAP","cResName","fw_totvs_logo_61x27","fw_btdn_logo_61x27.png"})

  47:     aAdd(aCustom,{"TBITMAP","cResName","fwlgn_byyou_icones" ,"fwlgn_btdn_icones.png"})

  48:     aAdd(aCustom,{"TBITMAP","cResName","fwlgn_byyou_slogan" ,"fwlgn_btdn_slogan.png"})

  49:     aAdd(aCustom,{"TBITMAP","cResName","fwlgn_byyou_bg"     ,"fwlgn_btdn_bg.png"})

  50:     aAdd(aCustom,{"TBITMAP","cResName","fwby_logo"          ,"fwbtdn_logo.png"})

  51:     

  52:     nW := 0

  53:     nY := Len( aCustom )

  54:     While ( ( ++nW ) <= nY )

  55:         cClassName := aCustom[nW][1]

  56:         aMsObj       := FindMsObject( cClassName )

  57:         For nX := nW TO nY

  58:             IF .NOT.( cClassName == aCustom[nX][1] )

  59:                 EXIT

  60:             EndIF

  61:             cMemberName := aCustom[nX][2]

  62:             cFind       := OemToAnsi(aCustom[nX][3])

  63:             cReplace    := aCustom[nX][4]

  64:             DO CASE

  65:             CASE ( cClassName == "TSAY" )

  66:                 DO CASE

  67:                 CASE ( cMemberName == "cCaption" )

  68:                     nObj := aScan( aMsObj , { |oObj|(ValType(oObj:cCaption)==”C”).and.(cFind$oObj:cCaption) } )

  69:                     IF ( nObj > 0 )

  70:                         oObj          := aMsObj[ nObj ]

  71:                         oObj:cCaption := StrTran(oObj:cCaption,cFind,cReplace)

  72:                         oObj:Refresh()

  73:                     EndIF    

  74:                 CASE ( cMemberName == "blClicked" )

  75:                     nObj := aScan( aMsObj , { |oObj|(ValType(oObj:blClicked)==”B”).and.(cFind$GetCbSource(oObj:blClicked)) } )

  76:                     IF ( nObj > 0 )

  77:                         oObj            := aMsObj[ nObj ]

  78:                         cbSource        := GetCbSource(oObj:blClicked)

  79:                         cbSource        := StrTran(cbSource,cFind,cReplace)

  80:                         oObj:blClicked  := &(cbSource)

  81:                         oObj:Refresh()

  82:                     EndIF    

  83:                 ENDCASE

  84:             CASE ( cClassName == "TBITMAP" )

  85:                 nObj := aScan( aMsObj , { |oObj|(ValType(oObj:cResName)==”C”).and.(cFind$oObj:cResName) } )

  86:                 IF ( nObj > 0 )

  87:                     oObj             := aMsObj[ nObj ]

  88:                     oObj:SetEmpty()

  89:                     oObj:SetBmp(cReplace)

  90:                     oObj:lAutoSize   := .T.

  91:                     oObj:lStretch    := .T.

  92:                     oObj:Refresh()

  93:                     oObj:Show()

  94:                 EndIF    

  95:             ENDCASE

  96:             nW := nX

  97:         Next nX

  98:     End While

  99:  

 100: Return

 101:  

 102: /*

 103:     Programa : BTDNCustomLogin.prg

 104:     Funcao   : FindMsObject

 105:     Autor    : Marinaldo de Jesus [http://www.blacktdn.com.br]

 106:     Data     : 07/09/2012

 107:     Uso      : Retornar Lista de Objetos conforme cClassName

 108: */

 109: Static Function FindMsObject(cMsClassName,oWnd)

 110: Return(StaticCall(U_FindMsObject,FindMsObject,@cMsClassName,@oWnd))

 111:  

 112: Static Function __Dummy( lRecursa )

 113:     Local oException

 114:     TRYEXCEPTION

 115:         lRecursa := .F.

 116:         IF !( lRecursa )

 117:             BREAK

 118:         EndIF

 119:         lRecursa := __Dummy( .F. )

 120:         CustomLogin()

 121:         SYMBOL_UNUSED( __cCRLF )

 122:     CATCHEXCEPTION USING oException

 123:     ENDEXCEPTION

 124: Return( lRecursa )

Com isso, a tela de entrada principal permanecerá a mesma (com as características definidas pela TOTVS) e, após o “login”, tornar-se-a “personalizada” e …

 

…, acredito eu, damos por “encerradas” as questões referentes à “Personalização da Tela de Login do TOTVS Protheus/by You”.

Para baixar os códigos utilizados neste post clique aqui, opcionalmente, e caso utilize alguma NDJLib, poderá obter o exemplo a partir de:

http://code.google.com/p/totvs-advpl-naldodj/source/browse/trunk/templates/P10/ndj_01/Projeto/Login/

obtendo as dependências a partir de:

http://code.google.com/p/totvs-advpl-naldodj/source/browse/trunk/templates/P10/ndj_01/Projeto/NDJLib/NDJLib016.prg

e

http://code.google.com/p/totvs-advpl-naldodj/source/browse/trunk/templates/P10/ndj_01/Projeto/NDJLib/NDJLib004.prg  

[]s
иαldσ dj