FiveTech Software tech support forums

Bueno aqui les dejo compaño oporte al foro hice _ 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