No artigo de hoje, vamos demonstrar como utilizar a classe FWCalendar para montar um calendário simples em AdvPL.

Se você já precisou montar um calendário em AdvPL, a classe FWCalendar é ideal para você, esse classe apesar de já ter sido descontinuada (faz parte do software legado segundo o TDN), ela ainda funciona bem para algumas necessidades.

Nesse exemplo que montei, ele é simples, mas é possível que você adapte as suas necessidades e até a gravação de registros em tabelas.

Abaixo um print da tela inicial assim quando a tela é aberta:

Exemplo da tela criada

Se você clicar com o botão direito em um dia, ele dá a opção de criar um novo agendamento.

Botão direito para criar novo agendamento

Será aberto uma tela simples, para você informar o cliente, a loja e uma descrição (não será armazenado nada no banco de dados).

Tela de agendamento

Após a confirmação, será exibido o agendamento no dia, e se você quiser, pode clicar com o botão direito em cima dele (como não é salvo no banco de dados, só fica em tempo de execução, e não é gravado a descrição).

Botão direito em cima de um agendamento

Partindo agora para o código fonte, abaixo alguns pontos importantes antes de vermos o código fonte:

• O calendário, é instanciando em um objeto chamado oCalend
• A função acionada pelo clique do botão direito é a fCliqueDir
• A função fCaledFont, converte a fonte padrão de MS Sans Serif para Tahoma na abertura da tela
• A função fMesAno, serve para definir o título de navegação (por exemplo, Maio / 2021) e também para acionar a função de busca das informações
• A função fBuscaInfo, aciona a busca de informações (nesse ponto se você quiser chamar uma query SQL para popular os dados), tanto que nessa parte, os registros são manipulados na parte do SetInfo
• Por último, a função fPopOpcao, mostra o ParamBox com os dados do registro e também salva no calendário (aqui você pode adaptar sua rotina para gravar com RecLock em uma tabela customizada)

Abaixo o código fonte desenvolvido:

//Bibliotecas
#Include "TOTVS.ch"

//Posições do array dos agendamentos do calendário
#Define ID         1 // Id do Celula
#Define OBJETO     2 // Objeto de Tela
#Define DATADIA    3 // Data Completa da Celula
#Define DIA        4 // Dia Ref. Data da Celula
#Define MES        5 // Mes Ref. Data da Celula
#Define ANO        6 // Ano Ref. Data da Celula
#Define NSEMANO    7 // Semana do Ano Ref. Data da Celula
#Define NSEMMES    8 // Semana do Mes Ref. Data da Celula
#Define ATIVO      9 // É celula referente a um dia ativo
#Define FOOTER    10 // É celula referente ao rodape
#Define HEADER    11 // É celula referente ao Header
#Define SEMANA    12 // É celula referente a semana
#Define BGDefault 13 // Cor de BackGround da Celula

/*/{Protheus.doc} User Function zCalend
Tela de agendamentos do Telemarketing
@type  Function
@author Atilio
@since 27/01/2021
@version 1.0
@obs Calendário baseado no fonte TECA190D
/*/

User Function zCalend()
    Local aArea := GetArea()
    Private aSize := MsAdvSize(.F.)

    fMontaTela()

    RestArea(aArea)
Return

