FiveTech Software tech support forums

/*
File Name:   DBCombo.prg
Author:      Elliott Whitticar, 71221.1413@Compuserve.com
Created:     4/25/96
Description: Database-aware ComboBox class. Can show one field and return another.
Revision:    Changes made by James Bott, Intellitech. jbott@compuserve.com
             11/2/2003 Changed manifest constants to also be 32bit compatible.
                       Initiate(): Changed to call TControl:initiate()
                       New() & Redefine() : Changed to return self (were incorrectly returning nil).
                       Refill() - Now adds blank record to all lists. (Was incorrectly showing first
                       item when variable was empty.)
             5/21/2004 Added keyChar method with incremental search. Space key resets search.
                       Of course, data has to be in sort order.
             6/14/2005 Changed to default cAlias to alias().
                       Refill() Changed name to Fill(). Added new method Refill().
                       Had to do this to properly reinitialize the control when refilled.
             6/15/2005 Updated the Default() method to fix some bugs (dropdown not working
                       after Refill(). Changed dbcombo.ch to allow specifying fields with
                       or without guotes. E.G. ITEMFIELD city or ITEMFIELD "city"
             7/21/2005 Fixed bug. When using autocomplete was returning numeric instead of char.
             2/23/2006 Fixed several bugs when passing arrays from the new or redefine methods.
             2/24/2006 LostFocus() Modified so aItems can be numeric.
             3/31/2006 KeyChar() Fixed bug when both bChanged and lUpdate were used.
             04/3/2006 Refill() Fixed typo.
             7/02/2006 Update() Added new method. Slightly different than Refill(). - Antonio Linares

//----------------------------------------------------------------------------//
Notes

The TDBCombo class provides a combo-box which displays one field from
a table (such as DeptName) and returns another (such as DeptID). Table can
be indexed and/or filtered, just set them before calling DBCombo.

To use dbcombo as a resource, define the resource as a combobox. Make sure the ComboBox
is not configured to sort aList, or DBCombo will not return the matching element of aItems.
Then REDEFINE the combobox control as a DBCOMBO.

aList must be character. aItems can be character or numeric.


*/
//----------------------------------------------------------------------------//



#include "FiveWin.ch"
#include "Constant.ch"

#ifndef __CLIPPER__
   #define COMBO_BASE      320
#else
   #define COMBO_BASE  WM_USER
#endif
#define CB_ADDSTRING     ( COMBO_BASE + 3 )
#define CB_DELETESTRING  ( COMBO_BASE +  4 )
#define CB_GETCURSEL     ( COMBO_BASE +  7 )
#define CB_INSERTSTRING  ( COMBO_BASE + 10 )
#define CB_RESETCONTENT  ( COMBO_BASE + 11 )
#define CB_FINDSTRING    ( COMBO_BASE + 12 )
#define CB_SETCURSEL     ( COMBO_BASE + 14 )
#define CB_SHOWDROPDOWN  ( COMBO_BASE + 15 )
#define CB_ERR              -1

#define COLOR_WINDOW       5
#define COLOR_WINDOWTEXT   8

#define MB_ICONEXCLAMATION  48   // 0x0030

#define GWL_STYLE          -16

#ifdef __XPP__
#define Super ::TComboBox
#endif


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


