Ir para conteúdo

POWERED BY:

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

FabianoSouza

[Resolvido] Calendário somente com dias úteis

Por , em ASP Clássico

Recommended Posts

FabianoSouza    5

FabianoSouza
Postado

Encontrei esse código para gerar um calendário (funciona).

Mas quero "configurar" para exibir apenas os dias úteis.

Anexei um print para ilustrar o problema.

 

Agradeço desde já. 

<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<%Option Explicit%>
<%
Session.LCID=1046
%>

<%
Function FormatStr(String)
	on Error resume next
	String = Replace(String, CHR(13), "")
	String = Replace(String, CHR(10) & CHR(10), "</P><P>")
	String = Replace(String, CHR(10), "<BR>")
	FormatStr = String
End Function

Dim dtToday 
dtToday = Date()

Dim dtCurViewMonth ' First day of the currently viewed month
Dim dtCurViewDay ' Current day of the currently viewed month
Dim frmDate ' Date submitted by form

' if the GO button was used, build the date from the month and year

If InStr(1, Request.Form, "subGO", 1) > 0  then
	if Request.Form("CURDATE_month") = "" then
		tmpMonth = month(now())
	else
		tmpMonth = Request.Form("CURDATE_month")
	End If
	
	if Request.Form("CURDATE_year") = "" then
		tmpyear = year(now())
	else
		tmpyear = Request.Form("CURDATE_year")
	End If
		
	tmpDate = "1 " & tmpMonth & " 1999"
	
	mnth = Month(tmpDate)
	frmDate = DateSerial(tmpyear, mnth, 1)
Else

	frmDate = Request.Form("CURDATE")
	
end if

if Request("view_date") <> "" then 
	frmDate= DateSerial(year(Request("view_date")), month(Request("view_date")), 1)
end if

%>

<% 
'--------------------------------------------------
   Function DtPrevSunday(ByVal dt)
      Do While WeekDay(dt) > vbMOnday
         dt = DateAdd("d", -1, dt) 
      Loop
   DtPrevSunday = dt
   End Function
'--------------------------------------------------
%>

<%REM Set current view month from posted CURDATE,  or
' the current date as appropriate.

' if posted from the form
' if prev button was hit on the form
   If InStr(1, Request.Form, "subPrev", 1) > 0 Then
      dtCurViewMonth = DateAdd("m", -1, frmDate)
' if next button was hit on the form
   ElseIf InStr(1, Request.Form, "subNext", 1) > 0 Then
      dtCurViewMonth = DateAdd("m", 1, frmDate)
' anyother time
      Else

' date add in text box
         If InStr(1, Request.Form, "subGO", 1) > 0 then
			dtCurViewMonth = frmDate
		 Else
			if Request("view_date") <> "" then 
				dtCurviewMonth = frmDate
			else
            dtCurViewMonth = DateSerial(Year(dtToday), Month(dtToday), 1)
            End If
         End If
   End If
%>

<% REM --------BEGINNING OF DRAW CALENDAR SECTION-------- %>
<% REM This section executes the event query and draws a matching calendar. %>
<%
   Dim iDay, iWeek, sFontColor, dictDte(31,2), intCount
   strSql = "SELECT * FROM DATAS WHERE month(DatasDataInicio)= " & month(dtCurViewMonth) & " and year(DatasDataInicio) = " & year(dtCurViewMonth) & ""
   
   set rs = conn.Execute (StrSql)
   
   intCount= 0
   
   ' populate array with days of month
   on Error resume next
   
  
   do until rs.EOF
  
   if intCount > 31 then exit do
   if Day(rs("DatasDataInicio")) = intCount + 1 then 
		dictDte(intCount, 1) = left(rs("DatasDescricao"),15)&"..."
		rs.Movenext
	Else 
		dictDte(intCount, 1) = " "
	End If
	dictDte(intCount, 2) = intCount + 1
	intCount = intCount + 1
   loop
  
%>          <table width="100%" border="0" cellspacing="0" cellpadding="2">
            <tr>
              <td colspan="2">

<table width="100%" border="0" align="center" cellpadding="3" cellspacing="0">
                <tr align="center" height="25" valign="middle">
                  <% For iDay = vbMonday To vbFriday %>
                  <th width="14%" align="left"><%=WeekDayName(iDay)%></th>
                  <%Next %>
                  </tr>
                <%
   dtCurViewDay = DtPrevSunday(dtCurViewMonth)
  
   For iWeek = 0 To 6
      Response.Write "<TR VALIGN=TOP>" & vbCrLf

Dim sBGCOLOR 
sBGCOLOR = "#FFFFFF"


For iDay = 0 To 6
sBGCOLOR = "#FFFFFF"
If Month(dtCurViewDay) = Month(dtCurViewMonth) Then

'Marca dia atual 
If dtCurViewDay = dtToday Then sBGCOLOR = "#EFB4CF"
else 
 sBGCOLOR = "#F5F5F5"
 
End If
Response.Write "<TD HEIGHT=75 bgcolor='" & sBGCOLOR & "' align=left class=gridCal >"
 
   If Month(dtCurViewDay) = Month(dtCurViewMonth) Then
		If dtCurViewDay = dtToday Then
               sFontColor = "#ff0000"

            Else
               sFontColor = "#00000"
            End If
      
         '---- Write day of month
            
            Response.Write "<a href=rhCalendarioDetalhes.asp?" & "view_date=" & day(dtCurViewday) & "-" & monthname(month(dtCurViewday)) & "-" & year(dtCurViewday) & " span class=data>"  & Day(dtCurViewDay) & "</a><span class=txt3>"& formatStr(dictDte(Day(dtCurViewDay)- 1, 1)) & "</span>"
         '---Else
            '---Response.Write " "
         End If

         Response.Write "</TD>" & vbCrLf
         dtCurViewDay = DateAdd("d", 1, dtCurViewDay)
      Next
      Response.Write "</TR>" & vbCrLf
   Next
%>

  </table>
</td>
</tr>
</table>

 

forum.PNG

Compartilhar este post

Link para o post
Compartilhar em outros sites

hargon    64

hargon
Postado

Você tem que criar um cadastro de feriados e fazer a leitura deles no momento em que montar o calendário.

Compartilhar este post

Link para o post
Compartilhar em outros sites

FabianoSouza    5

FabianoSouza
Postado

Olá hargon.

No meu caso é para exibir apenas a semana em formato de cinco dias (segunda à sexta-feira), não para verificar feriados. Mas de todo modo sua informação será útil para outras finalidades do meu sistema.

Valew!

Compartilhar este post

Link para o post
Compartilhar em outros sites

Gustavo Emygdio Barboza    24

Gustavo Emygdio Barboza
Postado 
For iWeek = 0 To 6
For iDay = 0 To 6

 

não parei para analisar o código por inteiro as esse 2 loops definem os nomes dos dias e o outro define o numero do dia 

onde começa com 0 a segunda feira até 6 domingo então para testar coloque os loop até 4 ao invés de 6

Compartilhar este post

Link para o post
Compartilhar em outros sites

xanburzum    169

xanburzum
Postado

você pode ter a cadstro de feriado e depois usar uma classe CSS para exibi-lo diferente ou também usar jquery para ocultar somente o que deseja

 

Compartilhar este post

Link para o post
Compartilhar em outros sites

FabianoSouza    5

FabianoSouza
Postado
Em 05/05/2017 at 08:46, Gustavo Emygdio Barboza disse: 

For iWeek = 0 To 6
For iDay = 0 To 6

 

não parei para analisar o código por inteiro as esse 2 loops definem os nomes dos dias e o outro define o numero do dia 

onde começa com 0 a segunda feira até 6 domingo então para testar coloque os loop até 4 ao invés de 6

 

Blz!! Era nos loops. 

             <% For iDay = vbSunday To vbSaturday%>
              <th width="14%" class="fundoBarraSemanas"><span class="tituloDia"><%=WeekDayName(iDay)%></span></th>
              <%Next %>

E nos outros... 

   For iWeek = 0 To 6
      Response.Write "<TR VALIGN=TOP>" & vbCrLf

Dim sBGCOLOR 
sBGCOLOR = "#FFFFFF"


For iDay = 0 To 6
sBGCOLOR = "#FFFFFF"
If Month(dtCurViewDay) = Month(dtCurViewMonth) Then
...

Agora compreendi a lógica disso.

É possível definir se a semana começa na segunda, se vai de domingo à sábado e várias outras "configurações".

 

Aí se esconde os finais de semana com CSS, por exemplo.

 

Valew, fera!!!!

Compartilhar este post

Link para o post
Compartilhar em outros sites

FabianoSouza    5

FabianoSouza
Postado

Valew galera. Problema resolvido.

Ajustei os três loops (nome dos dias da semana, quantidade de semanas e dos dias do mês) e tudo se resolveu.

 

Depois só usar CSS para esconder o sábado e o domingo (como os colegas sugeriram) e bingo!

 

Moderador, passa a régua no tópico.

 

Valew!

calendario.png

Compartilhar este post

Link para o post
Compartilhar em outros sites
Ir para a lista de tópicos ASP Clássico
×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.

  Aceito