autocomplete in get

[ukservice]

Hello,

Is it possible to do this with Fivewin?



Uploaded with ImageShack.us

Thank you

[Manuel Aranda]

Hola, mírate esto:

viewtopic.php?t=6726

[ukservice]

Thank you but it is not the same.

In the picture it shows a combobox to select various values.

I think this is an important feature for FW.

[James Bott]

Why don't you just use a combobox?

If you set oCmbo:lIncSearch:= .t. then it will do incremental searches.

Regards,
James

[ukservice]

Thank you. I added oCbx:lIncSearch := .t. to testcmb2.prg and does not work.

Anyway, I need a Get because the value typed on it may not be in the Array.

See working example at http://jqueryui.com/demos/autocomplete/#default

[Otto]

Ukservice,
jquery isn't it javascript?
This would be a great feature if we could add javascript to FWH the way we add C-functions?
I am curious what Antonio says.
Best regards,
Otto

[James Bott]

>Thank you. I added oCbx:lIncSearch := .t. to testcmb2.prg and does not work.

I forgot to mention that the data does need to be sorted.

>Anyway, I need a Get because the value typed on it may not be in the Array.

Then it seems that the Autoget class would be a better solution.

James

[ukservice]

Thank you James.

But autoget does not work as picture or link provided. I need that the user could select a item from the list or type a new value on the get.

This is a very interesting feature I think.

[James Bott]

Ukservice,

I note in the graphic in your first post that the items are not in alpha order and the item highlighted is not the first match to the text typed in. So your example is not working correctly.

I did some testing with TCombobox and incremental searching was broken (at least in my version). It was working at one time. I did get it working again with some effort, however, it is not really what you want.

There is an optional style that allows user input of new items called DROPDOWN. When in this mode the control is actually a GET object so the incremental searching has to be added to the get object. I think this might require a new subclass of the TGet class to add this capability. Then the subclass would be used in the TCombobox class.

Also in both forms of the Combobox, all items are listed in the dropdown, not just items that match the letters that have been typed in. Showing only matched items would have to be made an option (with both the normal DROPDOWNLIST and the DROPDOWN styles). I fear that this could be rather slow as the aItems array of the control has to be reloaded with each keystroke.

Regards,
James

[MarcoBoschi]

I've tested autoget with an array of 14.000 elements (Italian cities)
It is not fast.

Probably the solution is to have an ordered array and optimize the code

King regards

marco

[James Bott]

Marco,

>Probably the solution is to have an ordered array

Autoget reads every element in the array until if finds the first match. The speed is OK for smaller arrays.

With 14000 elements, a better speed would be an indexed database since indexes are not scanned sequentially. This would, of course, require a rewrite of the class.

[Maurizio]

This is only a test with index
the class must be refined , I tested with BIG dbf and it's very fast .

#include "fivewin.ch"
#include "autoget.ch"
#include "xbrowse.ch"

FUNCTION main()

LOCAL oDlg, oGet1, cName1, oGet2, cName2, aNames, lOk := .F.

cName := space(20)
cCity := space(20)
// aCities := {}
// aNames := {"RAmeSh", "rAmA rAo", "rAmDev", "rAM kUMAR", "raMADevi", "ramanA"}
// aCities := {"HYDERABAD", "SECUNDERABAD", "VIJAYAWADA", "VISAKHAPATNAM", "WARANGAL", "TIRUPATHI"}
REQUEST DBFCDX
rddsetdefault( "dbfcdx" )
REQUEST DBFFPT
USE CUSTOMER SHARED NEW
index on field->FIRST TAG I_TEMP TO TEMP TEMPORARY
XBROWSE()

dbgotop()


DEFINE DIALOG oDlg TITLE "Test Autoget"

//@ 1.2,1.2 SAY oSay1 PROMPT "Enter Name" oF oDlg
//@ 1.4,5.1 AUTOGET oGet1 VAR cName OF oDlg SIZE 110,12 ITEMS aNames CASE CUPPER ADD ITEMS

@ 2.1,1.2 SAY oSay1 PROMPT "Enter City" OF oDlg
@ 2.4,5.1 AUTOGET oGet2 VAR cCity OF oDlg SIZE 110,12 CASE CPROPER //ADD ITEMS

