PC Toledo

Em homenagem a Paulo Cesar Toledo
https://pctoledo.org/

Rotina de Calendario

https://pctoledo.org/viewtopic.php?t=25687

Página 1 de 1

Rotina de Calendario

Enviado: 16 Jun 2021 17:26
por marsp
Boa tarde,

Alguem por favor teria uma rotina de calendario para disponibilizar.


Obrigado

Rotina de Calendario

Enviado: 16 Jun 2021 23:34
por Vander
Tenho esta rotina mas nunca testei, talvez da pra aproveitar a ideia.

Código: Selecionar todos

FUNCTION MAIN

   REQUEST HB_LANG_PT
   HB_LANGSELECT( 'PT' )
   set date french
   set century on
   
   set printer on
   set printer to calendario.txt
   set console off
   set device to printer
   
   // Chamada dafunção (basta digitar o ano)
   for ct:= 1900 to 2100
      geraCalendario(ct)
   next

   set printer off
   set printer to 
   set console on
   set device to screen
   
return NIL

// =============================================================================================================================
// Função para gerar calendário de qualquer ano
function geraCalendario(ano)
local bissexto := .F., verdata:= "29/02/"+ alltrim(str(ano)), data_inicial:= "01/01/"+ alltrim(str(ano)), dia_inicial:= 1, calendario
   
   // verifica se o ano é bissexto:
   if len(alltrim(dtos(ctod(verdata)))) == 0
      bissexto = .F.
   else
      bissexto = .T.
   endif      
   
   // Verificando o dia inicial do ano:
   dia_inicial = dow(ctod(data_inicial))
   
   ? replicate("-",91)
   ? "| " + alltrim(str(ano)) + space(84) + "|"
   ? replicate("-",91)   
   calendario = calendario(dia_inicial,bissexto)
   MOSTRA_CALENDARIO(calendario)

return nil

// =============================================================================================================================
/*
   GERA UM CALENDÁRIO ANUAL
   dia_inicial = nº do dia da semana que o ano começa
   bissexto = variável para indicar se o ano é bissexto (.T. OU .F.)
*/
FUNCTION CALENDARIO(dia_inicial,bissexto)
local ano, numero_de_dias:=0, dia_mes, mes, dias:={"DOM","SEG","TER","QUA","QUI","SEX","SAB"},DIAMES:={31,28,31,30,31,30,31,31,30,31,30,31}, contador := 1

   if bissexto == .T.
      ano:= array(366,2)
      DIAMES:={31,29,31,30,31,30,31,31,30,31,30,31}
   else
      ano:= array(365,2)
      DIAMES:={31,28,31,30,31,30,31,31,30,31,30,31}
   endif      

   numero_de_dias = len(ano)
   
   // Montando o calendario:
   for mes:= 1 to 12
      for dia_mes:= 1 to DIAMES[mes]
         ano[contador,1] = strzero(dia_mes,3)
         ano[contador,2] = dias[dia_inicial]
         ++ dia_inicial
         if dia_inicial > 7
            dia_inicial = 1
         endif      
         ++contador
      next
   next

return ano
// =============================================================================================================================

FUNCTION MOSTRA_CALENDARIO(dados_anuais)
local dias:={"DOM","SEG","TER","QUA","QUI","SEX","SAB"},meses:={"JAN","FEV","MAR","ABR","MAI","JUN","JUL","AGO","SET","OUT","NOV","DEZ"},DIAMES:={31,28,31,30,31,30,31,31,30,31,30,31}, mapa1, mapa2, mapa3, mapa4,;
   mapa := ;
    "| 001                         | 002                         | 003                         |" +;
   "| DOM SEG TER QUA QUI SEX SAB | DOM SEG TER QUA QUI SEX SAB | DOM SEG TER QUA QUI SEX SAB |" +;
   "| A01 A02 A03 A04 A05 A06 A07 | B01 B02 B03 B04 B05 B06 B07 | C01 C02 C03 C04 C05 C06 C07 |" +;
   "| A08 A09 A10 A11 A12 A13 A14 | B08 B09 B10 B11 B12 B13 B14 | C08 C09 C10 C11 C12 C13 C14 |" +;
   "| A15 A16 A17 A18 A19 A20 A21 | B15 B16 B17 B18 B19 B20 B21 | C15 C16 C17 C18 C19 C20 C21 |" +;
   "| A22 A23 A24 A25 A26 A27 A28 | B22 B23 B24 B25 B26 B27 B28 | C22 C23 C24 C25 C26 C27 C28 |" +;
   "| A29 A30 A31 A32 A33 A34 A35 | B29 B30 B31 B32 B33 B34 B35 | C29 C30 C31 C32 C33 C34 C35 |" +;
   "| A36 A37 A38 A39 A40 A41 A42 | B36 B37 B38 B39 B40 B41 B42 | C36 C37 C38 C39 C40 C41 C42 |" 
