I don't know the name for this control, it is in pre-alpha state
- Code: Select all Expand view
#Include "FiveWin.Ch"
#include "xbrowse.ch"
Function Main()
Local oDlg
Local oGet, oGet1, oCb
local cVar := space( 20 )
local a := {}
USE customer NEW
customer -> ( DBEVAL( {|| AADD( a, field -> street ) } ) )
DEFINE DIALOG oDlg from 0,0 to 400,400 pixel
oGet := tListGet():new(15,15,{ | u | If( PCount()==0, cVar, cVar:= u ) },oDlg,120,12,"@!",,,,,,,.T.)
@ 29,15 get oGet1 var cVar picture "@!" size 120,12 of oDlg pixel
@ 43,15 COMBOBOX oCb ITEMS a OF oDlg pixel SIZE 120,100
oGet:aSource := a
oGet:bSearch := {|i,e| AT( i, UPPER(e) ) > 0 }
oGet:cSource := 'ARRAY'
oGet:lenDisplay := 15
ACTIVATE DIALOG oDlg
USE
return nil
//---------------------------------------------------------------
CLASS tListGet FROM tGet
DATA oBrw, oWin, aData, lenBuffer, bSearch, aSource, cSource, cField, cAlias, lenDisplay
METHOD new() CONSTRUCTOR
METHOD redefine() CONSTRUCTOR
METHOD FillList()
METHOD Initiate()
METHOD keyDown()
METHOD keychar()
ENDCLASS
//---------------------------------------------------------------
METHOD New( nRow, nCol, bSetGet, oWnd, nWidth, nHeight, cPict, bValid,;
nClrFore, nClrBack, oFont, lDesign, oCursor, lPixel, cMsg,;
lUpdate, bWhen, lCenter, lRight, bChanged, lReadOnly,;
lPassword, lNoBorder, nHelpId, lSpinner,;
bUp, bDown, bMin, bMax, bAction, cBmpName, cVarName, cCueText ) CLASS tListGet
//---------------------------------------------------------------
RETURN ::super:new( nRow, nCol, bSetGet, oWnd, nWidth, nHeight, cPict, bValid,;
nClrFore, nClrBack, oFont, lDesign, oCursor, lPixel, cMsg,;
lUpdate, bWhen, lCenter, lRight, bChanged, lReadOnly,;
lPassword, lNoBorder, nHelpId, lSpinner,;
bUp, bDown, bMin, bMax, bAction, cBmpName, cVarName, cCueText )
//---------------------------------------------------------------
METHOD ReDefine( nId, bSetGet, oWnd, nHelpId, cPict, bValid, nClrFore,;
nClrBack, oFont, oCursor, cMsg, lUpdate, bWhen, bChanged,;
lReadOnly, lSpinner, bUp, bDown, bMin, bMax, bAction, cBmpName,;
cVarName, cCueText ) CLASS tListGet
//---------------------------------------------------------------
RETURN ::super:ReDefine( nId, bSetGet, oWnd, nHelpId, cPict, bValid, nClrFore,;
nClrBack, oFont, oCursor, cMsg, lUpdate, bWhen, bChanged,;
lReadOnly, lSpinner, bUp, bDown, bMin, bMax, bAction, cBmpName,;
cVarName, cCueText )
//---------------------------------------------------------------
METHOD Initiate( hDlg ) CLASS TListGet
//---------------------------------------------------------------
LOCAL oSelf := SELF, aRect
::super:Initiate( hDlg )
::lenBuffer := LEN( cValToChar( Eval( ::bSetGet ) ) )
::aData := ARRAY(1)
DEFAULT ::lenDisplay := 5
DEFINE DIALOG ::oWin OF oSelf:oWnd FROM 100, 100 TO 100, 100 + ::nWidth PIXEL STYLE nOR( WS_CHILD, WS_POPUP, WS_VISIBLE )
@ 0, 0 XBROWSE ::oBrw OF oSelf:oWin ARRAY oSelf:aData COLUMNS 1 SIZEs ::nWidth
::oBrw:lHeader := .F.
::oBrw:lRecordSelector := .F.
::oBrw:lFlatStyle := .T.
::oBrw:nStyle -= WS_BORDER
::oWin:oClient := ::oBrw
::oBrw:bChange := {|| ::cText( PADR( ::aData[ ::oBrw:nArrayAt ], ::lenBuffer, ' ' ) ), ::refresh(), ::SetPos( LEN( ALLTRIM( ::aData[ ::oBrw:nArrayAt ] ) ) + 1 ), ::setFocus() }
::oBrw:bLClicked := {|| ::oWin:hide() }
::oBrw:lHScroll := .F.
::oBrw:lVScroll := .F.
::oBrw:createFromCode()
::bPostKey := {|oGet, cBuffer| ;
IF( EMPTY( cBuffer ), ::oWin:hide(), NIL ),;
oGet:aData[1] := cBuffer, ;
oGet:Assign(), ;
::FillList() }
ACTIVATE DIALOG oSelf:oWin NOWAIT ON INIT oSelf:oWin:hide()
::oWnd:bMoved := {|| ::oWin:hide() }
return nil
//---------------------------------------------------------------
METHOD FillList() CLASS TListGet
//---------------------------------------------------------------
LOCAL i := 1, aRect
ASIZE( ::aData, 1 )
DO CASE
CASE ::cSource = 'ARRAY'
DO WHILE LEN( ::aData ) < ::lenDisplay .AND. i <= LEN( ::aSource )
IF EVAL( ::bSearch, ALLTRIM(::aData[1]), ::aSource[i] )
AADD( ::aData, ::aSource[i] )
ENDIF
i++
ENDDO
::oWin:SetSize( ::oWin:nWidth, ( LEN( ::aData ) ) * GetTextHeight( ::hWnd ) + LEN( ::aData ) )
aRect := getWndRect( ::hWnd )
::oWin:move( aRect[1] + ::nHeight + 3, aRect[2] )
::oWin:show()
CASE ::cSource = 'DBF'
(::cAlias) -> ( DBGOTOP() )
DO WHILE LEN( ::aData ) < ::lenDisplay .AND. ! (::cAlias)-> ( EOF() )
IF EVAL( ::bSearch, ALLTRIM(::aData[1]), (::cAlias)-> ( fieldGet( fieldPos( ::cField ) ) ) )
AADD( ::aData, (::cAlias)-> ( fieldGet( fieldPos( ::cField ) ) ) )
ENDIF
i++
ENDDO
ENDCASE
::oBrw:refresh()
RETURN NIL
//---------------------------------------------------------------
METHOD KeyDown( nKey, nFlags ) CLASS TListGet
//---------------------------------------------------------------
IF ::oWin:lVisible
DO CASE
CASE nKey == VK_UP
::oBrw:GoUp()
RETURN 0
CASE nKey == VK_DOWN
::oBrw:GoDown()
RETURN 0
ENDCASE
ENDIF
IF nKey == VK_DELETE .or. nKey == VK_BACK
Super:KeyDown( nKey, nFlags )
::aData[1] := ::cText()
IF( EMPTY( ::aData[1] ), ::oWin:hide(), ::FillList() )
RETURN 0
ENDIF
RETURN Super:KeyDown( nKey, nFlags )
//---------------------------------------------------------------
METHOD keychar( nKey, nFlags ) CLASS TListGet
//---------------------------------------------------------------
IF nKey == VK_RETURN .AND. ::oWin:lVisible
::oWin:hide()
ENDIF
RETURN super:keychar( nkey, nFlags )