@ 3.0,19 BUTTON oOk PROMPT "&Finish" SIZE 35,12 OF oDlg ACTION (lOk := .T., oDlg:End())

ACTIVATE DIALOG oDlg CENTERED


RETURN nil





// 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.
Functin Proper() was added by RAMESH BABU P on 19-06-2011
DATA nCase was added by RAMESH BABU P on 19-06-2011
DATA lAddNewItems was added by RAMESH BABU P on 20-06-2011
FUNCTION AddNewItem(aItems,cText) was added by RAMESH BABU P on 20-06-2011

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.

*/


//---------------------------------------------------------------------------//

CLASS TAutoGet FROM TGet
DATA aItems AS ARRAY
DATA lAuto AS LOGICAL
DATA nCase AS NUMERIC INIT 3 // 1 UPPER CASE, 2 lower case, 3 Proper Case - Added by RAMESH BABU P
DATA lAddNewItems AS LOGICAL INIT .T. // .T. to Add New Items to aItems, .F. Don't Add - Added by RAMESH BABU P


DATA cAlias

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 ,;
nCase , lAddNewItems) CONSTRUCTOR

METHOD ReDefine( nID , bSetGet , oWnd , nHelpId , cPict, bValid ,;
nClrFore, nClrBack, oFont , oCursor , cMsg , lUpdate,;
bWhen , bChanged, lReadOnly, lSpinner, bUp , bDown ,;
bMin , bMax, aItems, nCase, lAddNewItems ) CONSTRUCTOR
METHOD SetItems( aItems )
METHOD AutoFill()
METHOD Autoseek()

METHOD LostFocus( hWndGetFocus ) inline ::SetPos(1), ::lAuto := .T., IF(::lAddNewItems,AddNewItem(@::aItems,::cText),) ,::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, nCase, lAddNewItems) CLASS TAutoGet
local nLen, i

DEFAULT nCase := 3, lAddNewItems := .T.

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 := {}, )

::nCase := nCase // Added by RAMESH BABU P
::lAddNewItems := lAddNewItems // Added by RAMESH BABU P
::aItems := aItems

//::bPostKey := {|oGet, cBuffer| ::AutoFill()}

::bPostKey := {|oGet, cBuffer| ::Autoseek()}




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 ,;
nCase, lAddNewItems ) CLASS TAutoGet

DEFAULT nCase := 3, lAddNewItems := .T.

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 := {}, )

::nCase := nCase
::lAddNewItems := lAddNewItems
::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 )


METHOD AutoSeek() 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

//-------------------------------------------------------------------------
// 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. nKey <= 256
dbseek(cStartTxt,.t.)
cItem := field->FIRST
if cItem = ToUpper(cStartTxt, ::nCase) // ADDED BY RAMESH BABU P on 19-06-2011
nLength := len( rtrim( cItem ) )
cItem += space( nLength - len(cItem) )
::SetText( cItem )
::SetSel( nPosCursor -1, nLength) // Select found text
::oGet:Buffer = Pad( cItem, Len( ::oGet:Buffer )) // add by:ss-bbs
return(.t.)
endif
::HideSel() // Text not found -> Undo selected text
endcase

Return .t.
//---------------------------------------------------------------------------//
// 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. nKey <= 256
FOR EACH cItem IN ::aItems
nPosItem += 1
//if ToUpper( cItem ) = ToUpper( cStartTxt ) // REMOVED BY RAMESH BABU P on 19-06-2011
cItem := ToUpper( cItem,::nCase ) // ADDED BY RAMESH BABU P on 19-06-2011

if cItem = ToUpper(cStartTxt, ::nCase) // ADDED BY RAMESH BABU P on 19-06-2011
nLength := len( rtrim( cItem ) )
cItem += space( nLength - len(cItem) )
::SetText( cItem )
::SetSel( nPosCursor -1, nLength) // Select found text
::oGet:Buffer = Pad( cItem, Len( ::oGet:Buffer )) // add by:ss-bbs
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, nCase )

if nCase = 2
cString := lower( cString )
elseif nCase = 3
cString := proper( cString )
else
cString := upper( cString )
endif

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 )

//---------------------------------------------------------------------------//
// ADDED BY RAMESH BABU P on 19-06-2011
STATIC FUNCTION proper(cString)

