option explicit
sub CallPickList()
dim strConnString
dim strData
dim strFeatures
dim strSearchString
dim strSQL
dim strTitle
dim strURL
strConnString = "Provider=Microsoft.Jet.OLEDB.3.51;"
strConnString = strConnString & "Persist Security Info=False;"
strConnString = strConnString & "Data Source=C:\InetPub\Northwind.mdb"
strSQL = "SELECT SupplierID, CompanyName, ContactName,"
strSQL = strSQl & " Phone FROM Suppliers"
strSearchString = txtRetVal.value
'--- Check to see if there is a value from the textbox. If there is, use it in
'--- the "LIKE" clause. This turns the pick list control into a search mode.
if len(strSearchString) > 0 then
strSQL = strSQL & " WHERE ContactName LIKE '" & strSearchString & "%'"
end if
'--- Clean up the SQL statement to be passed to the pick list control.
strSQL = EncodeURL(strSQL)
'--- Pass in the Connect String and SQL for RDS.
'--- Also pass in the name of the fields, the captions to use for them,
'--- The number of fields, the number of hidden fields, and their names, as
'--- well.
strURL = "RDSPickList.asp?Connect=" & strConnString
strURL = strURL & "&FieldNames=SupplierID|ContactName|CompanyName|Phone"
strURL = strURL & "&FieldCaptions=SupplierID|Contact|Company|Phone"
strURL = strURL & "&HiddenFields=SupplierID&HiddenFieldCount=1"
strURL = strURL & "&FieldCount=4&Title=Contact Lookup" & "&SQL=" & strSQL
'--- Set up the parameters that control what the pick list
'--- control will look like when it opens.
strFeatures = "dialogWidth:350px;dialogHeight:395px;dialogTop:100px;"
strFeatures = strFeatures & "help:no;center:yes;border:thin;status:no;"
strFeatures = strFeatures & "scrollbars=no;toolbar=no;menubar=no;"
strData = window.showModalDialog(strURL, , CStr(strFeatures))
'--- The pick list return to this point. If it has a value, parse it and
'--- put it into the text box.
if Len(Trim(strData)) > 0 then
FillData strData
end if
end sub
Figure 5 Retrieving the Column Values
Function RetrieveValue(strNames, intFieldNumber)
Dim intCurrentField, intFoundPos, strValue
'******************************************************************
' When the value is returned from RDSPickList.asp, it contains a
' string value separated by the "|" character.
' This routine returns the column value using a passed colnum.
' A Column equal to 1 would return the value in the first position
' of the string, colnum equal 2 the second value and so on.
'******************************************************************
intCurrentField = 0
Do While intCurrentField <> intFieldNumber
intFoundPos = InStr(strNames, "|")
intCurrentField = intCurrentField + 1
if intFoundPos <> 0 then
strValue = Left(strNames, intFoundPos - 1)
strNames = Mid(strNames, intFoundPos + 1, Len(strNames))
else
if intCurrentField = intFieldNumber then
strValue = strNames
else
strValue = ""
end if
exit do
end if
loop
RetrieveValue = strValue
End Function
Figure 6 Binding Values to Cells
<table id="tblList" name = "tblList"
datasrc="#mobjADC" datapagesize="10" border="0" cellpadding="0"
cellspacing="1" width="100%">
<thead bgcolor=gray>
<%for intField = 1 to CLng(Request("FieldCount"))
strFieldName = RetrieveValue(CStr(Request("FieldNames")), intField)
strIDName = "divCol" & strFieldName
strFieldCaption = RetrieveValue(CStr(Request("FieldCaptions")), intField)
Response.Write "<td NOWRAP align=left>" & vbCr
Response.Write "<font class=DataLabelFont><u><div id=" & strIDName
Response.Write " onclick=SortData('" & strFieldName & "')"
Response.Write " title='Sort by " & strFieldCaption & "'"
Response.Write " onmouseover=me.className='Point' _
onmouseout=me.className='DontPoint'>"
Response.Write strFieldCaption & "</div></u></font>" & vbCr
Response.Write "</td>"
next
%>
</thead>
<tbody bgcolor="#ffffff">
<%
for intField = 1 to Request("FieldCount")
Response.Write "<td NOWRAP align=left>" & vbCr
Response.Write "font class=DataFont>
<div "strFieldName = RetrieveValue(CStr(Request("FieldNames")), intField)
Response.Write "id=divDataCol" & strFieldName
Response.Write " datafld=" & strFieldName
Response.Write "></div></font>" & vbCr
Response.Write "</td>"
next
%>
</tbody>
Figure 7 Displaying Navigation Buttons
sub SetPageDisplay()
'--- Display the current page and page count.
divPaging.innerHTML = "<font class=DataLabelFont>Page " & _
"</font><font class=DataFont>" & mintPageNumber & " </font>" & _
"<font class=DataFontLabel>of</font>" & _
"<font class=DataFont> " & PageCount & "</font>"
end sub
function PageCount()
'--- The number of pages in the recordset
'--- based on the dataPageSize.
PageCount = mobjADC.Recordset.PageCount
end function
Sub SetNavigationDisplay()
'--- Show the appropriate navigational buttons.
'--- Set display for Previous Button
If mintPageNumber = 1 Then
frmList.btnPreviousPage.style.display = "none"
Else
frmList.btnPreviousPage.style.display = ""
End If
'--- Set display for Next Button
If mintPageNumber = PageCount Then
frmList.btnNextPage.style.display = "none"
Else
frmList.btnNextPage.style.display = ""
End If
End Sub
Figure 8 Calling Navigation Features
'--- Initialize the page number.
mintPageNumber = 1
'--- Display the current page and page count.
SetPageDisplay
'--- Display the number of records found.
divRecordCount.innerHTML = "<font class=DataLabelFont>Records Found: </font>
<font class=DataFont>" & mobjADC.Recordset.Recordcount & "</font>"
'--- Show the appropriate navigational buttons.
SetNavigationDisplay
'--- Hide appropriate fields.
<%
for intField = 1 to CLng(Request("HiddenFieldCount"))
strFieldName = RetrieveValue(CStr(Request("HiddenFields")), intField)
response.write "divCol" & strFieldName & ".style.display = ""none""" & vbCr
response.write "divDataCol" & strFieldName & ".style.display = ""none""" & vbCr
next
%>
Figure 9 Navigating the Table
sub btnNextPage_onclick()
'--- Go to the next page of data in the pick list.
PageControl
end sub
sub btnNextPage_onmouseover()
'--- Make the cursor a pointing hand.
frmList.btnNextPage.className="Point"
end sub
sub btnNextPage_onmouseout()
'--- Make the cursor normal.
frmList.btnNextPage.className="DontPoint"
end sub
sub btnPreviousPage_onclick()
'--- Go to the previous page of data in the pick list.
PageControl
end sub
sub btnPreviousPage_onmouseover()
'--- Make the cursor a pointing hand.
frmList.btnPreviousPage.className="Point"
end sub
sub btnPreviousPage_onmouseout()
'--- Make the cursor normal.
frmList.btnPreviousPage.className="DontPoint"
end sub
sub PageControl()
'--- Go forward or backwards 1 page.
'--- and determine which page we are on.
Dim objElement
Set objElement = window.event.srcElement
If objElement.id = "btnPreviousPage" Then
tblList.PreviousPage
mintPageNumber = mintPageNumber - 1
Else
tblList.NextPage
mintPageNumber = mintPageNumber + 1
End If
SetNavigationDisplay
SetPageDisplay
end sub
Figure 10 Returning the Selected Data
sub tblList_onclick()
'--- When the user clicks on a table row,
'--- we gather the row's data and we return it to
'--- the calling page, delimited by the "|" character.
dim strRow '--- The row of data that we return.
dim lngCell '--- The current cell, as we traverse them.
dim lngRec '--- The row we are on.
lngCell = 0
lngRec = CurrentRecord(window.event.srcElement.recordNumber)
if lngRec > 0 then
for lngCell = 0 to tblList.rows(lngRec).cells.length - 1
strRow = strRow & tblList.rows(lngRec).cells(lngCell).innerText & "|"
next
window.returnValue = strRow
window.close
end if
end sub
sub btnCancel_onclick()
window.close
end sub
function CurrentRecord(lngRec)
'--- This returns the current record number.
dim lngPageSize
if lngRec <> 0 then
lngPageSize = tblList.dataPageSize
lngRec = lngRec - (lngPageSize * (mintPageNumber - 1))
end if
CurrentRecord = lngRec
end function