You can use the Associative Search Engine in Verifier to enable the user to select the correct result from candidates. Complete the following steps.
- Switch to Verifier Design Mode.
- Create a default form for the class, if not yet available.
- If required, increase the field size.
- Add a button.
- Define an action.
-
On the toolbar, click the
Show/hide script
button.
- In the Script View window, click .
- In the References dialog box, ensure that the Cedar Associative Search Engine Library is selected and then click OK.
- Modify the Document_OnAction event in the script according to your needs.
Sample Script
Option Explicit
' Cedar Document Class Script for Class "LeaseModification"
Const LOGPIXELSY = 90
Const PointSize = 10
Const FontType As String = "Courier New"
Const WM_SETFONT = &H30
Declare Function CreateFontA Lib "gdi32" ( _
ByVal nHeight As Long, _
ByVal nWidth As Long, _
ByVal nEscapement As Long, _
ByVal nOrientation As Long, _
ByVal fnWeight As Long, _
ByVal fdwItalic As Long, _
ByVal fdwUnderline As Long, _
ByVal fdwStrikeOut As Long, _
ByVal fdwCharSet As Long, _
ByVal fdwOutputPrecision As Long, _
ByVal fdwClipPrecision As Long, _
ByVal fdwQuality As Long, _
ByVal fdwPitchAndFamily As Long, _
ByVal lpszFace As String _
) As Long
Declare Function DeleteObject Lib "gdi32" ( _
ByVal hObject As Long _
) As Long
Declare Function GetDeviceCaps Lib "gdi32" ( _
ByVal hDC As Long, _
ByVal nIndex As Long _
) As Long
Declare Function GetDlgItem Lib "user32" ( _
ByVal hDlg As Long, _
ByVal nIDDlgItem As Long _
) As Long
Declare Function GetWindowDC Lib "user32" ( _
ByVal hWnd As Long _
) As Long
Declare Function ReleaseDC Lib "user32" ( _
ByVal hWnd As Long, _
ByVal hDC As Long _
) As Long
Declare Function SendMessageA Lib "user32" ( _
ByVal hWnd As Long, _
ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long _
) As Long
Dim hFont As Long
' Title of candidates dialog
Const CANDIDATEBOXTITLE As String = "Search Partner Candidates"
' Title of Details dialog
Const DETAILSBOXTITLE As String = "Selected Partner Details"
' Name of Field of Document Class
Const FIELDNAME As String = "Partner"
' name of vendor pool column for the supplier name
Const COLUMNNAME As String = "PartnerName"
' name of vendor pool column for the supplierID
Const COLUMNID As String = "ID"
Public strModuleName As String
Public myWorkdoc As SCBCdrPROJLib.SCBCdrWorkdoc
Public mySupplierName As String
Public ListArray() As String
Public strSearchText As String
Public strSearchField As String
Public bSearchText As Boolean
Public bSearchCandidats As Boolean
Private Sub Document_OnAction(pWorkdoc As SCBCdrPROJLib.SCBCdrWorkdoc, ByVal ActionName As String)
Dim hDC As Long
hDC = GetWindowDC(0)
Dim Height As Long
Height = -(PointSize*GetDeviceCaps(hDC,LOGPIXELSY)/72)
ReleaseDC 0,hDC
hFont = CreateFontA(Height,0,0,0,0,0,0,0,0,0,0,0,0,FontType)
Select Case ActionName
Case "SearchPartner"
Call fnPartnerSearchDlg(pWorkdoc,pWorkdoc.Fields(FIELDNAME))
End Select
DeleteObject hFont
End Sub
Private Sub fnPartnerSearchDlg(pWorkdoc As SCBCdrPROJLib.SCBCdrWorkdoc, _
ByVal pField As SCBCdrPROJLib.SCBCdrField)
Dim theDocClass As SCBCdrDocClass
Dim theAnalysisSettings As ISCBCdrAnalysisSettings
Dim theSupplierSettings As Object
Dim lIndex As Long
Dim lCurrentLineIndex As Long
Dim lStart As Long
Dim lEnd As Long
Dim helper As Long
Dim strFormattedFieldText As String
Dim strNextLine As String
Dim lColumnCount As Long
Dim strColumnName As String
Dim strCandWeight As String
Dim lUniqueId As Long
Set theDocClass=Project.AllClasses.ItemByName(pWorkdoc.DocClassName)
theDocClass.GetFieldAnalysisSettings FIELDNAME,"German",theAnalysisSettings
Set theSupplierSettings = theAnalysisSettings
Set myWorkdoc=pWorkdoc
ReadFieldCandidates
lColumnCount=theSupplierSettings.ColumnCount
ReDim Combos$(lColumnCount)
For lIndex=0 To lColumnCount-1
strColumnName=theSupplierSettings.ColumnName(lIndex)
Combos$(lIndex) =strColumnName
Next lIndex
Begin Dialog UserDialog 580,300,CANDIDATEBOXTITLE,.dlgControl
'Comment %GRID:10,7,1,1
ListBox 10,60,560,200,ListArray(),.ListBox1
Text 10,10,180,20,"Search text"
TextBox 10,30,420,20,.Text$
OKButton 360,270,100,21
PushButton 470,30,100,21,"Search"
PushButton 135,270,115,21,"Item Details ..."
PushButton 10,270,115,21,"Show Best ..."
CancelButton 470,270,100,21
End Dialog
Dim dlg As UserDialog
bSearchCandidats=True
helper = 9
mySupplierName=Mid(ListArray(0),helper,InStr(ListArray(0)," (#") - helper)
If Dialog(dlg) = -1 Then
If (dlg.ListBox1 >= 0) Then
lUniqueId = CLng(Mid(ListArray(dlg.ListBox1),InStr(ListArray(dlg.ListBox1)," (#")+3, _
InStrRev(ListArray(dlg.ListBox1),")") -(InStr(ListArray(dlg.ListBox1), " (#")+3)))
theSupplierSettings.GetFormattedValueByID(0, lUniqueId, strFormattedFieldText)
For lIndex=0 To pField.LineCount-1
pField.DeleteLine(0)
Next lIndex
lCurrentLineIndex = 0
lStart=1
pField.PutUniqueEntryId(0, lUniqueId)
For lIndex=1 To Len(strFormattedFieldText)
If Mid(strFormattedFieldText,lIndex,2)=vbCrLf Or _
lIndex=Len(strFormattedFieldText) Then
lEnd=lIndex-lStart
If lIndex=Len(strFormattedFieldText) Then lEnd = lEnd + 1
strNextLine=Mid(strFormattedFieldText,lStart,lEnd)
lStart=lIndex+2
If pField.LineCount < lCurrentLineIndex + 1 Then
pField.InsertLine(lCurrentLineIndex)
End If
pField.Line(lCurrentLineIndex) = strNextLine
lCurrentLineIndex = lCurrentLineIndex + 1
End If
Next lIndex
End If
Call ReadFieldCandidates
End If
End Sub
Private Function dlgControl(DlgItem$, Action%, SuppValue&) As Boolean
' Sax Basic function used to code all events
Dim helper As Long
Select Case Action%
Case 1 ' Dialog box initialization
Dim hWnd As Long
hWnd = GetDlgItem(SuppValue,DlgControlId("ListBox1"))
SendMessageA hWnd,WM_SETFONT,hFont,1
Case 2 ' Value changing or button pressed
If DlgItem$ = "Search" Then
Call SearchPartner(myWorkdoc,strSearchText,strSearchField)
DlgListBoxArray "ListBox1", ListArray()
dlgControl = True 'do not exit the dialog
End If
If DlgItem$ = "ShowBest" Then
Call ReadFieldCandidates
DlgListBoxArray "ListBox1", ListArray()
dlgControl = True 'do not exit the dialog
End If
If DlgItem$ = "ItemDetails" Then
Call PartnerDetails (myWorkdoc,mySupplierName)
dlgControl = True 'do not exit the dialog
End If
' On list box item click
If DlgItem$ = "ListBox1" Then
helper = 9
mySupplierName = Mid(ListArray(SuppValue),helper, _
InStr(ListArray(SuppValue), " (#") - helper)
End If
Case 3 ' TextBox or ComboBox text changed
If DlgItem$ = "Text" Then
strSearchText = DlgText$(DlgItem$)
End If
If DlgItem$ = "combo" Then
strSearchField= DlgText$(DlgItem$)
End If
Case 4 ' Focus changed
Case 5 ' Idle
Rem dlgFunction = True ' Continue getting idle actions
Case 6 ' Function key
If (SuppValue = 1) Then
Call SearchPartner(myWorkdoc,strSearchText,strSearchField)
DlgListBoxArray "ListBox1", ListArray()
End If
End Select
End Function
Private Function dlgControl2(DlgItem$, Action%, SuppValue&) As Boolean
' Sax Basic function used to code all events
Dim helper As Long
Select Case Action%
Case 1 ' Dialog box initialization
Dim hWnd As Long
hWnd = GetDlgItem(SuppValue,DlgControlId("Text1"))
SendMessageA hWnd,WM_SETFONT,hFont,1
hWnd = GetDlgItem(SuppValue,DlgControlId("ListBox2"))
SendMessageA hWnd,WM_SETFONT,hFont,1
hWnd = GetDlgItem(SuppValue,DlgControlId("ListBox3"))
SendMessageA hWnd,WM_SETFONT,hFont,1
Case 2 ' Value changing or button pressed
Case 3 ' TextBox or ComboBox text changed
Case 4 ' Focus changed
Case 5 ' Idle
Rem dlgFunction = True ' Continue getting idle actions
Case 6 ' Function key
End Select
End Function
Private Sub PartnerDetails(pWorkdoc As SCBCdrPROJLib.SCBCdrWorkdoc,SupplierName As String)
' Shows the details for a selected candidate
Dim theDocClass As SCBCdrDocClass
Dim theAnalysisSettings As ISCBCdrAnalysisSettings
Dim theSupplierSettings As Object
Dim lIndex As Long
Dim lEntryCount As Long
Dim lEntryIndex As Long
Dim lIDHigh As Long
Dim lIDLow As Long
Dim lColumnCount As Long
Dim strSupplierName As String
Dim strColumnName As String
Dim myListArray() As String
Dim myListArray2() As String
Set theDocClass=Project.AllClasses.ItemByName(pWorkdoc.DocClassName)
theDocClass.GetFieldAnalysisSettings FIELDNAME,"German",theAnalysisSettings
Set theSupplierSettings = theAnalysisSettings
lEntryCount=theSupplierSettings.EntryCount
For lIndex = 0 To lEntryCount-1
theSupplierSettings.GetIDByIndex (lIndex, lIDHigh, lIDLow)
strSupplierName = theSupplierSettings.GetEntryByID(lIDHigh, lIDLow,COLUMNNAME)
If strSupplierName = SupplierName Then
lEntryIndex=lIDLow
Exit For
End If
Next lIndex
lColumnCount=theSupplierSettings.ColumnCount
ReDim myListArray(lColumnCount)
ReDim myListArray2(lColumnCount)
For lIndex = 0 To lColumnCount-1
strColumnName=theSupplierSettings.ColumnName(lIndex)
myListArray(lIndex) =UCase(CStr(strColumnName)) + ": "
If Len(CStr(theSupplierSettings.GetEntryByID(0,lEntryIndex,strColumnName)))=0 Then
myListArray2(lIndex) = " "
Else
myListArray2(lIndex) =CStr(theSupplierSettings.GetEntryByID _
(0,lEntryIndex,strColumnName))
End If
Next lIndex
Begin Dialog UserDialog 580,300,DETAILSBOXTITLE,.dlgControl2
'Comment %GRID:10,7,1,1
Text 10,10,560,20, "Partner Name: " + SupplierName,.Text1
ListBox 10,40,140,220,myListArray(),.ListBox2
ListBox 150,40,430,220,myListArray2(),.ListBox3
OKButton 250,270,90,21
End Dialog
Dim dlg As UserDialog
Dialog dlg ' show dialog (wait for ok)
End Sub
Private Sub SearchPartner(pWorkdoc As SCBCdrPROJLib.SCBCdrWorkdoc, _
SearchText As String,SearchField As String)
' Searches for special search items in the Associative Search pool
Dim theDocClass As SCBCdrDocClass
Dim lIndex As Long
Set theDocClass=Project.AllClasses.ItemByName(pWorkdoc.DocClassName)
For lIndex=0 To myWorkdoc.Fields.ItemByName(FIELDNAME).CandidateCount-1
If lIndex >myWorkdoc.Fields.ItemByName(FIELDNAME).CandidateCount-1 Then Exit For
myWorkdoc.Fields.ItemByName(FIELDNAME).RemoveCandidate(lIndex)
lIndex=lIndex-1
Next lIndex
If Len(SearchText) > 0 Then
Call BuildPartnerList(theDocClass,1)
End If
End Sub
Private Sub ReadFieldCandidates()
' Fills ListArray for the listbox of the dialog with candidates
Dim theDocClass As SCBCdrDocClass
Dim lIndex As Long
Set theDocClass=Project.AllClasses.ItemByName(myWorkdoc.DocClassName)
For lIndex=0 To myWorkdoc.Fields.ItemByName(FIELDNAME).CandidateCount-1
If lIndex >myWorkdoc.Fields.ItemByName(FIELDNAME).CandidateCount-1 Then Exit For
myWorkdoc.Fields.ItemByName(FIELDNAME).RemoveCandidate(lIndex)
lIndex=lIndex-1
Next lIndex
Call BuildPartnerList(theDocClass,0)
End Sub
Private Sub BuildPartnerList(theDocClass As SCBCdrDocClass, iListType As Integer)
Dim lIndex As Long
Dim lCandidateCount As Long
Dim strCandWeight As String
Dim theSupplierSettings As Object
Dim theAnalysisSettings As ISCBCdrAnalysisSettings
Dim theSupplierEngine As New SCBCdrSupplierExtractionEngine
Dim pField As SCBCdrField
theDocClass.GetFieldAnalysisSettings FIELDNAME,"German",theAnalysisSettings
Set theSupplierSettings = theAnalysisSettings
If iListType=0 Then
Set pField = myWorkdoc.Fields.ItemByName(FIELDNAME)
pField.FieldState=CDRFieldStateReset
theDocClass.AnalyzeField(myWorkdoc,FIELDNAME)
lCandidateCount=myWorkdoc.Fields.ItemByName(FIELDNAME).CandidateCount
Else
theSupplierEngine.SearchField(strSearchText,myWorkdoc,theAnalysisSettings,FIELDNAME)
lCandidateCount=myWorkdoc.Fields.ItemByName(FIELDNAME).CandidateCount
End If
ReDim ListArray(lCandidateCount)
For lIndex=0 To myWorkdoc.Fields.ItemByName(FIELDNAME).CandidateCount-1
strCandWeight=CStr(Format(myWorkdoc.Fields.ItemByName(FIELDNAME).Candidate(lIndex).Weight*100,"#.00"))
If Len(strCandWeight)<6 Then
strCandWeight=Space(6-Len(strCandWeight))+ strCandWeight
End If
ListArray(lIndex) = strCandWeight + "%" + _
" " + theSupplierSettings.GetEntryByID(0, _
myWorkdoc.Fields.ItemByName(FIELDNAME).Candidate(lIndex).FilterID,COLUMNNAME) + _
" (#" + theSupplierSettings.GetEntryByID _
(0,myWorkdoc.Fields.ItemByName(FIELDNAME).Candidate(lIndex).FilterID,COLUMNID) + ")"
Next lIndex
End Sub