FiveTech Support Forums

FiveWin / Harbour / xBase community
Board index FiveWin for Harbour/xHarbour SUB-CLASS TFolderEx()
Posts: 1772
Joined: Thu Sep 05, 2019 05:32 AM
SUB-CLASS TFolderEx()
Posted: Thu Feb 02, 2023 03:44 AM
hi,

i can change Color of TAB "Body" and Font but not TAB Color itself

so i try to SUB-CKASS TFolderEx()
Code (fw): Select all Collapse
CLASS TFolderDXE FROM TFolderEx, TControl
METHOD PaintTB() CLASS TFolderDXE
METHOD SetFldColors( oThis, n ) CLASS TFolderDXE
it work so far ... but there seems no "TAB-Stop" so i can´t use TAB-Key :shock:

what i´m doing wrong :!:
greeting,

Jimmy
Posts: 44162
Joined: Thu Oct 06, 2005 05:47 PM
Re: SUB-CLASS TFolderEx()
Posted: Thu Feb 02, 2023 09:02 AM

Dear Jimmy,

Just inherit from TFolderEx, so instead of:

CLASS TFolderDXE FROM TFolderEx, TControl

do:

CLASS TFolderDXE FROM TFolderEx

regards, saludos

Antonio Linares
www.fivetechsoft.com
Posts: 1487
Joined: Tue Jun 14, 2016 07:51 AM
Re: SUB-CLASS TFolderEx()
Posted: Thu Feb 02, 2023 09:18 AM

Jimmy,

Could you please post the working result for the sub-class ? (Method detail)

I want to sub-Class Xbrowse, but never did anything with a class...

Marc Venken

Using: FWH 23.08 with Harbour
Posts: 1096
Joined: Fri Oct 28, 2005 02:27 AM
Re: SUB-CLASS TFolderEx()
Posted: Thu Feb 02, 2023 09:35 AM
Jimmy,
Code (fw): Select all Collapse
CLASS TFolderDXE FROM TFolderEx
   CLASSDATA lRegistered AS LOGICAL // this variable is compulsory for inherited controls

   METHOD PaintTB() CLASS TFolderDXE
   METHOD SetFldColors( oThis, n ) CLASS TFolderDXE  
  .
  .
  .
ENDCLASS
FWH 11.08/FWH 19.12

BCC5.82/BCC7.3

xHarbour/Harbour
Posts: 1772
Joined: Thu Sep 05, 2019 05:32 AM
Re: SUB-CLASS TFolderEx()
Posted: Thu Feb 02, 2023 10:17 AM
hi,

@Antonio,
have remove Control so only
Code (fw): Select all Collapse
   CLASS TFolderDXE FROM TFolderEx
@hua
Code (fw): Select all Collapse
   CLASSDATA lRegistered AS LOGICAL   // this variable is compulsory for inherited controls
but same "Problem" that i can´t use TAB-Key ... other like Fx-Key work

---
@Marc
the Benefit of OOP is to make "own" CLASS from "other" OOP CLASS where you can "add" or "override" Method and Property (DATA)

so i do copy/paste from Original CLASS TFolderEx() and began to modify new CLASS CODE

as i want to modify "painting" i use
Code (fw): Select all Collapse
CLASS MYCLASS FROM TFolderEx
   // tip from hua
   CLASSDATA lRegistered AS LOGICAL   // this variable is compulsory for inherited controls

   DATA BFcolor  INIT nRGB( 000, 000, 001 ) // new Foregound Color
   DATA BGcolor  INIT nRGB( 025, 254, 255 ) // new Backgound Color

   METHOD PaintTB()       //Paint Top Bottom
   METHOD SetFldColors()
ENDCLASS

METHOD PaintTB() CLASS TFolderDXE
...
METHOD SetFldColors( oThis, n ) CLASS TFolderDXE
...
possible Problem
missing Constant or missing depend Method (search for "::" Method in paste Text )

