<%
'**********************************************
' Features are an array of numbers in the products table
' 7,9,3
' For each of those numbers, generate aselect list, radio button etc
' If so process them one at a time
' Features are generated with name
' checkname=fprefix & Prodindex & "Feature" & fcount
' x5Feature1 where x is arbitrary
' 5 is the product being select
' fcount =
' VP-ASP 6.50 June 29, 2005 allow multiplier
' Sept 7, 2004 handle multi language feature multi
' Sept 11, add Qtyproduct and Textarea cloning of products
' APril 27, 2005 add translate
'********************************************
dim featureid, featurevalue, sOptionNumber
dim sxQuantityOption, sxQuantityvalue
dim featurevalueids(100),featurevaluescount
dim featureerror
dim FeatureArray(9,100)
Dim Featurecount
const cMaxFeatureAttributes=9
const cFeaturecaption =1
Const cFeaturePrice = 2
Const cFeatureId = 3
Const cFeatureValue = 4
Const cFeatureOther = 5
Const cFeatureNum = 6
Const cFeatureWeight = 7
Const cFeaturePercent= 8
'
Sub FormatProductOptions
Dim i
dim Feature_Array
dim featurecount
if strFeatures="" then ' this product has no features
exit sub
end if
fcount=0
Requiredlist="" ' assume none are required
Feature_array = Split(strFeatures, ",") ' get feature numbers
featurecount=ubound(feature_array)
if featurecount> getconfig("xMaxFeatures") then
featurecount=getconfig("xMaxFeatures")-1
end if
for i = 0 to Featurecount
fcount=fcount+1
ProcessFeatureforProduct Feature_Array(i), dbc
next
if GetSess("MaxFeatures")= "" then
SetSess "MaxFeatures",fcount
else
if fcount > Getsess("MaxFeatures") then
SetSess "MaxFeatures",fcount
end if
end if
If Requiredlist<>"" and getconfig("xFeaturesRequired")<>"Yes" then
Response.Write ""
end if
end sub
'
'****************************************************************************
' We now know which feature num and nee to generate athe specific
' feature type
'**************************************************************************
Sub ProcessFeatureforProduct (featurenum, myconn)
' creater dropdow, checkbox, radio for one set of features
ReadFeaturesFromDatabase FeatureRs, myconn, featurenum
if FeatureRS.eof Then ' features have gone missing
closerecordset featureRS
exit sub
end if
GetOptionValues FeatureRS,myconn ' retrieve option values
GenerateFeatureList featureRs, myconn
closerecordset featureRS
'VP-ASP 6.09 - required wasn't working correctly for MYSQL
If ucase(strFeatureRequired)=ucase(TRUE) OR strFeatureRequired = 1 then
If Requiredlist="" then
requiredlist=lngfeaturenum
else
requiredlist=requiredlist & "," & lngfeaturenum
end if
end if
end sub
'
'*****************************************************************************
' Now have a recordset of all the values.
'*****************************************************************************
Sub GenerateFeatureList (featurers, myconn)
' Input is FeatureRS ( 1 set of options with same featurenum)
dim featuretype
fprefix=""
If prodindex<>"" Then
fprefix="x"
end if
featuretype=ucase(StrFeatureType)
if featuretype="" then
If strFeatureOther<>"" then
featuretype="SELECTLIST" ' compatibility
else
featuretype="DROPDOWN"
end if
end if
FeatureMultiSelection=ucase(strFeatureMulti)
Select case featureType
Case "DROPDOWN"
GenerateDropDownList myconn
case "CHECKBOX"
GenerateButton myconn
case "RADIO"
GenerateButton myconn
Case "SELECTLIST"
GenerateSelectList myconn
Case "USERTEXT"
GenerateUserText myconn, "text"
Case "USERPRICE"
GenerateUSERText myconn, "price" ' generates same as user text
Case "MULTIPLIER"
GenerateFeatureQuantity myconn ' generates same as user text
Case "QUANTITY","QTYPRODUCT"
GenerateFeatureQuantity myconn
Case "TEXTAREA"
GenerateTextArea myconn
Case else
GenerateDropDownList myconn
end select
end sub
'
'***************************************************************************
' Need to generate a dropdown list for values in the recordset
'***************************************************************************
Sub GenerateDropDownList (myconn)
Dim LoopEnd, featurevalue
Dim Multiple
Dim Multiname
dim selectname
dim checkname
dim msize, images
dim setselected
checkname=fprefix & Prodindex & "Feature" & fcount
Selectname=fprefix & Prodindex & "Feature" & fcount
If FeatureMultiSelection="YES" then
Multiple=" Multiple"
msize=3
Selectname=fprefix & Prodindex & "FeatureValue" & fcount
else
Multiple=""
msize=1
end if
loopend="False"
sSelect=""
setselected=""
' read features record and add to select statements
PrevOptionNum=lngFeatureNum ' set prev=current
sSelect = ProdFeatureCaption & strFeatureCaption & ProdFeatureCaptionEnd
sSelect = sSelect & ""
Response.write sSelect
If images<>"" then
WriteFeatureimages images
end if
If FeatureMultiSelection="YES" then
response.write ""
end if
end sub
'*************************************************************************
' Generate radio or checkbox buttons
'*************************************************************************
Sub GenerateButton (myconn)
' generates either radio or checkbox
Dim LoopEnd, FeatureValue, images
Dim Multiname, valuename
loopend="False"
sSelect=""
dim checkname, setselected
setselected=""
images=""
' read features record and add to select statements
response.write ProdFeatureCaption & strFeatureCaption & ProdFeatureCaptionEnd
tempOption=""
valuename=fprefix & Prodindex & "Featurevalue" & fcount
checkname=fprefix & Prodindex & "Feature" & fcount
Do While LoopEnd="False"
GenerateFeaturename tempoption
Featurevalue=lngFeatureid
If strfeaturedefault<>0 then
setselected=" checked=""checked"" "
else
setselected=""
end if
If FeatureMultiSelection="YES" then
sselect="" & tempoption & " "
else
sselect="" & tempoption & " "
end if
addfeatureimage images
response.write sselect & " "
sselect=""
FeatureRs.movenext
if Not FeatureRS.EOF then
GetOptionValues FeatureRS, myconn
else
LoopEnd="True"
end if
loop
sSelect= ""
response.write sSelect
If images<>"" then
WriteFeatureimages images
end if
If FeatureMultiSelection="YES" then
response.write ""
end if
end sub
'
'*******************************************************************************
' Name includes xxxx[dd.dd]
'*******************************************************************************
Sub GenerateFeaturename (tempoption)
dim percent, sign
sign=" + "
TempOption= strFeatureName
if getconfig("xpriceloggedinonly") = "Yes" then
if Getsess ("login") = "" then
exit sub
end if
end if
'VP-ASP 6.50 - price was displaying when it shouldn't
if getconfig("xdisplayprices") <> "Yes" then
exit sub
end if
if curFeaturePrice<>"" then
if curFeaturePrice<>0 then
If curfeatureprice<0 then
sign=" - "
end if
if lcase(getconfig("xenvironment"))<>"chillisoft" then
TempOption= TempOption & sign & shopformatcurrency(curFeaturePrice,getconfig("xdecimalpoint"))
else
TempOption= TempOption & sign & shopformatnumber(curFeaturePrice,getconfig("xdecimalpoint"))
end if
end if
If strfeaturepercent<>"" then
If strfeaturepercent<>0 then
percent=strfeaturepercent
If strfeaturepercent<1 then
percent=strfeaturepercent*100
percent=formatnumber(percent,2)
end if
percent= " + " & percent & "%"
TempOption= TempOption & Percent
end if
end if
end if
end sub
'
'********************************************************************
' User text has two fields. The normal feature
' featurevalue has the actual text entered by the person
'********************************************************************
Sub GenerateUserText (myconn, pricetext)
dim checkname, valuename, images
images=""
valuename=fprefix & Prodindex & "FeatureValue" & fcount
checkname=fprefix & Prodindex & "Feature" & fcount
Response.Write FeatureUserText & strFeatureCaption & FeatureUserTextEnd & " "
'VPASP 6.00 - write the symbol that the gift cert value needs to be entered in
if getsess("Conversionvalue") <> 1 AND lcase(pricetext)="price" then
'dim theSymbol
'getoriginalcurrencysymbol theSymbol
'if theSymbol > "" then
' response.write theSymbol
'end if
if GetSess("Newcurrencysymbol")<>"" then
response.write GetSess("Newcurrencysymbol")
elseif getconfig("XCurrencySymbol") <> "" then
response.write getconfig("XCurrencySymbol")
else
response.write "$"
end if
end if
response.write ""
addfeatureimage images
If images<>"" Then
writefeatureimages images
end if
Response.Write " "
end sub
'
'***************************************************************************
' Select list has values that come from the product intself
' first from the selectlist field and then from additional fields
'*************************************************************************
Sub GenerateSelectList (myconn)
Dim PArray,PArrayCount, selectlistvalue,images
dim checkname, valuename
images=""
' A select list is actually data in the products table selectlist field
If not isnull(strfeatureOther) Then
GetSelectListValue strfeatureother, selectlistvalue
if selectlistvalue="" then
exit sub
else
strselectlist=selectlistvalue
end if
end if
If isNull(strSelectList) then exit sub
dim i
valuename=fprefix & Prodindex & "FeatureValue" & fcount
checkname=fprefix & Prodindex & "Feature" & fcount
sSelect = ProdFeatureCaption & strFeatureCaption & ProdFeatureCaptionEnd
sSelect = sSelect & ""
addfeatureimage images
If images<>"" Then
writefeatureimages images
end if
Response.write sSelect
Response.Write ""
end Sub
'
'*******************************************************************
' SQL to read features with same feature number from prodfeatures table
'********************************************************************
Sub ReadFeaturesFromDatabase (FeatureRs, dbc, featurenum)
Dim sqlfeatures,delimiter
dim i
delimiter=","
sqlfeatures = "Select * from prodfeatures Where featurenum=" & featurenum
HandleCustomerfeatures sqlfeatures
sqlfeatures = sqlfeatures & " order by featurenum "
If Getconfig("xFeatureSort")<>"" then
sqlFeatures=SqlFeatures & "," & getconfig("xFeatureSort")
end if
set FeatureRS=dbc.execute(SqlFeatures)
end sub
'**********************************************************************
' undocumented feature
' to generate quantities
'************************************************************************
Sub GenerateFeatureQuantity (myconn)
' generates either radio or checkbox
Dim LoopEnd, FeatureValue, valuename, images
Dim Multiname
loopend="False"
sSelect=""
images=""
valuename=fprefix & Prodindex & "FeatureValue" & fcount
checkname=fprefix & Prodindex & "Feature" & fcount
dim checkname, value, quantityname
dim featurevalues
' read features record and add to select statements
response.write ProdFeatureCaption & strFeatureCaption & ProdFeatureCaptionEnd
tempOption=""
featurevalues=""
Do While LoopEnd="False"
sselect=""
quantityname=fprefix & Prodindex & "FeatureQuantity" & fcount & "_" & lngfeatureid
if featurevalues<>"" then
featurevalues=featurevalues & ","
end if
featurevalues=featurevalues & lngfeatureid
Generatefeaturename tempoption
Featurevalue=lngFeatureid
sselect=sselect & ""
sselect= sselect & " " & tempoption & " "
addfeatureimage sselect
response.write sselect & " "
FeatureRs.movenext
if Not FeatureRS.EOF then
GetOptionValues FeatureRS, myconn
else
LoopEnd="True"
end if
loop
sSelect= ""
response.write sSelect
writefeatureimages images
Response.write ""
Response.Write ""
end sub
'******************************
Sub GetOptionValues (objRS, myconn)
' Obtain field values for 1 feature record
strFeaturetype=""
strFeatureMulti=""
on error resume next
lngfeatureid=objrs("id")
lngfeaturenum = objrs("featurenum")
strfeaturecaption = objrs("featurecaption")
strfeaturename = objrs("featurename")
curfeatureprice = objrs("featureprice")
strfeatureother = objrs("featureother")
strfeaturetype=getrsitem(objrs("featuretype"))
strfeaturemulti=getrsitem(objrs("featuremulti"))
strfeaturerequired=getrsitem(objrs("featurerequired"))
strfeatureother1=Getrsitem(objrs("featureother1"))
strfeaturepercent=Getrsitem(objrs("featurepercent"))
strfeaturedefault=Getrsitem(objrs("featuredefault"))
If strfeaturedefault="" then strfeaturedefault=0
If getconfig("xdisplayprices")="No" then
curFeaturePrice=""
end if
strfeatureweight=GetRsitem(objrs("featureweight"))
strfeatureimage=Getrsitem(objrs("featureimage"))
if strfeaturemulti<>"" then strfeaturemulti="Yes" ' sept 6 fix for language
' add translate
strfeaturecaption=translatelanguage(myconn, "prodfeatures", "featurecaption","id", lngfeatureid, strfeaturecaption)
strfeaturename=translatelanguage(myconn, "prodfeatures", "featurename","id", lngfeatureid, strfeaturename)
end sub
Sub AddUserText
if memUserText="" then exit sub
NameIncart=NameinCart & " " & CartFeatureCaption & strAllowUserText & CartFeatureCaptionEnd & " " & memuserText
end sub
Sub FormatUserText
if isnull(strAllowusertext) then exit sub
If strallowUsertext="" then exit sub
Response.Write FeatureUserText & strAllowUserText & FeatureUserTextEnd & " "
Response.Write " "
end sub
Sub HandleCompatbilityUserText (caption,Value)
Featurearray(cfeaturecaption,featurecount)=caption
Featurearray(cfeatureprice,featurecount)=0
Featurearray(cfeatureid,featurecount)=0
Featurearray(cfeaturevalue,featurecount)=Value
Featurearray(cfeatureother,featurecount)=""
Featurearray(cfeaturenum,featurecount)=0
featurecount=featurecount+1
end sub
Sub HandleCustomerFeatures (sql)
dim customertype
if getconfig("xcustomerFeatures")<>"Yes" then exit sub
customertype=getsess("customertype")
if customertype="" then exit sub
sql=sql & " and (featureother1 like '%" & customertype & "%'"
sql =sql & " or featureother1 is null)"
end sub
Sub AddFeatureimage (istr)
dim image
if strfeatureimage="" then exit sub
image=""
'istr=istr & " " & Featurefont & strfeaturename & featurefontend
istr=istr & image
end sub
Sub Writefeatureimages (images)
response.write images & " "
end sub
'********************************************************
' Get select list from products table
'*********************************************************
Sub GetSelectListValue(fieldname,fieldvalue)
dim selectrs, selectsql
Selectsql="select * from products where catalogid=" & lngcatalogid
set selectrs=dbc.execute(selectsql)
if not selectrs.eof then
Fieldvalue=selectrs(fieldname)
if isnull(fieldvalue) then
fieldvalue=""
end if
end if
selectrs.close
set selectrs=nothing
end sub
'********************************************************************
' User text has two fields. The normal feature
' featurevalue has the actual text entered by the person
'********************************************************************
Sub GenerateTextArea (myconn)
dim checkname, valuename, images
dim rows, cols
rows=5
cols=30
images=""
valuename=fprefix & Prodindex & "FeatureValue" & fcount
checkname=fprefix & Prodindex & "Feature" & fcount
Response.Write FeatureUserText & strFeatureCaption & FeatureUserTextEnd
Response.write " "
response.write ""
addfeatureimage images
If images<>"" Then
writefeatureimages images
end if
Response.Write " "
end sub
%>