FiveTech Software tech support forums

www.FiveTechSoft.com
https://fivetechsupport.com/forums/

DBCombo para ADO - RSCOMBO (nueva clase)

https://fivetechsupport.com/forums/viewtopic.php?t=28938

Page 1 of 1

DBCombo para ADO - RSCOMBO (nueva clase)

Posted: Sat Jul 26, 2014 8:29 pm
by carlos vargas
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

Code: Select all | Expand


#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

Code: Select all | Expand


#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
//----------------------------------------------------------------------------//
 

Re: DBCombo para ADO - RSCOMBO (nueva clase)

Posted: Sun Jul 27, 2014 2:11 am
by leandro
Carlos Muchas Gracias por el Aporte.

De casualidad tienes un ejemplo para saber como funciona.

Re: DBCombo para ADO - RSCOMBO (nueva clase)

Posted: Sun Jul 27, 2014 9:43 am
by Antonio Linares
Carlos,

Muchas gracias por tu aporte! :-)

Re: DBCombo para ADO - RSCOMBO (nueva clase)

Posted: Sun Jul 27, 2014 3:48 pm
by Armando
Carlos:

Excelente aporte, Gracias !

Saludos

Re: DBCombo para ADO - RSCOMBO (nueva clase)

Posted: Mon Jul 28, 2014 12:59 pm
by checo176
Carlos muy bueno tu por el Aporte.

Tienes un ejemplo para saber como funciona.

Un abrazo

Re: DBCombo para ADO - RSCOMBO (nueva clase)

Posted: Mon Jul 28, 2014 2:58 pm
by carlos vargas

Code: Select all | Expand