LOCAL point,spot,times,char1,char2,char3,char4,char5

STORE 1 TO point,spot,times
STORE " " TO char1
STORE "." TO char2
STORE "/" TO char3
STORE "-" TO char4
STORE "_" TO char5

* Convert beginning letter of string to Upper Case & last letter to lower case
cString = UPPER(LEFT(cString,1))+LOWER(RIGHT(cString,LEN(cString)-1))

* First capitalise every 1st letter in a word after a space and after a dot
DO WHILE point >0 .AND. times <= 5

point = AT(char1,SUBSTR(cString,spot,LEN(TRIM(cString))-spot))

IF point >0
spot = point + spot
cString = STUFF(cString,spot,1,UPPER(SUBSTR(cString,spot,1)))
ELSE
IF times = 1
char1 = char2
ELSEIF times = 2
char1 = char3
ELSEIF times = 3
char1 = char4
ELSEIF times = 4
char1 = char5
ENDIF
STORE 1 TO point,spot
times = times + 1
IF times >5
EXIT
ELSE
LOOP
ENDIF
ENDIF

ENDDO

RETURN cString

//---------------------------------------------------------------------------//

FUNCTION AddNewItem(aItems,cText)

IF ASCAN(aItems,{|x|UPPER(ALLTRIM(x)) == UPPER(ALLTRIM(cText))}) = 0
AADD(aItems,cText)
ENDIF

RETURN nil

//---------------------------------------------------------------------------//



**********

Regards MAurizio
http://www.nipeservice.com

[MdaSolution]

autoget.ch(93) Error E0030 Syntax error: "syntax error at ')'"
test.prg(325) Error E0030 Syntax error: "syntax error at '('"
test.prg(334) Error E0030 Syntax error: "syntax error at '('"
test.prg(348) Error E0018 EXIT statement with no loop in sight
test.prg(350) Error E0018 LOOP statement with no loop in sight
test.prg(362) Error E0030 Syntax error: "syntax error at '('"
test.prg(364) Error E0010 ENDIF does not match IF

[Maurizio]

Marco ,

this works with DBF

Code: Select all  Expand view

#include "fivewin.ch"
#include "autoget.ch"
#include "xbrowse.ch"
//--------------------------------------------------------------------------------------

FUNCTION main()

LOCAL oDlg, oGet1, oGet2,oSay1, lOk := .F.
LOCAL cName := space(20)
LOCAL cFunc := space(20)

LOCAL cAl1,cAl2 := ""
   REQUEST DBFCDX
   rddsetdefault( "dbfcdx" )
   REQUEST DBFFPT
   USE CUSTOMER SHARED NEW
   index on  field->FIRST  TAG I_TEMP  TO TEMP  TEMPORARY
   cAl1 := alias()
   dbgotop()
   XBROWSE()
   
   USE EJEMPLO1 SHARED NEW
   index on  field->FUNCION TAG I_TEMP  TO TEMP  TEMPORARY
   cAl2 := alias()
   XBROWSE()
   dbgotop()
   

   DEFINE DIALOG oDlg TITLE "Test Autoget from DBF "

   @ 1.2,1.2 SAY oSay1 PROMPT "Name (dbf 1)" oF oDlg

   @ 2.1,1.2 SAY oSay1 PROMPT "Function (dbf 2)" OF oDlg

   @ 1.4,6.1 AUTOGET oGet1 VAR cName OF oDlg SIZE 110,12  CASE CPROPER ALIAS cAl1 INDEX 1

   
   @ 2.4,6.1 AUTOGET oGet2 VAR cFunc OF oDlg SIZE 110,12 CASE CUPPER ALIAS cAl2 INDEX 1
   

   @ 3.0,19  BUTTON oOk PROMPT "&Finish" SIZE 35,12 OF oDlg ACTION (lOk := .T., oDlg:End())

   ACTIVATE DIALOG oDlg CENTERED

   
RETURN nil





// 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.
Functin Proper()                  was added by RAMESH BABU P on 19-06-2011
DATA nCase                        was added by RAMESH BABU P on 19-06-2011
DATA lAddNewItems                 was added by RAMESH BABU P on 20-06-2011
FUNCTION AddNewItem(aItems,cText) was added by RAMESH BABU P on 20-06-2011