CLASS TDBCombo FROM TComboBox

   DATA  cAlias      // Workarea alias for fields to display.
   DATA  cFldList    // Field to display in the ComboBox.
   DATA  cFldItem    // Field to return in the bound variable.
   DATA  aList       // Array of display items corresponding to aItems.
                     // May be specified in the constructor or read from
                     // cAlias->cFldList
   DATA cSearchKey   // Holds current search key for incremental search.
   DATA lSound init .T. // Use sound

   METHOD New( nRow, nCol, bSetGet, aItems, nWidth, nHeight, oWnd, nHelpId, ;
              bChange, bValid, nClrText, nClrBack, lPixel, oFont, ;
              cMsg, lUpdate, bWhen, lDesign, acBitmaps, bDrawItem, ;
              cAlias, cFldItem, cFldList, aList ) CONSTRUCTOR

   METHOD ReDefine( nId, bSetGet, aItems, oWnd, nHelpId, bValid, ;
              bChange, nClrText, nClrBack, cMsg, lUpdate, ;
              bWhen, acBitmaps, bDrawItem, ;
              cAlias, cFldItem, cFldList, aList ) CONSTRUCTOR

   METHOD Add( cItem, nAt, cList )

   METHOD Default()

   METHOD Del( nAt )

   METHOD DrawItem( nIdCtl, nPStruct )

   METHOD Fill()  // Fill aItems, aList from database. Used internally only.

   METHOD Initiate( hDlg )

   METHOD Insert( cItem, nAt, cList )

   METHOD KeyChar( nKey, nFlags )     // Incremental search

   METHOD ListGet()                   // Returns the selected element of ::aList

   METHOD LostFocus()

   METHOD Modify( cItem, nAt, cList )

   METHOD Refill()                    // Refill aItems and aList from cFldItem and cFldList

   METHOD SetItems( aItems, aList )

   METHOD Update()

ENDCLASS

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

METHOD New( nRow, nCol, bSetGet, aItems, nWidth, nHeight, oWnd, nHelpId, ;
            bChange, bValid, nClrFore, nClrBack, lPixel, oFont, ;
            cMsg, lUpdate, bWhen, lDesign, acBitmaps, bDrawItem, ;
            cAlias, cFldItem, cFldList, aList ) CLASS TDBCombo

   DEFAULT cAlias := alias(), ;
           cFldList := "", ;
           cFldItem := "", ;
           aList := {},;
           aItems:= {}

   ::aList    := aList
   ::aItems   := aItems
   ::cAlias   := cAlias
   ::cFldList := cFldList
   ::cFldItem := cFldItem
   ::cSearchKey:=""
   if empty(::aItems) .and. empty(::aList)
      ::Fill()
   else
      ::cAlias:=""
   endif

   Super:New( nRow, nCol, bSetGet, ::aItems, nWidth, nHeight, oWnd, nHelpId, ;
      bChange, bValid, nClrFore, nClrBack, lPixel, oFont, ;
      cMsg, lUpdate, bWhen, lDesign, acBitmaps, bDrawItem )

return self

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

METHOD ReDefine( nId, bSetGet, aItems, oWnd, nHelpId, bValid, ;
                 bChange, nClrFore, nClrBack, cMsg, lUpdate, ;
                 bWhen, acBitmaps, bDrawItem, ;
                 cAlias, cFldItem, cFldList, aList ) CLASS TDBCombo

   DEFAULT cAlias := alias(), ;
         cFldList := "", ;
         cFldItem := "", ;
         aList := {},;
         aItems:= {}

   ::aList    := aList
   ::aItems   := aItems
   ::cAlias   := cAlias
   ::cFldList := cFldList
   ::cFldItem := cFldItem
   ::cSearchKey:=""
   if empty(::aItems) .and. empty(::aList)
      ::Fill()
   else
      ::cAlias:=""
   endif

   Super:ReDefine( nId, bSetGet, ::aItems, oWnd, nHelpId, bValid, ;
               bChange, nClrFore, nClrBack, cMsg, lUpdate, ;
               bWhen, acBitmaps, bDrawItem )

return self

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

METHOD Add( cItem, nAt, cList ) CLASS TDBCombo
   // Note that compared to the parent class, we've added an arg at the end.

   DEFAULT nAt := 0
   DEFAULT cList := cItem

   if nAt == 0
     AAdd( ::aItems, cItem )
     AAdd( ::aList,  cList )
   else
     ASize( ::aItems, Len( ::aItems ) + 1 )
     ASize( ::aList, Len( ::aList ) + 1 )
     AIns( ::aItems, nAt )
     AIns( ::aList, nAt )
     ::aItems[ nAt ] = cItem
     ::aList[ nAt ] = cList
   endif

   ::SendMsg( CB_ADDSTRING, nAt, cList )

return nil

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

