DBCombo para ADO - RSCOMBO (nueva clase)

Post Reply
User avatar
carlos vargas
Posts: 1721
Joined: Tue Oct 11, 2005 5:01 pm
Location: Nicaragua

DBCombo para ADO - RSCOMBO (nueva clase)

Post 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
//----------------------------------------------------------------------------//
 
Salu2
Carlos Vargas
Desde Managua, Nicaragua (CA)
Top
User avatar
leandro
Posts: 1744
Joined: Wed Oct 26, 2005 2:49 pm
Location: Colombia
Has thanked: 34 times
Been thanked: 10 times
Contact:
Contact leandro

Re: DBCombo para ADO - RSCOMBO (nueva clase)

Post by leandro »

Carlos Muchas Gracias por el Aporte.

De casualidad tienes un ejemplo para saber como funciona.
Saludos
LEANDRO AREVALO
Bogotá (Colombia)
https://hymlyma.com
https://hymplus.com/
leandroalfonso111@gmail.com
leandroalfonso111@hotmail.com

[ Turbo Incremental Link64 6.98 Embarcadero 7.70 ] [ FiveWin 24.09 ] [ xHarbour 64 bits) ]
Top
User avatar
Antonio Linares
Site Admin
Posts: 42520
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Has thanked: 31 times
Been thanked: 75 times
Contact:
Contact Antonio Linares

Re: DBCombo para ADO - RSCOMBO (nueva clase)

Post by Antonio Linares »

Carlos,

Muchas gracias por tu aporte! :-)
regards, saludos

Antonio Linares
www.fivetechsoft.com
Top
User avatar
Armando
Posts: 3271
Joined: Fri Oct 07, 2005 8:20 pm
Location: Toluca, México
Been thanked: 2 times
Contact:
Contact Armando

Re: DBCombo para ADO - RSCOMBO (nueva clase)

Post by Armando »

Carlos:

Excelente aporte, Gracias !

Saludos
SOI, s.a. de c.v.
estbucarm@gmail.com
http://www.soisa.mex.tl/
http://sqlcmd.blogspot.com/
Tel. (722) 174 44 45
Carpe diem quam minimum credula postero
Top
User avatar
checo176
Posts: 83
Joined: Wed Apr 20, 2011 3:08 pm

Re: DBCombo para ADO - RSCOMBO (nueva clase)

Post by checo176 »

Carlos muy bueno tu por el Aporte.

Tienes un ejemplo para saber como funciona.

Un abrazo
Sergio Vacarezza S.
Programador Freelance
sergio@vacarezza.cl
Santiago, Chile

Harbour 3.2.0dev (r2006301601) - FWH 22.03 - MariaDB - FivEdit
Top
User avatar
carlos vargas
Posts: 1721
Joined: Tue Oct 11, 2005 5:01 pm
Location: Nicaragua

Re: DBCombo para ADO - RSCOMBO (nueva clase)

Post 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

 
Salu2
Carlos Vargas
Desde Managua, Nicaragua (CA)
Top
User avatar
karinha
Posts: 7935
Joined: Tue Dec 20, 2005 7:36 pm
Location: São Paulo - Brasil
Been thanked: 3 times
Contact:
Contact karinha

Re: DBCombo para ADO - RSCOMBO (nueva clase)

Post by karinha »

Buén dia, RSCOMBO, funciona com .DBF?

Gracias, saludos.
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
Top
User avatar
carlos vargas
Posts: 1721
Joined: Tue Oct 11, 2005 5:01 pm
Location: Nicaragua

Re: DBCombo para ADO - RSCOMBO (nueva clase)

Post by carlos vargas »

LOL.
Salu2
Carlos Vargas
Desde Managua, Nicaragua (CA)
Top
User avatar
joseluisysturiz
Posts: 2064
Joined: Fri Jan 06, 2006 9:28 pm
Location: Guatire - Caracas - Venezuela
Contact:
Contact joseluisysturiz

Re: DBCombo para ADO - RSCOMBO (nueva clase)

Post 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:
Dios no está muerto...

Gracias a mi Dios ante todo!
Top
User avatar
leandro
Posts: 1744
Joined: Wed Oct 26, 2005 2:49 pm
Location: Colombia
Has thanked: 34 times
Been thanked: 10 times
Contact:
Contact leandro

Re: DBCombo para ADO - RSCOMBO (nueva clase)

Post 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
Saludos
LEANDRO AREVALO
Bogotá (Colombia)
https://hymlyma.com
https://hymplus.com/
leandroalfonso111@gmail.com
leandroalfonso111@hotmail.com

[ Turbo Incremental Link64 6.98 Embarcadero 7.70 ] [ FiveWin 24.09 ] [ xHarbour 64 bits) ]
Top
User avatar
joseluisysturiz
Posts: 2064
Joined: Fri Jan 06, 2006 9:28 pm
Location: Guatire - Caracas - Venezuela
Contact:
Contact joseluisysturiz

Re: DBCombo para ADO - RSCOMBO (nueva clase)

Post 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:
Dios no está muerto...

Gracias a mi Dios ante todo!
Top
User avatar
leandro
Posts: 1744
Joined: Wed Oct 26, 2005 2:49 pm
Location: Colombia
Has thanked: 34 times
Been thanked: 10 times
Contact:
Contact leandro

Re: DBCombo para ADO - RSCOMBO (nueva clase)

Post 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
Saludos
LEANDRO AREVALO
Bogotá (Colombia)
https://hymlyma.com
https://hymplus.com/
leandroalfonso111@gmail.com
leandroalfonso111@hotmail.com

[ Turbo Incremental Link64 6.98 Embarcadero 7.70 ] [ FiveWin 24.09 ] [ xHarbour 64 bits) ]
Top
User avatar
carlos vargas
Posts: 1721
Joined: Tue Oct 11, 2005 5:01 pm
Location: Nicaragua

Re: DBCombo para ADO - RSCOMBO (nueva clase)

Post 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
 
Salu2
Carlos Vargas
Desde Managua, Nicaragua (CA)
Top
User avatar
carlos vargas
Posts: 1721
Joined: Tue Oct 11, 2005 5:01 pm
Location: Nicaragua

Re: DBCombo para ADO - RSCOMBO (nueva clase)

Post by carlos vargas »

cualquier cosa leandro me puedes contactar, para que lo veamos por teamviewer
Salu2
Carlos Vargas
Desde Managua, Nicaragua (CA)
Top
User avatar
joseluisysturiz
Posts: 2064
Joined: Fri Jan 06, 2006 9:28 pm
Location: Guatire - Caracas - Venezuela
Contact:
Contact joseluisysturiz

Re: DBCombo para ADO - RSCOMBO (nueva clase)

Post 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:
Dios no está muerto...

Gracias a mi Dios ante todo!
Top
Post Reply

Return to “FiveWin para Harbour/xHarbour”