|
lcaseydc
VP-CART New User
USA
90 Posts |
 Posted - January 15 2003 : 22:52:03
|
Can anyone figure out where and how I could make alternating row colors in this file? It has some customization..it is the shopproductformat.asp
<%
'************************************************************
' Version 4.50 New customerprices
' Fields to be displayed are in shop$colors
' creates a table with columns
' add overallrating
' June 2, 2002
'*************************************************************
Dim ProdFields
Dim ProdHeaders
Dim QuantityFlag
Sub ProductFormatRow
dim url, stayonpage
QuantityFlag=False
If ProductSelect="Yes" then
Response.write ProdRow
ProductFormatFields
if getconfig("xproductcatalogonly")<>"Yes" then
AddSelect
end if
Response.write "</tr>"
else
response.write "<form action=""shopaddtocart.asp"" method=""POST"">"
Response.write ProdRow
ProductFormatFields ' actual row is formatted
if getconfig("xproductcatalogonly")<>"Yes" then
FormatButton
end if
Response.write "</tr>"
response.write "<input type=hidden name=productid value=" & lngCatalogId & ">"
stayonpage=getconfig("Xproductstayonpage")
If stayonpage="Yes" then
url="shopdisplayproducts.asp?page=" & mypage
response.write "<input type=hidden name=returnurl value='" & url & "'></form>"
end if
response.write "</form>"
end if
End Sub
Sub ProductFormatFields
Dim FieldCount
Dim i
Fieldcount=ubound(ProdFields)
for i=0 to FieldCount
FormatProductField ProdFields(i)
next
end sub
Sub FormatProductField (fieldname)
Dim rc, fieldvalue
ProcessSpecial fieldname, rc
If RC=0 then exit sub
Fieldvalue=objRS(fieldname)
response.write ProdColumn & ProdColumnFont & fieldvalue & "</font></td>"
end sub
Sub ProcessSpecial (fieldname, rc)
fieldname=ucase(fieldname)
rc=4
Select Case fieldname
Case "CDESCRIPTION"
FormatDescription
rc=0
Case "QUANTITY"
FormatQuantity
rc=0
Case "CPRICE"
FormatPrice
rc=0
Case "CNAME"
FormatName
rc=0
end Select
end sub
'
Sub AddSelect
dim rc
if getconfig("xproductcatalogonly")="Yes" then
exit sub
end if
PWriteNoStockMessage rc
if rc> 0 then exit sub
If productwithhtml<>"Yes" Then
response.write "<td bgcolor=" & ProdSelectColor & "><center>"
%>
<input type=checkbox name="Processed<%=prodIndex%>" value="<%=lngCatalogid%>"></center></td>
<%
else
%>
<input type=checkbox name="Processed<%=prodIndex%>" value="<%=lngCatalogid%>">
<%
end if
End sub
'
Sub FormatName
Response.write ProdNameColumn & ProdNameFont & objrs("cname")
FormatImage
Formatoverallrating
response.write ProdNameEnd
end sub
Sub FormatDescription
Dim Fieldvalue
Fieldvalue=objRS("cdescription")
response.write ProdDescriptionColumn & ProdDescriptionFont
If getconfig("xgeneratedesclink")="Yes" then
strdescurl="shopexd.asp"
strDescURL=strDescURL & "?id=" & lngCatalogID
end if
If strDescUrl <> "" Then
response.write("<a href=""#"" OnClick=""window.open('" & strDescURL & "','','width=550,height=400,menubar=no,toolbar=no,location=no,status=no,directories=no,copyhistory=no,resizable=yes,scrollbars=yes'); return false;"" >")
End if
response.write fieldvalue
If strDescUrl <> "" Then
response.write("</A>")
End If
''FormatProductOptions
''FormatUserText
''FormatSpecialOffer
''FormatCrossSelling
''FormatHyperlinks
response.write ProdDescriptionEnd
end sub
'
Sub FormatQuantity
If strMinimumQuantity=0 or strMinimumquantity="" then
If productwithhtml<>"Yes" Then
Response.write ProdQuantityColumn & "<input type='text' maxlength=4 size='3' value='1' name='quantity'>" & ProdQuantityEnd
else
Response.write "<input type='text' maxlength=4 size='3' value='1' name='quantity'>"
end if
else
GenerateMinList
end if
QuantityFlag=True
end sub
Sub GenerateMinList
Dim PArray(100),PArrayCount
dim minamount, amount, multiply
minamount=strminimumquantity
'*****************************************************************
' should we generate a list or just prevent the customer from order less
'********************************************************************
If Getconfig("xproductminimumquantity")="Yes" Then
If productwithhtml<>"Yes" Then
Response.write ProdQuantityColumn & "<input type='text' maxlength=4 size='3' value='" & strMinimumQuantity & "' name='quantity'>" & ProdQuantityEnd
else
Response.write "<input type='text' maxlength=4 size='3' value='" & strMinimumQuantity & "' name='quantity'>"
end if
exit sub
end if
parraycount=getconfig("xproductminimumlist")
if parraycount="" then
parraycount=6
end if
parraycount=clng(parraycount)
for i = 1 to parraycount
amount=i*minamount
parray(i)=amount
next
dim i
sSelect = "<select size=1 name='quantity'>"
sSelect = sSelect & "<option selected>" & minamount & "</option>"
for i = 2 to parraycount
sSelect = sSelect & "<option>" & Parray(i) & "</option>"
next
sSelect= sSelect & "</select></p>"
If productwithhtml<>"Yes" then
Response.write ProdQuantityColumn & sSelect & ProdQuantityend
else
Response.write sSelect
end if
end sub
Sub FormatPrice
Dim OriginalPrice, decimalpoint
If getconfig("XDisplayPrices")="No" then exit sub
dim strPrice, newprice
' if we read product in getproduct values all this has been done
If ProductFieldvalid<>True then
lngcatalogid=objrs("catalogid")
lngccategory=objrs("ccategory")
curcprice=objrs("cprice")
NewPrice=curCPrice
curOriginalPrice=curCprice
ShopCustomerPrices objrs,lngcatalogid, lngCcategory, CurCprice, Newprice, lngDiscount
curCPrice=Newprice
end if
decimalpoint=getconfig("xdecimalpoint")
strPrice=shopformatcurrency(curCprice,decimalpoint)
response.write ProdColumnPrice & ProdColumnFont & strPrice
If not isnull(objrs("retailprice")) then
if strRetailPrice> 0 then
response.write ProdRetailPriceStart & LangProductRetailPrice & shopformatcurrency(strRetailPrice,decimalpoint) & ProdRetailPriceEnd
end if
end if
If getconfig("xDisplayOriginalPrice")="Yes" and lngdiscount<>0 then
response.write ProdOriginalPriceStart & LangProductBasePrice & shopformatcurrency(curOriginalPrice,decimalpoint) & ProdOriginalPriceEnd
end if
Response.write ProdPriceEnd
If getconfig("xDualPrice")="Yes" then
FormatDualPrice
end if
end sub
'
Sub FormatDualPrice
Dim strPrice
ConvertCurrency curCprice, strPrice
strPrice=FormatNumber(strprice,2)
response.write ProdColumnPrice & ProdColumnFont & strPrice
Response.write "</font></td>"
end sub
'*********** Format Image and Extended Description
Sub FormatImage
'*******************************************************
' if product has an image, it is formatted here
'******************************************************
if isnull(strcimageurl) then
strcimageurl=""
end if
if isnull(strDescurl) then
strdescurl=""
end if
If strDescURL<>"" then
If getconfig("xAddCatalogid")="Yes" then
strDescURL=strDescURL & "?id=" & lngCatalogID
end if
else
If getconfig("xGenerateShopexdLink")="Yes" then
strdescurl="shopexd.asp"
strDescURL=strDescURL & "?id=" & lngCatalogID
end if
end if
'exit sub if both empty, no piont going further
If strdescurl="" and strcimageurl="" then
exit sub
end if
'
If strcImageUrl<>"" then
GenerateImage
else
GenerateNoImage
end if
end sub
'
Sub GenerateImage
If strDescUrl<>"" then
If Getconfig("XextendedPopup")="Yes" then
%>
<p align="center"><a href="#" OnClick=window.open('<%=strDescURL%>','','width=550,height=400,menubar=no,toolbar=no,location=no,status=no,directories=no,copyhistory=no,resizable=yes,scrollbars=yes')><img border="0" src="<%=strcimageURL%>"></a><br>
<font size="1"><a href="#" OnClick=window.open('<%=strDescURL%>','','width=550,height=400,menubar=no,toolbar=no,location=no,status=no,directories=no,copyhistory=no,resizable=yes,scrollbars=yes')><%=LangProductClick%></a></font></p>
<%
Else
%>
<p align="center"><a href="<%=strDescURL%>"><img border="0" src="<%=strcimageURL%>"></a><br>
<font size="1"><a href="<%=strDescURL%>"><%=LangProductClick%></a></font></p>
<%
end if
else
%>
<p align="center"><img border="0" src="<%=strcimageURL%>"></p>
<%
end if
end sub
'
Sub GenerateNoImage
dim buttonimage
buttonimage=Getconfig("xbuttonmoreinfo")
if isNull(buttonimage) Or buttonimage="" then
buttonimage=""
end if
If Getconfig("XextendedPopup")="Yes" then
If buttonimage="" Then
%>
<p align="left"><a href="#" OnClick=window.open('<%=strDescURL%>','','width=550,height=400,menubar=no,toolbar=no,location=no,status=no,directories=no,copyhistory=no,resizable=yes,scrollbars=yes')><%=LangProductExtendeddescription%></a></p>
<%
else
%>
<p align="center"><a href="#" OnClick=window.open('<%=strDescURL%>','','width=550,height=400,menubar=no,toolbar=no,location=no,status=no,directories=no,copyhistory=no,resizable=yes,scrollbars=yes')><img border="0" src="<%=buttonimage%>"></a><br>
<%
end if
else
If buttonimage<>"" Then
%>
<p align="center"><a href="<%=strDescURL%>"><img border="0" src="<%=getconfig("xbuttonmoreinfo")%>"></a><br></p>
<%
Else
%>
<p align="left"><a href="<%=strDescURL%>"><%=LangProductExtendeddescription%></a></p>
<%
End if
end if
end sub
'
Sub FormatButton
'******************************************************
' If product has a button image
' it is formatted here
'******************************************************
dim mybutton
Dim mytext
dim rc
if getconfig("xproductcatalogonly")="Yes" then
exit sub
end if
PWriteNoStockMessage rc
if rc> 0 then exit sub
mytext=getconfig("XButtonText")
if mytext="" then
mytext="Order"
end if
mybutton=""
' If strButtonimage is not null use it
' If Sess("buttonimage") is not null use it otherwise you normall button
If productwithhtml<>"Yes" Then
Response.write ProdButtonColumn
end if
if strButtonImage<>"" Then
mybutton= strbuttonimage
else
if getconfig("xButtonImage") <>"" then
mybutton=getconfig("xbuttonimage")
end if
end if
If myButton="" then
response.write "<p align=center><input type=submit value=""" & mytext & """ name=Order></td>"
exit sub
end if
response.write "<input border=0 src=" & mybutton & " type=image></p>"
If productwithhtml<>"Yes" then
response.write "</td>"
end if
end sub
'
Sub FormatSpecialOffer
if strSpecialOffer<>"" then
Response.write "<font color=""" & Prodspeccolor & """><b><br>" & strSpecialOffer & "</b></font>"
end if
end sub
Sub ProductFormatHeader
'*************************************
' Headers for product are displayed here
'**************************************
Dim FieldCount
Dim I
SetupProductFields ProdFields, ProdHeaders
Fieldcount=ubound(ProdHeaders)
Response.write ProdTable
Response.write ProdHeaderRow
for i=0 to FieldCount
if langProductPrice=ProdHeaders(i) then
If getconfig("XDisplayprices")="Yes" Then
FormatProductHeaders ProdHeaders(i)
if getconfig("xDualPrice")="Yes" then
FormatProductHeaders LangDualPrice
end if
end if
else
FormatProductHeaders ProdHeaders(i)
end if
next
if getconfig("xproductcatalogonly")<>"Yes" then
IF productSelect="Yes" then
FormatProductHeaders LangProductSelect
else
If getconfig("xproductcatalogonly")<>"Yes" then
FormatProductHeaders LangProductOrder
end if
end if
end if
response.write "</tr>"
end sub
'
Sub FormatProductHeaders (Name)
%>
<%=ProdHeaderColumn%><%=Name%></font></b></td>
<%
end sub
Sub PWriteNoStockMessage (rc)
rc=0
if getconfig("xOutOfStockLimit")="" then exit sub
if isnull(lngcstock) then exit sub
if lngcstock>clng(getconfig("xOutOfStocklImit")) then exit sub
If productwithhtml="Yes" then
Response.write LangOutOfStock
else
Response.write OutofStockColumn & LangOutOfStock & OutofStockColumnEnd
end if
rc=4
end sub
Sub FormatCrossSelling
dim strCrossProductIDs,strsql, rs, strmessage, strcdescurl,strurl
If getconfig("XCrossSelling")<>"Yes" then exit sub
strcrossproductids=objrs("crossselling")
if isnull(strCrossProductids) then exit sub
strsql="select * from products where catalogid in (" & strcrossproductids & ")"
set rs=dbc.execute(strsql)
While Not rs.EOF
strCDescURL=rs("cdescurl")
If isnull(Strcdescurl) then
strCDescURL=getconfig("xCrossLinkURL")
end if
if ucase(strcDESCURL)="SHOPEXD.ASP" then
strurl="shopexd.asp?id=" & rs("catalogid")
Else
strurl="shopquery.asp?catalogid=" & rs("catalogid")
End if
strMessage=strMessage & "<br><a href='" & strURL & "'>" & Rs("cname") & "</a>"
RS.MoveNext
WEND
RS.Close
set RS=Nothing
strMessage="<BR>" & LangCrossSellingMessage & strMessage
Response.write strmessage
end sub
Sub FormatHyperlinks
dim strmessage, breaker, strurl
breaker="<br>"
If getconfig("xProductLinkTellaFriend")="Yes" then
strurl="shoptellafriend.asp?id=" & lngcatalogid
If getconfig("xbuttontellafriend")<>"" then
strmessage=breaker & "<a href='" & strurl & "'><img border='0' src='" & getconfig("xbuttontellafriend") & "'></a>"
else
strMessage=breaker & "<a href='" & strURL & "'>" & LangTellaFriend & "</a>"
end if
Response.write ReviewHyperlinkFont
breaker=" "
response.write strMessage
Response.write ReviewHyperlinkFontEnd
end if
If getconfig("xRatingproducthyperlink")="Yes" then
Response.write ReviewHyperlinkFont
strurl="shopreviewadd.asp?id=" & lngcatalogid
If getconfig("xbuttonwritereview")<>"" then
strmessage=breaker & "<a href='" & strurl & "'><img border='0' src='" & getconfig("xbuttonwritereview") & "'></a>"
else
strMessage=breaker & "<a href='" & strURL & "'>" & LangRatingWrite & "</a>"
end if
breaker=" "
response.write strMessage
strurl="shopreviewlist.asp?id=" & lngcatalogid
If getconfig("xbuttonreadreview")<>"" then
strmessage=breaker & "<a href='" & strurl & "'><img border='0' src='" & getconfig("xbuttonreadreview") & "'></a>"
else
strMessage=breaker & "<a href='" & strURL & "'>" & LangRatingRead & "</a>"
end if
breaker=" "
response.write strMessage
Response.write ReviewHyperlinkFontEnd
end if
end sub
'
Sub FormatOverallrating
dim oaverage,image, count
If getconfig("xAllowRatingProducts")<>"Yes" then exit sub
If getconfig("xAllowRatingSummary")<>"Yes" then exit sub
Reviewaverage lngcatalogid, oaverage,image, count, dbc
If image="" then
response.write "<p align=center>" & LangNoReviews & "</p>"
exit sub
end if
%>
<p align="center">
<font face='verdana,arial' size=1 color='#000000'><%=count%> <%=Langratingheader%><br>
<img border="0" src="<%=image%>" ></p>
<%
end sub
Sub ProductFormattrailer
end sub
%>
|
|
All Forums
Alternating Row Colors
New Topic
Printer Friendly
Topic 
TrustGuard - PCI Security Scanner