Static Function fMontaTela()
	Local nCorFundo 	:= 16777215
	Local nLargBtn      := 50
	//Data
	Private dDtIni := Date()
	Private cMes   := StrZero(Month(dDtIni), 2)
	Private cAno   := StrZero(Year(dDtIni),  4)
	//Objetos e componentes
	Private oDlgTmk
	Private oFwLayer
	Private oPanTitulo
	Private oPanCalend
	Private oPanPreMon
	Private oPanNexMon
	Private oPanSair
	Private oMesAtual
	Private cMesAno
	Private cTitHtml
	//Cabeçalho
	Private oSayModulo, cSayModulo := 'FAT'
    Private oSayTitulo, cSayTitulo := 'Calendário de Agendamentos'
    Private oSaySubTit, cSaySubTit := 'Clique com o botão direito para registrar agendamentos'
	//Tamanho da janela
	Private nJanLarg := aSize[5]
	Private nJanAltu := aSize[6]
	//Fontes
    Private cFontUti    := "Tahoma"
    Private oFontMod    := TFont():New(cFontUti, , -38)
    Private oFontSub    := TFont():New(cFontUti, , -20)
    Private oFontSubN   := TFont():New(cFontUti, , -20, , .T.)
    Private oFontBtn    := TFont():New(cFontUti, , -14)
	Private oFontSay    := TFont():New(cFontUti, , -12)
	//Variáveis usadas para atualização das informações
	Private aInfoDia
	Private nSelecao
	Private cTextoSel
	Private nPosCell

	//Cria a janela
	DEFINE MSDIALOG oDlgTmk TITLE "Agendamentos Telemarketing"  FROM 0, 0 TO nJanAltu, nJanLarg PIXEL

		//Criando a camada
		oFwLayer := FwLayer():New()
		oFwLayer:init(oDlgTmk,.F.)

		//Adicionando 3 linhas, a de título, a superior e a do calendário
		oFWLayer:addLine("TIT", 10, .F.)
		oFWLayer:addLine("SUP", 05, .F.)
		oFWLayer:addLine("CAL", 85, .F.)

		//Adicionando as colunas das linhas
		oFWLayer:addCollumn("HEADERTEXT",   050, .T., "TIT")
		oFWLayer:addCollumn("BLANKBTN",     040, .T., "TIT")
		oFWLayer:addCollumn("BTNSAIR",      010, .T., "TIT")
		oFWLayer:addCollumn("BLANKSUP1",    015, .T., "SUP")
		oFWLayer:addCollumn("BTNPREVMONTH", 020, .T., "SUP")
		oFWLayer:addCollumn("TITLE",        030, .T., "SUP")
		oFWLayer:addCollumn("BTNNEXTMONTH", 020, .T., "SUP")
		oFWLayer:addCollumn("COLCAL",       100, .T., "CAL")

		//Criando os paineis
		oPanTitulo := oFWLayer:GetColPanel("TITLE",        "SUP")
		oPanCalend := oFWLayer:GetColPanel("COLCAL",       "CAL")
		oPanPreMon := oFWLayer:GetColPanel("BTNPREVMONTH", "SUP")
		oPanNexMon := oFWLayer:GetColPanel("BTNNEXTMONTH", "SUP")
		oPanSair := oFWLayer:GetColPanel("BTNSAIR",      "TIT")
		oPanHeader := oFWLayer:GetColPanel("HEADERTEXT",   "TIT")

		//Títulos e SubTítulos
        oSayModulo := TSay():New(004, 003, {|| cSayModulo}, oPanHeader, "", oFontMod,  , , , .T., RGB(149, 179, 215), , 200, 30, , , , , , .F., , )
        oSayTitulo := TSay():New(004, 045, {|| cSayTitulo}, oPanHeader, "", oFontSub,  , , , .T., RGB(031, 073, 125), , 200, 30, , , , , , .F., , )
        oSaySubTit := TSay():New(014, 045, {|| cSaySubTit}, oPanHeader, "", oFontSubN, , , , .T., RGB(031, 073, 125), , 300, 30, , , , , , .F., , )

		//Criando os botões
		oBtnEnd := TButton():New(006, 001, "Fechar",             oPanSair, {|| oDlgTmk:End()}, nLargBtn, 018, , oFontBtn, , .T., , , , , , )

		//Cria o calendário
		oCalend := FWCalendar():New( VAL(cMes), VAL(cAno) )
		oCalend:aNomeCol    := { 'Domingo'	, 'Segunda' , 'Terça' , 'Quarta' , 'Quinta'	, 'Sexta' , 'Sábado' , 'Semana'}	//'Domingo'	# 'Segunda' # 'Terça' # 'Quarta' # 'Quinta'	# 'Sexta' # 'Sábado' # 'Semana'
		oCalend:lWeekColumn := .F.
		oCalend:lFooterLine := .F.
		oCalend:bLClicked   := {|| }
		oCalend:bLDblClick  := {|| }
		oCalend:bRClicked   := {|aInfo, oObj, nRow, nCol| fCliqueDir(aInfo, oObj, nRow, nCol) }
		fCalendFont()
		oCalend:Activate( oPanCalend )

		//Criando o Say com o mês Atual
		oMesAtual := TSay():New(0, 0, {|| }, oPanTitulo, , , , , , .T., 20, 20, , , , , , , , .T.)
		oMesAtual:Align := CONTROL_ALIGN_ALLCLIENT
		oMesAtual:nClrPane := nCorFundo
		fMesAno(Val(cMes), Val(cAno))

		//Criando o botão do Mês Anterior
		@ 0, 0 BTNBMP oPrevMonth Resource "PMSSETAESQ" Size 80, 90 Of oPanPreMon Pixel
		oPrevMontht:cToolTip := "Mes Anterior"	//"Mes Anterior"
		oPrevMonth:bAction  := { || FwMsgRun(Nil, {|| fMudaMes(oPanCalend, oCalend, 2 )}, Nil, "Montando calendário...") }	//"Montando calendário..."
		oPrevMonth:Align    := CONTROL_ALIGN_RIGHT

		//Criando o botão do Próximo Mês
		@ 0, 0 BTNBMP oNextMonth Resource "PMSSETADIR" Size 90, 90 Of oPanNexMon Pixel
		oNextMonth:cToolTip := "Proximo Mes"	//"Proximo Mes"
		oNextMonth:bAction  := { || FwMsgRun(Nil, {|| fMudaMes(oPanCalend, oCalend, 1 )}, Nil, "Montando calendário...") }	//"Montando calendário..."
		oNextMonth:Align    := CONTROL_ALIGN_LEFT
	Activate MsDialog oDlgTmk Centered