/* Revisions 24/06/2011
Use DBF File
Method AuroSeek() : Added this method.
DATA cAlias                       was added by Ghirardini Maurizio P on 24-06-2011
DATA nIndex                       was added by Ghirardini Maurizio P on 24-06-2011



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.

*/


//---------------------------------------------------------------------------//

CLASS TAutoGet FROM TGet
   DATA aItems AS ARRAY
   DATA lAuto AS LOGICAL
   DATA nCase AS NUMERIC INIT 3          // 1 UPPER CASE, 2 lower case, 3 Proper Case - Added by RAMESH BABU P
   DATA lAddNewItems AS LOGICAL INIT .T.  // .T. to Add New Items to aItems, .F. Don't Add - Added by RAMESH BABU P
   DATA cAlias
   DATA nIndex

   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 ,;
               nCase   , lAddNewItems ,cAlias, nIndex ) CONSTRUCTOR

   METHOD ReDefine( nID     , bSetGet , oWnd     , nHelpId , cPict, bValid ,;
                    nClrFore, nClrBack, oFont    , oCursor , cMsg , lUpdate,;
                    bWhen   , bChanged, lReadOnly, lSpinner, bUp  , bDown  ,;
                    bMin    , bMax, aItems, nCase, lAddNewItems ,cAlias ,nIndex  ) CONSTRUCTOR
   METHOD SetItems( aItems )
   METHOD AutoFill()
   METHOD Autoseek()
   
   METHOD LostFocus( hWndGetFocus ) inline ::SetPos(1), ::lAuto := .T., IF(::lAddNewItems,AddNewItem(@::aItems,::cText),) ,::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,  nCase, lAddNewItems,cAlias ,nIndex) CLASS TAutoGet
   local nLen, i

   DEFAULT nCase := 3, lAddNewItems := .T.
   DEFAULT cAlias := ""
   DEFAULT nIndex := 0

   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 := {}, )

   ::nCase        := nCase           // Added by RAMESH BABU P
   ::lAddNewItems := lAddNewItems    // Added by RAMESH BABU P
   ::aItems       := aItems
   ::cAlias := cAlias
   ::nIndex := nIndex

 
   IF empty(cAlias)
     ::bPostKey := {|oGet, cBuffer| ::AutoFill()}
   ELSE
     ::bPostKey := {|oGet, cBuffer| ::Autoseek()}
   ENDIF
   
   

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  ,;
                nCase, lAddNewItems ,cAlias ,nIndex) CLASS TAutoGet

   DEFAULT nCase := 3, lAddNewItems := .T.
   DEFAULT cAlias := ""
   DEFAULT nIndex := 0


   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 := {}, )

   ::nCase        := nCase
   ::lAddNewItems := lAddNewItems
   ::aItems       := aItems
   ::cAlias := cAlias
   ::nIndex := nIndex


   ::bPostKey := {|oGet, cBuffer| ::AutoFill()}

return( Self )

//---------------------------------------------------------------------------//
// Set items of AutoGet
//---------------------------------------------------------------------------//

METHOD SetItems( aItems ) CLASS TAutoGet
   if(aItems == Nil, aItems := {}, )
   ::aItems   := aItems
return( Nil )

//---------------------------------------------------------------------------//
// Set items of AutoGet
//---------------------------------------------------------------------------//

METHOD AutoSeek() CLASS TAutoGet

   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
   Local nOrder  := (::cAlias)->(indexord())
   Local lReturn := .F.

   //-------------------------------------------------------------------------
   // 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. nKey <= 256
         select(::calias)
         dbgotop()
         dbseek(cStartTxt,.t.)
         cItem := &( indexKey() )
         if  cItem = ToUpper(cStartTxt, ::nCase)          // ADDED   BY RAMESH BABU P on 19-06-2011
             nLength := len( rtrim( cItem ) )
             cItem   += space( nLength - len(cItem) )
             ::SetText( cItem )
             ::SetSel( nPosCursor -1, nLength) // Select found text
             ::oGet:Buffer = Pad( cItem, Len( ::oGet:Buffer )) // add by:ss-bbs
             lReturn := .T.
         endif
         (::calias)->(dbsetorder(nOrder))
         IF lReturn
            Return .t.
         ENDIF    
         
         
         ::HideSel()   // Text not found -> Undo selected text
   endcase

