Modificando classes do Windows

[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"

[JoséQuintas]

Achei fantástico.

Ou quase....
Falta poder simular o ::super:

[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.

[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.

[JoséQuintas]

Passaram alternativas no harbour-users

Código: Selecionar todos

FUNCTION x

   LOCAL SELF := QSelf()

   RETURN ::any

Código: Selecionar todos

__ObjAddInLine( oRs, "GoTop", { | Self | iif( ::RecordCount() > 0, ::MoveFirst(), ) } )

Agora sim, ficou interessante.

[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