Bueno aqui les dejo compaño oporte al foro hice algunos cambios y al parecer funcionan bien espero les sea de ayuda.
esta es la clase.
- 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 REDEFINE DBCOMBO [ <oCbx> VAR ] <cVar> ;
[ <items: ITEMS, PROMPTS> <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> ] ;
[ RECORDSET <oDbrs> ] ;
=> ;
[ <oCbx> := ] TDBCombo():ReDefine( <nId>, bSETGET(<cVar>),;
<aItems>, <oWnd>, <nHelpId>, <{uValid}>, [{|Self|<uChange>}],;
<nClrText>, <nClrBack>, <cMsg>, <.update.>, <{uWhen}>,;
<acBitmaps>, [{|nItem|<uBmpSelect>}], ;
<cAlias>, <cFldItem>, <cFldList>, <aList>, <oDbrs> )
endif
Aqui el programa:
- File Name: DBCombo.prg
- Author: Elliott Whitticar, 71221.1413@Compuserve.com
- Created: 4/25/96
- Description: Database-aware ComboBox class
- Revision: 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.)
- -James Bott, jbott@compuserve.com
//----------------------------------------------------------------------------//
//
// 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.
//
// It overrides the TComboBox class from FiveWin 1.9.1.
//
// If redefining a ComboBox, make sure the ComboBox does not sort aList,
// or DBCombo will not return the matching element of aItems.
//
// As of 4/25/96, the DBCombo class has been tested displaying one column
// from an open work area, and returning another. I have not tried supplying
// two arrays. It could also use the following enhancements:
//
// 1) Display nothing if the bound Set/Get variable is NIL (or an illegal value).
// 2) Add support for an index and/or filter for the table of displayed values.
// 3) Add support for using the same field in the list box as is returned
// (workaround: specify the same field for cFldList and cFldItem).
// 4) It hasn't been tested passing the aItems and aList array without
// specifying any database fields.
// 5) Fix the ::Initiate() method to invoke the TControl:Initiate() method
// from the grandparent TControl class (I just cut/pasted code). [Done 10/2/03]
//----------------------------------------------------------------------------//
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
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 oDbRs AS OBJECT
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, oDbRS ) CONSTRUCTOR
METHOD ReDefine( nId, bSetGet, aItems, oWnd, nHelpId, bValid, ;
bChange, nClrText, nClrBack, cMsg, lUpdate, ;
bWhen, acBitmaps, bDrawItem, ;
cAlias, cFldItem, cFldList, aList , oDbRS) CONSTRUCTOR
METHOD Add( cItem, nAt, cList )
METHOD Default()
METHOD Del( nAt )
METHOD Initiate( hDlg )
METHOD Insert( cItem, nAt, cList )
METHOD LostFocus()
METHOD Modify( cItem, nAt, cList )
METHOD Refill() // Refill aItems and aList from cFldItem and cFldList
METHOD SetItems( aItems, aList )
METHOD DrawItem( nIdCtl, nPStruct )
// VarGet from the parent class returns the selected element of ::aItems
// METHOD VarGet()
// ListGet returns the selected element of ::aList
METHOD ListGet()
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, oDbRs ) CLASS TDBCombo
DEFAULT cAlias := "", ;
cFldList := "", ;
cFldItem := "", ;
aList := {}
::aList := aList
::cAlias := cAlias
::cFldList := cFldList
::cFldItem := cFldItem
::oDbRS := oDbrs
::refill()
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 , oDbrs ) CLASS TDBCombo
DEFAULT cAlias := "", ;
cFldList := "", ;
cFldItem := "", ;
aList := {}
::aList := aList
::cAlias := cAlias
::cFldList := cFldList
::cFldItem := cFldItem
::oDbRs := oDbrs
// msginfo(::oDbRs:oRs:Fields("NomGpo"):Value)
::refill()
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 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( ::aItems, { | cItem | Upper( AllTrim( cItem ) ) == ;
Upper( AllTrim( cStart ) ) } )
else
::nAt = cStart
endif
::nAt = If( ::nAt > 0, ::nAt, 1 )
::Select( ::nAt )
if ::oFont != nil
::SetFont( ::oFont )
else
::SetFont( ::oWnd:oFont )
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 )
//::Refill()
::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 ListGet() CLASS TDBCombo
local cRet, nAt := ::SendMsg( CB_GETCURSEL )
if nAt != CB_ERR
::nAt = nAt + 1
cRet := ::aList[ nAt + 1 ]
else
cRet := GetWindowText( ::hWnd )
endif
return cRet
//----------------------------------------------------------------------------//
METHOD LostFocus() CLASS TDBCombo
local nAt := ::SendMsg( CB_GETCURSEL )
// Super:LostFocus()
if nAt != CB_ERR
::nAt = nAt + 1
if ValType( Eval( ::bSetGet ) ) == "N"
Eval( ::bSetGet, nAt + 1 )
else
Eval( ::bSetGet, ::aItems[ nAt + 1 ] )
endif
else
Eval( ::bSetGet, GetWindowText( ::hWnd ) )
endif
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 Refill() CLASS TDBCombo
// Refill aItems and aList from cAlias->cFldItem and cAlias->cFldList
// Note that we have yet to define an index!
LOCAL nOldRecNo
LOCAL nOldArea := SELECT()
LOCAL nItem, nList
IF ::cAlias == "" .and. Empty(::oDbRs)
// There's no workarea defined, so do nothing
RETURN NIL
END IF
IF Empty( ::cAlias ) .and. Empty(::oDbRS)
MsgInfo( "TDBCombo:Refill() - Alias '" + ::cAlias + "' does not exist." )
RETURN NIL
ELSE
if ! Empty( ::cAlias)
DBSELECTAREA(::cAlias)
endif
ENDIF
::aItems := {}
::aList := {}
if ! Empty( ::cAlias)
IF (nItem := FIELDPOS( ::cFldItem )) > 0
IF (nList := FIELDPOS( ::cFldList )) > 0
nOldRecNo := RECNO()
// Make first record blank
DBGOBOTTOM()
DBSKIP()
AADD( ::aItems, FIELDGET( nItem ) )
AADD( ::aList, FIELDGET( nList ) )
DBGOTOP()
DO WHILE !EOF()
AADD( ::aItems, FIELDGET( nItem ) )
AADD( ::aList, FIELDGET( nList ) )
DBSKIP()
ENDDO
DBGOTO( nOldRecNo )
ELSE
msgInfo("TDBCombo:Refill() - Fieldname "+::cFldList+" not found.")
ENDIF
ENDIF
SELECT (nOldArea)
elseif ! Empty( ::oDbRS)
if ! ::oDbRs:Eof() .and. ! ::oDbRS:Bof()
::oDbRS:GoTop()
else
MsgInfo("La tabla "+ ::oDbRS:cAlias +" Esta basia")
return(.t.)
endif
DO WHILE ! ::oDbRs:EOF()
AADD( ::aItems, ::oDbRs:FieldGet(::oDbRs:FieldPos(::cFldItem)) )
AADD( ::aList, ::oDbRs:FieldGet( ::oDbRs:FieldPos(::cFldList )) )
::oDbRs:Skip(1)
ENDDO
endif
RETURN NIL
//----------------------------------------------------------------------------//
METHOD SetItems( aItems, aList ) CLASS TDbCombo
IF LEN(aItems) != LEN(aList)
MsgInfo( "Invalid args to TDBCombo:SetItems()" )
ELSE
::Reset()
::aItems := aItems
::aList := aList
::Default()
::Change()
END IF
RETURN NIL
dudas o sugenrencias o modificaciones que haga, pasenlas, gracias.
fernando sandoval ruiz
fsandoval@hotmail.com