PROCEDURE Fami_Agregar( lNuevo )
   PRIVATE oDlgEF
   PRIVATE nNumeroF, cNombreF, dFechaNacF, cGeneroF, lCasadoF, nNumTiFa, ;
           nNumPaisF, nNumClasF, nNumEstaF, ;
           nNumTiidF, cNumTiidF, ;
           cNumRegF, dFecEmiRegF, dFecVenRegF
   PRIVATE oRS_TIFA, oRS_PAIS, oRS_TIID, oRS_CLAS, oRS_ESTA, oRS_CTRL

   oRS_TIFA := FW_OpenRecordSet( oConn, "SELECT NUM_TIFA, NOMBRE FROM TIPO_FAMILIAR   ORDER BY NUM_TIFA" )
   oRS_PAIS := FW_OpenRecordSet( oConn, "SELECT NUM_PAIS, NOMBRE FROM PAISES          ORDER BY NUM_PAIS" )
   oRS_TIID := FW_OpenRecordSet( oConn, "SELECT NUM_TIID, NOMBRE FROM TIPOS_IDEN      ORDER BY NUM_TIID" )
   oRS_CLAS := FW_OpenRecordSet( oConn, "SELECT NUM_CLAS, NOMBRE FROM CLASIFICACIONES ORDER BY NUM_CLAS" )
   oRS_ESTA := FW_OpenRecordSet( oConn, "SELECT NUM_ESTA, NOMBRE FROM ESTADOS         ORDER BY NUM_ESTA" )
   oRS_CTRL := FW_OpenRecordSet( oConn, "SELECT TOP 1 CONT_FAMI FROM CONTROL" )

   IF HB_IsNil( oRS_TIFA ) .or. HB_IsNil( oRS_PAIS ) .or. ;
      HB_IsNil( oRS_TIID ) .or. HB_IsNil( oRS_CLAS ) .or. ;
      HB_IsNil( oRS_ESTA ) .or. HB_IsNil( oRS_CTRL )
      FW_CloseRecordSet( { oRS_TIFA, oRS_PAIS, oRS_TIID, oRS_CLAS, oRS_ESTA, oRS_CTRL } )
      RETURN
   ENDIF

   IF lNuevo
      nNumeroF     := oRS_CTRL:Fields( "CONT_FAMI" ):Value + 1
      cNombreF     := Space( 40 )
      dFechaNacF   := CToD("")
      cGeneroF     := aGeneros[ 01 ]
      lCasadoF     := FALSE
      nNumTiFa     := 0
      nNumPaisF    := 0
      nNumTiidF    := 0
      cNumTiidF    := Space( 30 )
      nNumClasF    := 0
      nNumEstaF    := 0
      cNumRegF     := Space( 20 )
      dFecEmiRegF  := CToD( "" )
      dFecVenRegF  := CToD( "" )
   ELSE
      nNumeroF     := oRSFam:Fields( "NUM_FAMI"   ):Value
      cNombreF     := oRSFam:Fields( "NOMBRE"     ):Value
      dFechaNacF   := ttodate( oRSFam:Fields( "FECHA_NACI" ):Value )
      cGeneroF     := oRSFam:Fields( "GENERO"     ):Value
      lCasadoF     := oRSFam:Fields( "CASADO"     ):Value
      nNumTiFa     := oRSFam:Fields( "NUM_TIFA"   ):Value
      nNumPaisF    := oRSFam:Fields( "NUM_PAIS"   ):Value
      nNumTiidF    := oRSFam:Fields( "NUM_TIID"   ):Value
      cNumTiidF    := oRSFam:Fields( "NUM_DOCID"  ):Value
      nNumClasF    := oRSFam:Fields( "NUM_CLAS"   ):Value
      nNumEstaF    := oRSFam:Fields( "NUM_ESTA"   ):Value
      cNumRegF     := oRSFam:Fields( "NUMREG"     ):Value
      dFecEmiRegF  := ttodate( oRSFam:Fields( "NUMREG_FE"  ):Value )
      dFecVenRegF  := ttodate( oRSFam:Fields( "NUMREG_FV"  ):Value )
   ENDIF

   DEFINE DIALOG oDlgEF NAME "DLG_FAMIE" OF oDlgF ICON GetIcon() FONT oFontD

   REDEFINE GET nNumeroF ;
      ID 101 OF oDlgEF ;
      WHEN FALSE

   REDEFINE GET cNombreF ;
      ID 102 OF oDlgEF ;
      PICTURE "@!" ;
      VALID Validar_NoVacio( cNombreF, "Introdusca nombre del familiar." )

   REDEFINE GET dFechaNacF ;
      ID 103 OF oDlgEF ;
      PICTURE "@D"

   REDEFINE COMBOBOX cGeneroF ;
      ID 104 OF oDlgEF ;
      ITEMS aGeneros

   REDEFINE CHECKBOX lCasadoF ;
      ID 105 OF oDlgEF

   REDEFINE RSCOMBO nNumTiFa ;
      ID 106 OF oDlgEF ;
      RECORDSET oRS_TIFA  ;
      ITEMFIELD "NUM_TIFA" ;
      LISTFIELD "NOMBRE"

   REDEFINE RSCOMBO nNumPaisF ;
      ID 107 OF oDlgEF ;
      RECORDSET oRS_PAIS  ;
      ITEMFIELD "NUM_PAIS" ;
      LISTFIELD "NOMBRE"

   REDEFINE RSCOMBO nNumTiidF ;
      ID 108 OF oDlgEF ;
      RECORDSET oRS_TIID  ;
      ITEMFIELD "NUM_TIID" ;
      LISTFIELD "NOMBRE"

   REDEFINE GET cNumTiidF ;
      ID 109 OF oDlgEF ;
      PICTURE "@!" ;
      WHEN nNumTiidF > 0

   REDEFINE RSCOMBO nNumClasF ;
      ID 110 OF oDlgEF ;
      RECORDSET oRS_CLAS ;
      ITEMFIELD "NUM_CLAS" ;
      LISTFIELD "NOMBRE"

   REDEFINE RSCOMBO nNumEstaF ;
      ID 111 OF oDlgEF ;
      RECORDSET oRS_ESTA ;
      ITEMFIELD "NUM_ESTA" ;
      LISTFIELD "NOMBRE"

   REDEFINE GET cNumRegF ;
      ID 112 OF oDlgEF  ;
      PICTURE "@!"

   REDEFINE GET dFecEmiRegF ;
      ID 113 OF oDlgEF ;
      PICTURE "@D"

   REDEFINE GET dFecVenRegF ;
      ID 114 OF oDlgEF ;
      PICTURE "@D"

   REDEFINE BUTTON ;
      ID 201 OF oDlgEF ;
      WHEN !Empty( cNombreF ) ;
      ACTION IIf( Fami_Grabar( lNuevo ), oDlgEF:END(), NIL )

   REDEFINE BUTTON ;
      ID 202 OF oDlgEF ;
      ACTION oDlgEF:END() ;
      CANCEL

   ACTIVATE DIALOG oDlgEF

   FW_CloseRecordSet( { oRS_TIFA, oRS_PAIS, oRS_TIID, oRS_CLAS, oRS_ESTA, oRS_CTRL } )

RETURN

 

Re: DBCombo para ADO - RSCOMBO (nueva clase)

Posted: Fri Jun 26, 2015 1:11 pm
by karinha
Buén dia, RSCOMBO, funciona com .DBF?

Gracias, saludos.

Re: DBCombo para ADO - RSCOMBO (nueva clase)

Posted: Fri Jun 26, 2015 4:29 pm
by carlos vargas
LOL.

Re: DBCombo para ADO - RSCOMBO (nueva clase)

