Combobox and database

[pawelu]

Antonio,

Is this possible to use combobox control with database alias (one or more character fields) where items are read from database ?

Thanks
Pawel

[Antonio Linares]

Pawel,

In FWH there is a Class TDbCombo where items are read from a DBF.

If you want it, we can email it to you, so you can test it with FWPPC. It should work

[pawelu]

Antonio,

Yes, please.

Thanks
Pawel

[Antonio Linares]

Already sent

[rasptty]

No tenho a classe TDbCombo, dá para enviar um exemplo,, como utilizar essa classe com uma tabela .dbf

Obrigado

Sérgio Gonçalves

[Antonio Linares]

Sergio,

Here you have it,

dbcombo.prg

Code: Select all | Expand

/*File Name:   DBCombo.prgAuthor:      Elliott Whitticar, 71221.1413@Compuserve.comCreated:     4/25/96Description: 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//----------------------------------------------------------------------------//NotesThe TDBCombo class provides a combo-box which displays one field froma table (such as DeptName) and returns another (such as DeptID). Table canbe 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 ComboBoxis 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 )   endifreturn 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 )   endifreturn nil//----------------------------------------------------------------------------//METHOD DrawItem( nIdCtl, nPStruct ) CLASS TDBComboreturn 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 )   endifreturn 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 )   endifreturn 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 )   endifreturn 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   ENDIFRETURN 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 IFRETURN NIL//----------------------------------------------------------------------------//METHOD Update() CLASS TDBCombo   local bChange:= ::bChange   ::bChange:= Nil   ::Reset()   ::Fill()   ::Default()   ::bChange := bChangereturn nil//----------------------------------------------------------------------------// 

[rasptty]

pederias me enviar um exemplo como utilizar esta classe
ex. tabela1.dbf

Obrigado

[Antonio Linares]

DbCombo.ch is also required:

DbCombo.ch

Code: Select all | Expand

********************************************************************** 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 

[Antonio Linares]

This is an example for FWH, and it should work for FWPPC too:

test.prg

Code: Select all | Expand

/*Program : DBC1.PRGPurpose : Test DBComboNotes   :*/#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 

[rasptty]

Dá o seguinte erro:
error LNK2001: unresolved external symbol HB_FUN_TDBCOMBO

Sérgio