Return

/*
	Função que muda de mês
*/

Static Function fMudaMes(oPan, oCalend, nOp)
	Local nMonth    := oCalend:nMes
	Local nYear     := oCalend:nAno
	Default	nOp		:= 1

	//Se for a seta ->, incrementa um mês
	If nOp == 1
		If nMonth == 12
			nMonth := 01
			nYear += 1
		Else
			nMonth := nMonth += 1
		EndIf

	//Se for a seta <-, diminui um mês
	ElseIf nOp == 2
		If nMonth == 01
			nMonth := 12
			nYear -= 1
		Else
			nMonth := nMonth -= 1
		EndIf
	EndIf

	//Define o calendário e seta o título
	oCalend:SetCalendar( oPan, cValToChar(nMonth), cValToChar(nYear) )
	fMesAno(nMonth, nYear)
Return

/*
	Função que define o texto do título em cima do calendário
*/

Static Function fMesAno(nMonth, nYear)
	cMesAno := Capital(MesExtenso(nMonth)) + " / " + cValToChar(nYear)
	cTitHtml := fTitHTML(cMesAno)
	oMesAtual:SetText( cTitHtml )

	//Chama a busca de informações para definir as informações no calendário
	fBuscaInfo()
Return Nil

/*
	Função que transforma o título no formato html
*/

Static Function fTitHTML(cMesAno)
	Local cRet := ''
	cRet += '<p align="center">'
	cRet += '<font face="' + cFontUti + '" color="#000000" style="font-size:14px"><strong>' + cMesAno + '</strong></font>'
	cRet += '</p>'
Return cRet

/*
	Função que define o primeiro calendário com a fonte Tahom
*/

Static Function fCalendFont()
	oCalend:aFontDay[1]     := cFontUti
	oCalend:aFontDayHead[1] := cFontUti
	oCalend:aFontDayText[1] := cFontUti
	oCalend:aFontFooter[1]  := cFontUti
	oCalend:aFontFsFer[1]   := cFontUti
	oCalend:aFontHeader[1]  := cFontUti
	oCalend:aFontOff[1]     := cFontUti
	oCalend:aFontToday[1]   := cFontUti
	oCalend:aFontWeek[1]    := cFontUti
	oCalend:cHtmlDay        := StrTran(oCalend:cHtmlDay,     "MS Sans Serif", cFontUti)
	oCalend:cHtmlDayOff     := StrTran(oCalend:cHtmlDayOff,  "MS Sans Serif", cFontUti)
	oCalend:cHtmlFooter     := StrTran(oCalend:cHtmlFooter,  "MS Sans Serif", cFontUti)
	oCalend:cHtmlHeader     := StrTran(oCalend:cHtmlHeader,  "MS Sans Serif", cFontUti)
	oCalend:cHtmlToday      := StrTran(oCalend:cHtmlToday,   "MS Sans Serif", cFontUti)
	oCalend:cHtmlWeek       := StrTran(oCalend:cHtmlWeek,    "MS Sans Serif", cFontUti)
	oCalend:cHtmlWeekend    := StrTran(oCalend:cHtmlWeekend, "MS Sans Serif", cFontUti)
Return

/*
	Função que busca as informações e atualiza a agenda
*/

Static Function fBuscaInfo()
	Local nCell
    Local nDia

	For nCell := 1 To (Len(oCalend:aCell) - 10)
		nDia := oCalend:aCell[nCell][DIA] // Dia
		//nMes := oCalend:aCell[nCell][MES] // Mês
		//nAno := oCalend:aCell[nCell][ANO] // Ano

		//Se for um dia útil
		If oCalend:aCell[nCell][ATIVO] .And. nDia == 10
			aItens := {}
			aAdd(aItens, "000001 - Cliente A")
			aAdd(aItens, "000002 - Cliente B")
			aAdd(aItens, "000003 - Cliente C")

			//Define as informações da célula
			oCalend:SetInfo(oCalend:aCell[nCell][ID], aClone(aItens))
		EndIf
	Next
Return

