/*
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 // MVGreturn 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 TDBCombo
return LbxDrawItem
( nPStruct, ::
aBitmaps, ::
aList, ::
nBmpWidth, ::
bDrawItem )//----------------------------------------------------------------------------//METHOD Initiate
( hDlg
) CLASS TDbCombo
::
TControl():
Initiate( hDlg
) ::
Default() ::
change() // MVGRETURN 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|
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 ) 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
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
IFRETURN NIL//----------------------------------------------------------------------------//METHOD Update() CLASS TDBCombo
local bChange:= ::
bChange ::
bChange:=
Nil ::
Reset() ::
Fill() ::
Default() ::
bChange := bChange
return nil//----------------------------------------------------------------------------//