LOCAL ct, dia_inicial:=1, mes,semanas:={"S01","S02","S03","S04","S05","S06","S07","S08","S09","S10","S11","S12","S13","S14","S15","S16","S17","S18","S19","S20","S21"}
   
   if len(dados_anuais) == 366
      DIAMES:={31,29,31,30,31,30,31,31,30,31,30,31}
   endif

   mapa1 = mapa
   mapa2 = mapa
   mapa3 = mapa
   mapa4 = mapa
   
   // MONTANDO O PRIMEIRO TRIMESTRE
   dia_inicial = 1
   total_dias = 0
   
   DO CASE
      case dados_anuais[1,2] = "DOM"
         dia_inicial = 1
      case dados_anuais[1,2] = "SEG"
         dia_inicial = 2
      case dados_anuais[1,2] = "TER"
         dia_inicial = 3
      case dados_anuais[1,2] = "QUA"
         dia_inicial = 4
      case dados_anuais[1,2] = "QUI"
         dia_inicial = 5
      case dados_anuais[1,2] = "SEX"
         dia_inicial = 6
      case dados_anuais[1,2] = "SAB"
         dia_inicial = 7
   ENDCASE
   
   total_dias = diames[1] + diames[2] + diames[3]   //   total de dias do trimestre
   mes = 1
   marca_mes = DIAMES[mes]
   
   marcador = 1
   do while marcador < dia_inicial
      mapa1 = strtran(mapa1,("A"+strzero(marcador,2)),"   ")
      ++marcador
   enddo

   prefixo := {"A","B","C"}   
   contador = 1
   for ct:= 1 to total_dias
      mapa1 = strtran(mapa1,(prefixo[mes]+strzero(marcador,2)),str(contador,3))
      ++dia_inicial
      if dia_inicial > 7
         dia_inicial = 1
      endif   

      ++marcador
      ++contador
      
      if (ct == diames[1]) .or. (ct == diames[1] + diames[2]) .or. (ct == diames[1] + diames[2] + diames[3])
         for ct2:= 1 to 49
            mapa1 = strtran(mapa1,(prefixo[mes]+strzero(ct2,2)),"   ")
            ++marcador
         next
      
         marcador = 1
         do while marcador < dia_inicial
            mapa1 = strtran(mapa1,(prefixo[mes]+strzero(marcador,2)),"   ")
            ++marcador
         enddo
         
         ++mes
         marca_mes = diaMES[mes]
         contador = 1

      endif
      
   next
   
   mapa1 = strtran(mapa1,"001",meses[1])
   mapa1 = strtran(mapa1,"002",meses[2])
   mapa1 = strtran(mapa1,"003",meses[3])
   
   // MONTANDO O SEGUNDO TRIMESTRE
   total_dias = diames[1] + diames[2] + diames[3]   //   total de dias do trimestre
   
   DO CASE
      case dados_anuais[TOTAL_DIAS+1,2] = "DOM"
         dia_inicial = 1
      case dados_anuais[TOTAL_DIAS+1,2] = "SEG"
         dia_inicial = 2
      case dados_anuais[TOTAL_DIAS+1,2] = "TER"
         dia_inicial = 3
      case dados_anuais[TOTAL_DIAS+1,2] = "QUA"
         dia_inicial = 4
      case dados_anuais[TOTAL_DIAS+1,2] = "QUI"
         dia_inicial = 5
      case dados_anuais[TOTAL_DIAS+1,2] = "SEX"
         dia_inicial = 6
      case dados_anuais[TOTAL_DIAS+1,2] = "SAB"
         dia_inicial = 7
   ENDCASE
   
   total_dias = diames[4] + diames[5] + diames[6]   //   total de dias do trimestre
   mes = 4
   marca_mes = DIAMES[mes]
   
   marcador = 1
   do while marcador < dia_inicial
      mapa2 = strtran(mapa2,("A"+strzero(marcador,2)),"   ")
      ++marcador
   enddo

   prefixo := {"A","B","C"}   
   contador = 1
   for ct:= 1 to total_dias
      mapa2 = strtran(mapa2,(prefixo[mes-3]+strzero(marcador,2)),str(contador,3))
      ++dia_inicial
      if dia_inicial > 7
         dia_inicial = 1
      endif   

      ++marcador
      ++contador
      
      if (ct == diames[4]) .or. (ct == diames[4] + diames[5]) .or. (ct == diames[4] + diames[5] + diames[6])
         for ct2:= 1 to 49
            mapa2 = strtran(mapa2,(prefixo[mes-3]+strzero(ct2,2)),"   ")
            ++marcador
         next
      
         marcador = 1
         do while marcador < dia_inicial
            mapa2 = strtran(mapa2,(prefixo[mes-3]+strzero(marcador,2)),"   ")
            ++marcador
         enddo
         
         ++mes
         marca_mes = diaMES[mes]
         contador = 1

      endif
      
   next
   
   mapa2 = strtran(mapa2,"001",meses[4])
   mapa2 = strtran(mapa2,"002",meses[5])
   mapa2 = strtran(mapa2,"003",meses[6])
   
   // MONTANDO O TERCEIRO TRIMESTRE
   total_dias = diames[1] + diames[2] + diames[3] + diames[4] + diames[5] + diames[6]   //   total de dias do trimestre
   
   DO CASE
      case dados_anuais[TOTAL_DIAS+1,2] = "DOM"
         dia_inicial = 1
      case dados_anuais[TOTAL_DIAS+1,2] = "SEG"
         dia_inicial = 2
      case dados_anuais[TOTAL_DIAS+1,2] = "TER"
         dia_inicial = 3
      case dados_anuais[TOTAL_DIAS+1,2] = "QUA"
         dia_inicial = 4
      case dados_anuais[TOTAL_DIAS+1,2] = "QUI"
         dia_inicial = 5
      case dados_anuais[TOTAL_DIAS+1,2] = "SEX"
         dia_inicial = 6
      case dados_anuais[TOTAL_DIAS+1,2] = "SAB"
         dia_inicial = 7
   ENDCASE
   
   total_dias = diames[7] + diames[8] + diames[9]   //   total de dias do trimestre
   mes = 7
   marca_mes = DIAMES[mes]
   
   marcador = 1
   do while marcador < dia_inicial
      mapa3 = strtran(mapa3,("A"+strzero(marcador,2)),"   ")
      ++marcador
   enddo

   prefixo := {"A","B","C"}   
   contador = 1
   for ct:= 1 to total_dias
      mapa3 = strtran(mapa3,(prefixo[mes-6]+strzero(marcador,2)),str(contador,3))
      ++dia_inicial
      if dia_inicial > 7
         dia_inicial = 1
      endif   

      ++marcador
      ++contador
      
      if (ct == diames[7]) .or. (ct == diames[7] + diames[8]) .or. (ct == diames[7] + diames[8] + diames[9])
         for ct2:= 1 to 49
            mapa3 = strtran(mapa3,(prefixo[mes-6]+strzero(ct2,2)),"   ")
            ++marcador
         next
      
         marcador = 1
         do while marcador < dia_inicial
            mapa3 = strtran(mapa3,(prefixo[mes-6]+strzero(marcador,2)),"   ")
            ++marcador
         enddo
         
         ++mes
         marca_mes = diaMES[mes]
         contador = 1

      endif
      
   next
   
   mapa3 = strtran(mapa3,"001",meses[7])
   mapa3 = strtran(mapa3,"002",meses[8])
   mapa3 = strtran(mapa3,"003",meses[9])
   
   // MONTANDO O QUARTO TRIMESTRE
   total_dias = diames[1] + diames[2] + diames[3] + diames[4] + diames[5] + diames[6] + diames[7] + diames[8] + diames[9]   //   total de dias do quarto
   
   DO CASE
      case dados_anuais[TOTAL_DIAS+1,2] = "DOM"
         dia_inicial = 1
      case dados_anuais[TOTAL_DIAS+1,2] = "SEG"
         dia_inicial = 2
      case dados_anuais[TOTAL_DIAS+1,2] = "TER"
         dia_inicial = 3
      case dados_anuais[TOTAL_DIAS+1,2] = "QUA"
         dia_inicial = 4
      case dados_anuais[TOTAL_DIAS+1,2] = "QUI"
         dia_inicial = 5
      case dados_anuais[TOTAL_DIAS+1,2] = "SEX"
         dia_inicial = 6
      case dados_anuais[TOTAL_DIAS+1,2] = "SAB"
         dia_inicial = 7
   ENDCASE
   
   total_dias = diames[10] + diames[11] + diames[12]   //   total de dias do trimestre
   mes = 10
   marca_mes = DIAMES[mes]
   
   marcador = 1
   do while marcador < dia_inicial
      mapa4 = strtran(mapa4,("A"+strzero(marcador,2)),"   ")
      ++marcador
   enddo

   prefixo := {"A","B","C"}   
   contador = 1
   for ct:= 1 to total_dias
      mapa4 = strtran(mapa4,(prefixo[mes-9]+strzero(marcador,2)),str(contador,3))
      ++dia_inicial
      if dia_inicial > 7
         dia_inicial = 1
      endif   

      ++marcador
      ++contador
      
      if (ct == diames[10]) .or. (ct == diames[10] + diames[11]) .or. (ct == diames[10] + diames[11] + diames[12])
         for ct2:= 1 to 49
            mapa4 = strtran(mapa4,(prefixo[mes-9]+strzero(ct2,2)),"   ")
            ++marcador
         next
      
         marcador = 1
         do while marcador < dia_inicial
            mapa4 = strtran(mapa4,(prefixo[mes-9]+strzero(marcador,2)),"   ")
            ++marcador
         enddo
         
         ++mes
         if mes > 12
            exit
         endif   
         marca_mes = diaMES[mes]
         contador = 1
      
      endif
      
   next

   mapa4 = strtran(mapa4,"001",meses[10])
   mapa4 = strtran(mapa4,"002",meses[11])
   mapa4 = strtran(mapa4,"003",meses[12])
   
   mapa = mapa1 + mapa2 + mapa3 + mapa4
   nome_mes1 = {"JAN    ","FEV      ","MAR  ","ABR  ","MAI ","JUN  ","JUL  ","AGO   ","SET     ","OUT    ","NOV     ","DEZ     "}
   nome_mes2 = {"JANEIRO","FEVEREIRO","MARCO","ABRIL","MAIO","JUNHO","JULHO","AGOSTO","SETEMBRO","OUTUBRO","NOVEMBRO","DEZEMBRO"}

   for ct:= 1 to 12
      mapa = strtran(mapa,nome_mes1[ct],nome_mes2[ct])
   next

   ? replicate("-",91)
   inicio = 1
   fim = 91
   for ct:= 1 to 32
      ? substr(mapa,inicio,fim)
      inicio = inicio + 91
      if ct % 8 == 0
         ? replicate("-",91)
      endif
   next
   