METHOD Default() CLASS TDBCombo

   local cStart := Eval( ::bSetGet )
   if ! Empty( ::hWnd ) .and. ::nStyle == CBS_DROPDOWNLIST
      ::nStyle := GetWindowLong( ::hWnd, GWL_STYLE )
   endif

   if cStart == nil
      Eval( ::bSetGet, If( Len( ::aItems ) > 0, ::aItems[ 1 ], "" ) )
      cStart = If( Len( ::aItems ) > 0, ::aItems[ 1 ], "" )
   endif

   AEval( ::aList, { | cList, nAt | ::SendMsg( CB_ADDSTRING, nAt, cList ) } )

   if ValType( cStart ) != "N"
      ::nAt = AScan( ::aList, { | cList | Upper( AllTrim( cList ) ) == ;
                                           Upper( AllTrim( cStart ) ) } )
   else
      ::nAt = cStart
   endif

   ::nAt = If( ::nAt > 0, ::nAt, 1 )

   if cStart == nil
      ::Select( ::nAt )
   else
      ::Set( cStart )
   endif

return nil

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

METHOD Del( nAt ) CLASS TDBCombo

   DEFAULT nAt := 0

   if nAt != 0
      ADel( ::aItems, nAt )
      ADel( ::aList, nAt )
      ASize( ::aItems, Len( ::aItems ) - 1 )
      ASize( ::aList, Len( ::aList ) - 1 )
      ::SendMsg( CB_DELETESTRING, nAt - 1 )
   endif

return nil

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

METHOD DrawItem( nIdCtl, nPStruct ) CLASS TDBCombo

return LbxDrawItem( nPStruct, ::aBitmaps, ::aList, ::nBmpWidth, ::bDrawItem )

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

METHOD Initiate( hDlg ) CLASS TDbCombo

   ::TControl():Initiate( hDlg )
   ::Default()

RETURN NIL

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

METHOD Insert( cItem, nAt, cList ) CLASS TDBCombo

   DEFAULT nAt := 0
   DEFAULT cList := cItem

   if nAt != 0
      ASize( ::aItems, Len( ::aItems ) + 1 )
      ASize( ::aList, Len( ::aList ) + 1 )
      AIns( ::aItems, nAt )
      AIns( ::aList, nAt )
      ::aItems[ nAt ] = cItem
      ::aList[ nAt ] = cList
      ::SendMsg( CB_INSERTSTRING, nAt - 1, cList )
   endif

return nil

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

METHOD KeyChar( nKey, nFlags) CLASS TDBCombo

   local nNewAT := 0, nOldAT:=::nAT

   // Incremental search
   if nKey = 32   // space resets the search
      ::cSearchKey := ""
      ::Set( If( ValType( Eval( ::bSetGet ) ) == "N", 1, ::aItems[ 1 ] ) )
   else
      if nKey = VK_BACK
         ::cSearchKey := left(::cSearchKey,Len(::cSearchKey)-1)
      else
         ::cSearchKey += upper(chr(nKey))
      endif

      nNewAT := ascan(::aList, {|x| upper(x) = ::cSearchKey} )

      if nNewAt != nOldAt .and. nNewAT != 0  // If found and changed

         if ::lSound
            tone(60,.3) // sound if searchkey found
         endif

         ::Set( If( ValType( Eval( ::bSetGet ) ) == "N", nNewAt, ::aItems[ nNewAt ] ) )

         if ::bChange != nil

            if ::oGet != nil                        // Always not nil for dropdown
               ::oGet:VarPut( Eval( ::bSetGet ) )   // udate variable before calling bChange
               ::oGet:Refresh()
            endif

            Eval( ::bChange, Self, ::varGet() )

         endif
         return 0

      else
         ::cSearchKey := left(::cSearchKey,Len(::cSearchKey)-1)
      endif
   endif

   Super:KeyChar(nKey, nFlags)

RETURN 0   // Must be 0 - We don't want API default behavior.

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

METHOD ListGet() CLASS TDBCombo

   local cRet, nAt := ::SendMsg( CB_GETCURSEL )

   if nAt != CB_ERR
      ::nAt = nAt + 1
      cRet :=  ::aList[ ::nAt ]
   else
      cRet := GetWindowText( ::hWnd )
   endif

return cRet

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

