Página 1 de 1
Modificando classes do Windows
Enviado: 04 Jun 2020 10:47
por JoséQuintas
Façam o teste se isso é possível com Harbour 3.2 e XHarbour.
Achei fantástico.
Código: Selecionar todos
#include "hbclass.ch"
PROCEDURE Main
LOCAL a
a := win_OleCreateObject( "ADODB.Recordset" )
__ObjAddMethod( a, "Test", @Test() )
? a:CacheSize
? a:Test()
Inkey(0)
RETURN
FUNCTION Test()
RETURN "ok"
Modificando classes do Windows
Enviado: 04 Jun 2020 11:06
por JoséQuintas
JoséQuintas escreveu:Achei fantástico.
Ou quase....
Falta poder simular o ::super:
Modificando classes do Windows
Enviado: 04 Jun 2020 11:26
por JoséQuintas
Código: Selecionar todos
#include "hbclass.ch"
PROCEDURE Main
LOCAL a
a := win_OleCreateObject( "ADODB.Recordset" )
__ObjAddMethod( a:Fields, "ToString", @ADOToString() )
? a:CacheSize
? a:ToString( a:CacheSize )
Inkey(0)
RETURN
FUNCTION ADOToString( x )
RETURN Transform( x, "" )
Acima, acrescentei ToString() no recordset ADO.
Agora faltaria o ToString() pegar informação do recordset, sem precisar passar parâmetro, ou passar o nome do campo por exemplo.
Modificando classes do Windows
Enviado: 04 Jun 2020 11:52
por JoséQuintas
Código: Selecionar todos
#include "hbclass.ch"
PROCEDURE Main
LOCAL a, aList, cName
a := win_OleCreateObject( "ADODB.Recordset" )
__ObjAddMethod( a:Fields, "ToString", @ADOToString() )
? a:CacheSize
? a:ToString( a:CacheSize )
aList := __objGetMethodList( a )
FOR EACH cName IN aList
? cName
NEXT
Inkey(0)
RETURN
FUNCTION ADOToString( x )
RETURN Transform( x, "" )
1
1
WIN_OLEAUTO
REALCLASS
TOSTRING
win_OleCreateObject() cria uma classe intermediária.
Adicionar um método que não tem acesso ao resto da classe me parece algo inútil.
Deve existir alguma outra possibilidade nisso, mas não encontrei.
Modificando classes do Windows
Enviado: 05 Jun 2020 00:05
por JoséQuintas
Passaram alternativas no harbour-users
Código: Selecionar todos
__ObjAddInLine( oRs, "GoTop", { | Self | iif( ::RecordCount() > 0, ::MoveFirst(), ) } )
Agora sim, ficou interessante.
Modificando classes do Windows
Enviado: 05 Jun 2020 23:11
por dbsh
EXEMPLO EXTENDENDO CLASSE QT
Código: Selecionar todos
PROCEDURE ExtendQLineEdit()
EXTEND CLASS QLineEdit WITH DATA cbGetSet //bloco de codigo para salvar e restaura variavel/campo vinculado ao controle
EXTEND CLASS QLineEdit WITH DATA VarTipo //tipo original de variavel vinculado ao controle, buffer e sempre string, recuperado de ::cbGetSet
EXTEND CLASS QLineEdit WITH DATA cbWhen
EXTEND CLASS QLineEdit WITH DATA cbValid
EXTEND CLASS QLineEdit WITH MESSAGE VarGet METHOD VarGet //retornava valor do buffer, ::Text()
EXTEND CLASS QLineEdit WITH MESSAGE VarPut METHOD VarPut //altera variavel, passando parametro para VarPut( [uSet] ), altera buffer
EXTEND CLASS QLineEdit WITH MESSAGE Refresh METHOD Refresh1 //restaura buffer, ::Text(), usando ::cbGetSet
EXTEND CLASS QLineEdit WITH MESSAGE Commit METHOD Commit1 //altera variavel vinculado ao controle, passando parametro para ::Commit( default uSet=::Text() )
EXTEND CLASS QLineEdit WITH MESSAGE Upper INLINE Upper(::Text())
EXTEND CLASS QLineEdit WITH MESSAGE Lower INLINE Lower(::Text())
EXTEND CLASS QLineEdit WITH MESSAGE SetKey(cbKey, sCtrl, nKey) INLINE addKeyPress(Self, cbKey, sCtrl, nKey)
RETURN
STATIC FUNCTION VarGet()
LOCAL Self := QSelf(), uRet
uRet := ::Text()
IF ::cbGetSet <> NIL
DEFA ::VarTipo TO ValType(Eval(::cbGetSet))
ELSE
DEFA ::VarTipo TO "C"
ENDIF
uRet := ConvertVar(uRet, ::VarTipo)
RETURN uRet
//uSet altera buffer e variavel vinculada ao controle
STATIC FUNCTION VarPut(uSet)
LOCAL Self := QSelf()
IF uSet <> NIL
::SetText( Trim( ConvertVar(uSet, 'C') ) )
ENDIF
RETURN ::Commit()
STATIC FUNCTION Refresh1()
LOCAL Self := QSelf()
LOCAL uBuffer
//::__Super:Refresh()
IF ::cbGetSet <> NIL
uBuffer := Eval(::cbGetSet)
DEFA ::VarTipo TO ValType(uBuffer)
IF ::VarTipo = 'D'
uBuffer := DToC(uBuffer)
ENDIF
::SetText( Trim( xStr( uBuffer ) ) )
ELSE
uBuffer := ::Text()
ENDIF
RETURN uBuffer
//uSet altera variavel vinculada ao controle
STATIC FUNCTION Commit1(uSet)
LOCAL Self := QSelf()
LOCAL uBuffer
//::__Super:Commit()
DEFA uSet TO ::Text()
IF ::cbGetSet <> NIL
DEFA ::VarTipo TO ValType(Eval(::cbGetSet))
uBuffer := ConvertVar(uSet, ::VarTipo)
Eval(::cbGetSet, uBuffer)
ELSE
uBuffer := uSet
ENDIF
RETURN uBuffer
PROCEDURE AddKeyPress( Obj, cbSetKey, sCtrl, nKey )
LOCAL nPos
DEFA sCtrl TO ""
DEFA nKey TO 0
IF !ValType(Obj) = 'O'
RETURN
ENDIF
IF !__objHasData(Obj, 'acbKey')
IF Empty(cbSetKey)
RETURN
ELSE
AddVar(Obj, "acbKey")
Obj:acbKey := {}
ENDIF
ELSEIF Empty(cbSetKey) .and. (Empty(Obj:acbKey) .or. Len(Obj:acbKey) = 0)
RETURN
ENDIF
IF Empty(sCtrl)
nPos := 0
ELSEIF ValType(sCtrl) = "C"
nPos := aScan({ 'SHIFT', 'CONTROL', 'ALT', 'META' , 'KEYPAD', 'GROUPSWITCH' }, Upper(sCtrl))
IF nPos > 0 .and. nPos < 7
nPos :=({Qt_ShiftModifier, Qt_ControlModifier, Qt_AltModifier, Qt_MetaModifier, Qt_KeypadModifier, Qt_GroupSwitchModifier})[nPos]
ELSE
nPos := 0
ENDIF
ELSE
nPos := sCtrl
ENDIF
IF obj:acbKey = NIL
obj:acbKey := {}
ENDIF
IF Empty(cbSetKey)
cbSetKey := AScan(Obj:acbKey, {|p| p[1] = nPos .and. p[2] = nKey})
IF cbSetKey > 0
aDelSize(Obj:acbKey, cbSetKey)
ENDIF
ELSE
AAdd(Obj:acbKey, {nPos, nKey, cbSetKey})
ENDIF
RETURN