RETURN NIL

Rotina de Calendario

Enviado: 17 Jun 2021 23:01
por JoséQuintas
Eu uso esta:

Código: Selecionar todos

/*
ZE_CALENDARIO - CALENDARIO
1992.10 - José Quintas
*/

#include "hbgtinfo.ch"
#include "inkey.ch"
#include "josequintas.ch"

MEMVAR m_Prog

PROCEDURE Calendario

   LOCAL mData, nKey, oSetKey, nRow, nCol, cSaveScreen
   PRIVATE m_Prog

   oSetKey := hb_SetKeySave()

   m_Prog := "CALEND"
   mData  := Date()
   IF Day( mData ) < 16
      mData -= 16
   ENDIF
   nRow := Int( ( MaxRow() - 10 ) / 2 )
   nCol := Int( ( MaxCol() - 71 ) / 2 )
   AppGuiHide()
   SAVE SCREEN TO cSaveScreen

   DO WHILE .T.
      mData := mData - Day( mData ) + 1
      CalendMes( mData, nRow, nCol )
      CalendMes( mData + 35, nRow, nCol + 36 )
      nKey := Inkey(0)
      DO CASE
      CASE nKey == K_PGUP
         mData -= 5
      CASE nKey == K_PGDN
         mData += 35
      CASE nKey == K_UP
         nRow := Max( 0, nRow - 1 )
      CASE nKey == K_DOWN
         nRow := Min( MaxRow() - 10, nRow + 1 )
      CASE nKey == K_LEFT
         nCol := Max( 0, nCol - 1 )
      CASE nKey == K_RIGHT
         nCol := Min( MaxCol() - 71, nCol + 1 )
      CASE nKey == K_CTRL_UP
         nRow := 0
      CASE nKey == K_CTRL_DOWN
         nRow := MaxRow() - 10
      CASE nKey == K_CTRL_LEFT
         nCol := 0
      CASE nKey == K_CTRL_RIGHT
         nCol := MaxCol() - 71
      CASE nKey == K_ESC
         EXIT
      ENDCASE
      RESTORE SCREEN FROM cSaveScreen
   ENDDO
   hb_SetKeySave( oSetKey )
   RESTORE SCREEN FROM cSaveScreen
   AppGuiShow()
   KEYBOARD Chr( 205 )
   Inkey(0)

   RETURN