Return .t.
//---------------------------------------------------------------------------//
// 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. nKey <= 256
         FOR EACH cItem IN ::aItems
            nPosItem += 1
            //if  ToUpper( cItem )  = ToUpper( cStartTxt )   // REMOVED BY RAMESH BABU P on 19-06-2011
            cItem := ToUpper( cItem,::nCase )                // ADDED   BY RAMESH BABU P on 19-06-2011
           
            if  cItem = ToUpper(cStartTxt, ::nCase)          // ADDED   BY RAMESH BABU P on 19-06-2011
               nLength := len( rtrim( cItem ) )
               cItem   += space( nLength - len(cItem) )
               ::SetText( cItem )
               ::SetSel( nPosCursor -1, nLength) // Select found text
               ::oGet:Buffer = Pad( cItem, Len( ::oGet:Buffer )) // add by:ss-bbs
               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, nCase )

   if nCase = 2
      cString := lower( cString )
   elseif nCase = 3
      cString := proper( cString )
   else
      cString := upper( cString )
   endif

   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 )

//---------------------------------------------------------------------------//
// ADDED BY RAMESH BABU P on 19-06-2011
STATIC FUNCTION proper(cString)

LOCAL point,spot,times,char1,char2,char3,char4,char5

STORE 1 TO point,spot,times
STORE " " TO char1
STORE "." TO char2
STORE "/" TO char3
STORE "-" TO char4
STORE "_" TO char5

* Convert beginning letter of string to Upper Case & last letter to lower case
cString = UPPER(LEFT(cString,1))+LOWER(RIGHT(cString,LEN(cString)-1))

* First capitalise every 1st letter in a word after a space and after a dot
DO WHILE point >0 .AND. times <= 5

   point = AT(char1,SUBSTR(cString,spot,LEN(TRIM(cString))-spot))

   IF point >0
      spot = point + spot
      cString = STUFF(cString,spot,1,UPPER(SUBSTR(cString,spot,1)))
   ELSE
      IF times = 1
         char1 = char2
      ELSEIF times = 2
         char1 = char3
      ELSEIF times = 3
         char1 = char4
      ELSEIF times = 4
         char1 = char5
      ENDIF
      STORE 1 TO  point,spot
      times = times + 1
      IF times >5
           EXIT
      ELSE
          LOOP
      ENDIF
   ENDIF

ENDDO

RETURN cString

//---------------------------------------------------------------------------//

FUNCTION AddNewItem(aItems,cText)

IF ASCAN(aItems,{|x|UPPER(ALLTRIM(x)) == UPPER(ALLTRIM(cText))}) = 0
   AADD(aItems,cText)
ENDIF

RETURN nil
 

Autoget.ch

Code: Select all  Expand view

/*----------------------------------------------------------------------------//
!short: AUTOGET  */

#define CUPPER  1
#define CLOWER  2
#define CPROPER 3

#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>]                    ;  
             [ CASE <nCase> ]                     ;
             [ <lAddNewItem: ADD ITEMS> ]         ;
             [ ALIAS <cAlias> ]                   ;
             [ INDEX <nIndex> ]                   ;
       => ;
          [ <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>, <nCase>, <.lAddNewItem.>,;
             <cAlias> ,<nIndex>)

#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>] ;
            [ CASE <nCase> ] ;
            [ <lAddNewItem: ADD ITEMS> ]          ;
            [ ALIAS <cAlias> ]                   ;
            [ INDEX <nIndex> ]                   ;
       => ;
          [ <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>, <nCase>, <.lAddNewItem.>, ;
             <cAlias> ,<nIndex>)

#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>] ;
            [ CASE <nCase> ] ;
            [ <lAddNewItem: ADD ITEMS> ]        ;
            [ ALIAS <cAlias> ]                   ;
            [ INDEX <nIndex> ]                   ;
       => ;
          [ <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>, <nCase>, <.lAddNewItem.>,;
             <cAlias> ,<nIndex>)

 
 

Regards Maurizio
http://www.nipeservice.com

[RAMESHBABU]

