An update...
I finally got my Progressive Find working well enough to use. It's listed below (configured to work with AlphaSports) in case it proves useful to anyone. I still haven't figured out why the <array>.SORT() function doesn't work as it should, but I found a workaround. I'm still hoping someone can enlighten me as to what I am doing wrong.
This Progressive Find reads the whole customer table into an array, which is processed into the form needed for display in a Listview control. For this reason it is not appropriate for large customer files, but it works fine with files up to 1000 records or so. (The Progressive Find generated by ActionScript works differently, only reading the records that need to be displayed.) My version automatically selects the first record displayed, so the user doesn't have to select a record if his typing has narrowed it down to one name.
Thanks to all who helped...
Code:
'Date Created: 02-Aug-2013 11:59:38 PM
'Last Updated: 12-Aug-2013 12:08:06 AM
'Created By : Jim
'Updated By : Jim
'Inline-Xbasic. Converted from: Create an Xdialog Progressive Search.
DIM SHARED vLastname as C ' search string
DIM SHARED varC_result as C ' "ok" means success
DIM SHARED vSelID AS C ' Customer_ID of selected customer
DIM cFuncSrc AS C = <<%code%
' trace function for debugging
FUNCTION cTrcPropArr AS C(aArray AS P)
DIM cResult AS C = ""
DIM cPropList AS C
cPropList = STRTRAN(TRIM(PROPERTIES_ENUM(aArray[1])),CRLF(),"|")
cResult = aArray.DUMP_PROPERTIES(cPropList)
cTrcPropArr = cResult
END FUNCTION
' set selection to top name in list
FUNCTION vSetSelTop AS V(aContents AS P)
vSelID = ""
IF aContents.SIZE()>0
IF PROP_VALID(aContents[1],"Customer_ID")
vSelID = aContents[1].Customer_ID
END IF
END IF
END FUNCTION
' sort aContents array when a column is picked
FUNCTION cDoSort AS C(BYREF cCurSrtFld AS C,\
BYREF cCurSrtDir AS C,NewSrtFld AS C,\
pTableDef AS P,aContents AS P)
DIM cDirFld AS C
IF NewSrtFld=cCurSrtFld
cCurSrtDir = IIF(cCurSrtDir="D","AB","D")
ELSE
cCurSrtFld = NewSrtFld
cCurSrtDir = "AB"
END IF
' why is this necessary? why is cCurSrtDir ignored in the sort?
cDirFld = IIF(cCurSrtDir="D","INVERT("+cCurSrtFld+")",cCurSrtFld)
aContents.SORT(cCurSrtDir,cDirFld)
vSetSelTop(aContents)
cDoSort = cEvalContents(pTableDef,aContents)
END FUNCTION
' get selected records from table and return desired fields as CRLF list
FUNCTION cGetContents AS C(pTableDef AS P,aContents AS P,pVarFrame AS P)
DIM cFieldList AS C
DIM cContentExp AS C
DIM pTable AS P
DIM cFilter AS C
aContents.CLEAR()
IF .NOT.FILE.EXISTS(TABLE.FILENAME_GET(pTableDef.TableName))
UI_MSG_BOX("ProgressiveLookup:cGetContents", \
"Table missing:"+TABLE.FILENAME_GET(pTableDef.TableName))
EXIT FUNCTION
END IF
pTable = TABLE.OPEN(pTableDef.TableName,FILE_RO_SHARED)
aContents.RESIZE(pTable.RECORDS_GET())
cFilter = cGetFltrArgs(pTableDef,pVarFrame)
cFilter = CONVERT_EXPRESSION(cFilter,"VC","",pVarFrame)
aContents.INITIALIZE_FROM_TABLE(pTable,cFilter,pTableDef.Order)
pTable.CLOSE()
cCurSrtFld = "LASTNAME"
cCurSrtOrd = "AB"
vSetSelTop(aContents)
cGetContents = cEvalContents(pTableDef,aContents)
END FUNCTION
' convert from a property array of fields to a CRLF list
FUNCTION cEvalContents AS C(pTableDef AS P,aContents AS P)
DIM cEval AS C
pTableDef.FieldList = ALLTRIM(pTableDef.FieldList)
IF pTableDef.FieldList=""
cEvalContents = ""
EXIT FUNCTION
END IF
cEval = *FOR_EACH(x,"TrimCRLFs(x."+x+")",pTableDef.FieldList)
cEval = ALLTRIM(cEval)
cEval = STRITRAN(cEval,CRLF(),"+"+QUOTE("|")+"+")
IF pTableDef.cRetValExp <> ""
cEval = QUOTE("{DATA=")+"+TrimCRLFs(x."+pTableDef.cRetValExp+ \
")+"+QUOTE("}")+"+"+cEval
END IF
cEval = "*FOR_EACH(x,"+cEval+",aContents)"
cEvalContents = EVAL(cEval)
END FUNCTION
' replace CRLFs with blanks in a string
FUNCTION TrimCRLFs AS A(aData AS A)
IF TYPEOF(aData)="C"
TrimCRLFs = STRITRAN(aData,CRLF()," ")
ELSE
TrimCRLFs = aData
END IF
END FUNCTION
' replace arguments in filter expression with their values
FUNCTION cGetFltrArgs AS C(pTableDef AS P,pVarFrame AS P)
DIM cFilter AS C = pTableDef.Filter
FOR EACH x IN pTableDef.pArgs.arrArgs
IF (":"+x.Name) $ pTableDef.Filter
x.Value = A5_ArgGetValue(x,pVarFrame)
cFilter = STRITRAN(cFilter,":"+x.Name,x.Value)
END IF
NEXT
cGetFltrArgs = cFilter
END FUNCTION
%code%
vLastname = ""
DIM pFuncObj AS P = COMPILE_TEMPLATE(cFuncSrc)
DIM aContents[1] AS P
DIM cCurSrtFld AS C = "Lastname"
DIM cCurSrtDir AS C = "AB"
DIM pTableDef AS P
DIM pTableDef.cRetValExp AS C = "Customer_ID"
DIM pTableDef.FieldList AS C = <<%txt%
LASTNAME
FIRSTNAME
COMPANY
%txt%
DIM pTableDef.TitleRow AS C = "{WIDTH=1.5}Last name|{WIDTH=1.3}First name|{WIDTH=1.3}Company"
DIM pTableDef.Arguments AS C = <<%txt%
<lastbutton="ok">
<arrArgs<[1]<Name="argLastname">
<DataType="Character">
<Source="Variable">
<SourceDisplay="Get value from variable">
<VariableScope="Session Variable">
<VariableName="vLastname">
<VariableWithScope="vLastname (Session Variable)">
<DefaultValue="">
<Prompt=.F.>
<PromptText="">
<PromptControlType="Text Box">
<PromptChoices="">
<PromptDlgTitle="Missing Argument">
<PromptTextAbove="">
<PreviewValue="">
>
>
%txt%
DIM pTableDef.pArgs AS P
property_from_string(pTableDef.pArgs,pTableDef.Arguments)
DIM pTableDef.TableName AS C = "customer"
DIM pTableDef.Filter AS C = "LEFT(Lastname,LEN(\":argLastname\"))=\":argLastname\" .AND. (recno() > 0)" ' recno() > 0 is required in order to avoid showing deleted variables
DIM pTableDef.Order AS C = "LASTNAME+FIRSTNAME"
pLV.titlerow = pTableDef.titlerow
pLV.titleevents = "Sort_LASTNAME|Sort_FIRSTNAME|Sort_COMPANY"
pLV.style = "report,singlesel,showselalways,gridlines,fullrowselect"
pLV.dragbehaviour = ""
pLV.dropbehaviour = ""
pLV.contents = pFuncObj.cGetContents(pTableDef,aContents,LOCAL_VARIABLES())
pLV.events = <<%code%
FUNCTION OnDoubleClick AS C(pLV AS P,pListView AS P,pArgs AS P)
WITH pLV
vSelID = pListView.GETROWVALUE(pArgs.GETCLICKROW())
' here we need to somehow close the dialog
END WITH
END FUNCTION
FUNCTION OnSelectionChanged AS V(pLV AS P,pListView AS P)
WITH pLV
vSelID = pListView.Selection
END WITH
END FUNCTION
%code%
DIM cHdgTxt AS C = "Start typing the desired last name in the box below..."
DIM cDlgNam AS C = "Find Customer"
varC_result = UI_DLG_BOX(cDlgNam,<<%dlg%
{watch=vLastname!refresh}
{on_activate=activate}
{can_exit=close}
{auto_external_refresh}
{region0}
{region_xmargin=.5}
{region_ymargin=.5}
{region1}
{text=95,1:cHdgTxt};
{lf};
{endregion1};
{region2}
Type partial last name:| [.40vLastname];
{lf};
Select Customer:| {listview=82,20vSelID^=pLV}|;
{endregion2};
{line=1,0};
{region3}
{sp}
<*20&Generate Invoice!ok>
{sp=5}
<15&Cancel!cancel>
{endregion3};
{endregion0};
%dlg%,<<%code%
IF LEFT(A_DLG_BUTTON,LEN("Sort_"))="Sort_"
DIM cRetVal AS C
cRetVal = pFuncObj.cDoSort(cCurSrtFld,cCurSrtDir, \
SUBSTR(A_DLG_BUTTON,LEN("Sort_")+1), \
pTableDef,aContents)
pLV.Contents = cRetVal
A_DLG_BUTTON = ""
END IF
IF A_DLG_BUTTON="activate"
A_DLG_BUTTON = ""
END IF
IF A_DLG_BUTTON="refresh"
pLV.CONTENTS = pFuncObj.cGetContents(pTableDef,aContents,LOCAL_VARIABLES())
A_DLG_BUTTON = ""
END IF
IF A_DLG_BUTTON="ok"
END IF
IF A_DLG_BUTTON="cancel"
END IF
IF A_DLG_BUTTON="close"
END IF
%code%)
END
Leave a comment: