<%
'#################################################################################
'## Copyright (C) 1999-2002 - Matt Smith
'##
'## This program is free software; you can use it and/or
'## modify it as you see fit. I only ask that somewhere in your comments,
'## (you do comment your programs, don't you?) you keep a reference
'## to the original 4GuysFromRolla article which is:
'##
'## http://www.4guysfromrolla.com/webtech/111899-1.shtml
'##
'## Matt Smith
'## Questions: matt@smitty.net
'## PayPal: matt@smitty.net - tipping is appreciated!
'#################################################################################
Const adOpenStatic = 3
Const adCmdText = &H0001
Const adUseClient = 3
Const TITLE = "Activitats"
dim objRS 'Recordset object
dim strSQL 'SQL string
dim intNumRows 'number of rows in table
dim intNumCols 'number of columns in table
dim strLayoutType 'whether intSize refers to (C)olumns or (R)ows
dim strOrientation 'direction of output: (V)ertical or (H)orizontal
dim intNumRecs 'number of records in the database
dim intPage 'current page to disply
dim intPageSize 'number of records to display on page
dim intNumPages 'number of pages
dim intRowIndex 'placeholder for current row
dim intColIndex 'placeholder for current column
dim intPosition 'placeholder for current record
intNumRows = 3
intNumCols = 2
strOrientation = "H"
'strLayoutType = UCase(Request("LayoutType"))
%>
<%
Dim Actes__MMColParam
Actes__MMColParam = "0"
if (Request("MM_EmptyValue") <> "") then Actes__MMColParam = Request("MM_EmptyValue")
%>
<%
'create recordset object
Set objRS = Server.CreateObject("ADODB.Recordset")
'connect via ODBC
objRS.ActiveConnection = MM_armeriaandorrana_STRING
'create SQL query
strSQL = "SELECT * FROM Activitats WHERE DATEPART('m', Inici) = " & Meses__MMColParam & " OR DATEPART('m', Fi) = " & Meses__MMColParam & ";"
'response.write strSQL
objRS.CursorLocation = adUseClient
'execute SQL statement
objRS.Open strSQL, ,adOpenStatic , , adCmdText
%>
<% If objRS.EOF And objRS.BOF Then %>
<% Session.LCID = 1027 %>
>> <%=UCASE(MonthName(Meses__MMColParam))%>
No tenim cap activitat programada per aquest mes.
<% else If NOT objRS.EOF AND NOT objRS.BOF Then
Dim Ref
Ref = objRS.Fields("ID")
'intNumRows = 3
'intNumCols = 2
'strOrientation = "H"
intNumRecs = objRS.RecordCount
intPage = Request("Page")
intPageSize = cint(intNumRows) * cint(intNumCols)
objRS.PageSize = intPageSize
intNumPages = objRS.PageCount
if intPage = "" then
intPage = 1
objRS.AbsolutePage = intPage
else
objRS.AbsolutePage = intPage
end if
Response.Write " " & vbCRLF
'span the number of columns in the table with the title
Response.Write "" & vbCrlf
Response.Write "![]() >> "
Session.LCID = 1027
Response.Write UCASE(MonthName(Meses__MMColParam))
Response.Write " | " & vbCrlf
Response.Write " " & vbCrlf
Response.Write "" & vbCrlf
Response.Write "
| " & vbCrlf
Response.Write " " & vbCrlf
'loop thru table by row
For intRowIndex = 1 To intNumRows
Response.Write "" & vbCRLF
If strOrientation = "V" Then
'intPosition = intRowIndex
'intPosition = ((intPage - 1) * intPageSize) + intColIndex + ((intRowIndex - 1) * intNumCols)
'loop thru table by column
For intColIndex = 1 To intNumCols
intPosition = ((intPage - 1) * intPageSize) + intRowIndex + ((intColIndex - 1) * intNumRows)
PrintRecord
'intPosition = intPosition + intNumRows
Next
Else'If strOrientation = "H" Then
'loop thru table by column
For intColIndex = 1 To intNumCols
intPosition = ((intPage - 1) * intPageSize) + intColIndex + ((intRowIndex - 1) * intNumCols)
PrintRecord
Next
End If
Response.Write " " & vbCRLF
Response.Write "" & vbCrlf
Response.Write "![]() | " & vbCrlf
Response.Write " " & vbCrlf
Next
Response.Write "" & vbCrlf
Response.Write "
| " & vbCrlf
Response.Write "" & vbCrlf
Response.Write " " & vbCRLF
End If
Response.Write " "
Response.Write ""
Response.Write "| "
if intPage = 1 then
Response.Write " "
else
Response.Write "<< Anterior"
end if
Response.Write " | "
Response.Write ""
if cint(intPage) < cint(intNumPages) then
Response.Write " Següent >> "
else
Response.Write " "
end if
sub PrintRecord
'if position is past EOF print a blank cell
If intPosition > intNumRecs Then
Response.Write " | ![]() | " & vbCRLF
Else
objRS.AbsolutePosition = intPosition
'if necessary, check for blank field values and print blank cell
If objRS.Fields("Activitat_cat") = "" Then
Response.Write "![]() | " & vbCRLF
Else
Response.Write "" & vbCRLF
Response.Write "" & vbCrlf
Response.Write "" & vbCRLF
Response.Write "" & vbCrlf
Response.Write "" & vbCrlf
Response.Write "" & vbCrlf
Response.Write " Activitat " & vbCRLF
Response.Write " | " & vbCrlf
Response.Write ""
Response.Write objRS.Fields("Activitat_cat")
Response.Write " | " & vbCrlf
Response.Write " " & vbCrlf
Response.Write "" & vbCrlf
Response.Write "Lloc | " & vbCrlf
Response.Write "" & vbCrlf
Response.Write objRS.Fields("Lloc")
Response.Write " | " & vbCrlf
Response.Write " " & vbCrlf
Response.Write "" & vbCrlf
Response.Write "Característiques
del Lloc | "
Response.Write ""
Response.Write Replace(objRS.Fields("Caract_lloc"),Chr(13),"
")
Response.Write " | " & vbCrlf
Response.Write " " & vbCrlf
Response.Write "" & vbCrlf
Response.Write "Dates | " & vbCrlf
Response.Write ""
Response.Write FormatDateTime(objRS.Fields("Inici"),2) & " - " & FormatDateTime(objRS.Fields("Fi"),2)
Response.Write " | " & vbCrlf
Response.Write " " & vbCrlf
Response.Write "" & vbCrlf
Response.Write "Descripció | " & vbCrlf
Response.Write ""
Response.Write Replace(objRS.Fields("Descripcio"),Chr(13),"
")
Response.Write " | " & vbCrlf
Response.Write " " & vbCrlf
Response.Write "" & vbCrlf
Response.Write "Altres | " & vbCrlf
Response.Write ""
Response.Write Replace(objRS.Fields("Altres"),Chr(13),"
")
Response.Write " | " & vbCrlf
Response.Write " " & vbCrlf
Response.Write "" & vbCrlf
Response.Write "Logotips | " & vbCrlf
Response.Write "![]() > "
Response.Write objRS.Fields("Organitza")
Response.Write " | " & vbCrlf
Response.Write " " & vbCrlf
Response.Write " " & vbCrlf
Response.Write " | " & vbCrlf
Response.Write " " & vbCrlf
Response.Write " " & vbCrlf
Response.Write " | " & vbCrlf
End If
End If
End Sub
Function IIF(sExp, sTrue, sFalse)
If CBool((sExp)) = True Then
IIF = sTrue
Else
IIF = sFalse
End If
End Function
Response.Write " "
Response.Write " " & vbCrlf
Response.Write " | " & vbCrlf
Response.Write "
