Cómo hacer un OVERRIDE en la clase TGET.PRG

Cómo hacer un OVERRIDE en la clase TGET.PRG

Postby karinha » Fri Jul 21, 2023 5:30 pm

Buenas tardes. ¿Cómo hacer un OVERRIDE en la clase TGET.PRG?
¿Para no tener que modificar la clase TGET.PRG cada vez que cambio la versión de FIVEWIN?
¿Usando el código fuente de este ejemplo?

Code: Select all  Expand view

#Include "FiveWin.ch"

FUNCTION CAMBIA_GET() // OVERRIDE() in TGET.PRG

   /*
   Vamos para o nosso POG. Na Classe TGET.PRG, faça as incluções abaixo:
   */


   //Declare as seguintes variáveis

   DATA   oPlcHld INIT NIL
   DATA   cPlcHld INIT ""
   DATA   nPlcClr INIT RGB(100,100,100)

   /*
   //Declare o seguinte Method
   */


   METHOD SetPlcHld(cPlc, nClr)

RETURN...

/*
// Localize o METHOD LostFocus( hCtlFocus ) CLASS TGet
// e adicione o seuinte código, logo no início
*/


METHOD LostFocus( hCtlFocus ) CLASS TGet
 
    //ADD Isso
    if !empty(::oPlcHld)

        if empty(::cText)

            ::oPlcHld:nWidth := ::nWidth-8

        endif

    endif

RETURN...

/*
// Localize o METHOD GotFocus( hCtlLost ) CLASS TGet
// e adicione o seuinte código, logo no início
*/


METHOD GotFocus( hCtlLost ) CLASS TGet
 
    //ADD isso
    if !empty(::oPlcHld)

        ::oPlcHld:nWidth=0

    endif

RETURN...

/*
// Inclua o Method SetPlcHld(cPlc, nClr)
*/


METHOD SetPlcHld(cPlc, nClr) CLASS TGet
 
    local oWnd := self
    local nWidth := ::nWidth-8

    DEFAULT nClr := ::nPlcClr

    ::nPlcClr := nClr
    ::cPlcHld := cPlc
 
    if !empty(::cText)

        nWidth := 0

    endif
 
    @ 2, 4 SAY ::oPlcHld VAR ::cPlcHld SIZE nWidth, ::nHeight-4 COLOR ::nPlcClr, ::nClrPane OF oWnd Pixel
 
RETURN NIL

// FIN / END
 


Muchas gracias.

Regards, saludos.
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
User avatar
karinha
 
Posts: 7822
Joined: Tue Dec 20, 2005 7:36 pm
Location: São Paulo - Brasil

Re: Cómo hacer un OVERRIDE en la clase TGET.PRG

Postby carlos vargas » Sat Jul 22, 2023 2:28 pm

Karinha, te adjunto un modulo donde realizo OverrideAndExtend de las clase de fwh, puedes tomarlo como ejemplo. :-)
Code: Select all  Expand view
/*----------------------------------------------------------------------------*/

#include "prestamos.ch"

#ifdef __HARBOUR__
   #ifndef __XHARBOUR__
      #include "xhb.ch"
      #include "xhbcls.ch"
   #endif
#endif

#include "hbclass.ch"

/*----------------------------------------------------------------------------*/

PROCEDURE OverrideAndExtend()

   OVERRIDE METHOD GETDLGCODE IN CLASS TBUTTON WITH KGETDLGCODE

   EXTEND CLASS TCONTROL     WITH METHOD MyDisable
   EXTEND CLASS TDIALOG      WITH METHOD RefreshDialog
   EXTEND CLASS TFOLDER      WITH METHOD GoFirstControl
   EXTEND CLASS TFOLDER      WITH METHOD RefreshPages
   EXTEND CLASS TXBROWSE     WITH METHOD RefreshTotals
   EXTEND CLASS TXBROWSE     WITH METHOD SetMyBmpSort
   EXTEND CLASS TXBROWSE     WITH METHOD MyConfig
   EXTEND CLASS TMYSQLSERVER WITH METHOD ShowError

RETURN

/*----------------------------------------------------------------------------*/

