Calendário v1.0

Estava afim de estudar um pouco de Orientação à Objeto, daí resolvi criar essa Classe abaixo.

O objetivo dela é facilitar a inserção de eventos ao calendário. Não criei a navegação entre meses, mas desenvolvi pensando nisso. Por isso não é dificil criar uma navegação, basta ter um pouco de conhecimento.

No exemplo abaixo inseri os eventos manualmente, mas você pode buscá-los diretamente do banco de dados. A propósito, esse é o objetivo principal.

Obs. Única observação: Mantenha os créditos. :D

Correção:

• mostrarTitulo(valor): caso informe string como valor será considerado falso. (29/04/2008)
• criaCalendario(): correção no cálculo de colunas vazias. (29/04/2008)
• Alteração no CSS para corrigir exibição de link na data atual. (15/12/2008)

calendario.asp

<%
'****************************************************
' Classe para criar calendário
' Autor: hargon
' Propósito: Criar um calendário com datas agendadas
' Data: 28/04/2008
' Fórum: Imasters (www.imasters.com.br/forum)
'*****************************************************
Option Explicit

'*****************************************************
' Classe para Calendário
'*****************************************************
Class Calendario
Public dia, mes, ano, dtevento, nmevento, idevento, url, exibir

Public Sub Calendario()
mes = mesVerifica(mes)
ano = anoVerifica(ano)
criaCalendario()
End Sub

Private Function mesVerifica(mes)
if isnumeric(mes) then
if (mes < 1) or (mes > 12) then
mes = month(date)
end if
else
mes = month(date)
end if
mesVerifica = mes
End Function

Private Function anoVerifica(ano)
If isNumeric(ano) Then
If (ano < 1900) or (ano > 2050) Then
ano = year(date)
End If
Else
ano = year(date)
End If
anoVerifica = ano
End Function

Private Function dataVerifica(dia)
dim i, verifica, diaAtual

If (dia = day(date)) Then

 diaAtual = "<span class='diaAtual'>" & dia & "</span>"
 else
 diaAtual = dia
 End If

 If (ubound(dtevento) - 1) >= 0 then
 For i = 0 To (ubound(dtevento) - 1)
 verifica = True
 If (dtevento(i) = (dia & "/" & mes & "/" & ano)) Then
 dataVerifica = "<td class='tdCalendarioColEvento'><a id='lnk"&url(i)&"' class='evento' href='"&url(i)&"' >" & diaAtual & "<span id='spn"&idevento(i)&"' class='evento'>" & nmevento(i) & "</span></a></td>" & vbCrLf
 verifica = False
 i = ubound(dtevento)
 End If
 Next
 If verifica Then
 dataVerifica = "<td class='tdCalendarioColPadrao'>" & diaAtual & "</td>" & vbCrLf
 End If
 Else
 dataVerifica = "<td class='tdCalendarioColPadrao'>" & diaAtual & "</td>" & vbCrLf
 End If
	End Function

	Public Sub criaCalendario()
 dim diafinal
 nmevento = split(nmevento,";*")
 idevento = split(idevento,";*")
 dtevento = split(dtevento,";*")
 url = split(url,";*")

 with Response
 .Write "<table class='tblCalendario'>" & vbCrLf

 if (exibir) then
 .Write "	<tr class='trTituloCalendario'><td class='tdTituloCalendario' colspan='7'>"& monthName(mes)&" de "& ano &"</td></tr>" & vbCrLf
 end if

 .Write "	<tr class='trSubtituloCalendario'>" & vbCrLf

 For dia = 1 To 7
 .Write "<td class='tdCalendarioCoTitulo'>" & uCase(left(weekDayName(dia),1)) & "</td>" & vbCrLf
 Next

 .Write "</tr>" & vbCrLf

 .Write "	<tr class='trCalendario'>" & vbCrLf

 For dia = 1 To weekday("1/"&mes&"/"&ano) - 1
 .Write "<td class='tdCalendarioColVazia'></td>" & vbCrLf
 Next

 For dia = 1 To 31
 If isDate(dia & "/" & mes & "/" & ano) Then
 .Write dataVerifica(dia)
 diafinal = dia
 Else
 .Write "<td class='tdCalendarioColVazia'></td>" & vbCrLf
 End If

 If (((dia + weekday("1/" & mes & "/" & ano)-1) mod 7) = 0) Then
 .Write "</tr>" & vbCrLf & "<tr class='trCalendario'>" & vbCrLf
 End If
 Next

 dia = diafinal
 diafinal = weekday(diafinal&"/"&mes&"/"&ano)

 For dia = (weekday((dia-diafinal)&"/"&mes&"/"&ano)) To (7 - (weekday((dia-diafinal)&"/"&mes&"/"&ano)))
 .Write "<td class='tdCalendarioColVazia'></td>" & vbCrLf
 Next

 .Write "</tr>" & vbCrLf
 .Write "</table>"
 End With
	End Sub

	Public Sub addEvento(data,evento,id,link)
 dtevento = dtevento & data & ";*"
 nmevento = nmevento & evento & ";*"
 idevento = idevento & id & ";*"
 If len(link) = 0 Then
 link = "#"
 End If
 url = url & link & ";*"
	End Sub

	Public Sub informaMes(mesnovo)
 mes = mesVerifica(mesnovo)
	End Sub

	Public Sub informaAno(anonovo)
 ano = anoVerifica(anonovo)
	End Sub

	Public Sub mostrarTitulo(valor)
 exibir = False
 If (isnumeric(valor)) Then
 exibir = CBool(valor)
 End If
	End Sub