METHOD LostFocus() CLASS TDBCombo

   local nAt := ::SendMsg( CB_GETCURSEL )

   if nAt != CB_ERR
      ::nAt = nAt + 1
      Eval( ::bSetGet, ::aItems[ ::nAt ] )
   else
      Eval( ::bSetGet, GetWindowText( ::hWnd ) )
   endif

   ::cSearchKey:=""

return nil

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

METHOD Modify( cItem, nAt, cList ) CLASS TDBCombo

   DEFAULT nAt := 0
   DEFAULT cList := cItem

   if nAt != 0
      ::aItems[ nAt ] = cItem
      ::aList[ nAt ] = cList
      ::SendMsg( CB_DELETESTRING, nAt - 1 )
      ::SendMsg( CB_INSERTSTRING, nAt - 1, cList )
   endif

return nil

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

METHOD Fill() CLASS TDBCombo

   // Refill aItems and aList from cAlias->cFldItem and cAlias->cFldList

   LOCAL nOldRecNo
   LOCAL nItem, nList

   IF ::cAlias == ""
      // There's no workarea defined, so do nothing.
      RETURN NIL
   END IF

   IF SELECT( ::cAlias ) == 0
      MsgAlert( "TDBCombo:Fill() - Alias '" + ::cAlias + "' does not exist." )
      RETURN NIL
   END IF

   ::aItems := {}
   ::aList := {}

   IF (nItem := (::cAlias)->(FIELDPOS( ::cFldItem ))) > 0
      IF (nList := (::cAlias)->(FIELDPOS( ::cFldList ))) > 0

         nOldRecNo := (::cAlias)->(RECNO())

         // Make first record blank (so you can have an empty field)
         (::cAlias)->(DBGOBOTTOM())
         (::cAlias)->(DBSKIP())
         AADD( ::aItems, (::cAlias)->(FIELDGET( nItem )) )
         AADD( ::aList, (::cAlias)->(FIELDGET( nList )) )

         (::cAlias)->(DBGOTOP())

         DO WHILE ! (::cAlias)->(EOF())
            AADD( ::aItems, (::cAlias)->(FIELDGET( nItem )) )
            AADD( ::aList, (::cAlias)->(FIELDGET( nList )) )
            (::cAlias)->(DBSKIP())
         ENDDO

         (::cAlias)->(DBGOTO( nOldRecNo ))

      ELSE
         msgAlert("TDBCombo:Fill() - Fieldname "+::cFldList+" not found.")
      ENDIF
   ENDIF

RETURN NIL

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

METHOD Refill() CLASS TDBCombo
   ::Reset()
   ::Fill()
   ::Default()
   ::Change()
return nil

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

METHOD SetItems( aItems, aList ) CLASS TDbCombo

   IF LEN(aItems) != LEN(aList)
      MsgAlert( "TDBCombo:SetItems(): aItems and aList must be same length." )
   ELSE
      ::cAlias:= ""
      ::Reset()
      ::aItems := aItems
      ::aList := aList
      ::Default()
      ::Change()
   END IF

RETURN NIL

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

METHOD Update() CLASS TDBCombo

   local bChange:= ::bChange

   ::bChange:= Nil
   ::Reset()
   ::Fill()
   ::Default()
   ::bChange := bChange

return nil

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

*********************************************************************
* File Name:    DBCombo.ch
* Author:   Elliott Whitticar
* Created:  04/23/96
* Description:  Preprocessor directives for TDBCombo class.
*********************************************************************
#ifndef _DBCOMBO_CH
#define _DBCOMBO_CH

/*----------------------------------------------------------------------------//
!short: DBCOMBO */

