<%
const xallowMultiplier="No"
'**********************************************
' 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 5.0 May 31, 2003 Demo Version
'********************************************
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 ' retrieve option values
GenerateFeatureList featureRs, myconn
closerecordset featureRS
If strFeatureRequired=TRUE 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
case "CHECKBOX"
GenerateButton
case "RADIO"
GenerateButton
Case "SELECTLIST"
GenerateSelectList
Case "USERTEXT"
GenerateUserText
Case "USERPRICE"
GenerateUSERText ' generates same as user text
Case "MULTIPLIER"
GenerateUserText ' generates same as user text
Case "QUANTITY"
GenerateFeatureQuantity
Case else
GenerateDropDownList
end select
end sub
'
'***************************************************************************
' Need to generate a dropdown list for values in the recordset
'***************************************************************************
Sub GenerateDropDownList
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
' 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 "
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
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 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
dim checkname, valuename, images
images=""
valuename=fprefix & Prodindex & "FeatureValue" & fcount
checkname=fprefix & Prodindex & "Feature" & fcount
Response.Write FeatureUserText & strFeatureCaption & FeatureUserTextEnd & " "
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
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
selectlistvalue="Multi select lists not supported in this version"
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
' 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
else
LoopEnd="True"
end if
loop
sSelect= ""
response.write sSelect
writefeatureimages images
Response.write ""
Response.Write ""
end sub
'******************************
Sub GetOptionValues (objRS)
' 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"))
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
%>