Estimado, como la necesidad es la madre de la inventiva, me puse manos a la obra con una clase que emulara el comportamiento de DBCombo, la cual le he puesto RSCOMBO
aca la dejo para quien la necesite. Realmente fue facil, dado qeu dbcombo lo que hace al final y al cambo es tomar los datos de una tabla, y levantarlos en arreglos.
creo que para dolphin sera mas facil aun, cunado tenga tiempo hare la QRYCOMBO
RSCOMBO.CH
RSCOMBO.PRG
aca la dejo para quien la necesite. Realmente fue facil, dado qeu dbcombo lo que hace al final y al cambo es tomar los datos de una tabla, y levantarlos en arreglos.
creo que para dolphin sera mas facil aun, cunado tenga tiempo hare la QRYCOMBO
RSCOMBO.CH
#ifndef _RSCOMBO_CH
#define _RSCOMBO_CH
/*----------------------------------------------------------------------------*/
#xcommand @ <nRow>, <nCol> RSCOMBO [ <oCbx> VAR ] <cVar> ;
[ ITEMS <aItems> ] ;
[ SIZE <nWidth>, <nHeight> ] ;
[ <dlg:OF,WINDOW,DIALOG> <oWnd> ] ;
[ <help:HELPID, HELP ID> <nHelpId> ] ;
[ ON CHANGE <uChange> ] ;
[ VALID <uValid> ] ;
[ <color: COLOR,COLORS> <nClrText> [,<nClrBack>] ] ;
[ <pixel: PIXEL> ] ;
[ FONT <oFont> ] ;
[ <update: UPDATE> ] ;
[ MESSAGE <cMsg> ] ;
[ WHEN <uWhen> ] ;
[ <design: DESIGN> ] ;
[ BITMAPS <acBitmaps> ] ;
[ ON DRAWITEM <uBmpSelect> ] ;
[ RECORDSET <oRS> ] ;
[ ITEMFIELD <cFldItem> ] ;
[ LISTFIELD <cFldList> ] ;
[ <list: LIST, PROMPTS> <aList> ] ;
=> ;
[ <oCbx> := ] TRSCombo():New( <nRow>, <nCol>, bSETGET(<cVar>),;
<aItems>, <nWidth>, <nHeight>, <oWnd>, <nHelpId>,;
[{|Self|<uChange>}], <{uValid}>, <nClrText>, <nClrBack>,;
<.pixel.>, <oFont>, <cMsg>, <.update.>, <{uWhen}>,;
<.design.>, <acBitmaps>, [{|nItem|<uBmpSelect>}], ;
<oRS>, <(cFldItem)>, <(cFldList)>, <aList> )
#xcommand REDEFINE RSCOMBO [ <oCbx> VAR ] <cVar> ;
[ <items: ITEMS> <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> ] ;
[ RECORDSET <oRS> ] ;
[ ITEMFIELD <cFldItem> ] ;
[ LISTFIELD <cFldList> ] ;
[ <list: LIST, PROMPTS> <aList> ] ;
[ <lNoBlank: NOBLANK>] ;
=> ;
[ <oCbx> := ] TRSCombo():ReDefine( <nId>, bSETGET(<cVar>),;
<aItems>, <oWnd>, <nHelpId>, <{uValid}>, [{|Self|<uChange>}],;
<nClrText>, <nClrBack>, <cMsg>, <.update.>, <{uWhen}>,;
<acBitmaps>, [{|nItem|<uBmpSelect>}], ;
<oRS>, <(cFldItem)>, <(cFldList)>, <aList>, <.lNoBlank.> )
#endif
/*----------------------------------------------------------------------------*/
//EOF
/*----------------------------------------------------------------------------*/RSCOMBO.PRG
#include "FiveWin.ch"
#include "Constant.ch"
#define TRUE .t.
#define FALSE .f.
#define COMBO_BASE 320
#define CB_ADDSTRING ( COMBO_BASE + 03 )
#define CB_DELETESTRING ( COMBO_BASE + 04 )
#define CB_GETCURSEL ( COMBO_BASE + 07 )
#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 -01
#define COLOR_WINDOW 5
#define COLOR_WINDOWTEXT 8
#define GWL_STYLE -16
//----------------------------------------------------------------------------//
CLASS TRSCombo FROM TComboBox
DATA oRS
DATA cFldList
DATA cFldItem
DATA aList
DATA cSearchKey
DATA lSound
DATA lNoBlank
METHOD New( nRow, nCol, bSetGet, aItems, nWidth, nHeight, oWnd, nHelpId, ;
bChange, bValid, nClrText, nClrBack, lPixel, oFont, ;
cMsg, lUpdate, bWhen, lDesign, acBitmaps, bDrawItem, ;
oRS, cFldItem, cFldList, aList, lNoBlank ) CONSTRUCTOR
METHOD ReDefine( nId, bSetGet, aItems, oWnd, nHelpId, bValid, ;
bChange, nClrText, nClrBack, cMsg, lUpdate, ;
bWhen, acBitmaps, bDrawItem, ;
oRS, cFldItem, cFldList, aList, lNoBlank ) CONSTRUCTOR
METHOD Add( cItem, nAt, cList )
METHOD Change()
METHOD Default()
METHOD Del( nAt )
METHOD DrawItem( nIdCtl, nPStruct )
METHOD Fill()
METHOD Initiate( hDlg )
METHOD Insert( cItem, nAt, cList )
METHOD KeyChar( nKey, nFlags )
METHOD ListGet()
METHOD LostFocus()
METHOD Modify( cItem, nAt, cList )
METHOD Refill()
METHOD SetItems( aItems, aList, lChanged )
METHOD Update()
METHOD Set( cItem )
ENDCLASS
//----------------------------------------------------------------------------//
METHOD New( nRow, nCol, bSetGet, aItems, nWidth, nHeight, oWnd, nHelpId, ;
bChange, bValid, nClrFore, nClrBack, lPixel, oFont, ;
cMsg, lUpdate, bWhen, lDesign, acBitmaps, bDrawItem, ;
oRS, cFldItem, cFldList, aList, lNoBlank ) CLASS TRSCombo
DEFAULT cFldList := "", ;
cFldItem := "", ;
aList := {}, ;
aItems := {}, ;
lNoBlank := FALSE
::oRS := oRS
::aList := aList
::aItems := aItems
::cFldList := cFldList
::cFldItem := cFldItem
::cSearchKey :=""
::lSound := TRUE
::lNoBlank := lNoBlank
IF Empty( ::aItems ) .and. Empty( ::aList )
::Fill()
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, ;
oRS, cFldItem, cFldList, aList, lNoBlank ) CLASS TRSCombo
DEFAULT cFldList := "", ;
cFldItem := "", ;
aList := {}, ;
aItems := {}, ;
lNoBlank := FALSE
::oRS := oRS
::aList := aList
::aItems := aItems
::cFldList := cFldList
::cFldItem := cFldItem
::cSearchKey := ""
::lSound := TRUE
::lNoBlank := lNoBlank
IF Empty( ::aItems ) .and. Empty( ::aList )
::Fill()
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 TRSCombo
DEFAULT nAt := 0, ;
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 Change() CLASS TRSCombo
LOCAL cItem := ::GetText()
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 )
Eval( ::bSetGet, ::aItems[ ::nAt ] )
ENDIF
IF !Empty( ::oGet:hWnd )
::oGet:VarPut( Eval( ::bSetGet ) )
::oGet:Refresh()
ENDIF
IF ::nAt != 0 .and. !HB_IsNil( ::bChange )
Eval( ::bChange, Self, ::aItems[ ::nAt ] )
ENDIF
RETURN NIL
//----------------------------------------------------------------------------//
METHOD Default() CLASS TRSCombo
LOCAL cStart := Eval( ::bSetGet )
IF !Empty( ::hWnd ) .and. ::nStyle == CBS_DROPDOWNLIST
::nStyle := GetWindowLong( ::hWnd, GWL_STYLE )
ENDIF
IF HB_IsNil( cStart )
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 !HB_IsNumeric( cStart )
::nAt := AScan( ::aList, { | cList | Upper( AllTrim( cList ) ) == ;
Upper( AllTrim( cStart ) ) } )
ELSE
::nAt := cStart
ENDIF
::nAt := IIf( ::nAt > 0, ::nAt, 1 )
IF HB_IsNil( cStart )
::Select( ::nAt )
ELSE
::Set( cStart )
ENDIF
IF ::lNoBlank
::Select( ::nAt )
ENDIF
RETURN NIL
//----------------------------------------------------------------------------//
METHOD Del( nAt ) CLASS TRSCombo
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 TRSCombo
RETURN LbxDrawItem( nPStruct, ::aBitmaps, ::aList, ::nBmpWidth, ::bDrawItem )
//----------------------------------------------------------------------------//
METHOD Initiate( hDlg ) CLASS TRSCombo
::TControl():Initiate( hDlg )
::Default()
RETURN NIL
//----------------------------------------------------------------------------//
METHOD Insert( cItem, nAt, cList ) CLASS TRSCombo
DEFAULT nAt := 0, ;
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 TRSCombo
LOCAL nNewAT := 0
LOCAL nOldAT := ::nAT
IF nKey == 32
::cSearchKey := ""
::Set( IIf( HB_IsNumeric( Eval( ::bSetGet ) ), 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 ::lSound
Tone( 60, 0.3 )
ENDIF
::Set( IIf( HB_IsNumeric( Eval( ::bSetGet ) ), nNewAt, ::aItems[ nNewAt ] ) )
IF !HB_IsNil( ::bChange )
IF !HB_IsNil( ::oGet )
::oGet:VarPut( Eval( ::bSetGet ) )
::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
//----------------------------------------------------------------------------//
METHOD ListGet() CLASS TRSCombo
LOCAL cRet
LOCAL nAt := ::SendMsg( CB_GETCURSEL )
IF nAt != CB_ERR
::nAt := nAt + 1
cRet := ::aList[ ::nAt ]
ELSE
cRet := GetWindowText( ::hWnd )
ENDIF
RETURN cRet
//----------------------------------------------------------------------------//
METHOD LostFocus() CLASS TRSCombo
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 TRSCombo
DEFAULT nAt := 0, ;
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 TRSCombo
LOCAL oField
LOCAL nOldRecNo
LOCAL nItem := -1
LOCAL nList := -1
IF HB_IsNil( ::oRS )
MsgAlert( "TSRCombo:No definio un objeto recordset." )
RETURN NIL
ELSE
IF ::oRS:Fields:Count == 0
MsgAlert( "TRSCombo:El recordset no tiene campos definidos." )
RETURN NIL
ENDIF
ENDIF
::aItems := {}
::aList := {}
FOR EACH oField IN ::oRS:FIELDS
IF oField:Name == ::cFldItem
nItem := HB_EnumIndex()
ENDIF
IF oField:Name == ::cFldList
nList := HB_EnumIndex()
ENDIF
NEXT
IF nItem >= 0
IF nList >= 0
IF !::lNoBlank
AAdd( ::aItems, 0 )
AAdd( ::aList , "" )
ENDIF
nOldRecNo := ::oRS:AbsolutePosition
::oRS:MoveFirst()
DO WHILE ! ::oRS:Eof()
AAdd( ::aItems, ::oRS:FIELDS( ::cFldItem ):Value )
AAdd( ::aList , ::oRS:FIELDS( ::cFldList ):Value )
::oRS:MoveNext()
ENDDO
::oRS:AbsolutePosition := nOldRecNo
ENDIF
ENDIF
RETURN NIL
//----------------------------------------------------------------------------//
METHOD Refill() CLASS TRSCombo
::Reset()
::Fill()
::Default()
::Change()
RETURN NIL
//----------------------------------------------------------------------------//
METHOD Set( cItem ) CLASS TRSCombo
LOCAL nAt
IF HB_IsString( cItem )
nAt := AScan( ::aItems, { | c | Upper( c ) == Upper( cItem ) } )
ELSE
nAt := AScan( ::aItems, { | c | c == cItem } )
ENDIF
IF nAt != 0
::Select( nAt )
ELSE
SetWindowText( ::hWnd, cItem )
ENDIF
RETURN NIL
//----------------------------------------------------------------------------//
METHOD SetItems( aItems, aList, lChanged ) CLASS TRSCombo
DEFAULT lChanged := TRUE
IF Len( aItems ) != LEN( aList )
MsgAlert( "TRSCombo:SetItems(): aItems y aList deben tener la misma longitud." )
ELSE
::Reset( lChanged )
::aItems := aItems
::aList := aList
::Default()
IF lChanged
::Change()
ENDIF
ENDIF
RETURN NIL
//----------------------------------------------------------------------------//
METHOD Update() CLASS TRSCombo
LOCAL bChange := ::bChange
::bChange := NIL
::Reset()
::Fill()
::Default()
::bChange := bChange
RETURN NIL
//----------------------------------------------------------------------------//
//EOF
//----------------------------------------------------------------------------//Salu2
Carlos Vargas
Desde Managua, Nicaragua (CA)
Carlos Vargas
Desde Managua, Nicaragua (CA)
