Se trata de una clase que autocompleta a partir de un array lo que se escribe en un get.. permitiendo eliminar unos cuantos comboboxes.
Me atrevo, por valorarla mucho, a hacer un "copy, paste" y ponerla en el foro de utilidades para que esté más accesible a todos nosotros.
Muchas Gracias Maurilio por tan buen aporte, sea este post una muestra de gratitud por tu trabajo.
I use this class I created: TAutoGet
New features, bug fixes and enhancements are welcome
Código:
// TAutoGet.prg
// Auto complete text in get features
// By: Maurilio Viana mouri_ryo@hotmail.com
//
// New features, bug fixes and enhancements are welcome
// Please, let me now when you include new features, bug fixes etc in this class
//
// ToDo: Show drop down window with possible options when typing
//
#include "fivewin.ch"
CLASS TAutoGet FROM TGet
DATA aItems AS ARRAY
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 , aItems ) CONSTRUCTOR
METHOD ReDefine( nID , bSetGet , oWnd , nHelpId , cPict, bValid ,;
nClrFore, nClrBack, oFont , oCursor , cMsg , lUpdate,;
bWhen , bChanged, lReadOnly, lSpinner, bUp , bDown ,;
bMin , bMax, aItems ) CONSTRUCTOR
METHOD SetItems( aItems )
METHOD AutoFill()
END CLASS
//-----------------------------------------------------------------------------------------
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 , aItems) CLASS TAutoGet
local nLen, i
Super:New(nRow , nCol , bSetGet , oWnd , nWidth , nHeight,;
cPict , bValid , nClrFore , nClrBack , oFont , lDesign,;
oCursor, lPixel , cMsg , lUpdate , bWhen , lCenter,;
lRight , ::bChange, lReadOnly, lPassword, lNoBorder, nHelpId,;
lSpinner, bUp , bDown , bMin , bMax )
if(aItems == Nil, aItems := {}, )
::aItems := aItems
::bPostKey := {|oGet, cBuffer| ::AutoFill() }
return( Self )
//-----------------------------------------------------------------------------------------
METHOD ReDefine(nID , bSetGet , oWnd , nHelpId, cPict , bValid, nClrFore,;
nClrBack , oFont , oCursor, cMsg , lUpdate, bWhen , bChanged,;
lReadOnly, lSpinner, bUp , bDown , bMin , bMax , aItems ) CLASS TAutoGet
Super:ReDefine(nID , bSetGet , oWnd , nHelpId, cPict , bValid, nClrFore ,;
nClrBack , oFont , oCursor, cMsg , lUpdate, bWhen , ::bChange,;
lReadOnly, lSpinner, bUp , bDown , bMin , bMax , aItems )
if(aItems == Nil, aItems := {}, )
::aItems := aItems
::bPostKey := {|oGet, cBuffer| ::AutoFill() }
return( Self )
//---------------------------------------------------------------------------------------
// Set items of AutoGet
//---------------------------------------------------------------------------------------
METHOD SetItems( aItems ) CLASS TAutoGet
if(aItems == Nil, aItems := {}, )
::aItems := aItems
return( Nil )
//---------------------------------------------------------------------------------------
// Auto fill text when type based on aItems options
// Return: Ever return .T.
//---------------------------------------------------------------------------------------
METHOD AutoFill() CLASS TAutoGet
local nPosItem := 0 // Text position into ::aItems
local nPosCursor := ::nPos // Current cursor position
local nLenght := len(::cText) // Text lenght
local cStartTxt := left(::cText, nPosCursor-1) // Start text (position 1 to cursor position -1)
local cItem
if len(::aItems) = 0 // We have no items to search in this GET
return(.T.)
endif
//-------------------------------------------------------------------------
// We use ::cargo to control when we must search in ::aItems for typed text
// We must seek in ::aItems when GET is blank or when user clear it
//-------------------------------------------------------------------------
if valtype(::Cargo) != "L" // Cargo isn't logical yet -> GET received focus now
if ! empty(::Value) // GET isn't empty
::Cargo := .F. // We don't use autofill
else // GET is empty
::Cargo := .T. // Use autofill
endif
else // We are controlling if use or no autofill
if empty(::Value) // User could cleaned the GET text
::Cargo := .T. // Use autofill
endif
endif
//-------------------------------------------------------------------------
// When lost focus we clean ::Cargo and set GET cursor position to 1st pos
//-------------------------------------------------------------------------
::bLostFocus := {|| ::SetPos(1), ::Cargo := Nil }
if ! ::Cargo // If don't control autofill
return(.t.)
endif
nKey := ::nLastKey
do case
case nKey == 9 .or. ; // Tab key
nKey == 13 .or. ; // Enter key
nKey == 46 // Del key
::Assign() // Assign typed text
case nKey > 31
FOR EACH cItem IN ::aItems
nPosItem += 1
if ToUpper( cItem ) = ToUpper(cStartTxt)
nLenght := len( rtrim( cItem ) )
cItem += space( nLenght - len(cItem) )
::SetText( cItem )
::SetSel( nPosCursor -1, nLenght) // Select found text
return(.t.)
endif
NEXT
::HideSel() // Text not found -> Undo selected text
endcase
return( .T. )
// Convert latin characters to ANSI upper case
// (for any reason AnsiUpper cause a GPF with Comercial xHB)
STATIC function ToUpper( cString )
cString := upper( cString )
cString := strtran(strtran(strtran(strtran(cString,"á","Á"),"à","À"),"ã","Ã"),"â","Â")
cString := strtran(strtran(cString,"é","É"),"ê","Ê")
cString := strtran(cString,"í","Í")
cString := strtran(strtran(strtran(cString,"ó","Ó"),"õ","Õ"),"ô","Ô")
cString := strtran(strtran(strtran(cString,"ú","Ú"),"ñ","Ñ"),"ç","Ç")
return( cString )
// --- EoF ---
xBase definition (AutoGet.ch):
Código:
/*----------------------------------------------------------------------------//
!short: AUTOGET */
#xcommand REDEFINE AUTOGET [ <oGet> VAR ] <uVar> ;
[ ID <nId> ] ;
[ <dlg: OF, WINDOW, DIALOG> <oDlg> ] ;
[ <help:HELPID, HELP ID> <nHelpId> ] ;
[ VALID <ValidFunc> ] ;
[ <pict: PICTURE, PICT> <cPict> ] ;
[ <color:COLOR,COLORS> <nClrFore> [,<nClrBack>] ] ;
[ FONT <oFont> ] ;
[ CURSOR <oCursor> ] ;
[ MESSAGE <cMsg> ] ;
[ <update: UPDATE> ] ;
[ WHEN <uWhen> ] ;
[ ON CHANGE <uChange> ] ;
[ <readonly: READONLY, NO MODIFY> ] ;
[ <spin: SPINNER> [ON UP <SpnUp>] [ON DOWN <SpnDn>] [MIN <Min>] [MAX <Max>] ] ;
[ ITEMS <aItems>] ;
=> ;
[ <oGet> := ] TAutoGet():ReDefine( <nId>, bSETGET(<uVar>), <oDlg>,;
<nHelpId>, <cPict>, <{ValidFunc}>, <nClrFore>, <nClrBack>,;
<oFont>, <oCursor>, <cMsg>, .T., <{uWhen}>,;
[ \{|nKey,nFlags,Self| <uChange> \}], <.readonly.>,;
<.spin.>, <{SpnUp}>, <{SpnDn}>, <{Min}>, <{Max}>, <aItems>)
#command @ <nRow>, <nCol> AUTOGET [ <oGet> VAR ] <uVar> ;
[ <dlg: OF, WINDOW, DIALOG> <oWnd> ] ;
[ <pict: PICTURE, PICT> <cPict> ] ;
[ VALID <ValidFunc> ] ;
[ <color:COLOR,COLORS> <nClrFore> [,<nClrBack>] ] ;
[ SIZE <nWidth>, <nHeight> ] ;
[ FONT <oFont> ] ;
[ <design: DESIGN> ] ;
[ CURSOR <oCursor> ] ;
[ <pixel: PIXEL> ] ;
[ MESSAGE <cMsg> ] ;
[ <update: UPDATE> ] ;
[ WHEN <uWhen> ] ;
[ <lCenter: CENTER, CENTERED> ] ;
[ <lRight: RIGHT> ] ;
[ ON CHANGE <uChange> ] ;
[ <readonly: READONLY, NO MODIFY> ] ;
[ <pass: PASSWORD> ] ;
[ <lNoBorder: NO BORDER, NOBORDER> ] ;
[ <help:HELPID, HELP ID> <nHelpId> ] ;
[ ITEMS <aItems>] ;
=> ;
[ <oGet> := ] TAutoGet():New( <nRow>, <nCol>, bSETGET(<uVar>),;
[<oWnd>], <nWidth>, <nHeight>, <cPict>, <{ValidFunc}>,;
<nClrFore>, <nClrBack>, <oFont>, <.design.>,;
<oCursor>, <.pixel.>, <cMsg>, .T., <{uWhen}>,;
<.lCenter.>, <.lRight.>,;
[\{|nKey, nFlags, Self| <uChange>\}], <.readonly.>,;
<.pass.>, [<.lNoBorder.>], <nHelpId>,,,,,,<aItems> )
#command @ <nRow>, <nCol> AUTOGET [ <oGet> VAR ] <uVar> ;
[ <dlg: OF, WINDOW, DIALOG> <oWnd> ] ;
[ <pict: PICTURE, PICT> <cPict> ] ;
[ VALID <ValidFunc> ] ;
[ <color:COLOR,COLORS> <nClrFore> [,<nClrBack>] ] ;
[ SIZE <nWidth>, <nHeight> ] ;
[ FONT <oFont> ] ;
[ <design: DESIGN> ] ;
[ CURSOR <oCursor> ] ;
[ <pixel: PIXEL> ] ;
[ MESSAGE <cMsg> ] ;
[ <update: UPDATE> ] ;
[ WHEN <uWhen> ] ;
[ <lCenter: CENTER, CENTERED> ] ;
[ <lRight: RIGHT> ] ;
[ ON CHANGE <uChange> ] ;
[ <readonly: READONLY, NO MODIFY> ] ;
[ <help:HELPID, HELP ID> <nHelpId> ] ;
[ <spin: SPINNER> [ON UP <SpnUp>] [ON DOWN <SpnDn>] [MIN <Min>] [MAX <Max>] ] ;
[ ITEMS <aItems>] ;
=> ;
[ <oGet> := ] TAutoGet():New( <nRow>, <nCol>, bSETGET(<uVar>),;
[<oWnd>], <nWidth>, <nHeight>, <cPict>, <{ValidFunc}>,;
<nClrFore>, <nClrBack>, <oFont>, <.design.>,;
<oCursor>, <.pixel.>, <cMsg>, .T., <{uWhen}>,;
<.lCenter.>, <.lRight.>,;
[\{|nKey, nFlags, Self| <uChange>\}], <.readonly.>,;
.f., .f., <nHelpId>,;
<.spin.>, <{SpnUp}>, <{SpnDn}>, <{Min}>, <{Max}>, <aItems> )
A fragment of code:
#include "autoget.ch"
(...)
cName := space(20)
aNames := {"Mauro", "Mauricio", "Maurilio", "Maurizio"}
redefine autoget oGet var cName id 101 of oDlg items aNames
(...)
You can update items from available text to autocomplete using:
aNames := {"Angelo", "Antonio", "Afonso"}
oGet:SetItems( aNames )
Best regards!
Maurilio