Posted: Mon Sep 04, 2017 9:41 pm
by joseluisysturiz
Saludos, alguien ha probado esta clase de Carlos y sabra si hace la busqueda secuencial asi como el SAY en el xBrowse.? necesito usar DBCOMBO pero con busqueda secuencial, trabajo con MySQL y TDolphin por los momentos, algunas ideas y sugerencias que sea usando la DBCOMBO no estan de mas, saludos...gracias... :shock:

Re: DBCombo para ADO - RSCOMBO (nueva clase)

Posted: Tue Sep 05, 2017 7:43 pm
by leandro
Hola carlos buenas tardes.... estuve probando tu clase ... pero tengo un problema. Logre realizar la compilación y no me arroja ningún tipo de error. Pero no funciona :shock:

Al dar clic sobre el dbcombo no sale nada.

Code: Select all | Expand



 oVar:="SELECT codig,descr from lyma_nlistado order by codig "
 oConsZZ := FW_OPENRECORDSET(oCon,oVar)

   REDEFINE RSCOMBO nNumTiFa ;
      ID 4003 OF oFld2:aDialogs[ 4 ] ;
      RECORDSET oConsZZ  ;
      ITEMFIELD "codig" ;
      LISTFIELD "NOMBRE"

 


No se si tenga que ver con la definición del recurso...

Saludos

Re: DBCombo para ADO - RSCOMBO (nueva clase)

Posted: Tue Sep 05, 2017 10:37 pm
by joseluisysturiz
leandro wrote:Hola carlos buenas tardes.... estuve probando tu clase ... pero tengo un problema. Logre realizar la compilación y no me arroja ningún tipo de error. Pero no funciona :shock:

Al dar clic sobre el dbcombo no sale nada.

Code: Select all | Expand



 oVar:="SELECT codig,descr from lyma_nlistado order by codig "
 oConsZZ := FW_OPENRECORDSET(oCon,oVar)

   REDEFINE RSCOMBO nNumTiFa ;
      ID 4003 OF oFld2:aDialogs[ 4 ] ;
      RECORDSET oConsZZ  ;
      ITEMFIELD "codig" ;
      LISTFIELD "NOMBRE"

 


No se si tenga que ver con la definición del recurso...

Saludos


Saludos, revisa que veo que en el select llamas al campo descr, pero en el LISTFIELD "NOMBRE", no se si eso tendra algo que ver con que no te muestre nada, estas usando ADO o MYSQL.? necesito usar la clase pero con busqueda de secuencial usando mysql, como la estas manejando.? saludos...gracias... :shock:

Re: DBCombo para ADO - RSCOMBO (nueva clase)

Posted: Wed Sep 06, 2017 4:10 pm
by leandro
Como vas Jose Luis

Gracias por responder....

Apenas ayer me entro la curiosidad con esta clase, quería saber que ventajas tenia, pero la verdad es hasta ahora no he logrado hacerla andar. Por otro lado, ya había intentado lo que mencionas pero sin resultado positivo, ahora mas tarde que me quede un tiempo le pego una checada mas a fondo.

Saludos

Re: DBCombo para ADO - RSCOMBO (nueva clase)

Posted: Wed Sep 06, 2017 8:38 pm
by carlos vargas
Estimados,
La clase en si no es gran cosa, simplemente es una copia de la original dbcombo de fw,
la cual lo que hace es que en el metodo que se encarga de llenar los datos recorre la base de datos y pasa los datos a un array,
esa es la funcion de dbcombo.
Ahora aca lo que hice fue reemplazar el recorrido de la tabla por un recorrido de una consulta ado.

Code: Select all | Expand


METHOD Fill() CLASS TRSCombo
   LOCAL oField
   LOCAL nOldRecNo
   LOCAL nItem := -1
   LOCAL nList := -1
   LOCAL x

   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 x := 1 TO ::oRS:Fields:COUNT
      IF ::oRS:Fields( x - 1 ):Name == ::cFldItem
         nItem := x
      ENDIF
      IF ::oRS:Fields( x - 1 ):Name == ::cFldList
         nList := x
      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
 

Re: DBCombo para ADO - RSCOMBO (nueva clase)

Posted: Wed Sep 06, 2017 8:40 pm
by carlos vargas
cualquier cosa leandro me puedes contactar, para que lo veamos por teamviewer

Re: DBCombo para ADO - RSCOMBO (nueva clase)

Posted: Thu Sep 07, 2017 2:20 am
by joseluisysturiz
Carlos, gracias por comentar, lo que mas me interesa sobre la clase o sobre la TDbCombo es que se haga una busqueda secuencial, veo que guiandonos por tu cambio hacia ADO se puede adaptar a SQL, pero en mi caso lo necesario es LA BUSQUEDA SECUENCIAL, asi como lo hace el SAY en el xBrowse...saludos...gracias... :shock:
All times are UTC
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited