Recebe 2 argumentos e retona valor logico.
// -----------------------------------------------------------------------------
// Mauricio P Pires <mauricioppires at gmail dot com>
// Funcao....: SimNao( aTxt, cTit )
// Argumentos: aTxt - array de linhas de texto para compor o informe na tela.
// cTit - String - Titulo da janela SimNao.
// Retorno...: Valor logico: TRUE (.T.) ou FALSE (.F.)
// Data......: 2022-01-25
// -----------------------------------------------------------------------------
#include "inkey.ch"
#define COR_FUNDO "B/W"
#define COR_JANELA "N/W+*"
#define COR_TITULO "W+/B"
#define TRUE .T.
#define FALSE .F.
function main()
local aTexto1, aTexto2, cTitulo1, cTitulo2, lRet1, lRet2
SETMODE( 25, 80)
setcolor( COR_FUNDO )
cls
cTitulo1 := "Compactacao dos dados"
aTexto1 := {"Confirma a compactacao dos dados?", ;
"Atencao! Este procedimento eh irreverssivel!", ;
"Executar somente se tiver certeza!"}
// excede o tamanho - retorna FALSE
// cTitulo2 := "Lorem Ipsum is simply dummy text of the printing and typesetting industry. Lorem Ipsum"
cTitulo2 := "Lorem Ipsum"
// o segundo item deste array,
// foi colocado intencionalmente maior que 80 caracteres ( ou MaxCol() )
// para testar o corte da linha e acrescentar reticencias
aTexto2 := {" 1. Deseja finalizar o sistema agora?", ;
" 2. Lorem Ipsum is simply dummy text of the printing and typesetting industry. Lorem Ipsum", ;
" 3. Lorem Ipsum is simply dummy text of the printing and typesetting industry. Lorem Ipsum", ;
" 4. Lorem Ipsum is simply dummy text of the printing and typesetting industry. Lorem Ipsum", ;
" 5. Lorem Ipsum is simply dummy text of the printing and typesetting industry. Lorem Ipsum", ;
" 6. Lorem Ipsum is simply dummy text of the printing and typesetting industry. Lorem Ipsum", ;
" 7. Lorem Ipsum is simply dummy text of the printing and typesetting industry. Lorem Ipsum", ;
" 8. Lorem Ipsum is simply dummy text of the printing and typesetting industry. Lorem Ipsum", ;
" 9. Lorem Ipsum is simply dummy text of the printing and typesetting industry. Lorem Ipsum", ;
"10. Escolha Sim ou Nao"}
cTitulo3 := "Finalizar o Sistema"
aTexto3 := {"Deseja finalizar o sistema agora?" }
lRet1 := SimNao( aTexto1, cTitulo1 )
lRet2 := SimNao( aTexto2, cTitulo2 )
lRet3 := SimNao( aTexto3, cTitulo3 )
? if( lRet1, "Compactar os dados!", "Nao compactar!")
? if( lRet2, "Respondendo Sim", "Respondendo Nao")
? if( lRet3, "Finalizar o sistema", "Permanecer no sistema")
return Nil
function SimNao( aTexto, cTitulo )
local nTopo, nEsquerda, nBaixo, nDireita
local nMaiorItem, nTamArray
local nLinha, nEsqTexto, nBaixoTexto, nDirTexto
local x, cCor, cTela
if ( aTexto == Nil )
return FALSE
endif
// Limmitando a 10 linhas/itens no array
if ( len(aTexto) > 10 )
return FALSE
endif
if ( cTitulo == Nil )
cTitulo := "Portela Info"
endif
cTela := savescreen(,,,,)
nTopo := 0
nEsquerda := 0
nBaixo := MaxRow()
nDireita := MaxCol()
nMaiorItem := 0
nTamArray := len(aTexto)
if ( nTamArray > nBaixo )
return FALSE
endif
for x := 1 to nTamArray
if ( len(aTexto[x]) > nDireita )
AFill( aTexto, substr(aTexto[x], 1, (nDireita -7)) + "...", x, 1 )
// TODO: implementar aqui, a possibilidade de quebrar a string e
// acrescentar o restante em uma nova linha, logo abaixo.
endif
if ( len(aTexto[x]) > nMaiorItem )
nMaiorItem := len(aTexto[x])
endif
next
if ( len(cTitulo) > nMaiorItem )
return FALSE
endif
@ nTopo, nEsquerda, nBaixo, nDireita box space(9) color COR_FUNDO
nLinha := ((nBaixo - nTamArray)/ 2) -2
nEsqTexto := ((nDireita - nMaiorItem) /2)
nBaixoTexto := (nLinha + nTamArray + 2)
nDirTexto := if((nEsqTexto + nMaiorItem +2) >= 79, 79, (nEsqTexto + nMaiorItem + 2))
@ nLinha -2, nEsqTexto, nBaixoTexto, nDirTexto box space(9) color COR_JANELA
@ nLinha -2, nEsqTexto say space(nMaiorItem+3) color COR_TITULO
@ nLinha -2, nEsqTexto +1 say cTitulo color COR_TITULO
for x := 1 to nTamArray
@ nLinha, nEsqTexto +1 say aTexto[x] color COR_JANELA
nLinha++
next
nLinha++
cCor := setcolor()
setcolor("W+/BG, GR+/R, R/W, B/W, W/BG")
@ nLinha, (nEsqTexto + 1 ) prompt " Sim "
@ nLinha, (nEsqTexto + 7 ) prompt " Nao "
menu to nOpcao
if ( lastkey() == K_ESC )
lRetorno := FALSE
endif
do case
case nOpcao == 1 ; lRetorno := TRUE
case nOpcao == 2 ; lRetorno := FALSE
endcase
setcolor(cCor)
restscreen(,,,, cTela)
return lRetorno