FUNCTION KGetDlgCode( nLastKey )
   LOCAL Self := hb_QSelf()

   ::oWnd:nLastKey := nLastKey

   DO CASE
   CASE !hb_isNil( ::oWnd:oWnd ) .and. ( ::oWnd:oWnd:IsKindOf( "TFOLDER" ) .or. ::oWnd:oWnd:IsKindOf( "TFOLDEREX" ) )
      RETURN DLGC_WANTALLKEYS
   CASE nLastKey == VK_ESCAPE .and. !hb_isNil( ::oWnd:oWnd ) .and. ( ::oWnd:oWnd:IsKindOf( "TWINDOW" ) .or. ::oWnd:IsKindOf( "TDIALOG" ) .or. ::oWnd:IsKindOf( "TPAGES" ) )
      RETURN DLGC_WANTALLKEYS
   ENDCASE

RETURN NIL

/*----------------------------------------------------------------------------*/

FUNCTION MyDisable( aCtrlType )
   LOCAL Self := hb_QSelf()

   IF ( ::ClassName() IN aCtrlType )
      ::bWhen := NIL
      ::Disable()
   ENDIF

RETURN NIL

/*----------------------------------------------------------------------------*/

FUNCTION RefreshDialog( nPos )
   LOCAl Self := hb_QSelf()

   DEFAULT nPos := 0

   AEval( ::aControls, { |oCtrl| oCtrl:Refresh() } )

   IF nPos > 0
      IF Between( nPos, 1, Len( ::aControls ) )
         ::aControls[ nPos ]:SetFocus()
      ENDIF
   ENDIF

RETURN NIL

/*----------------------------------------------------------------------------*/

FUNCTION GoFirstControl()
   LOCAL Self := hb_QSelf()

   IF Len( ::aDialogs ) > 0 .and. Len( ::aDialogs[ 01 ]:aControls[ 01 ] ) > 0
      ::aDialogs[ 1 ]:aControls[ 1 ]:SetFocus()
   ENDIF

RETURN NIL

/*----------------------------------------------------------------------------*/

FUNCTION RefreshPages( nSelectPage )
   LOCAl Self := hb_QSelf()
   LOCAL oPage

   DEFAULT nSelectPage := 0

   FOR EACH oPage IN ::aDialogs
      AEval( oPage:aControls, {|oCtrl| oCtrl:Refresh() } )
   NEXT

   IF Between( nSelectPage, 1, Len( ::aDialogs ) )
      ::SetOption( nSelectPage )
   ENDIF

RETURN NIL

/*----------------------------------------------------------------------------*/

FUNCTION RefreshTotals( lSavePos )
   LOCAL Self   := hb_QSelf()
   LOCAL nRecNo := Eval( ::bBookMark )

   DEFAULT lSavePos := TRUE

   ::MakeTotals()

   IF lSavePos .and. nRecNo > 0
      Eval( ::bBookMark, nRecNo )
   ENDIF

   ::Refresh()

RETURN NIL

/*----------------------------------------------------------------------------*/

FUNCTION SetMyBmpSort()
   LOCAL Self := hb_QSelf()
   LOCAL oBmp, hBmp

   IF ::aSortBmp[ 1, 1 ] != 0
      DeleteObject( ::aSortBmp[ 1, 1 ] )
   ENDIF
   IF ::aSortBmp[ 2, 1 ] != 0
      DeleteObject( ::aSortBmp[ 2, 1 ] )
   ENDIF

   ::aSortBmp := {}

   DEFINE BITMAP oBmp NAME "BMS_ARROWDOWN2"
   hBmp := oBmp:hBitmap
   AAdd( ::aSortBmp, { hBmp, 0, nBmpWidth( hBmp ), nBmpHeight( hBmp ), NIL, FALSE } )

   DEFINE BITMAP oBmp NAME "BMS_ARROWUP2"
   hBmp := oBmp:hBitmap
   AAdd( ::aSortBmp, { hBmp, 0, nBmpWidth( hBmp ), nBmpHeight( hBmp ), NIL, FALSE } )

RETURN NIL

/*----------------------------------------------------------------------------*/

