Rotina de Calendario

Projeto [x]Harbour - Compilador de código aberto compatível com o Clipper.

Moderador: Moderadores

Responder
marsp
Usuário Nível 1
Usuário Nível 1
Mensagens: 46
Registrado em: 11 Fev 2013 14:09

Rotina de Calendario

Mensagem por marsp »

Boa tarde,

Alguem por favor teria uma rotina de calendario para disponibilizar.


Obrigado
Voltar ao topo
Avatar do usuário
Vander
Usuário Nível 3
Usuário Nível 3
Mensagens: 214
Registrado em: 23 Jul 2004 01:43
Localização: João Monlevade - MG

Rotina de Calendario

Mensagem 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
HbMake v1.17
xHarbour build 0.99.70 Intl. (SimpLex)
Borland C++ 5.5.1
fivewin 6.12 (FREE)
Workshop 4.5
MEdit
Voltar ao topo
Avatar do usuário
JoséQuintas
Administrador
Administrador
Mensagens: 20267
Registrado em: 26 Fev 2007 11:59
Localização: São Paulo-SP

Rotina de Calendario

Mensagem 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
José M. C. Quintas
Harbour 3.2, mingw, gtwvg mt, fivewin 25.04, multithread, dbfcdx, MySQL, ADOClass, PDFClass, SefazClass, (hwgui mt), (hmg3), (hmg extended), (oohg), PNotepad, ASP, stored procedure, stored function, Linux (Flagship/harbour 3.2)
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"
https://github.com/JoseQuintas/
Voltar ao topo
marsp
Usuário Nível 1
Usuário Nível 1
Mensagens: 46
Registrado em: 11 Fev 2013 14:09

Rotina de Calendario

Mensagem por marsp »

Obrigado Vander e José Quintas, corrigi a que tinha aqui.
Resolvido
Voltar ao topo
Responder

Voltar para “[x]Harbour”