Hi Friends,

One more addtion to TAutoget functionality

Now a New item can be added to the Database also.

Regards,

- Ramesh Babu P

* AUTOGET.PRG - A Test Program

Code: Select all  Expand view

#include "fivewin.ch"
#include "autoget.ch"
#include "xbrowse.ch"
//--------------------------------------------------------------------------------------

FUNCTION main()

LOCAL oDlg, oGet1, oGet2,oSay1, oOk, lOk := .F.
LOCAL cName := space(20)
LOCAL cFunc := space(20)

LOCAL cAl1,cAl2 := ""

   REQUEST DBFCDX
   rddsetdefault( "dbfcdx" )
   REQUEST DBFFPT

   USE CUSTOMER SHARED NEW
   index on  field->FIRST TAG I_TEMP  TO TEMP  TEMPORARY
   cAl1 := alias()
   dbgotop()
   XBROWSE()
   
   USE EJEMPLO1 SHARED NEW
   index on  field->FUNCION TAG I_TEMP  TO TEMP  TEMPORARY
   cAl2 := alias()
   XBROWSE()
   dbgotop()
   

   DEFINE DIALOG oDlg TITLE "Test Autoget from DBF "

   @ 1.2,1.2 SAY oSay1 PROMPT "Name (dbf 1)" oF oDlg

   @ 2.1,1.2 SAY oSay1 PROMPT "Function (dbf 2)" OF oDlg

   @ 1.4,6.1 AUTOGET oGet1 VAR cName OF oDlg SIZE 110,12  CASE CPROPER ALIAS cAl1 INDEX 1 ADD ITEM

   * Custom Function to Add a New Record
   oGet1:bAddNewItem := {||AddNewItem(oGet1)}

   
   @ 2.4,6.1 AUTOGET oGet2 VAR cFunc OF oDlg SIZE 110,12 CASE CUPPER ALIAS cAl2 INDEX 1
   

   @ 3.0,19  BUTTON oOk PROMPT "&Finish" SIZE 35,12 OF oDlg ACTION (lOk := .T., oDlg:End())

   ACTIVATE DIALOG oDlg CENTERED

   
RETURN lOk

**********

FUNCTION AddNewItem(oGet)

local cValue

if alltrim(oGet:oGet:Buffer) = nil
   return nil
endif

select(oGet:calias)
dbgotop()
DbSeek(alltrim(oGet:oGet:Buffer),.t.)

if .not. found()
   DbAppend()
   if .not. NetErr()
      if rlock()
         do case
            case oGet:nCase = 1
                 cValue :=  UPPER(alltrim(oGet:oGet:Buffer))
            case oGet:nCase = 2
                 cValue :=  LOWER(alltrim(oGet:oGet:Buffer))
            case oGet:nCase = 3
                 cValue :=  PROPER(alltrim(oGet:oGet:Buffer))
         endcase      
         replace first with cValue
         dbcommit()
         dbunLock()
         XBROWSER oGet:cAlias // Only for testing
      endif
   endif
endif

RETURN nil

**********

 

* TAUTOGET.PRG - TAutoget Class

Code: Select all  Expand view

// 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.
Functin Proper()                  was added by RAMESH BABU P on 19-06-2011
DATA nCase                        was added by RAMESH BABU P on 19-06-2011
DATA lAddNewItems                 was added by RAMESH BABU P on 20-06-2011
DATA bAddNewItem                  was added by RAMESH BABU P on 25-06-2011

FUNCTION AddNewItem(aItems,cText) was added by RAMESH BABU P on 20-06-2011