FUNCTION MyConfig( lOrder, nFreeze, lCell, lColSize, lSchemeColor, lRowCount )
   LOCAL Self   := hb_QSelf()
   LOCAL cAlias := ::cAlias

   DEFAULT lOrder       := FALSE,;
           lCell        := FALSE,;
           lColSize     := FALSE,;
           lSchemeColor := FALSE,;
           nFreeze      := 0,;
           lRowCount    := FALSE

   ::lGDIP                  := FALSE
   ::lFlatStyle             := FALSE
   ::nRowHeight             := 24
   ::lRecordSelector        := TRUE
   ::nStretchCol            := STRETCHCOL_LAST
   ::nColDividerStyle       := LINESTYLE_DARKGRAY
   ::lColDividerComplete    := TRUE
   ::nRowDividerStyle       := LINESTYLE_NOLINES
   //::nColDividerStyle       := LINESTYLE_NOLINES
   IF !Empty( cAlias )
      ::bGoTop              := {|| ( cAlias )->( dbGoTop() ) }
      ::bGoBottom           := {|| ( cAlias )->( dbGoBottom() ) }
      ::bSkip               := {|n| IIf( hb_isNil( n ), n := 1, ), ( cAlias )->( dbSkipper( n ) ) }
      ::bBof                := {|| ( cAlias )->( Bof() ) }
      ::bEof                := {|| ( cAlias )->( Eof() ) }
      ::bBookMark           := {|n| IIf( hb_isNil( n ), ( cAlias )->( RecNo() ), ( cAlias )->( dbGoTo( n ) ) )}
      ::bKeyCount           := {|| ( cAlias )->( ordKeyCount() ) }
      ::bKeyNo              := {|| ( cAlias )->( ordKeyNo()    ) }
   ENDIF
   ::bClrHeader             := {|| { CLR_BLUE, CLR_BROWTIT, CLR_BLACK } }
   ::bClrSelFocus           := {|| { CLR_WHITE, CLR_MIDNIGHTBLUE } }
   ::bClrFooter             := {|| { CLR_RED, CLR_BROWTIT, CLR_BLACK } }
   ::bClrSel                := {|| { CLR_WHITE, CLR_BLACK } }
   ::l2007                  := TRUE
   ::lFullGrid              := FALSE
   ::lAllowColHiding        := FALSE
   ::lAllowColSwapping      := FALSE
   ::lAllowRowSizing        := FALSE
   ::lAllowCopy             := FALSE
   ::lKinetic               := FALSE
   ::lKineticBrw            := FALSE
   ::lHScroll               := FALSE

   IF nFreeze > 0
      ::nFreeze := nFreeze
   ENDIF

   IF !lCell
      ::nMarqueeStyle := MARQSTYLE_HIGHLROW
   ELSE
      ::bClrRowFocus  := {|| { CLR_BLACK, RGB( 185, 220, 255 ) } }
      ::nMarqueeStyle := MARQSTYLE_HIGHLCELL
   ENDIF

   //AEval( ::aCols, {|oCol| oCol:cSortOrder := NIL, IIf( !lColSize, ( oCol:lAllowSizing := FALSE ), NIL ) } )
   AEval( ::aCols, {|oCol| IIf( !lColSize, ( oCol:lAllowSizing := FALSE ), NIL ) } )

   IF lSchemeColor
      ColorScheme( Self )
   ENDIF

   IF Type( "nScale" ) != "U" .and. nScale > 1
      AEval( ::aCols, {|oCol| IIf( ValType( oCol:nWidth ) == "N", ( oCol:nWidth *= nScale ), NIL ) } )
   ENDIF

   IF lRowCount
      ::nRecSelWidth  := 50 * IIf( Type( "nScale" ) != "U" .and. nScale > 1, nScale, 1 )
      ::nRecSelColor  := CLR_MYCELESTE2
      ::bRecSelHeader := "#"
      ::bRecSelData   := {|oB| oB:KeyNo }
   ENDIF

   ::SetMyBmpSort()

RETURN NIL

/*----------------------------------------------------------------------------*/

FUNCTION ShowError()
   LOCAL Self := hb_QSelf()

   IF ::nError > 0
      MsgStop( ::cError, "MYSQL-ERROR" )
   ENDIF

RETURN NIL

