La clase BrowseGet de Angel Salom me ha dado muchas satisfacciones, es una alternativa a autoget que funcionaba muy bien.
Sin embargo desde esta última versión de Fivewin ( 25.09 ) me da errores:
Atribuyo estos errores a modificaciones del método keydown de la clase tGet de Fivewin.
Agradecería si pudieran revisar estos cambios recientes para ver que ocasiona este problema.
Adjunto la clase Browseget, por si habría que realizar algún cambio en ella.
Estuve mirando la clase tget, pero hay mucho que no entiendo, entre los comentarios que no están ni en español ni en inglés de los cambios y que los mismos son bastantes.
Agradecería cualquier ayuda al respecto.
BrowseGet.ch
#ifndef _BROWSEGET_CH
#define _BROWSEGET_CH
#xcommand REDEFINE BROWSEGET [ <oGet> VAR ] <uVar> ;
[ ID <nId> ] ;
[ <dsrc: ARRAY, HASH, DATASOURCE> <uDataSrc> ];
[ <fil: FILTERLIST, FILTER, LIST> <uFilter> ];
[ <dlg: OF, WINDOW, DIALOG> <oDlg> ] ;
[ <help:HELPID, HELP ID> <nHelpId> ] ;
[ VALID <ValidFunc> ] ;
[ <pict: PICT, PICTURE> <cPict> ] ;
[ <color:COLOR,COLORS> <nClrFore> [,<nClrBack>] ] ;
[ FONT <oFont> ] ;
[ CURSOR <oCursor> ] ;
[ MESSAGE <cMsg> ] ;
[ <update: UPDATE> ] ;
[ WHEN <uWhen> ] ;
[ ON CHANGE <uChange> ] ;
[ <readonly: READONLY, NO MODIFY> ] ;
[ <spin: SPINNER> [ON UP <SpnUp>] [ON DOWN <SpnDn>] [MIN <Min>] [MAX <Max>] ] ;
[ ACTION <uAction> ] ;
[ BITMAP <cBmpName> ] ;
[ LISTHEIGHT <nListHeight> ] ;
[ CUEBANNER <cCueText> ] ;
[ [ <fld: FIELD, COLUMN> ] <xField>] ;
[ ITEMCOLOR <nColorTxt>[,<nColorSel>] ];
[ LISTWIDTH <nListWidth> ];
[ ADAPTAGET <bAdaptaGet>];
=> ;
[ <oGet> := ] TBrowseGet():ReDefine( <nId>, bSETGET(<uVar>), <oDlg>,;
<nHelpId>, <cPict>, <{ValidFunc}>, <nClrFore>, <nClrBack>,;
<oFont>, <oCursor>, <cMsg>, <.update.>, <{uWhen}>,;
[ \{|nKey,nFlags,Self| <uChange> \}], <.readonly.>,;
<.spin.>, <{SpnUp}>, <{SpnDn}>, <{Min}>, <{Max}>, [\{|self| <uAction> \}], <cBmpName>, <"uVar">,;
[<cCueText>], <uDataSrc>, ;
<xField>, <nListHeight>, <nListWidth>, <{bAdaptaGet}>, [\{|uDataSource, cData, Self| <uFilter>\}],;
<nColorTxt>[,<nColorSel>] )
#command @ <nRow>, <nCol> BROWSEGET [ <oGet> VAR ] <uVar> ;
[ <dsrc: ARRAY, HASH, DATASOURCE> <uDataSrc> ];
[ <fil: FILTERLIST, FILTER, LIST> <uFilter> ];
[ <dlg: OF, WINDOW, DIALOG> <oWnd> ] ;
[ <pict: PICT, PICTURE> <cPict> ] ;
[ VALID <ValidFunc> ] ;
[ <color:COLOR,COLORS> <nClrFore> [,<nClrBack>] ] ;
[ SIZE <nWidth>, <nHeight> ] ;
[ HEIGHTLIST <nListHeight> ] ;
[ FONT <oFont> ] ;
[ <design: DESIGN> ] ;
[ CURSOR <oCursor> ] ;
[ <pixel: PIXEL> ] ;
[ MESSAGE <cMsg> ] ;
[ <update: UPDATE> ] ;
[ WHEN <uWhen> ] ;
[ <lCenter: CENTER, CENTERED> ] ;
[ <lRight: RIGHT> ] ;
[ ON CHANGE <uChange> ] ;
[ <readonly: READONLY, NO MODIFY> ] ;
[ <help:HELPID, HELP ID> <nHelpId> ] ;
[ CUEBANNER <cCueText> ] ;
[ [ <fld: FIELD, COLUMN> ] <xField>] ;
[ ITEMCOLOR <nColorTxt>[,<nColorSel>] ];
[ LISTWIDTH <nListWidth> ];
[ ADAPTAGET <bAdaptaGet>];
=> ;
[ <oGet> := ] TBrowseGet():New( <nRow>, <nCol>, bSETGET(<uVar>),;
[<oWnd>], <nWidth>, <nHeight>, <cPict>, <{ValidFunc}>,;
<nClrFore>, <nClrBack>, <oFont>, <.design.>,;
<oCursor>, <.pixel.>, <cMsg>, <.update.>, <{uWhen}>,;
<.lCenter.>, <.lRight.>,;
[\{|nKey, nFlags, Self| <uChange>\}], <.readonly.>,;
.f., .f., <nHelpId>,;
.f., , , , ,,, <"uVar">, [<cCueText>], <uDataSrc>, ;
<xField>, <nListHeight>, <nListWidth> , <{bAdaptaGet}>, [\{|uDataSource, cData, Self| <uFilter>\}],;
<nColorTxt>[,<nColorSel>] )
#endiBrowseget.prg
/* CLASS: TBrowseGet
Permite mostrar una lista de datos desplegable para seleccionar desde un get
Autor: Ángel Salom
*/
#include "fivewin.ch"
#include "browseget.ch"
#define COLOR_CAPTIONTEXT 9
#define BROWSEGETCODIGOCOLUMN 1
#define DEFAULT_GUI_FONT 17
#define BROWSEGETCODIGOCOLUMN 1
#define DATATYPE_HASH 256
CLASS TBrowseGet FROM TGet
DATA nItemTextColor
DATA nItemBackgroundColor
DATA uDataSource
DATA uOrgData
DATA nDataType
DATA xField
DATA oList
DATA bCreateList
DATA nListHeight
DATA nListWidth
DATA bAdaptaGet
METHOD New( ... )
METHOD ReDefine( ... )
METHOD CreateList( uDataSource )
METHOD CloseList()
METHOD KeyChar( nKey, nFlags )
METHOD KeyDown( nKey, nFlags )
METHOD MouseWheel( nKeys, nDelta, nXPos, nYPos )
METHOD SetList( uDataSource, xField ) INLINE ::uDataSource := uDataSource, ::xField := xField
METHOD ValidList() INLINE ( HB_ISOBJECT (::oList) )
END CLASS
//---------------------------------------------------------------------------//
METHOD New( nRow, nCol, bSetGet, oWnd, nWidth, nHeight, cPict, bValid,;
nClrFore, nClrBack, oFont, lDesign, oCursor, lPixel, cMsg,;
lUpdate, bWhen, lCenter, lRight, bChanged, lReadOnly,;
lPassword, lNoBorder, nHelpId, lSpinner,;
bUp, bDown, bMin, bMax, bAction, cBmpName, cVarName, cCueText,;
uDataSrc, xField , nListHeight, nListWidth, bAdaptaGet, bCreateList,;
nItemTextColor, nItemBackgroundColor ) CLASS TBrowseGet
DEFAULT xField := BROWSEGETCODIGOCOLUMN
DEFAULT nListHeight := 300
DEFAULT nListWidth := 500
::xField := xField
::nListHeight := nListHeight
::uDataSource := uDataSrc
::bCreateList := bCreateList
::SetList( uDataSrc, ::xField )
::nItemTextColor := nItemTextColor
::nItemBackgroundColor := nItemBackgroundColor
::nListWidth := nListWidth
::bAdaptaGet := bAdaptaGet
::Super:New(nRow , nCol , bSetGet , oWnd , nWidth , nHeight,;
cPict , bValid , nClrFore , nClrBack , oFont , lDesign,;
oCursor, lPixel , cMsg , lUpdate , bWhen , lCenter,;
lRight , bChanged, lReadOnly, lPassword, lNoBorder, nHelpId,;
lSpinner, bUp , bDown , bMin , bMax )
return ( self )
//---------------------------------------------------------------------------//
METHOD ReDefine( nId, bSetGet, oWnd, nHelpId, cPict, bValid, nClrFore,;
nClrBack, oFont, oCursor, cMsg, lUpdate, bWhen, bChanged,;
lReadOnly, lSpinner, bUp, bDown, bMin, bMax, bAction,;
cBmpName, cVarName, cCueText,;
uDataSrc, xField , nListHeight, nListWidth, bAdaptaGet, bCreateList,;
nItemTextColor, nItemBackgroundColor ) CLASS TBrowseGet
DEFAULT xField := BROWSEGETCODIGOCOLUMN
DEFAULT nListHeight := 300
DEFAULT nListWidth := 300
::xField := xField
::nListHeight := nListHeight
::uDataSource := uDataSrc
::bCreateList := bCreateList
::SetList( uDataSrc, ::xField )
::nItemTextColor := nItemTextColor
::nItemBackgroundColor := nItemBackgroundColor
::nListWidth := nListWidth
::bAdaptaGet := bAdaptaGet
::Super:ReDefine( nId, bSetGet, oWnd, nHelpId, cPict, bValid, nClrFore,;
nClrBack, oFont, oCursor, cMsg, lUpdate, bWhen, bChanged,;
lReadOnly, lSpinner, bUp, bDown, bMin, bMax, bAction,;
cBmpName, cVarName, cCueText )
return ( self )
METHOD CreateList() CLASS TBrowseGet
If ! ::ValidList()
if Len ( ::uDataSource ) > 0
::oList := TBrowseGetList():New( ::nListWidth, ::nListHeight, Self,;
::oFont, ::nItemTextColor, ::nItemBackgroundColor )
::oList:bAdaptaGet:=::bAdaptaGet
::oList:SetList( ::uDataSource, ::xField )
if HB_ISOBJECT (::oList)
::oList:Paint()
endif
::SetFocus()
Endif
Else
::uDataSource := Eval( ::bCreateList, ::uDataSource, AllTrim( ::oGet:Buffer ), Self )
::oList:SetList( ::uDataSource, ::xField )
If Len ( ::oList:aData ) == 0
::uDataSource := ::uOrgData
::oList:end()
::oList = NIL
Else
::oList:Refresh()
::SetFocus()
Endif
Endif
return ( nil )
METHOD CloseList() CLASS TBrowseGet
if ::ValidList()
::oList:End()
endif
return ( nil )
METHOD MouseWheel( nKeys, nDelta, nXPos, nYPos ) CLASS TBrowseGet
local aPos := { nYPos, nXPos }
if ::ValidList()
if nDelta < 0
::oList:GoDown()
else
::oList:GoUp()
endif
endif
return ( nil )
METHOD KeyDown( nKey, nFlags ) CLASS TBrowseGet
if ::ValidList()
switch nKey
case VK_BACK
::CreateList()
return ::Super:KeyDown( nKey, nFlags )
case VK_LEFT
case VK_RIGHT
return ::Super:KeyDown( nKey, nFlags )
exit
case VK_DOWN
::oList:GoDown()
exit
case VK_UP
::oList:GoUp()
endswitch
else
return ::Super:KeyDown( nKey, nFlags )
endif
return ( 0 )
//---------------------------------------------------------------------------//
METHOD KeyChar ( nKey, nFlags ) CLASS TBrowseGet
local nret
switch nKey
case VK_ESCAPE
::CloseList()
return ::Super:KeyChar( nKey, nFlags )
case VK_BACK
nRet = ::Super:KeyChar( nKey, nFlags )
if HB_ISOBJECT ( ::oGet )
if Len ( Alltrim ( ::oGet:Buffer ) ) == 0
::CloseList()
else
::uDataSource := Eval( ::bCreateList, ::uDataSource, AllTrim( ::oGet:Buffer ), Self )
::CreateList()
endif
endif
return nRet
case VK_RETURN
if ::ValidList()
eval ( ::oList:oBrowse:bChange )
::bValid := ::oList:bGetValid
::oList:End()
::oWnd:GoNextCtrl( ::hWnd )
endif
case VK_TAB
if ::ValidList()
eval ( ::oList:oBrowse:bChange )
::bValid := ::oList:bGetValid
::oList:End()
::oWnd:GoNextCtrl( ::hWnd )
endif
case VK_DOWN
return ::Super:KeyChar( nKey, nFlags )
endswitch
nret = ::Super:KeyChar( nKey, nFlags )
if ::oGet:Buffer != nil .and. Len ( Alltrim ( ::oGet:Buffer ) ) > 0
::uOrgData := ::uDataSource
::uDataSource := Eval( ::bCreateList, ::uDataSource, AllTrim( ::oGet:Buffer ), Self )
::CreateList()
endif
return ( nret )
/*
Clase TBrowseGetList
Clase para la TBrowseGet que se encarga de la lista.
Autor: Ángel Salom
*/
CLASS TBrowseGetList
DATA oDlgBrowse
DATA oFont
DATA oBrowse
DATA lReleaseFont INIT .f.
DATA nWidth
DATA nHeight
DATA uOrgValue
DATA nDataType
DATA aData
DATA oGet
DATA bAdaptaGet
DATA bGetValid
DATA bClrSel
DATA bClrSelFocus
DATA bClrStd
METHOD New( nWidth, nHeight, oGet, oFont, nItemTextColor, nItemBackGroundColor )
METHOD SetList( uDataSource, xField )
METHOD Paint()
METHOD Change()
METHOD Refresh()
METHOD GoUp()
METHOD GoDown()
METHOD End()
END CLASS
//---------------------------------------------------------------------------//
METHOD New( nWidth, nHeight, oGet, oFont, nITemTextColor, nItemBackGroundColor ) CLASS TBrowseGetList
::nWidth := nWidth
::nHeight := nHeight
::oGet := oGet
::oFont := oFont
DEFAULT nItemTextColor := nRgb ("#333333")
DEFAULT nItemBackGroundColor := nRgb ("#3399fe")
::bClrStd := {|| { nITemTextColor, nRgb ( '#fffffd' ) } }
::bClrSel := {|| { nRgb ( '#fffffd' ), nItemBackGroundColor } }
::bClrSelFocus := {|| { nRgb ( '#fffffd' ), nItemBackGroundColor } }
If ::oFont == nil
::oFont := TFont():New()
::oFont:hFont := GetStockObject( DEFAULT_GUI_FONT )
::lReleaseFont := .t.
Else
::oFont := oFont
Endif
return Self
METHOD SetList( uDataSource, xField ) CLASS TBrowseGetList
local cType := ValType( uDataSource )
DEFAULT xField := 1
if cType == "A"
::nDataType = DATATYPE_ARRAY
::aData := ::oGet:uDataSource
elseif cType == "H"
::nDataType = DATATYPE_HASH
::aData := ::oGet:uDataSource
endif
if HB_ISOBJECT ( ::oBrowse )
::oBrowse:SetArray ( ::aData )
endif
Return ( nil )
METHOD Paint() CLASS TBrowseGetList
Local aPoint
Local nColumn
aPoint :={ ::oGet:nTop + ::oGet:nHeight, ::oGet:nLeft }
aPoint = ClientToScreen( ::oGet:oWnd:hWnd, aPoint )
::bGetValid := ::oGet:bValid
::oGet:bValid := nil
DEFINE DIALOG ::oDlgBrowse OF ::oGet:oWnd STYLE WS_POPUP ;
SIZE ::nWidth, ::nHeight COLOR CLR_WHITE, CLR_WHITE
::oDlgBrowse:nStyle := nOr (WS_POPUP, WS_BORDER)
ACTIVATE DIALOG ::oDlgBrowse NOWAIT ;
ON INIT ::SetPos( aPoint[ 1 ] , aPoint[ 2 ] )
@ 5, 5 XBROWSE ::oBrowse DATASOURCE ::aData AUTOCOLS ;
SIZE ::oDlgBrowse:nWidth - 10, ::oDlgBrowse:nHeight - 10 OF ::oDlgBrowse PIXEL FONT ::oFont NOBORDER
WITH OBJECT ::oBrowse
:nMarqueeStyle := 5
:lRecordSelector := .F.
:lAllowColSwapping := .F.
:lAllowColHiding := .F.
:lFastDraw := .t.
:lHScroll := .f.
:lVScroll := .f.
:lHeader := .f.
:lFlatStyle := .t.
:nStretchCol := STRETCHCOL_WIDEST
:lColDividerComplete := .t.
:nColDividerStyle := LINESTYLE_LIGHTGRAY
:nMarqueeStyle := MARQSTYLE_HIGHLROW
:lRefreshOnlyData := .F.
:lReadOnly := .t.
:bClrStd := ::bClrStd
:bClrSel := ::bClrSel
:bClrSelFocus := ::bClrSelFocus
:CreateFromCode()
:PostMsg( WM_SETFOCUS )
:bKeyDown := { | nKey | If( nKey == VK_RETURN .OR. nKey == VK_TAB, ::End() , ) }
:bLButtonUp := { | nRow, nCol | ( Eval( ::oBrowse:bChange ),;
::End(),;
::oGet:oWnd:GoNextCtrl( ::oGet:hWnd ) ) }
:bChange := { || ::Change() }
END WITH
WITH OBJECT ::oGet
:oWnd:bMoved := { || ( ::End() ) }
:oWnd:bResized := { || ( ::End() ) }
:oWnd:bLClicked := { || ( ::End() ) }
END WITH
Return ( nil )
METHOD GoDown() CLASS TBrowseGetList
::oBrowse:GoDown()
Return ( nil )
METHOD GoUp() CLASS TBrowseGetList
::oBrowse:GoUp()
Return ( nil )
METHOD Change() CLASS TBrowseGetList
::oGet:VarPut( ::oBrowse:aCols[ ::oGet:xField ]:Value )
if ::bAdaptaGet != NIL
Eval ( ::bAdaptaGet )
endif
::oGet:SetPos( Len ( Alltrim ( ::oGet:cText ) ) + 1 )
::oGet:Refresh()
Return ( nil )
METHOD Refresh() CLASS TBrowseGetList
::oBrowse:Refresh()
return ( nil )
METHOD End() CLASS TBrowseGetList
if HB_ISOBJECT ( ::oBrowse )
::oBrowse:End()
endif
if HB_ISOBJECT ( ::oFont ) .and.;
::lReleaseFont
::oFont:End()
::oFont:=NIL
endif
if HB_ISOBJECT ( ::oDlgBrowse )
::oDlgBrowse:End()
endif
::oGet:oList := nil
::oGet:bValid := ::bGetValid
return ( nil )
//-----------------------------------------//Saludos/Regards,
José Murugosa
"Los errores en programación, siempre están entre la silla, el teclado y la IA!!"
José Murugosa
"Los errores en programación, siempre están entre la silla, el teclado y la IA!!"