when get no more Error change TFolderEx to MYCLASS
it should work same way as SUPER-CLASS TFolderEx

now you can begin to modify your CODE for your need
greeting,

Jimmy
Posts: 44162
Joined: Thu Oct 06, 2005 05:47 PM
Re: SUB-CLASS TFolderEx()
Posted: Thu Feb 02, 2023 11:11 AM

Jimmy,

Use this:

oFolder:nDlgCode = DLGC_WANTALLKEYS

regards, saludos

Antonio Linares
www.fivetechsoft.com
Posts: 1772
Joined: Thu Sep 05, 2019 05:32 AM
Re: SUB-CLASS TFolderEx()
Posted: Fri Feb 03, 2023 05:15 AM
hi Antonio,
Antonio Linares wrote:oFolder:nDlgCode = DLGC_WANTALLKEYS
no luck ... still can´t use TAB-Key to change Control

i have reduce CLASS to only 1 Method to set Bitmap (depend on Drive Type)
Code (fw): Select all Collapse
METHOD SetDriveIcon(cPath,nOption) CLASS TFolderDXE
LOCAL aDrives, cDrive, nPosi, cIcon
LOCAL acItem, acBitmaps

DEFAULT nOption := 1

   IF !EMPTY(cPath)
      cDrive := UPPER(SUBSTR(cPath,1,1))
      aDrives := FillDriveArray()
      acItem    := aDrives[ 1 ]
      acBitmaps := aDrives[ 2 ]

      nPosi := ASCAN(acItem,{ | x | SUBSTR(x,1,1) = cDrive })
      IF nPosi > 0
         cIcon := acBitmaps[nPosi]
         ::SetBitmap( cIcon, nOption )
         ::Update()
      ENDIF
   ENDIF
RETURN nil
but as soon i use this CLASS i can "TAB-in" but not "TAB-out" :shock:

i will try to make a small Sample

---

ok here Demo Sample for "no TAB-Key"
Code (fw): Select all Collapse
#include "FiveWin.ch"

function Main()
   local oDlg, oFld, oGet, cTest := "Hello world", cAnother := "Another GET"
LOCAL nWidth     := 190
LOCAL nHeight    := 120
LOCAL nTop       := 0
LOCAL nLeft      := 0
LOCAL lPixel     := .T.
LOCAL lDesign    := .F.
   // TFolderEx
LOCAL aPrompts := {"&One", "&Two", "&Three"}
LOCAL aBitmaps      := {}
   // DEFAULT
LOCAL nFolderHeight := 25
LOCAL aHelps
LOCAL nRound        := 3
LOCAL bAction
LOCAL bClrTabs
LOCAL bClrText
LOCAL aAlign
LOCAL lAdjust       := .F.
LOCAL nSeparator    := 3
LOCAL nOption       := 1
LOCAL bPopUp
LOCAL lStretch      := .F.
LOCAL cLayOut       := "TOP"
LOCAL bBmpAction
LOCAL nBright       := 0
LOCAL lAnimate      := .F.
LOCAL nSpeed
LOCAL oFont
LOCAL lTransparent  := .F.
LOCAL aDialogs
LOCAL lBorder       := .T.
LOCAL nClrPane      := CLR_WHITE
LOCAL cVarName

   DEFINE DIALOG oDlg SIZE 400, 300
* #define Original  
#ifdef Original
   @ 3, 5 FOLDEREX oFld PIXEL ;
      PROMPT "&One", "&Two", "&Three" ;
      SIZE 190, 120
