- the prompt and result list can be an expression, this means you can combine field in the result and the showed list
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
//------------------------------------------------------------------------------
#include "FiveWin.ch"
//----------------------------------------------------------------------------//
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
DATA lnoBlank // si deseamos que no haya uno en blanco => .T.
DATA bFor // MVG
DATA bOrder // MVG
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, lnoBlank, bFor, border ) CLASS TDBCombo
DEFAULT cAlias := alias(),;
cFldList := "" ,;
cFldItem := "" ,;
aList := {} ,;
aItems := {} ,;
lnoBlank := .F. ,; // MVG
bFor := {|| .T. } // MVG
::lnoBlank := lnoBlank // MVG
::bFor := bFor // MVG
::border := border // MVG
::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, lnoBlank, bFor, border ) CLASS TDBCombo
DEFAULT cAlias := alias(),;
cFldList := "" ,;
cFldItem := "" ,;
aList := {} ,;
aItems := {} ,;
lnoBlank := .F. ,; // MVG
bFor := {|| .T. } // MVG
::lnoBlank := lnoBlank // MVG
::bFor := bFor // MVG
::border := border // MVG
::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
IF ::lnoBlank // MVG
::Select( ::nAt ) // MVG
ENDIF // MVG
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()
::change() // MVG
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| LEFT( upper(x), LEN(::cSearchKey) ) = ::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
LOCAL antord, antarea //MVG
IF ::cAlias == ""
// There's no workarea defined, so do nothing.
RETURN NIL
END IF
IF ( antarea := SELECT( ::cAlias ) ) == 0
MsgAlert( "TDBCombo:Fill() - Alias '" + ::cAlias + "' does not exist." )
RETURN NIL
ELSE // MVG
DBSelectArea( ::cAlias ) //MVG
END IF
::aItems := { }
::aList := { }
IF ::border != NIL // MVG
antord := ( ::cAlias ) -> ( ordSetfocus( ::border ) ) // MVG
ENDIF
//IF (nItem := (::cAlias)->(FIELDPOS( ::cFldItem ))) > 0
// IF (nList := (::cAlias)->(FIELDPOS( ::cFldList ))) > 0
nOldRecNo := (::cAlias)->(RECNO())
// Make first record blank if we want (so you can have an empty field)
IF ! ::lnoBlank // MVG
(::cAlias)->(DBGOBOTTOM())
(::cAlias)->(DBSKIP())
//AADD( ::aItems, (::cAlias)->(FIELDGET( nItem )) )
//AADD( ::aList, (::cAlias)->(FIELDGET( nList )) )
AADD( ::aItems, "" ) // MVG
AADD( ::aList, "" ) // MVG
ENDIF // MVG
(::cAlias)->(DBGOTOP())
DO WHILE ! (::cAlias)->(EOF())
IF Eval( ::bFor ) // MVG
AAdd( ::aItems, &(::cFldItem) )
AAdd( ::aList, &(::cFldList) )
//AADD( ::aItems, (::cAlias)->(FIELDGET( nItem )) )
//AADD( ::aList, (::cAlias)->(FIELDGET( nList )) )
ENDIF
(::cAlias)->(DBSKIP())
ENDDO
(::cAlias)->(DBGOTO( nOldRecNo ))
//ELSE
// msgAlert("TDBCombo:Fill() - Fieldname "+::cFldList+" not found.")
//ENDIF
//ENDIF
IF ::border != NIL // MVG
( ::cAlias ) -> ( ordSetfocus( antord ) ) // MVG
ENDIF // MVG
DBSelectArea( antarea )
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
//----------------------------------------------------------------------------//