/*
	Função que mostra PopUp, ao clicar com o botão direito
*/

Static Function fCliqueDir(aInfo, oObj, nRow, nCol)
	Local cClassName := Upper(Alltrim(oObj:ClassName()))
	Local oMenu
	Local oMenuItem := {}
	Local aOpcoes := {}
	Local nOpcao := 0
	Local dData := aInfo[DATADIA]
	aInfoDia  := aInfo
	nSelecao  := aInfo[OBJETO]:nSelectedIndex
	cTextoSel := ""
	nPosCell  := aScan(oCalend:aCell, {|x| AllTrim(Upper(x[1])) == aInfo[1]})
	
	//Somente se estiver dentro do ListBox
	If cClassName == "TLISTBOX"
		aAdd(aOpcoes, {"Novo Agendamento", {|| fPopOpcao(3, dData)}})

		//Se houver linhas, terá outras opções
		If nSelecao != 0
			aAdd(aOpcoes, {"Visualizar Agendamento", {|| fPopOpcao(2, dData)}})
			aAdd(aOpcoes, {"Alterar Agendamento",    {|| fPopOpcao(4, dData)}})
			aAdd(aOpcoes, {"Excluir Agendamento",    {|| fPopOpcao(5, dData)}})
			cTextoSel := aInfo[OBJETO]:oListBoxContent:aItems[nSelecao]
		Endif
	EndIf

	//Criando o menu e os itens
	MENU oMenu POPUP
		For nOpcao := 1 To Len(aOpcoes)
			aAdd( oMenuItem, MenuAddItem(aOpcoes[nOpcao][1], , , .T., , , , oMenu, aOpcoes[nOpcao][2], , , , , {|| .T.}) )
		Next
	ENDMENU
	oMenu:Activate(nRow, nCol, oObj)
Return

Static Function fPopOpcao(nOpcao, dData)
	Local aPergs := {}
	Local cTexto := ""
	Local cEditCli := ".F."
	Local cCliente := Space(TamSX3('A1_COD')[1])
	Local cLoja    := Space(TamSX3('A1_LOJA')[1])
	Local cObserv  := ""
	Default nOpcao := 3
	Default dData  := Date()

	//Define o texto
	If nOpcao == 3
		cEditCli := ".T."
		cTexto := "Inclusão de Agendamento"
	Else
		cEditCli := ".F."
		If nOpcao == 2
			cTexto := "Visualização de Agendamento"
		ElseIf nOpcao == 4
			cTexto := "Alteração de Agendamento"
		ElseIf nOpcao == 5
			cTexto := "Exclusão de Agendamento"
		EndIf
		cCliente := SubStr(cTextoSel, 1, 6)
		cLoja    := "01"
		cTexto   += " (" + SubStr(cTextoSel, 10, Len(cTextoSel)) + ")"
	EndIf

	//Adiciona os parâmetros
	aAdd(aPergs, {09, cTexto, 200, 40, .T.}) 
	aAdd(aPergs, {01, "Data",      dData,    "", ".T.", "",    ".F.",    80,  .T.})
	aAdd(aPergs, {01, "Cliente",   cCliente, "", ".T.", "SA1", cEditCli, 80,  .T.})
	aAdd(aPergs, {01, "Loja",      cLoja,    "", ".T.", "",    cEditCli, 80,  .T.})
	aAdd(aPergs, {11, "Histórico", cObserv, ".T.", ".T.", .T.})

	//Se a pergunta for confirmada
	If ParamBox(aPergs, "Informe os parâmetros", , , , , , , , , .F., .F.)
		cCliente := MV_PAR03
		cLoja    := MV_PAR04
		cObserv  := MV_PAR05
		cNomeCli := Posicione('SA1', 1, FWxFilial('SA1') + cCliente + cLoja, "A1_NOME")

		//Se for inclusão, adiciona no calendário
		If nOpcao == 3
			aItens := aClone(aInfoDia[OBJETO]:oListBoxContent:aItems)
			aAdd(aItens, cCliente + " - " + SubStr(cNomeCli, 1, 15))
			oCalend:SetInfo(oCalend:aCell[nPosCell][ID], aClone(aItens))

		//Se for exclusãoRetira o elemento do array e depois define no calendário
		ElseIf nOpcao == 5
			aItens := aClone(aInfoDia[OBJETO]:oListBoxContent:aItems)
			aDel(aItens, nSelecao)
			aSize(aItens, Len(aItens) - 1)
			oCalend:SetInfo(oCalend:aCell[nPosCell][ID], aClone(aItens))
		EndIf
	EndIf
Return

Bom pessoal, por hoje é só.

Abraços e até a próxima.

Tags: AdvPLProtheus