End Class
%>
arquivo.asp

<!--#include file='calendario.asp'-->

<style type="text/css">
 body{
 font: 10px arial, verdana, helvetica, sans-serif;
 }

 table.tblCalendario{
 font: 10px arial, verdana, helvetica, sans-serif;
 }
 tr.trTituloCalendario, tr.trSubtituloCalendario, tr.trCalendario{
 height: 16px;
 }
 td.tdTituloCalendario, td.tdCalendarioCoTitulo, td.tdCalendarioColVazia, td.tdCalendarioColEvento, td.tdCalendarioColPadrao{
 width: 20px;
 text-align: center;
 }
 td.tdTituloCalendario{
 width: 100%;
 }
 td.tdCalendarioCoTitulo{
 font-weight: bold;
 }
 a.evento{
 position: relative;
 padding: 0;
 color: #039;
 text-decoration:none;
 border-bottom: 2px dotted #039;
 cursor: help;
 z-index: 30;
 }

 a.evento:hover{
 background: transparent;
 z-index: 31;
 }

 a.evento span.evento{display: none}

 a.evento:hover span.evento{
 display: block;
 position: absolute;
 width: 230px;
 top: 3em;
 text-align: justify;
 left: 0;
 padding: 5px 10px;
 border:1px solid #999;
 background: #E0FFFF;
 color: #000000;
 }
 span.diaAtual{
 color: #FF0000;
 font-weight: bold;
 }
</style>

<%
Dim cal

Set cal = New calendario
With cal
.mostrarTitulo True 'Preencher essa linha somente para mostrar o título da tabela com o mês e o ano. Caso queira criar seu próprio título dispense essa linha
.informaMes 5 'Preencher somente caso o mês for diferente do mês atual. Necessário para cria navegação entre os meses
.informaAno 2009 'Preencher somente caso o ano for diferente do ano atual. Necessário para cria navegação entre os anos
.addEvento "1/4/2008", "Evento 1", 1, "" 'Informar os 5 parâmetros: data(Sem formatação. Ex. 1/1/2000), nome e/ou descrição do evento(aceita código HTML), código do evento para criação do ID do span e a href, endereço URL caso seja para abrir uma nova janela ou popup
.addEvento "2/4/2008", "Evento 2", 2, "url"
.addEvento "6/4/2008", "Evento 3", 3, "url"
.addEvento "9/4/2008", "Evento 4", 4, "url"
.addEvento "30/4/2008", "Evento 5", 5, "url"
.calendario
End With
Set cal = Nothing
%>