Fiquei um pouco chateado quando coloquei um código de calendário em uma pagina e não funcionou. Para principiantes isso é uma decepção, ele ficaria muito chateado, então resolvi arrumar e mostrar todo o código.
Aceito críticas e sugestões
[]´s
Myers
<%@ Language="VBScript" %>
<%
fDia = 1 ' Varaivel para iniciar contagem no dia 1
' Nome de como foi salva esta página(neste caso a sugestão é calendario.asp)
sURL = "calendario.asp"
' Matriz que indica o nº máximo de Dias permitidos em cada mês
' Jan. tem 31 Dias, Fev. tem 28 ou 29 Dias, Mar. tem 31 Dias, etc.
' A contagem dos Meses começa a partir do um (1): Jan. = 1, Fev. = 2, Mar. = 3, etc.
Dim aDiasMes
ReDim aDiasMes(12)
aDiasMes(01) = 31
aDiasMes(02) = 28
aDiasMes(03) = 31
aDiasMes(04) = 30
aDiasMes(05) = 31
aDiasMes(06) = 30
aDiasMes(07) = 31
aDiasMes(08) = 31
aDiasMes(09) = 30
aDiasMes(10) = 31
aDiasMes(11) = 30
aDiasMes(12) = 31
' Função que escreve o mês por extenso, passando o numero do Mes como parametro
Function MesExtenso(Mes)
Select Case Mes
Case 1
MesExtenso = "Janeiro"
Case 2
MesExtenso = "Fevereiro"
Case 3
MesExtenso = "Março"
Case 4
MesExtenso = "Abril"
Case 5
MesExtenso = "Maio"
Case 6
MesExtenso = "Junho"
Case 7
MesExtenso = "Julho"
Case 8
MesExtenso = "Agosto"
Case 9
MesExtenso = "Setembro"
Case 10
MesExtenso = "Outubro"
Case 11
MesExtenso = "Novembro"
Case 12
MesExtenso = "Dezembro"
End Select
End Function
' Função que escreve os dias da semana
Function DiaSemana(iDia)
Select Case iDia
Case 0
DiaSemana = "Dom"
Case 1
DiaSemana = "Seg"
Case 2
DiaSemana = "Ter"
Case 3
DiaSemana = "Qua"
Case 4
DiaSemana = "Qui"
Case 5
DiaSemana = "Sex"
Case 6
DiaSemana = "Sab"
End Select
End Function
' Funcao para saber quantas semanas tem o mes
Function nSemanas(Mes, Ano)
Dim nSem
DtInicial = DateSerial(Ano, Mes, fDia)
if WeekDay(DtInicial) = 1 then
nSem = 0
else
nSem = 1
end if
nDiasMes = aDiasMes(Mes)
for i = 1 to nDiasMes
if WeekDay(DtInicial) = 1 then
nSem = nSem + 1
end if
DtInicial = DateAdd("d", 1, DtInicial)
next
nSemanas = nSem
End Function
' Subrotina que identifica se o ano é bissexto
Sub SetBissexto
Data = Request("Data")
if Trim(data) = "" then
Data = Date()
else
Data = CDate(Data)
end if
Ano = Year(Data)
'Verifica se é Ano bissexto e diz se fevereiro tem 28 ou 29 dias
if (Ano mod 4 = 0) or (Ano mod 100 = 0) and (Ano mod 400 = 0) then
aDiasMes(2) = 29
else
aDiasMes(2) = 28
end if
End Sub
SetBissexto ' Chamada da Subrotina de verificacao
' Subrotina que monta o calendario
Sub MontaCalendario
Data = Request("Data")
if Trim(data) = "" then
Data = Date()
else
Data = CDate(Data)
end if
Ano = Year(Data)
Mes = Month(Data)
DiaInicial = WeekDay(DateSerial(Ano, Mes, fDia))
DtInicial = DateSerial(Ano, Mes, fDia)
' Início da Tabela
response.write "<table border=""1"" cellpading=""0"" cellspacing=""0""><tr>"&VBCrLf
' Retroage um mês
response.write "<th width=""25"">"&VBCrLf
response.write "<center><input type=""button"" value="" << "" onclick=""javascript:document.location.href='"&sURL&"?data="&DateAdd("m", -1, DtInicial)&"'"">"&VBCrLf
response.write "</center></th>"&VBCrLf
' Escreve mês e o Ano no cabeçalho
response.write "<th colspan=""5"" class=""cel"" align=""center"" nowrap width=""120"">"&MesExtenso(Month(DtInicial))&" - "&Year(DtInicial)&"</th>"&VBCrLf
' Avança um mês
response.write "<th width=""25"">"&VBCrLf
response.write "<center><input type=""button"" value="" >> "" onclick=""javascript:document.location.href='"&sURL&"?data="& DateAdd("m", 1, DtInicial)& "'"">"&VBCrLf
response.write "</center></th></tr>"&VBCrLf
' Escreve cabeçalho dos Dias da semana
response.write "<tr>"
for j = 0 to 6
if j=0 then
response.write "<td class=""cel"" align=""center""><div class=""dom"">"&DiaSemana(j)&"</div></td>"&VBCrLf
else
response.write "<td class=""cel"" align=""center"">"&DiaSemana(j)&"</td>"&VBCrLf
end if
next
response.write "</tr>"
' Escreve tabela de dias
for i = 0 to (nSemanas(Month(DtInicial), Year(DtInicial)) -1)
response.write "<tr>"&VBCrLf
for j = 0 to 6
if (DiaInicial-1) > j and i = 0 then
if j=0 and i=0 then
response.write "<td class=""cel""><div class=""dom""> </div></td>"&VBCrLf
else
response.write "<td class=""cel""> </td>"&VBCrLf
end if
else
if Month(DtInicial) > Mes or Year(DtInicial) > Ano then
response.write "<td class=""cel""> </td>"&VBCrLf
else
if weekDay(DtInicial) = 1 then
response.write "<td class=""cel"" align=""center""><div class=""dom""><a href=""javascript:upData('"&DtInicial&"')"">"&Day(DtInicial)&"</a></div></td>"&VBCrLf
else
if DtInicial = Date() then
response.write "<td align=""center""><div class=""hoje""><a href=""javascript:upData('"&DtInicial&"')"" style=""Color: White;"">"&Day(DtInicial)&"</a></div></td>"&VBCrLf
else
response.write "<td class=""cel"" id="&Day(DtInicial)&" align=center><a href=""javascript:upData('"&DtInicial&"'); ClickedDay('"&Day(DtInicial)&"')"">"&Day(DtInicial)&"</a></td>"&VBCrLf
end if
end if
end if
DtInicial = DateAdd("d", DtInicial, 1)
end if
next
response.write "</tr>"&VBCrLf
next
' Fim tabela
response.write "</table>"&VBCrLf
End Sub
%>
<html>
<head>
<script language="JavaScript">
<!--
// Função para exibir a data quando clicar no dia
function upData(data){
alert(data);
}
function ClickedDay(Dia){
return
}
-->
</script>
<style>
th.cel{Font-Family: Verdana; Font-Size: 8 pt; Background : #DDF4FF; Color: #003366;}
td.cel{Font-Family: Verdana; Font-Size: 8 pt;}
.hoje {Font-Family: Verdana; Font-Size: 8 pt; Background : #0000FF; Color: #FFFFFF;}
a{Font-Family: Verdana; Font-Size: 8 pt; Text-Decoration: None; Color: #000000;}
a:hover{Font-Family: Verdana; Font-Size: 8 pt; Text-Decoration: None; Color: #FF0000;}
.dom{Font-Family: Verdana; Font-Size: 8 pt; Text-Decoration: None; Color: #003366;
background : #DDF4FF;}
p {Font-Family: Verdana; Font-Size: 10 pt;}
td{Font-Family: Verdana; Font-Size: 10 pt;}
</style>
<title>calendario.asp [Atualizado por: Myers :: mayersk@hotmail.com]</title></head>
<body bgcolor="#FFFFFF">
<p align="center">
<% MontaCalendario %>
<br><br>
<font size="1"><a href="mailto:mayersk@hotmail.com">Atualizado por Myers :: mayersk@hotmail.com</a></font>
</p>
</body>
</html>
Esta matéria foi postada originalmente no ASP4Developers por Rafael "M4yers" Rossi (site), que na época era "...". Hoje, vai saber...
