<%
'***********************************************************************
' Formats shopping cart during buying process
' Version 5.00
' March 3, 2003
' add image formatting
'*********************************************************************
Dim CartRemove
Dim Carttotal
Dim Cartisubtotal
Dim cartshipcost
Dim cartDiscount
Dim cartdualcost
Dim DualTotal
Dim Dualshipcost
Dim Dualsubtotal
Dim dualdiscount
Dim DualHandling
Dim Minamount, maxamount
Dim columnspacing
dim xxdecimalpoint
dim cartallowdelete
Sub CartFormat (AllowDelete)
CartRemove=""
CartallowDelete=AllowDelete
xxdecimalpoint=getconfig("xdecimalpoint")
columnspacing=0
If allowdelete="TRUE" then
CartRemove=getlang("langProductRemove")
columnspacing=columnspacing+1
If getconfig("xdeliveryAddress")="Yes"then
columnspacing=columnspacing+1
end if
end if
If Cartremove<>"" then
CartSpecialHandling
end if
CartShipCost=GetSess("smprice")
DualShipcost=GetSess("DualShipCost")
CartDiscount=GetSess("Custdiscount")
CartFormatTitle
CartFormatProducts
CartFormatProductTotal
If Cartremove="" then
If getconfig("XdisplayPrices")<>"No" then
CartFormatShipping
CartFormatHandling
CartFormatTax
CartFormatDiscount
CartFormatCoupon
CartFormatGiftCertificate
CartFormatTotal
end if
end if
cartresponsewrite ""
CartShippingMessage
cartresponsewrite ""
end sub
'
'**********************************************************
' put titles above each column
'********************************************************
Sub CartFormatTitle
cartresponsewrite CartTable
cartresponsewrite CartRow
If cartremove<> "" then
DisplayTitle "10%",CartRemove
If getconfig("XDeliveryAddress")="Yes" then
DisplayTitle "10%",getlang("langDeliveryPrompt")
end if
end if
DisplayTitle "50%",getlang("langProductDescription")
DisplayTitle "10%",getlang("langProductQuantity")
If getconfig("XDisplayPrices")<>"No" then
DisplayTitle "10%",getlang("langProductUnitPrice")
DisplayTitle "10%",getlang("langProductTotal")
If getconfig("xDualPrice")="Yes" then
DisplayTitle "10%",getlang("langDualPrice")
DisplayTitle "10%",getlang("langDualTotal")
end if
end if
cartresponsewrite ""
End sub
Sub DisplayTitle (percent, titlename)
response.write CartTitleColumn & TitleName & CartTitleColumnEnd
end sub
'****************************************************************
' go through cart array and format values
'****************************************************************
'
Sub CartFormatProducts
Dim scartItem, arrCart, displayprice,catalogid
Dim i, CartFields, image
scartItem = GetSess("CartCount")
arrCart = GetSessA("CartArray")
if getconfig("xLCID")<>"" then
Session.LCID=getconfig("xLCID") ' set user supplied LCID
end if
cartisubtotal = 0
For i = 1 to scartItem
cartresponsewrite CartRow
If cartremove<> "" then
AddRemoveBox i
If getconfig("xdeliveryAddress")="Yes" then
AddEdit i, arrCart(cDelivery,i)
end if
end if
cartfields=arrCart(cProductname,i)
catalogid=arrCart(cProductid,i)
CartCreateHyperlink cartfields, catalogid
image=arrCart(cProductimage,i)
GetDeliveryName cartfields, arrCart(cDelivery,i)
if getconfig("xcartimage")="Yes" and image<>"" then
CartAddimage "50%","left", image, cartfields
else
AddField "50%","left", CartFontDesc & CartFields & CartFontEnd
end if
Minamount=arrCart(cMinimumQuantity,i)
Maxamount=arrCart(cMaximumQuantity,i)
If maxamount="" then maxamount=0
AddQuantity i, arrCart(cQuantity,i)
If getconfig("XDisplayPrices")<>"No" then
displayprice= CartFontUnitPrice & shopformatcurrency(arrCart(cUnitPrice,i),xxdecimalpoint) & CartFontEnd
If getconfig("xDisplayOriginalPrice")="Yes" then
If arrCart(cUnitPrice,i)<> arrCart(coriginalPrice,i) then
DisplayPrice =DisplayPrice & CartOriginalprice & shopformatcurrency(arrCart(coriginalPrice,i),xxdecimalpoint) & cartoriginalpriceend
end if
end if
AddField "10%","right", DisplayPrice
AddField "10%","right", CartFontPriceTotal & shopformatcurrency(arrCart(cUnitPrice,i) * arrCart(cQuantity,i),xxdecimalpoint) & CartFontEnd
if getconfig("xDualPrice")="Yes" then
AddField "10%","right", CartFontDualPrice & FormatNumber(arrCart(cDualPrice,i),2) & CartFontEnd
AddField "10%","right", cartFontDualTotal & FormatNumber(arrCart(cDualPrice,i) * arrCart(cQuantity,i),xxdecimalpoint) & cartfontEnd
dualsubtotal=dualsubtotal +(arrCart(cDualPrice,i) * arrCart(cQuantity,i))
end if
end if
cartisubtotal = cartisubtotal + (arrCart(cUnitPrice,i) * arrCart(cQuantity,i))
cartresponsewrite ""
next
SetSess "OrderTotal",cartisubtotal
SetSess "OrderProductTotal",cartisubtotal
SetSess "DualTotal",dualsubtotal
cartTotal=cartisubtotal
dualtotal=dualsubtotal
end sub
Sub AddField (percent, alignment, fieldvalue)
%>
<%=fieldvalue%>
<%
end sub
Sub AddQuantity (i, quantity)
if cartremove<>"" Then
If minamount<>"" then
If Minamount>0 then
if getconfig("xproductminimumquantity")<>"Yes" then
GenerateMinQuantityList i, quantity
exit sub
end if
end if
end if
If getconfig("xcartstaticquantity")="Yes" or maxamount=1 then
response.write "
"
end if
end sub
Sub addRemoveBox (i)
dim image
image=getconfig("xbuttonremove")
If image<>"" Then
%>
<%
exit sub
end if
if getconfig("xCartRemoveChecked")="Yes" then
%>
type=checkbox value="yes" checked>
<%
else
%>
type=checkbox value="yes">
<%
end if
end Sub
Sub addEdit (i, deliveryaddress)
dim prompt, promptimage
prompt=getlang("langDeliveryAdd")
promptimage=getconfig("xbuttonaddressadd")
if isarray(DeliveryAddress) then
prompt=getlang("langDeliveryChange")
promptimage=getconfig("xbuttonaddresschange")
end if
'
cartresponsewrite "
"
If promptimage="" then
%>
<%=prompt%>
<%
else
%>
<%
end if
cartresponsewrite "
"
end Sub
Sub AddColumnSpacing
dim i
If columnspacing=0 then exit sub
for i = 0 to columnspacing-1
cartresponsewrite "
"
next
end sub
Sub CartFormatProductTotal
If getconfig("XDisplayprices")="No" then exit sub
cartresponsewrite "
"
AddColumnSpacing
Cartresponsewrite CartSubTotalRowLeft & getlang("langProductCost") & CartTotalRowLeftEnd
CartResponsewrite CartSubTotalRowRight & shopformatcurrency(cartisubtotal,xxdecimalpoint) & CartTotalRowRightEnd
If getconfig("xDualPrice")="Yes" Then
CartResponsewrite "
"
Cartresponsewrite CartSubTotalRowRight & FormatNumber(dualsubtotal,2) & CartTotalRowRightEnd
end if
cartresponsewrite "
"
end sub
Sub CartFormatTax
Dim Taxes, dualtaxes
CalculateTax cartisubtotal, carttotal, cartshipcost, Taxes
SetSess "taxes",taxes
if Taxes<>"" then
If Taxes<>0 then
If getconfig("xDualPrice")="Yes" then
ConvertCurrency taxes, dualTaxes
Setsess "dualtaxes",dualtaxes
dualtotal=dualtotal+dualtaxes
end if
CartDisplayRow getlang("langProductTax"), taxes, dualtaxes
If getconfig("xtaxincludedinprice")="Yes" then
cartTotal=cartTotal
else
cartTotal=cartTotal+taxes
end if
end if
end if
end sub
'
Sub CartFormatHandling
Dim Handling
CalculateHandling cartisubtotal, carttotal, cartshipcost, Handling
SetSess "Handling",handling
if Handling<>"" then
If Handling<>0 then
If getconfig("xDualPrice")="Yes" then
ConvertCurrency handling, dualHandling
Setsess "dualhandling",dualhandling
dualtotal=dualtotal+dualhandling
end if
CartDisplayRow getlang("langProductHandling"), handling, dualhandling
cartTotal=cartTotal+handling
end if
end if
end sub
Sub CartFormatDiscount
' cart discount is coming from database
Dim Discount
discount=""
SetSess "discount",discount
SetSess "dualdiscount",discount
CalculateDiscount cartisubtotal, carttotal, cartshipcost, cartDiscount, discount
if discount<>"" then
If Discount<>0 then
If getconfig("xDualPrice")="Yes" then
ConvertCurrency Discount, dualdiscount
dualTotal=dualTotal-dualdiscount
SetSess "dualdiscount",dualdiscount
end if
CartDisplayRow getlang("langProductDiscount"), -Discount, -dualdiscount
cartTotal=cartTotal-discount
SetSess "discount",discount
end if
end if
end sub
'
Sub CartDisplayRow (msg, amount, dualamount)
cartresponsewrite "
"
AddColumnSpacing
CartResponsewrite CartSubTotalRowLeft & msg & carttotalrowleftend
Cartresponsewrite CartSubTotalRowRight & shopformatcurrency(amount,xxdecimalpoint)& carttotalrowRightend
If getconfig("xdualprice")="Yes" then
cartResponsewrite "
"
cartresponsewrite CartSubTotalRowRight & FormatNumber(dualamount,2) &cartTotalrowrightend
end if
cartresponsewrite "
"
end Sub
Sub CartFormatShipping
if cartshipcost<>"" then
If cartshipcost> 0 then
ConvertCurrency cartshipcost, dualshipcost
SetSess "Dualshipping",dualshipcost
CartDisplayRow getlang("langProductShippingCost"), cartshipcost, dualshipcost
cartTotal=cartTotal+cartshipcost
dualTotal=dualTotal+dualshipcost
end if
end if
end sub
Sub CartFormatTotal
%>
<%=CartTotalRowLeft%><%=getlang("langProductTotal")%>
<%=CartTotalRowRight%><%= shopformatcurrency(carttotal,xxdecimalpoint) %>
<%
If getconfig("xdualprice")="Yes" then
%>
<%=CartTotalRowRight%><%= FormatNumber(dualtotal,2) %>
<%
end if
cartresponsewrite "
"
SetSess "OrderTotal",carttotal
SetSess "DualTotal",dualtotal
end sub
'
Sub CartFormatCoupon
' cart discount is coming from database
Dim Discount, coupondiscountdual, coupon
Coupon=Getsess("Coupon")
if coupon="" then exit sub
ApplyCoupon
discount=GetSess("coupondiscount")
If discount="" then exit sub
if Discount <>"" then
If Discount<>0 then
If getconfig("xDualPrice")="Yes" then
ConvertCurrency Discount, coupondiscountdual
end if
CartDisplayRow getlang("langCouponDiscount"), -Discount, -coupondiscountdual
cartTotal=cartTotal-discount
SetSess "coupondiscountdual",coupondiscountdual
dualtotal=dualtotal-coupondiscountdual
end if
end if
end sub
'
Sub CartFormatGiftCertificate
' cart discount is coming from database
Dim Discount, discountdual
discount=""
discount=GetSess("giftamountmax")
if Discount <>"" then
If Discount<>0 then
If carttotal<= discount then
discount=carttotal
end if
setsess "Giftamountused",discount
If getconfig("xDualPrice")="Yes" then
ConvertCurrency Discount, discountdual
end if
CartDisplayRow getlang("langGiftCertificate"), -Discount, -discountdual
cartTotal=cartTotal-discount
SetSess "GiftAmountuseddual",discountdual
dualtotal=dualtotal-discountdual
If dualtotal<0 then dualtotal=0
end if
end if
end sub
Sub CartResponseWrite (msg)
if cartallowdelete="TRUE" then
response.write msg
exit sub
end if
if getconfig("Xbypasscreateorder")="Yes" then exit sub
response.write msg
end sub
Sub CartShippingMessage
if Getsess("shipmessage")="" then exit sub
Response.write "
"
end sub
'****************************************************************
' if an image is to be displayed we need to create a small table
' within the cell
'*****************************************************************
Sub CartAddimage (percent, alignment, image, cartfields)
%>
<%
end sub
'*********************************************************************
' add Hyperlink back to product
Sub CartCreateHyperlink (name, catalogid)
dim strmessage, strurl
If getconfig("xcarthyperlink")<>"Yes" then exit sub
strurl="shopquery.asp?catalogid=" & catalogid
strMessage="" & name & ""
name=strmessage
end sub
%>