// 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 ---
/*----------------------------------------------------------------------------//
!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> )
// TAutoGet.prg
// Auto complete text in get features
// By: Maurilio Viana, mouri_ryo@hotmail.com
// Date: 4/25/2007
// 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
//
/* Revisions 4/25/2007 10:49AM by James Bott
Method AutoFill: nKey was not defined as a LOCAL. Fixed.
Method AutoFill: nLength was mispelled (as nLenght). Fixed.
Method AutoFill: ::Cargo changed to ::lAuto (see reason below)
Method AutoFill: Changed to using vkey.ch manifest constants instead of numbers.
Method Redefine: Was passing aItems to the parent method (not needed).
Method LostFocus: Added this method.
Methos New() and Redefine(). Was passing bChanged, and then ::bChange to parent. Fixed.
It is not a good idea to use ::Cargo, ::bPostKey, or ::bLostFocus in the class since these
then cannot be used by the programmer. It would be better to subclass the needed methods and add
whatever functionality needed. So, ::Cargo and ::bLostFocus were eliminated.
Unfortuneately, not using ::bPostKey is somewhat of a challenge. We can subclass KeyDown() and
KeyChar() but some of each method will have to be copied into the new methods and thus if there
are any changes to these sections of code in future versions of TGET, then this method in
TAutoGet will have to be updated also.
Bug?: If the items in ::aArray are in proper case, e.g. "Mauro," they are automatically converted
to proper case when autofilled, however, if you backspace they are converted to all lower case.
*/
#include "fivewin.ch"
//---------------------------------------------------------------------------//
CLASS TAutoGet FROM TGet
DATA aItems AS ARRAY
DATA lAuto AS LOGICAL
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()
METHOD LostFocus( hWndGetFocus ) inline ::SetPos(1), ::lAuto := Nil, ::super:LostFocus( hWndGetFocus )
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 , bChanged, 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 , bChanged,;
lReadOnly, lSpinner, bUp , bDown , bMin , bMax )
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 typed based on aItems
// Return: Always returns .T.
//---------------------------------------------------------------------------//
METHOD AutoFill() CLASS TAutoGet
local nPosItem := 0 // Text position into ::aItems
local nPosCursor := ::nPos // Current cursor position
local nLength := len(::cText) // Text length
local cStartTxt := left(::cText, nPosCursor-1) // Start text (position 1 to cursor position -1)
local cItem := ""
local nKey := 0
if len(::aItems) = 0 // We have no items to search in this GET
return(.T.)
endif
//-------------------------------------------------------------------------
// We use ::lAuto 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(::lAuto) != "L" // Cargo isn't logical yet -> GET received focus now
if ! empty(::Value) // GET isn't empty
::lAuto := .F. // We don't use autofill
else // GET is empty
::lAuto := .T. // Use autofill
endif
else // We are controlling if use or no autofill
if empty(::Value) // User could cleaned the GET text
::lAuto := .T. // Use autofill
endif
endif
if ! ::lAuto // If don't control autofill
return(.t.)
endif
nKey := ::nLastKey
do case
case nKey == VK_TAB .or. ;
nKey == VK_RETURN .or. ;
nKey == VK_DELETE
::Assign() // Assign typed text
case nKey >= 32 .and. <= 256
FOR EACH cItem IN ::aItems
nPosItem += 1
if ToUpper( cItem ) = ToUpper(cStartTxt)
nLength := len( rtrim( cItem ) )
cItem += space( nLength - len(cItem) )
::SetText( cItem )
::SetSel( nPosCursor -1, nLength) // 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 some reason AnsiUpper causes a GPF with Commercial 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 ---
AOKISANTOS wrote:Maurilio, que erro é este?
xHarbour Compiler build 0.99.71 (SimpLex)
Copyright 1999-2006, http://www.xharbour.org http://www.harbour-project.org/
Compiling 'C:\genesis\tautoget.prg'...
C:\genesis\tautoget.prg(138) Error E0030 Syntax error: "parse error at '32'"
C:\genesis\tautoget.prg(150) Error E0017 Unclosed control structure at line 135
2 errors
No code generated
Case nKey >= 32 .And. nKey <= 256
:
:
::SetText( cItem )
::SetSel( nPosCursor -1, nLength) // Select found text
::oGet:Buffer = Pad( cItem, Len( ::oGet:Buffer )) // add by:ss-bbs
return(.t.)
endif
NEXT
#include "fivewin.ch"
#include "autoget.ch"
function main()
local oDlg, oGet, cName, aNames
cName := space(20)
aNames := {"Mauro", "Mauricio", "Maurilio", "Maurizio"}
define dialog oDlg title "Test Autoget"
@ 2,2 autoget oGet var cName of oDlg items aNames
activate dialog oDlg centered
return nil
Return to FiveWin for Harbour/xHarbour
Users browsing this forum: EASYSOFT and 20 guests