/*----------------------------------------------------------------------------*/
/*EOF*/
/*----------------------------------------------------------------------------*/
 
Salu2
Carlos Vargas
Desde Managua, Nicaragua (CA)
User avatar
carlos vargas
 
Posts: 1720
Joined: Tue Oct 11, 2005 5:01 pm
Location: Nicaragua

Re: Cómo hacer un OVERRIDE en la clase TGET.PRG

Postby carlos vargas » Sat Jul 22, 2023 2:47 pm

aclarar que para que funcione en harbour, debes incluir la libreria xhb, ademas de los encbezados (.ch) de dicha libraria
algo que no encontre es como darle un valor inicial a cPlcHld y nPlcClr, para ello deberia sobreescribir el metodo new, lo cual no quiero hacer, pero pensando, no se si sea una opcion extender la clase tget con un metodo init y ahi si se pude inicializar las variables. en cuanto a los metodos gotfoucs y lostfocus, no estoy muy claro que hacer ellos...
Code: Select all  Expand view

#include "hbclass.ch"

/*----------------------------------------------------------------------------*/

PROCEDURE OverrideAndExtend()
    EXTEND CLASS TGET WITH DATA oPlcHld
    EXTEND CLASS TGET WITH DATA cPlcHld
    EXTEND CLASS TGET WITH DATA nPlcClr
    EXTEND CLASS TGET WITH METHOD SetPlcHld
    OVERRIDE METHOD LOSTFOCUS IN CLASS TGET WITH MYLOSTFOCUS
    OVERRIDE METHOD GOTFOCUS IN CLASS TGET WITH MYGOTFOCUS
RETURN

FUNCTION MyLostFocus( hCtlFocus )
    LOCAL Self := hb_QSelf()
    if !empty(::oPlcHld)
        if empty(::cText)
            ::oPlcHld:nWidth := ::nWidth-8
        endif
    endif
RETURN ::Super:LostFocus()

FUNCTION MyGotFocus( hCtlFocus )
    LOCAL Self := hb_QSelf()
    if !empty(::oPlcHld)
        ::oPlcHld:nWidth=0
    endif
RETURN ::Super:GotFocus()

FUNCTION SetPlcHld( cPlc, nClr )
    LOCAL Self := hb_QSelf()
    LOCAL oWnd := self
    LOCAL nWidth := ::nWidth-8

    DEFAULT nClr := ::nPlcClr

    ::nPlcClr := nClr
    ::cPlcHld := cPlc
 
    if !empty(::cText)
        nWidth := 0
    endif
   
    //TO CONTINUE

RETURN NIL
Salu2
Carlos Vargas
Desde Managua, Nicaragua (CA)
User avatar
carlos vargas
 
Posts: 1720
Joined: Tue Oct 11, 2005 5:01 pm
Location: Nicaragua

Re: Cómo hacer un OVERRIDE en la clase TGET.PRG

Postby leandro » Fri Jul 28, 2023 1:22 am

Que pena entrometerme en la conversión, pero para que se usa OVERRIDE?
Saludos
LEANDRO AREVALO
Bogotá (Colombia)
https://hymlyma.com
https://hymplus.com/
leandroalfonso111@gmail.com
leandroalfonso111@hotmail.com

[ Embarcadero C++ 7.60 for Win32 ] [ FiveWin 23.07 ] [ xHarbour 1.3.0 Intl. (SimpLex) (Build 20230914) ]
User avatar
leandro
 
Posts: 1676
Joined: Wed Oct 26, 2005 2:49 pm
Location: Colombia

Re: Cómo hacer un OVERRIDE en la clase TGET.PRG

Postby carlos vargas » Fri Jul 28, 2023 4:43 am

digamos que tienes una clase de la cual no tienes las fuentes y deseas modificar el comportamiento de un método, o agregar uno nuevo, pues usas extend u override para hacerlos, o de plano no deseas modificar las fuentes originales.
Salu2
Carlos Vargas
Desde Managua, Nicaragua (CA)
User avatar
carlos vargas
 
Posts: 1720
Joined: Tue Oct 11, 2005 5:01 pm
Location: Nicaragua


Return to FiveWin para Harbour/xHarbour

Who is online

Users browsing this forum: No registered users and 66 guests