STATIC FUNCTION CalendMes( dCalDate, mLin, mCol )

   LOCAL cOldColor, dItemDate, nCont, aSemanaList := { "Dom", "Seg", "Ter", "Qua", "Qui", "Sex", "Sab" }

   cOldColor := SetColor()
   SetColor( SetColorBox() )
   @ mLin, mCol CLEAR TO mLin + 10, mCol + 35
   @ mLin, mCol       TO mLin + 10, mCol + 35
   SetColor( SetColorTituloBox() )
   @ mLin, mCol + 10 SAY Padc( Trim( NomeMes( dCalDate ) ) + "/" + StrZero( Year( dCalDate ), 4 ), 14 )
   SetColor( SetColorBox() )
   FOR nCont = 1 TO 7
      @ mLin + 2, mCol - 1 + Dow( dCalDate + nCont ) * 4 SAY aSemanaList[ Dow( dCalDate + nCont ) ]
   NEXT
   @ mLin + 3, mCol SAY ""
   dItemDate := dCalDate - Day( dCalDate ) + 1
   DO WHILE .T.
      IF Dow( dItemDate ) == 1 .OR. Day( dItemDate ) == 1
         @ Row() + 1, mCol SAY ""
      ENDIF
      @ Row(), mCol + Dow( dItemDate ) * 4 SAY Day( dItemDate ) PICTURE "99" COLOR DayColor( dItemDate )
      dItemDate += 1
      IF Month( dItemDate ) != Month( dCalDate )
         EXIT
      ENDIF
   ENDDO
   SetColor( cOldColor )

   RETURN .T.

STATIC FUNCTION DayColor( d )

   LOCAL c

   DO CASE
   CASE Dow( d ) == DOW_DOMINGO    ; c := SetColorAlerta()
   CASE ! Empty( ze_Feriado( d ) ) ; c := SetColorAlerta()
   CASE d == Date()                ; c := SetColorFocus()
   OTHERWISE                       ; c := SetColor()
   ENDCASE

   RETURN c
É só remover o uso de ze_Feriado() e outras coisas que não interessem.
E criar as funções pra retornar cor, nome do mes, etc.
Mostra 2 meses por vez e permite "passear".
calendario.png

Rotina de Calendario

Enviado: 22 Jun 2021 14:33
por marsp
Obrigado Vander e José Quintas, corrigi a que tinha aqui.
Resolvido
Todos os horários são UTC-03:00
Página 1 de 1

Powered by phpBB® Forum Software © phpBB Limited

Traduzido por: Suporte phpBB