#xcommand @ <nRow>, <nCol> DBCOMBO [ <oCbx> VAR ] <cVar> ;
             [ ITEMS <aItems> ] ;
             [ SIZE <nWidth>, <nHeight> ] ;
             [ <dlg:OF,WINDOW,DIALOG> <oWnd> ] ;
             [ <help:HELPID, HELP ID> <nHelpId> ] ;
             [ ON CHANGE <uChange> ] ;
             [ VALID <uValid> ] ;
             [ <color: COLOR,COLORS> <nClrText> [,<nClrBack>] ] ;
             [ <pixel: PIXEL> ] ;
             [ FONT <oFont> ] ;
             [ <update: UPDATE> ] ;
             [ MESSAGE <cMsg> ] ;
             [ WHEN <uWhen> ] ;
             [ <design: DESIGN> ] ;
             [ BITMAPS <acBitmaps> ] ;
             [ ON DRAWITEM <uBmpSelect> ] ;
             [ ALIAS <cAlias> ] ;
             [ ITEMFIELD <cFldItem> ] ;
             [ LISTFIELD <cFldList> ] ;
             [ <list: LIST, PROMPTS> <aList> ] ;
       => ;
          [ <oCbx> := ] TDBCombo():New( <nRow>, <nCol>, bSETGET(<cVar>),;
             <aItems>, <nWidth>, <nHeight>, <oWnd>, <nHelpId>,;
             [{|Self|<uChange>}], <{uValid}>, <nClrText>, <nClrBack>,;
             <.pixel.>, <oFont>, <cMsg>, <.update.>, <{uWhen}>,;
             <.design.>, <acBitmaps>, [{|nItem|<uBmpSelect>}], ;
             <cAlias>, <(cFldItem)>, <(cFldList)>, <aList> )

#xcommand REDEFINE DBCOMBO [ <oCbx> VAR ] <cVar> ;
             [ <items: ITEMS> <aItems> ] ;
             [ ID <nId> ] ;
             [ <dlg:OF,WINDOW,DIALOG> <oWnd> ] ;
             [ <help:HELPID, HELP ID> <nHelpId> ] ;
             [ ON CHANGE <uChange> ] ;
             [ VALID   <uValid> ] ;
             [ <color: COLOR,COLORS> <nClrText> [,<nClrBack>] ] ;
             [ <update: UPDATE> ] ;
             [ MESSAGE <cMsg> ] ;
             [ WHEN <uWhen> ] ;
             [ BITMAPS <acBitmaps> ] ;
             [ ON DRAWITEM <uBmpSelect> ] ;
             [ ALIAS <cAlias> ] ;
             [ ITEMFIELD <cFldItem> ] ;
             [ LISTFIELD <cFldList> ] ;
             [ <list: LIST, PROMPTS> <aList> ] ;
       => ;
          [ <oCbx> := ] TDBCombo():ReDefine( <nId>, bSETGET(<cVar>),;
             <aItems>, <oWnd>, <nHelpId>, <{uValid}>, [{|Self|<uChange>}],;
             <nClrText>, <nClrBack>, <cMsg>, <.update.>, <{uWhen}>,;
             <acBitmaps>, [{|nItem|<uBmpSelect>}], ;
             <cAlias>, <(cFldItem)>, <(cFldList)>, <aList> )

#endif
 

/*
Program : DBC1.PRG
Purpose : Test DBCombo
Notes   :
*/

#include "fivewin.ch"
#include "dbcombo.ch"


function main()
   local oDlg, oDBC1, oDBC2, cVar, oCust, cStateID:="  ", oBtn, cState:=""
   local cDept:= space(3), oStates, aItems, aList
   field NAME

   if file("states.dbf")
      use states
      index on upper(NAME) to temp
      database oStates
   else
      msgInfo("File states.dbf not found.")
   endif

   define dialog oDlg

   @ 10,30 dbcombo oDBC1 var cStateID of oDlg;
      alias oStates:cAlias;
      size 100,200 pixel;
      itemfield "CODE" ;
      listfield "NAME";
      update;

   aList:= {"Accounting","HR","Marketing","Production","Research","Shipping","Sales"}
   aItems:= {"100","200","400","300","600","500","700"}

   @ 30,30 DBCOMBO oDBC2 VAR cDept;
      items aItems;
      size 100,200 pixel;
      list aList;
      of oDlg;
      update


   @ 50, 50 button oBtn prompt "Selected";
      of oDlg pixel ;
      action msgInfo( "cStateId: " +cStateID +CRLF+"DeptNo: "+cDept,"Selected" );
      default

   activate dialog oDlg center;

   ferase("temp.ntx")

return nil

// EOF