Te envié a tu correo mi versión de twbrowse, Tiene habilitado los mensajes al editar una línea, espero que guste con el fín de unificar la clase
- Code: Select all Expand view
- METHOD lEditCol( nCol, uVar, cPicture, bValid, nClrFore, nClrBack,;
aItems, bAction, bOnInit, bOnCreate,cMessage,bButAction, lNextControl )
.
.
.
.
//----------------------------------------------------------------------------//
METHOD lEditCol( nCol, uVar, cPicture, bValid, nClrFore, nClrBack,;
aItems, bAction, bOnInit, bOnCreate,cMessage,cButAction, lNextControl ) CLASS TWBrowse
local oDlg, oGet, oFont, oBtn, oBtnAction
local nWidth := ::aColSizes[ nCol ]
local uTemp
local aDim
local lOk
local cType
LOCAL uJustify, lValid:= .f.
LOCAL bInit
local nDif
local lButAction :=.f.,bButAction // angel blanco
LOCAL nColorCol, oLbx:= Self, bValid2 // CeSoTech
LOCAL bOldValid
DEFAULT nCol := ::nColAct,;
bAction:= {|| .T. },;
bOnInit:= {|| .T. },;
cMessage :="" ,;
bButaction:={|| nil} ,;
lNextControl:= .T. // fjhg para brincar al siguiente control cuando es registro nuevo
IF PCOUNT()>=12 // ESTO ES PARTICULAR ANGEL
lButAction:=.t. // ESTO ES PARTICULAR ANGEL
bButAction:={|| CONSULTA(oGet, cButaction ,oDlg)} // ESTO ES PARTICULAR ANGEL
ENDIF // ESTO ES PARTICULAR ANGEL
If nClrFore == Nil
If "B"$Valtype( ::bTextColor ) .and. ;
"N"$Valtype( nColorCol:= Eval( ::bTextColor, ::nRowPos, nCol ) )
nClrFore:= nColorCol
Else
nClrFore := ::nClrText
EndIf
EndIf
If nClrBack == Nil
If "B"$Valtype( ::bBkColor ) .and. ;
"N"$Valtype( nColorCol:= Eval( ::bBkColor, ::nRowPos, nCol ) )
nClrBack:= nColorCol
Else
nClrBack := ::nClrPane
EndIf
EndIf
// CeSoTech // -> Si son bloques de codigo habia RTError
If "B"$ValType( nClrFore )
nClrFore:= Eval( nClrFore )
EndIf
If "B"$ValType( nClrBack )
nClrBack:= Eval( nClrBack )
EndIf
uTemp := uVar
aDim := ::aBrwPosRect( nCol )
lOk := .f.
cType := ValType( uVar )
IF ::lCellStyle .and. nCol != ::nColAct
::nColAct := nCol
if ::oHScroll != nil
::oHScroll:SetPos(nCol)
endif
::Refresh(.F.)
ENDIF
DEFINE DIALOG oDlg FROM 0,0 TO 0,0 ;
STYLE nOR( WS_VISIBLE, WS_POPUP, 4 ) PIXEL ;
COLOR nClrFore, nClrBack of ::oWnd
if ::oFont != nil
oFont := ::oFont // fjhg
* oFont = TFont():New( ::oFont:cFaceName, ::oFont:nWidth,;
* ::oFont:nHeight, .f., ::oFont:lBold )
endif
do case
case cType == "L"
DEFAULT aItems := { ".T.", ".F." }
uVar = If( uTemp, aItems[ 1 ], aItems[ 2 ] )
@ 0, 0 COMBOBOX oGet VAR uVar ITEMS aItems ;
MESSAGE cMessage;
SIZE ( aDim[ 4 ] - aDim[ 2 ] ) * 0.50, 50 OF oDlg ;
ON CHANGE ( if(lNextControl,oDlg:End(),), lOk := .t. ) ; // fjhg
FONT oFont COLOR nClrFore, nClrBack STYLE CBS_DROPDOWNLIST // fjhg
* ON CHANGE ( oDlg:End(), lOk := .t. ) ; /// linea original
case aItems != nil
@ 0, 0 COMBOBOX oGet VAR uVar ITEMS aItems ;
MESSAGE cMessage;
SIZE ( aDim[ 4 ] - aDim[ 2 ] ) * 0.50, 50 OF oDlg ;
ON CHANGE ( if(lNextControl,oDlg:End(),), lOk := .t. ) ; // fjhg
FONT oFont COLOR nClrFore, nClrBack STYLE CBS_DROPDOWNLIST // fjhg
* ON CHANGE ( oDlg:End(), lOk := .t. ) ; /// linea original
otherwise
If cType == "C" .and. At( CRLF, uVar ) > 0 // MULTILINE
@ 0, 0 GET oGet VAR uVar MEMO NO VSCROLL ;
MESSAGE cMessage;
SIZE 0,0 OF oDlg FONT oFont COLOR nClrFore, nClrBack NOBORDER
oGet:bGotFocus := {|| PostMessage(oGet:hWnd, EM_SETSEL, 0, 0)}
else
IF lButAction // Angel Blanco
@ 0, 0 BTNGET oGet VAR uVar ;
MESSAGE cMessage;
ACTION EVAL( bButaction ) ;
SIZE 0,0 OF oDlg FONT oFont COLOR nClrFore, nClrBack NOBORDER
oGet:oGet:Picture = cPicture
ELSE
@ 0, 0 GET oGet VAR uVar ;
MESSAGE cMessage;
SIZE 0,0 OF oDlg FONT oFont COLOR nClrFore, nClrBack NOBORDER
oGet:oGet:Picture = cPicture
ENDIF
EndIf
//////////// Ini //////////////
//// Justificacion del GET ////
///////////////////////////////
If ValType( ::aJustify ) $ "AB"
If "B" $ ValType( ::aJustify )
uJustify:= Eval( ::aJustify )
Else
uJustify:= AClone( ::aJustify )
EndIf
If nCol <= Len( uJustify )
uJustify:= uJustify[ nCol ]
If "L" $ ValType( uJustify )
uJustify:= If( uJustify, 1, 0 )
ElseIf ! "N" $ ValType( uJustify )
uJustify:= 0
EndIf
If lAnd( uJustify, HA_RIGHT )
oGet:nStyle:= nOr( oGet:nStyle, ES_RIGHT )
ElseIf lAnd( uJustify, HA_CENTER )
oGet:nStyle:= nOr( oGet:nStyle, ES_CENTER )
EndIf
EndIf
EndIf
//////////// Fin //////////////
//// Justificacion del GET ////
///////////////////////////////
EndCase
DEFAULT bOnCreate:= {|oGet, oDlg| .T. }
Eval( bOnCreate, oGet, oDlg )
bOldValid:= oGet:bValid
DEFAULT bOldValid:= {|| .T. },;
bValid := {|| .T. }
oGet:bValid:= {|| ValidlEditCol( Self, oGet, oDlg, bOldValid, bValid, bAction, @lOk ) }
@ 10, 0 BUTTON oBtn PROMPT "" OF oDlg
// fjhg casi todo ajustado
If ::nLineStyle == 3
If aItems != nil .or. cType == "L"
bInit:= {|| nDif:= ((aDim[6]-GetTextHeight(oGet:hWnd))/2)+0,;
oDlg:Move( aDim[ 1 ], aDim[ 2 ], aDim[5], aDim[6] ),;
oGet:Move( nDif-3, 0, aDim[5], aDim[6] ) }
Else
bInit:= {|| nDif:= ((aDim[6]-GetTextHeight(oGet:hWnd))/2)+0,;
oDlg:Move( aDim[ 1 ], aDim[ 2 ], aDim[5], aDim[6] ),;
oGet:Move( 2+nDif, 0, aDim[5], aDim[6] ) }
Endif
Else
If aItems != nil .or. cType == "L"
bInit:= {|| nDif:= ((aDim[6]-GetTextHeight(oGet:hWnd))/2)+0,;
oDlg:Move( aDim[ 1 ], aDim[ 2 ], aDim[5], aDim[6] ),;
oGet:Move( nDif-4, 0, aDim[5], aDim[6] ) }
Else
bInit:= {|| nDif:= ((aDim[6]-GetTextHeight(oGet:hWnd))/2)+1,;
oDlg:Move( aDim[ 1 ], aDim[ 2 ], aDim[5], aDim[6] ),;
oGet:Move( nDif-1, 0, aDim[5], aDim[6] ) }
Endif
Endif
*-------- original de la clase
* Else
* bInit:= {|| nDif:= ((aDim[6]-GetTextHeight(oGet:hWnd))/2)+2,;
* oDlg:Move( aDim[ 1 ], aDim[ 2 ], aDim[5], aDim[6] ),;
* oGet:Move( 0+nDif, 1, aDim[5]-2, aDim[6] ) }
* EndIf
* bOpenCombo:= {|| if(cType="L" .OR. aItems!=nil,if(lAutoOpen=.t.,oGet:Open(),),)} // fjhg
* ACTIVATE DIALOG oDlg ON INIT ( Eval( bInit ), Eval( bOnInit, oGet, oDlg ), Eval( bOpenCombo ) ) // fjhg
ACTIVATE DIALOG oDlg ON INIT ( Eval( bInit ), Eval( bOnInit, oGet, oDlg ) )
if ! lOk
uVar = uTemp
else
if cType == "L"
uVar = ( uVar == aItems[ 1 ] )
endif
endif
return lOk
Lo único que le sobra es lo referente al uso de la clase btnget que se pudiera sustituir por la nueva clase get con acción.