* Revisions 24/06/2011
Use DBF File
Method AuroSeek() : Added this method.
DATA cAlias                       was added by Ghirardini Maurizio P on 24-06-2011
DATA nIndex                       was added by Ghirardini Maurizio P on 24-06-2011



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
   DATA nCase AS NUMERIC INIT 3           // 1 UPPER CASE, 2 lower case, 3 Proper Case - Added by RAMESH BABU P
   DATA lAddNewItems AS LOGICAL INIT .T.  // .T. to Add New Items to aItems, .F. Don't Add - Added by RAMESH BABU P
   DATA bAddNewItem                       // was added by RAMESH BABU P on 25-06-2011
   DATA cAlias                            // was added by Ghirardini Maurizio P on 24-06-2011
   DATA nIndex                            // was added by Ghirardini Maurizio P on 24-06-2011

   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 ,;
               nCase   , lAddNewItems ,cAlias, nIndex ) CONSTRUCTOR

   METHOD ReDefine( nID     , bSetGet , oWnd     , nHelpId , cPict, bValid ,;
                    nClrFore, nClrBack, oFont    , oCursor , cMsg , lUpdate,;
                    bWhen   , bChanged, lReadOnly, lSpinner, bUp  , bDown  ,;
                    bMin    , bMax, aItems, nCase, lAddNewItems ,cAlias ,nIndex  ) CONSTRUCTOR
   METHOD SetItems( aItems )
   METHOD AutoFill()
   METHOD Autoseek() // Added by Ghirardini Maurizio P on 24-06-2011  
   
   METHOD LostFocus( hWndGetFocus ) inline ::SetPos(1), ::lAuto := .T., IF(::lAddNewItems,AddNewItem(@::aItems,::cText,::cAlias,::bAddNewItem),) ,::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,  nCase, lAddNewItems,cAlias ,nIndex) CLASS TAutoGet

   local nLen, i

   DEFAULT nCase := 3, lAddNewItems := .T.
   DEFAULT cAlias := ""
   DEFAULT nIndex := 0
   
   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 := {}, )

   ::nCase        := nCase           // Added by RAMESH BABU P
   ::lAddNewItems := lAddNewItems    // Added by RAMESH BABU P
   ::cAlias := cAlias                // Added by Ghirardini Maurizio P on 24-06-2011  
   ::nIndex := nIndex                // Added by Ghirardini Maurizio P on 24-06-2011  
   ::aItems := aItems
     
   IF empty(cAlias)
     ::bPostKey := {|oGet, cBuffer| ::AutoFill()}
   ELSE
     ::bPostKey := {|oGet, cBuffer| ::Autoseek()}
   ENDIF

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  ,;
                nCase, lAddNewItems ,cAlias ,nIndex) CLASS TAutoGet

   DEFAULT nCase := 3, lAddNewItems := .T.
   DEFAULT cAlias := ""
   DEFAULT nIndex := 0


   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 := {}, )

   ::nCase        := nCase           // Added by RAMESH BABU P
   ::lAddNewItems := lAddNewItems    // Added by RAMESH BABU P
   ::cAlias := cAlias                // Added by Ghirardini Maurizio P on 24-06-2011  
   ::nIndex := nIndex                // Added by Ghirardini Maurizio P on 24-06-2011  
   ::aItems := aItems

   IF empty(cAlias)
     ::bPostKey := {|oGet, cBuffer| ::AutoFill()}
   ELSE
     ::bPostKey := {|oGet, cBuffer| ::Autoseek()}
   ENDIF
   

return( Self )

//---------------------------------------------------------------------------//
// Set items of AutoGet
//---------------------------------------------------------------------------//

METHOD SetItems( aItems ) CLASS TAutoGet
   if(aItems == Nil, aItems := {}, )
   ::aItems   := aItems
return( Nil )

//---------------------------------------------------------------------------//
// Set items of AutoGet
//---------------------------------------------------------------------------//

METHOD AutoSeek() CLASS TAutoGet

   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
   Local nOrder  := (::cAlias)->(indexord())
   Local lReturn := .F.

   //-------------------------------------------------------------------------
   // 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. nKey <= 256
         select(::calias)
         dbgotop()
         dbseek(cStartTxt,.t.)
         cItem := &( indexKey() )
         if  cItem = ToUpper(cStartTxt, ::nCase)          // ADDED   BY RAMESH BABU P on 19-06-2011
             nLength := len( rtrim( cItem ) )
             cItem   += space( nLength - len(cItem) )
             ::SetText( cItem )
             ::SetSel( nPosCursor -1, nLength) // Select found text
             ::oGet:Buffer = Pad( cItem, Len( ::oGet:Buffer )) // add by:ss-bbs
             lReturn := .T.
         endif
         (::calias)->(dbsetorder(nOrder))
         IF lReturn
            Return .t.
         ENDIF    
         
         
         ::HideSel()   // Text not found -> Undo selected text
   endcase