#else
* #define Use_normal  
   #ifdef Use_normal
      oFld  := TFolderEx() :New( 3, 5, nWidth , nHeight , oDlg, ;
                               aBitmaps, lPixel, lDesign, aPrompts, nFolderHeight, ;
                               aHelps, nRound, bAction, bClrTabs, bClrText, aAlign, ;
                               lAdjust, nSeparator, nOption, bPopUp, lStretch, ;
                               cLayOut, bBmpAction, nBright, lAnimate, nSpeed, oFont, ;
                               lTransparent, aDialogs, lBorder, nClrPane, cVarName )
   #else
      oFld  := TFolderDXE() :New( 3, 5, nWidth , nHeight , oDlg, ;
                               aBitmaps, lPixel, lDesign, aPrompts, nFolderHeight, ;
                               aHelps, nRound, bAction, bClrTabs, bClrText, aAlign, ;
                               lAdjust, nSeparator, nOption, bPopUp, lStretch, ;
                               cLayOut, bBmpAction, nBright, lAnimate, nSpeed, oFont, ;
                               lTransparent, aDialogs, lBorder, nClrPane, cVarName )
      oFld:SetDriveIcon(,1)
      oFld:SetDriveIcon(,2)
      oFld:SetDriveIcon(,3)   
      
      oFld:nDlgCode := DLGC_WANTALLKEYS
   #endif     
#endif      

   @ 1, 1 GET oGet VAR cTest OF oFld:aDialogs[ 1 ]
   
   @ 2, 1 GET cAnother OF oFld:aDialogs[ 1 ]  
   
   @ 7.2, 14 BUTTON "Ok" ACTION oDlg:End()    
          
   ACTIVATE DIALOG oDlg CENTERED ;
      ON INIT ( oGet:SetFocus(), .F. ) 

return nil
Code (fw): Select all Collapse
CLASS TFolderDXE FROM TFolderEx
  CLASSDATA lRegistered AS LOGICAL   // this variable is compulsory for inherited controls

   DATA BFcolor  INIT nRGB( 000, 000, 001 )
   DATA BGcolor  INIT nRGB( 025, 254, 255 )

   METHOD SetDriveIcon(cPath,nOption)
ENDCLASS

METHOD SetDriveIcon(cPath,nOption) CLASS TFolderDXE
LOCAL aDrives
LOCAL cDrive
LOCAL nPosi
LOCAL cBMP := "BMPGREEN"
LOCAL acItem
LOCAL acBitmaps
LOCAL acType

DEFAULT nOption := 1

/************   
   IF !EMPTY(cPath)
      cDrive := UPPER(SUBSTR(cPath,1,1))
      aDrives := FillDriveArray()
      acItem    := aDrives[ 1 ]
      acBitmaps := aDrives[ 2 ]
      acType    := aDrives[ 3 ]

      nPosi := ASCAN(acItem,{ | x | SUBSTR(x,1,1) = cDrive })
      IF nPosi > 0
         cBMP := acBitmaps[nPosi]
************/        
         ::SetBitmap( cBMP, nOption )
         ::Update()
*      ENDIF
*   ENDIF
RETURN nil
---

Demo show 3 x TAB
on TAB 1 there are 2 x GET and you can "TAB-Key" between GET

but you can NOT "TAB-Key" to "OK" Button to leave GET
on "blank" TAB 2 and 3 "TAB-Key" troggle "OK" Button

---

it does work when use
Code (fw): Select all Collapse
#define Use_normal
for use Original TFolderEx() to "TAB-Key" from GET to "OK" Button
greeting,

Jimmy
Posts: 44162
Joined: Thu Oct 06, 2005 05:47 PM
Re: SUB-CLASS TFolderEx()
Posted: Fri Feb 03, 2023 08:13 AM

Dear Jimmy,

If you look for "TFolderEx" in *.prg in FWH\source\classes you will find several places where "TFolderEx" is hardcoded and this is the reason why tab is not working

We should modify those or think about a way to change the Class name at runtime (if possible)

regards, saludos

Antonio Linares
www.fivetechsoft.com
Posts: 866
Joined: Tue Oct 16, 2007 08:57 AM
Re: SUB-CLASS TFolderEx()
Posted: Fri Feb 03, 2023 08:27 AM
Dear Jimmy, Antonio

Maybe we can add Paco's C5 TFolder or C5Tab show different Folder style.



Best Regards,



