/*
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 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 // ROS DATA cOrder
// Order with Alias //RenOmaS DATA lBlank AS LOGICAL
INIT .T.
// Adicionar una linea em blanko DATA lDouble AS LOGICAL
INIT .F.
// para mostrar los dos campos DATA lFieldNumeric AS LOGICAL
INIT .F.
//field de Items e numerico DATA bPreEdit
// bloque antes de edicion con F3-- utilizo F3 para llamar uma function DATA bPostEdit
// bloque para evaluar por cada reg adicionado //ROS 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, lChanged
) METHOD Update() //ROS METHOD Set
() METHOD FillAlias
() METHOD FillObject
() METHOD Change() //ROSENDCLASS//----------------------------------------------------------------------------//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, cOrder, lBlank
) CLASS TDBCombo
//ROS DEFAULT cAlias :=
alias(), ;
cFldList :=
"", ;
cFldItem :=
"", ;
aList :=
{},;
aItems :=
{}, ;
lBlank := .T.
//ROS ::
aList := aList
::
aItems := aItems
::
cAlias := cAlias
::
cFldList := cFldList
::
cFldItem := cFldItem
::
cSearchKey:=
'' ::
cOrder := cOrder
//ROS ::
lBlank := lBlank
//ROS 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, cOrder, lBlank, lDouble
) CLASS TDBCombo
//ROS DEFAULT cAlias :=
alias(), ;
cFldList :=
"", ;
cFldItem :=
"", ;
aList :=
{}, ;
aItems :=
{}, ;
lBlank := .T., ;
//ROS lDouble := .F.
//ROS ::
aList := aList
::
aItems := aItems
::
cAlias := cAlias
::
cFldList := cFldList
::
cFldItem := cFldItem
::
cSearchKey:=
'' ::
cOrder := cOrder
//ROS ::
lBlank := lBlank
//ROS ::
lDouble := lDouble
//ROS 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 ) // ROS para asignar a la variable por defecto el primar valor If !::
lBlank //ROS If Empty
( cStart
) Eval
( ::
bSetGet, ::
VarGet() ) EndIf EndIf // 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 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
) 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 //ROS If ::
lFieldNumeric ::
Set( ::
aItems[ nNewAt
] ) else//ROS ::
Set( If( ValType
( Eval
( ::
bSetGet ) ) ==
"N", nNewAt, ::
aItems[ nNewAt
] ) ) endif //ROS 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 Empty
( ::
cAlias ) //ROS == "" // There's no workarea defined, so do nothing. RETURN NIL END
IF //ROS If ValType
( ::
cAlias ) ==
'O' //Solo hacemos esto cuando es un Objeto DATABASE ::
FillObject() Else //ROS IF SELECT( ::
cAlias ) ==
0 MsgAlert
( "TDBCombo:Fill() - Alias '" + ::
cAlias +
"' does not exist." ) RETURN NIL END
IF //ROS ::
FillAlias() EndIf //ROSRETURN NIL//----------------------------------------------------------------------------//METHOD Refill
() CLASS TDBCombo
::
Reset() ::
Fill() ::
Default() ::
Change()return nil//----------------------------------------------------------------------------//METHOD SetItems
( aItems, aList, lChanged
) CLASS TDbCombo
DEFAULT lChanged := .T.
IF LEN
(aItems
) != LEN
(aList
) MsgAlert
( "TDBCombo:SetItems(): aItems and aList must be same length." ) ELSE ::
cAlias:=
"" ::
Reset(lChanged
) // lChanged parameter passed to Reset() ::
aItems := aItems
::
aList := aList
::
Default() if lChanged
::
Change() endif END
IFRETURN NIL//----------------------------------------------------------------------------//METHOD Update() CLASS TDBCombo
local bChange:= ::
bChange ::
bChange:=
Nil ::
Reset() ::
Fill() ::
Default() ::
bChange := bChange
return nil//----------------------------------------------------------------------------////ROSMETHOD Set
( cNewItem
) CLASS TDBCombo
Local nAt :=
0 if ValType
( cNewItem
) ==
"N" nAt = cNewItem
if nAt ==
0 nAt =
1 endif else //ROS //que sejam texto. If Len
( ::
aItems) >
0 .and. Valtype
( ::
aItems[ 1 ] ) ==
'C' nAt = AScan
( ::
aItems,;
{ | cItem | Upper
( AllTrim
( cItem
) ) == ;
Upper
( AllTrim
( cNewItem
) ) } ) EndIf endif If ValType
( cNewItem
) ==
"N" .or. nAt !=
0 //ROS 24.9.12 If ::
lFieldNumeric nAt = AScan
( ::
aItems,;
{ | cItem | cItem == cNewItem
} ) ::
nAt := nAt
EndIf //ROS ::
Select( nAt
) If Eval
( ::
bSetGet ) != cNewItem
Eval
( ::
bSetGet, cNewItem
) EndIf Else cNewItem := cValToChar
( cNewItem
) If Eval
( ::
bSetGet ) != cNewItem
Eval
( ::
bSetGet, cNewItem
) EndIf SetWindowText
( ::
hWnd , cNewItem
) //ROS If Empty
( cNewItem
) // ROS para cuando es blanko ::
SendMsg( CB_SETCURSEL,
-1,
0 ) EndIf //ROS Endif Return nil//----------------------------------------------------------------------------//METHOD FillObject
() CLASS TDbCombo
LOCAL nOldRecNo
LOCAL nItem, nList
Local cOldOrder
//RoS Local oDbf := ::
cAlias //RoS Local oClon, bValid, uVar
//RoS //funcion F3 para llama a edicion , caso de append //el objeto oDbf tiene que tener um metodo Edit que trata de la adicion de un registros If ::
bKeyDown ==
Nil //Solo cuando es NIL ::
bKeyDown :=
{ | nKey |
If( nKey == VK_F3, ;
( If( ::
bPreEdit !=
Nil, Eval
( ::
bPreEdit,
Self ),
), ;
oClon := oClone
( oDbf
), ;
oClon:
SetBuffer( .T.
), ;
oClon:
Blank(), ;
// ::cOrder ), ; bValid := ::
bValid, ;
::
bValid :=
nil, ;
::
oWnd:
nLastKey :=
0, ;
uVar := oClon:
Edit( .T., ::
oWnd ), ;
If( !Empty
( uVar
), ;
//Actualizando cuando agregamos ( oDbf:
Requery(), ;
//para o caso os que tem cquery ::
Update(), ;
Eval
( ::
bSetGet, uVar
), ;
::
Refresh(), ;
If( ::
bChange !=
Nil, Eval
( ::
bChange,
Self, uVar
),
) ),
), ;
::
bValid := bValid
),
) } EndIf // ::
aItems :=
{} ::
aList :=
{} If ( nItem := oDbf:
FieldPos( ::
cFldItem ) ) >
0 If ( nList := oDbf:
FieldPos( ::
cFldList ) ) >
0 If oDbf:
RecCount() >
0 nOldRecNo := oDbf:
RecNo() EndIf If !Empty
( ::
cOrder ) cOldOrder := oDbf:
SetOrder( ::
cOrder ) EndIf If ValType
( oDbf:
FieldGet( nItem
) ) ==
'N' ::
lFieldNumeric := .T.
EndIf // Make first record blank (so you can have an empty field) If ::
lBlank If ::
lFieldNumeric AAdd
( ::
aItems,
0 ) Else AAdd
( ::
aItems,
'' ) EndIf AAdd
( ::
aList,
'') EndIf oDbf:
GoTop() If Empty
( ::
bPostEdit ) If ::
lDouble Do While !oDbf:
Eof() uVar := oDbf:
FieldGet( nItem
) AAdd
( ::
aItems, uVar
) //quando e numerico If ValType
( uVar
) ==
'N' uVar := Str
( uVar
) EndIf AAdd
( ::
aList, Alltrim
( uVar
) +
' ' + ;
oDbf:
FieldGet( nList
) ) oDbf:
Skip() EndDo Else // Do While !oDbf:
Eof() AAdd
( ::
aItems, oDbf:
FieldGet( nItem
) ) AAdd
( ::
aList, oDbf:
FieldGet( nList
) ) oDbf:
Skip() ENDDO EndIf Else Do While !oDbf:
Eof() AAdd
( ::
aItems, oDbf:
FieldGet( nItem
) ) AAdd
( ::
aList, Eval
( ::
bPostEdit,
Self, oDbf
) ) oDbf:
Skip() EndDo EndIf If !Empty
( cOldOrder
) oDbf:
SetOrder( cOldOrder
) EndIf If !Empty
( nOldRecno
) oDbf:
Goto( nOldRecNo
) EndIf Else MsgAlert
( 'TDBCombo:Fill() - Fieldname ' + ::
cFldList +
' not found.' ) EndIf EndIf Return Nil//----------------------------------------------------------------------------//METHOD FillAlias
() CLASS TDbCombo
LOCAL nOldRecNo
LOCAL nItem, nList
::
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 Change() CLASS TDbCombo
local cItem := ::
GetText() // Current Value local nAt
nAt = ::
SendMsg( CB_GETCURSEL
) +
1 if nAt == ::
nAt .and. ! Empty
( Eval
( ::
bSetGet ) ) return nil endif ::
nAt := nAt
if ::
nAt !=
0 .and. ::
nAt <= Len
( ::
aItems ) if ValType
( Eval
( ::
bSetGet ) ) ==
"N" //ROS If ::
lFieldNumeric Eval
( ::
bSetGet, ::
aItems[ ::
nAt ] ) Else //ROS Eval
( ::
bSetGet, ::
nAt ) EndIf //ROS else Eval
( ::
bSetGet, ::
aItems[ ::
nAt ] ) endif endif if ::
oGet !=
nil // Always not nil for dropdown ::
oGet:
VarPut( Eval
( ::
bSetGet ) ) // udate variable before calling bChange ::
oGet:
Refresh() endif if ::
bChange !=
nil Eval
( ::
bChange,
Self, cItem
) endifreturn nil//----------------------------------------------------------------------------// 