Return .t.

//---------------------------------------------------------------------------//
// 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. nKey <= 256
         FOR EACH cItem IN ::aItems
            nPosItem += 1
            //if  ToUpper( cItem )  = ToUpper( cStartTxt )   // REMOVED BY RAMESH BABU P on 19-06-2011
            cItem := ToUpper( cItem,::nCase )                // ADDED   BY RAMESH BABU P on 19-06-2011
           
            if  cItem = ToUpper(cStartTxt, ::nCase)          // ADDED   BY RAMESH BABU P on 19-06-2011
               nLength := len( rtrim( cItem ) )
               cItem   += space( nLength - len(cItem) )
               ::SetText( cItem )
               ::SetSel( nPosCursor -1, nLength) // Select found text
               ::oGet:Buffer = Pad( cItem, Len( ::oGet:Buffer )) // add by:ss-bbs
               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, nCase )

   if nCase = 2
      cString := lower( cString )
   elseif nCase = 3
      cString := proper( cString )
   else
      cString := upper( cString )
   endif

   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 )

//---------------------------------------------------------------------------//
// ADDED BY RAMESH BABU P on 19-06-2011
FUNCTION proper(cString)

LOCAL point,spot,times,char1,char2,char3,char4,char5

STORE 1 TO point,spot,times
STORE " " TO char1
STORE "." TO char2
STORE "/" TO char3
STORE "-" TO char4
STORE "_" TO char5

* Convert beginning letter of string to Upper Case & last letter to lower case
cString = UPPER(LEFT(cString,1))+LOWER(RIGHT(cString,LEN(cString)-1))

* First capitalise every 1st letter in a word after a space and after a dot
DO WHILE point >0 .AND. times <= 5

   point = AT(char1,SUBSTR(cString,spot,LEN(TRIM(cString))-spot))

   IF point >0
      spot = point + spot
      cString = STUFF(cString,spot,1,UPPER(SUBSTR(cString,spot,1)))
   ELSE
      IF times = 1
         char1 = char2
      ELSEIF times = 2
         char1 = char3
      ELSEIF times = 3
         char1 = char4
      ELSEIF times = 4
         char1 = char5
      ENDIF
      STORE 1 TO  point,spot
      times = times + 1
      IF times >5
           EXIT
      ELSE
          LOOP
      ENDIF
   ENDIF

ENDDO

RETURN cString

//---------------------------------------------------------------------------//

STATIC FUNCTION AddNewItem(aItems,cText,cAlias,bAddNewItem)

IF EMPTY(cAlias)
   IF ASCAN(aItems,{|x|UPPER(ALLTRIM(x)) == UPPER(ALLTRIM(cText))}) = 0
      AADD(aItems,cText)
   ENDIF
ELSE
   IF bAddNewItem != nil
      Eval(bAddNewItem)
   ENDIF
ENDIF

RETURN nil
 
//---------------------------------------------------------------------------//

 

* AUTOGET.CH - Autoget Include file

Code: Select all  Expand view

/*----------------------------------------------------------------------------//
!short: AUTOGET  */

#define CUPPER  1
#define CLOWER  2
#define CPROPER 3

#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>]                    ;  
             [ CASE <nCase> ]                     ;
             [ <lAddNewItem: ADD ITEMS> ]         ;
             [ ALIAS <cAlias> ]                   ;
             [ INDEX <nIndex> ]                   ;
       => ;
          [ <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>, <nCase>, <.lAddNewItem.>,;
             <cAlias> ,<nIndex>)

#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>] ;
            [ CASE <nCase> ] ;
            [ <lAddNewItem: ADD ITEMS> ]          ;
            [ ALIAS <cAlias> ]                   ;
            [ INDEX <nIndex> ]                   ;
       => ;
          [ <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>, <nCase>, <.lAddNewItem.>, ;
             <cAlias> ,<nIndex>)

#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>] ;
            [ CASE <nCase> ] ;
            [ <lAddNewItem: ADD ITEMS> ]        ;
            [ ALIAS <cAlias> ]                   ;
            [ INDEX <nIndex> ]                   ;
       => ;
          [ <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>, <nCase>, <.lAddNewItem.>,;
             <cAlias> ,<nIndex>)