Richard



Harbour 3.2.0dev (r2503251254) => Borland C++ v7.7 32bit

MySQL v8.0

Harbour 3.2.0dev (r2503251254) => Borland C++ v7.7 64bit
Posts: 1772
Joined: Thu Sep 05, 2019 05:32 AM
Re: SUB-CLASS TFolderEx()
Posted: Fri Feb 03, 2023 07:08 PM
hi Antonio,
Antonio Linares wrote: If you look for "TFolderEx" in *.prg in FWH\source\classes you will find several places where "TFolderEx" is hardcoded and this is the reason why tab is not working
oooh ...

under Xbase++ i can use
Code (fw): Select all Collapse
   IF ::isDerivedFrom( <cClassName>|<oClassObject> ) --> lIsDerived
i thought that Fivewin use same as
Code (fw): Select all Collapse
   if ::oWnd:IsKindOf( "TFOLDEREX" )
---

under Xbase++ it will also work with SUB-CLASS when ask for SUPER-CLASS

when made a own
Code (fw): Select all Collapse
   CLASS MYABC FROM ABC
under Xbase++ i can ask
Code (fw): Select all Collapse
   ::isDerivedFrom("MYABC") or ::isDerivedFrom("ABC")
Antonio Linares wrote:We should modify those or think about a way to change the Class name at runtime (if possible)
it would be nice if Fivewin can react like Xbase++ when using own CLASS made FROM fwCLASS
i like to request a new Method ::isFamilyFrom(cControl)
greeting,

Jimmy
Posts: 1772
Joined: Thu Sep 05, 2019 05:32 AM
Re: SUB-CLASS TFolderEx()
Posted: Sat Feb 04, 2023 12:40 AM
hi Antonio,

i do not know how Xbase++ :isDerivedFrom work
but we might can use a Workaroud which i saw in QContrib from Bedi Pritpal
Code (fw): Select all Collapse
METHOD XbpWindow:isDerivedFrom( cClassORoObject )
   LOCAL lTrue := .f.
   LOCAL cCls := __ObjGetClsName( Self )

   /* Compares without Xbp or Wvg prefixes  */
   IF HB_ISSTRING( cClassORoObject )
      RETURN __clsParent( Self:classH, cClassORoObject )

   ELSEIF HB_ISOBJECT( cClassORoObject )
      IF upper( substr( cClassORoObject:className,4 ) ) == upper( substr( cCls,4 ) )
         lTrue := .t.
      ENDIF
   ENDIF

   IF !( lTrue )
      IF HB_ISOBJECT( ::oParent )
         lTrue := ::oParent:isDerivedFrom( cClassORoObject )
      ENDIF
   ENDIF

RETURN lTrue
i guess ::IsKindOf get Object CLASS Name and compare it
Code (fw): Select all Collapse
   ( ::oWnd:oWnd:IsKindOf( "TFOLDER" ) .or. ;
     ::oWnd:oWnd:IsKindOf( "TFOLDEREX" ) )
but what when use "just" Part of it :idea:
Code (fw): Select all Collapse
METHOD isDerivedFrom( cClassORoObject ) CLASS ???
  IF upper( substr( cClassORoObject:className,1,6 ) ) == upper( substr( cCls,1,6 ) )
SUBSTR() Length depend on "shortest" Fiwewin Control CLASS Name.
i think 6 is a good length (or better use a Constant which can be easy change )
greeting,

Jimmy
Posts: 1772
Joined: Thu Sep 05, 2019 05:32 AM
Re: SUB-CLASS TFolderEx()
Posted: Sat Feb 04, 2023 06:40 AM
while also this Syntax is used
Code (fw): Select all Collapse
METHOD Update() INLINE AEval( ::aControls,;
          { | o | If( ( Upper( o:ClassName() ) $ "TFOLDER;TFOLDEREX" ), o:Update(),;
          If( o:lUpdate, o:Refresh(),)) } )
