www.FiveTechSoft.com
http://forums.fivetechsoft.com/
Code: Select all
/*
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
//----------------------------------------------------------------------------//
Code: Select all
*********************************************************************
* 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
Code: Select all
/*
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