or
Code (fw): Select all Collapse
METHOD GotFocus( hFromWnd ) CLASS TWindow
   ...
   if Upper( GetClassName( ::hCtlFocus ) ) $ "SYSTABCONTROL32,TPAGES,TFOLDEREX"
or
Code (fw): Select all Collapse
METHOD GoNextCtrl( hCtrl ) CLASS TWindow
   ...
   if ::oWnd:ClassName() $ "TFOLDER,TFOLDEREX,TPAGES"
i need to check for every ClassName() ---
greeting,

Jimmy
Posts: 44162
Joined: Thu Oct 06, 2005 05:47 PM
Re: SUB-CLASS TFolderEx()
Posted: Sat Feb 04, 2023 07:27 AM
Dear Jimmy,

Instead of creating a new Class TFolderDXE inherited from TFolderEx, you could dynamically modify Class TFolderEx to add the extra DATAs and/or Methods that you may need using the functions __objAddData( oObject, cSymbol ) and __objAddMethod( oObject, cSymbol, nFuncPtr ), __objModMethod( oObject, cSymbol, nFuncPtr )

Please review https://github.com/harbour/core/blob/master/src/rtl/objfunc.prg
regards, saludos

Antonio Linares
www.fivetechsoft.com
Posts: 1772
Joined: Thu Sep 05, 2019 05:32 AM
Re: SUB-CLASS TFolderEx()
Posted: Sat Feb 04, 2023 09:05 AM
hi Antonio,
Antonio Linares wrote:Instead of creating a new Class TFolderDXE inherited from TFolderEx, you could dynamically modify Class TFolderEx to add the extra DATAs and/or Methods that you may need using the functions __objAddData( oObject, cSymbol ) and __objAddMethod( oObject, cSymbol, nFuncPtr ), __objModMethod( oObject, cSymbol, nFuncPtr )
WOW
i did not know that Technique

---

but it will not help when i want to "override" Nethod, here PaintTB()

i like to use "Dark-Mode" so also TAB should have a Callback Slot for Background Color.
used Color are
Code (fw): Select all Collapse
METHOD SetDefColors( aGradSel, aGradUnSel, aGradOverUnSel, aGradOver, aGradDis ) CLASS TFolderEx
...
     DEFAULT aGradSel       := { { 0.25, nRGB( 255, 215, 0 ), nRGB( 205, 173, 0 ) },;
                                 { 0.75,  nRGB( 255, 255, 255 ), nRGB( 255, 255, 255 ) } }

     DEFAULT aGradUnSel     := { { 0.5, nRGB( 255, 255, 255 ), nRGB( 240, 240, 240 ) },;
                                 { 0.5,  nRGB( 240, 240, 240 ), nRGB( 200, 200, 200 ) } }

     DEFAULT aGradOverUnSel := { { 0.25, nRGB( 100, 149, 237 ), nRGB( 100, 149, 237 ) },;
                                 { 0.75,  nRGB( 255, 255, 255 ), nRGB( 200, 200, 200 ) } }

     DEFAULT aGradOver      := { { 0.5,  nRGB( 200, 200, 200), nRGB( 240, 240, 240 ) },;
                                 { 0.5, nRGB( 240, 240, 240 ), nRGB( 255, 255, 255  ) }  }

     DEFAULT aGradDis       := { { 1, nRGB( 211, 211, 211 ), nRGB( 190, 190, 190) } }
for
Code (fw): Select all Collapse
METHOD SetFldColors( oThis, n ) CLASS TFolderEx
called by PaintTB()

how can i enhance it to use "Dark-Mode" :?:
greeting,

Jimmy
Posts: 44162
Joined: Thu Oct 06, 2005 05:47 PM
Re: SUB-CLASS TFolderEx()
Posted: Sat Feb 04, 2023 09:17 AM
Dear Jimmy,

If you add a method with the same name, you are in fact overriding it.

Please try it :-)
regards, saludos

Antonio Linares
www.fivetechsoft.com