Error when using inherited Class from xBrowse and xBrowse si

Post Reply
User avatar
gkuhnert
Posts: 274
Joined: Fri Apr 04, 2008 1:25 pm
Location: Aachen - Germany // Kerkrade - Netherlands
Contact:

Error when using inherited Class from xBrowse and xBrowse si

Post by gkuhnert »

Hello,

to be able to extend and modify some functionality in xBrowse I wanted to create an inherited class of xBrowse. I'm using FWH1903 with BCC7.
As such, it works fine, but as soon as I use the original xBrowse with a Dialog, I get an error, "Error FiveWin/3 Cannot create Dialog Box: Resource: Two"

If I use the original xBrowse first, I'm not able any more to use my inherited class. So the first of both classes used, can be used. But the other one cannot be used anymore, causing a runtime error.

So I now created an example, based on the sample "foldxbrw.prg" and called it xbrw_test.prg. The inherited class is included here and is called "CLASS TCtoXbrowse FROM TXbrowse". I also copied "function XbrowseNew" from the original sourcecode and called it "Function CtoXbrowseNew". Here I modified the call "TXbrowse():New" to "TCtoXbrowse():New()"
I also modified foldxbrw.rc and saved it as xbrw_test.rc. Here the first folder "one" is now using class "TCtoXbrowse" instead of "TXbrowse"
I made a new .ch-file called ctoxbrowse.ch to be able to access the inherited class.

If these files are copied to the \samples folder and compiled there, you can see the Error.

Isn't it possible to use the original and inherited class simultaneously or am I making a mistake somewhere?


Sourcecode of "xbrw_test.prg"

Code: Select all

#include "FiveWin.ch" 
#include "CtoXBrowse.ch" 
#include "XBrowse.ch" 

function Main() 

   local oDlg, oFld, oBrw1, oBrw2 
   local aDat1, aDat2 

   aDat1:={{"Row1-Col1","Row1-Col2","Row1-Col3"},; 
                 {"Row2-Col1","Row2-Col2","Row2-Col3"},; 
                 {"Row3-Col1","Row3-Col2","Row3-Col3"},; 
                 {"Row4-Col1","Row4-Col2","Row4-Col3"}} 

   aDat2:={{"ROW1-COL1","ROW1-COL2","ROW1-COL3"},; 
                 {"ROW2-COL1","ROW2-COL2","ROW2-COL3"},; 
                 {"ROW3-COL1","ROW3-COL2","ROW3-COL3"},; 
                 {"ROW4-COL1","ROW4-COL2","ROW4-COL3"}} 

   DEFINE DIALOG oDlg RESOURCE "Test" 

   REDEFINE FOLDER oFld ; 
      PROMPTS "One", "Two" ; 
      DIALOGS "One", "Two" ; 
      ID 100 OF oDlg 

   REDEFINE CTOXBROWSE oBrw1 ID 10 OF oFld:aDialogs[ 1 ] ARRAY aDat1 AUTOCOLS 

   REDEFINE XBROWSE oBrw2 ID 10 OF oFld:aDialogs[ 2 ] ARRAY aDat2 AUTOCOLS 

   oBrw1:aCols[ 2 ]:nEdittype := EDIT_BUTTON
   oBrw1:aCols[ 2 ]:bEditBlock := { || MsgYesNo( "Please select" ) }
    
   oBrw2:aCols[ 2 ]:nEdittype := EDIT_GET 

   ACTIVATE DIALOG oDlg CENTERED 

return nil 

//----------------------------------------------------------------------------//

CLASS TCtoXBrowse FROM TXbrowse

METHOD Hello() INLINE MsgInfo("Hello")

ENDCLASS

//----------------------------------------------------------------------------//

function CtoXbrowseNew( oWnd, nRow, nCol, nWidth, nHeight,;
                     aFlds, aHeaders, aColSizes,  ;
                     bChange, bLDblClick, bRClick, ;
                     oFont, oCursor, nClrFore, nClrBack, ;
                     cMsg, lUpdate, cDataSrc, bWhen, ;
                     lDesign, bValid, lPixel, nResID, lAutoSort, lAddCols, ;
                     aPics, aCols, aJust, aSort, lFooter, lFastEdit, ;
                     lCell, lLines, aRows, uBack, cBckMode, bClass, lTransparent,;
                     lNoBorder, cVarName, c2KStyle )

   local oBrw, n, i, oCol, oClass

   DEFAULT lTransparent := .F.
   DEFAULT oWnd := If( GetWndDefault() == nil, TWindow():New(), GetWndDefault() )

   // This function is intended only to support command syntax
   // and not to be used directly in application program

   if ValType( bClass ) == 'B'
      oClass      := Eval( bClass )
   endif
   if oClass != nil .and. oClass:IsKindOf( 'TCTOXBROWSE' )
      oBrw        := oClass:New( oWnd )
   else
      oBrw        := TCTOXBrowse():New( oWnd )
      if oClass != nil .and. oClass:IsKindOf( 'TXBRWCOLUMN' )
         oBrw:bColClass := bClass
      endif
   endif

   if ValType( aCols ) == 'A' .and. Len( aCols ) == 1 .and. ValType( aCols[ 1 ] ) == 'C' .and. AllTrim( aCols[ 1 ] ) == "*"
      lAddCols    := .t.
      aCols       := nil
   endif
   if ValType( aSort ) == 'A' .and. Len( aSort ) == 1 .and. ValType( aSort[ 1 ] ) == 'C' .and. Upper( AllTrim( aSort[ 1 ] ) ) == "AUTO"
      lAutoSort   := .t.
      aSort       := nil
   endif

   oBrw:lAutoSort  := lAutoSort
   oBrw:bLDblClick := bLDblClick
   oBrw:bRClicked  := bRClick

   aFlds          := CheckArray( aFlds )
   aHeaders       := CheckArray( aHeaders )
   aColSizes      := CheckArray( aColSizes )
   aPics          := CheckArray( aPics )
   aCols          := CheckArray( aCols )
   aJust          := CheckArray( aJust )
   aSort          := CheckArray( aSort )

   if aCols != nil
      aCols          := ASize( ArrTranspose( aCols ), 6 )
   endif

   XbrwSetDataSource( oBrw, cDataSrc, lAddCols, lAutoSort, ;
      If( aCols == nil, nil, aCols[ 1 ] ), aRows, aHeaders, bChange  )

   if c2KStyle != nil
      oBrw:SetStyle( If( c2KStyle == "FLAT", -1, Val( c2KStyle ) ) )
   endif

   DEFAULT oBrw:bChange := bChange

   DEFAULT aHeaders := {}, aPics := {}, aColSizes := {}, aSort := {}

   if aCols != nil
      aHeaders       := ArrMerge( aCols[ 2 ], aHeaders )
      aPics          := ArrMerge( aCols[ 3 ], aPics )
      aColSizes      := ArrMerge( aCols[ 4 ], aColSizes )
      aJust          := ArrMerge( aCols[ 5 ], aJust )
      aSort          := ArrMerge( aCols[ 6 ], aSort )
      //
      AEval( oBrw:aCols, { |o,i| If( Empty( o:cExpr ), o:cExpr := cValToChar( aCols[ 1, i ] ), nil ) },,Len( aCols[ 1 ] ) )
   endif

   if ! Empty( aFlds )
      for n := 1 to Len( aFlds )
         oBrw:AddCol():bEditValue   := aFlds[ n ]
      next
   endif

   for i := 1 to Len( oBrw:aCols )
      oCol  := oBrw:aCols[ i ]
      if Len( aPics ) >= i .and. aPics[ i ] != nil
         if ValType( aPics[ i ] ) == 'A'
            oCol:SetCheck( aPics[ i ] )
         elseif !Empty( aPics[ i ] )
            oCol:cEditPicture := aPics[ i ]
         endif
      endif
      if Len( aHeaders ) >= i .and. aHeaders[ i ] != nil
        oCol:cHeader   := cValToChar( aHeaders[ i ] )
      endif
      if Len( aColSizes ) >= i
         if .F. //aColSizes[ i ] != nil .and. aColSizes[ i ] < 0
            n              := -aColSizes[ i ]
            oCol:nDataLen  := Int( n )
            if n > oCol:nDataLen
               n           := Int( 10 * ( n - oCol:nDataLen ) )
               oCol:nDataDec  := n
            endif
         else
            oCol:nWidth    := aColSizes[ i ]
         endif
      endif
      if Len( aSort ) >= i .and. ! Empty( aSort[ i ] )
         oCol:cSortOrder := aSort[ i ]
      endif
   next i

   if valtype( nClrFore ) == 'N'
      DEFAULT nClrBack  := CLR_WHITE
      oBrw:bClrStd      := {|| { nClrFore, nClrBack } }
      oBrw:SetColor( nClrFore, nClrBack )
   endif

   if ValType( uBack ) $ 'ACNO'
      if ValType( uBack ) == 'A'
         n     := If( ValType( cBckMode ) == 'C', ( cBckMode != 'HORIZONTAL' ), .t. )
      else
         n     := If( ValType( cBckMode ) == 'C', AScan( { 'TILED','STRETCH','FILL' }, cBckMode ), 0 )

         n     := If( n > 0, n - 1, nil )
      endif
      oBrw:SetBackGround( uBack, n )
   endif

   if oFont != nil
      oBrw:SetFont( oFont )
   endif
   if bWhen != nil
      oBrw:bWhen      := bWhen
   endif
   if bValid != nil
      oBrw:bValid     := bValid
   endif
   if oCursor != nil
      oBrw:oCursor    := oCursor
   endif
   if cMsg != nil
      oBrw:cMsg       := cMsg
   endif

   oBrw:lDesign       := lDesign
   oBrw:lDrag         := lDesign

   if ! Empty( aJust )
      oBrw:aJustify  := aJust
   endif

   oBrw:lFooter   := lFooter
   oBrw:lFastEdit := lFastEdit

   if lLines
      oBrw:nColDividerStyle         := LINESTYLE_BLACK
      oBrw:nRowDividerStyle         := LINESTYLE_BLACK
      oBrw:lColDividerComplete      := .T.
   endif

   if lCell
      oBrw:nMarqueeStyle            := MARQSTYLE_HIGHLCELL
   endif

   if ValType( nResID ) == 'N'
      oBrw:CreateFromResource( nResID )
   else
      if nRow != nil
         oBrw:nTop       := nRow * If( lPixel, 1, BRSE_CHARPIX_H ) // 14
      endif

      if nCol != nil
         oBrw:nLeft      := nCol * If( lPixel, 1, BRSE_CHARPIX_W )  //8
      endif

      if nWidth != nil
         if nWidth <= 0
            oBrw:nRightMargin := -nWidth
            if oWnd:IsKindOf( "TDIALOG" ) .and. Empty( oWnd:hWnd ) .and. !oWnd:lTruePixel
               oBrw:nRightMargin *= 2
            endif
         else
            oBrw:nRight     := oBrw:nLeft + nWidth - 1
         endif
      endif

      if nHeight != nil
         if nHeight <= 0
            oBrw:nBottomMargin    := -nHeight
            if oWnd:IsKindOf( "TDIALOG" ) .and. Empty( oWnd:hWnd ) .and. !oWnd:lTruePixel
               oBrw:nBottomMargin *= 2
            endif
         else
            oBrw:nBottom    := oBrw:nTop + nHeight - 1
         endif
      endif

      if lNoBorder == .t. .and. lAnd( oBrw:nStyle, WS_BORDER )
         oBrw:nStyle       -= WS_BORDER
      endif
      if lTransparent
         oBrw:lTransparent := .t.
      endif
      oBrw:lUpdate      := lUpdate
   endif

   oBrw:cVarName = cVarName

return oBrw

//----------------------------------------------------------------------------//

static function CheckArray( aArray )

   if ValType( aArray ) == 'A' .and. ;
      Len( aArray ) == 1 .and. ;
      ValType( aArray[ 1 ] ) == 'A'

      aArray   := aArray[ 1 ]
   endif

return aArray

//----------------------------------------------------------------------------//

static function ArrMerge( aArray1, aArray2 )

   local n, nLen

   if Empty( aArray1 )
      aArray1    := aArray2
   elseif ! Empty( aArray2 )
      if Len( aArray1 ) < Len( aArray2 )
         ASize( aArray1, Len( aArray2 ) )
      endif
      AEval( aArray2, { |u,i| If( u == nil, , aArray1[ i ] := u ) } )
   endif

return aArray1
 
Source code of "xbrw_test.rc"

Code: Select all

#ifdef _FLAT_ 
1 24 "WindowsXP.Manifest" 
#endif 

test DIALOG 17, 36, 185, 147 
STYLE DS_MODALFRAME | WS_POPUP | WS_VISIBLE | WS_CAPTION | WS_SYSMENU 
CAPTION "Test" 
FONT 8, "MS Sans Serif" 
{ 
CONTROL "", 100, "SysTabControl32", 0 | WS_CHILD | WS_VISIBLE | WS_TABSTOP, 5, 6, 175, 117 
DEFPUSHBUTTON "OK", 1, 67, 128, 50, 14 
} 

one DIALOG 6, 15, 175, 117 
STYLE WS_CHILD | WS_VISIBLE 
FONT 8, "MS Sans Serif" 
{ 
CONTROL "", 10, "TCTOXBrowse", 0 | WS_CHILD | WS_VISIBLE | WS_BORDER | WS_HSCROLL, 4, 4, 168, 110 
} 

two DIALOG 6, 15, 175, 117 
STYLE WS_CHILD | WS_VISIBLE 
FONT 8, "MS Sans Serif" 
{ 
CONTROL "", 10, "TXBrowse", 0 | WS_CHILD | WS_VISIBLE | WS_BORDER | WS_HSCROLL, 4, 4, 168, 110 
}
Source code of "ctoxbrowse.ch"

Code: Select all


#xcommand @ <nRow>, <nCol> [ COLUMN ] CTOXBROWSE  <oBrw>  ;
               [ [ FIELDS ] <Flds,...>] ;
               [ <dsrc: ALIAS, ARRAY, RECSET, RECORDSET, OBJECT, DATASOURCE> <uDataSrc> ] ;
               [ <sizes:FIELDSIZES, SIZES, COLSIZES> <aColSizes,...> ] ;
               [ <head:HEAD,HEADER,HEADERS> <aHeaders,...> ] ;
               [ <pic: PICS, PICTURE, PICTURES> <aPics,...> ] ;
               [ <cols: COLS, COLUMNS> <aCols,...> ] ;
               [ <idx: SORT,ORDERS> <aSort,...> ] ;
               [ JUSTIFY <aJust,...> ] ;
               [ SIZE <nWidth>, <nHeigth> ] ;
               [ ID <nID> ] ;
               [ <dlg:OF,DIALOG> <oWnd> ] ;
               [ SELECT <cField> FOR <uValue1> [ TO <uValue2> ] ] ;
               [ <change: ON CHANGE, ON CLICK> <uChange> ] ;
               [ ON [ LEFT ] DBLCLICK <uLDblClick> ] ;
               [ ON RIGHT CLICK <uRClick> ] ;
               [ FONT <oFont> ] ;
               [ CURSOR <oCursor> ] ;
               [ <color: COLOR, COLORS> <nClrFore> [,<nClrBack>] ] ;
               [ MESSAGE <cMsg> ] ;
               [ <update: UPDATE> ] ;
               [ <pixel: PIXEL> ] ;
               [ WHEN <uWhen> ] ;
               [ <design: DESIGN> ] ;
               [ VALID <uValid> ] ;
               [ <autosort: AUTOSORT> ] ;
               [ <autocols: AUTOCOLS> ] ;
               [ <footers: FOOTERS> ] ;
               [ <fasted: FASTEDIT> ] ;
               [ <lcell: CELL> ] [ <llines: LINES> ] ;
               [ ROWS <aRows> ] ;
               [ BACKGROUND <uBack> [ <bckmode: TILED, STRETCH, FILL, VERTICAL, HORIZONTAL> ] ] ;
               [ CLASS <child> ] [ <transp: TRANSPARENT> ] [ <noborder: NOBORDER> ] ;
               [ STYLE <c2KStyle: FLAT,STANDARD,2007,2010,2013,2015> ] ;
      => ;
          <oBrw> := CtoXbrowseNew( <oWnd>, <nRow>, <nCol>, <nWidth>, <nHeigth>,;
                           [ \{ <{Flds}> \} ], ;
                           [\{<aHeaders>\}], [\{<aColSizes>\}], ;
                           [<{uChange}>],;
                           [\{|nRow,nCol,nFlags|<uLDblClick>\}],;
                           [\{|nRow,nCol,nFlags|<uRClick>\}],;
                           <oFont>, <oCursor>, <nClrFore>, <nClrBack>, <cMsg>,;
                           <.update.>, <uDataSrc>, <{uWhen}>,;
                           <.design.>, <{uValid}>, <.pixel.>, [<nID>], <.autosort.>, <.autocols.> , ;
                           [\{<aPics>\}], [\{<aCols>\}],;
                           [\{<aJust>\}], [\{<aSort>\}], <.footers.>, <.fasted.>, ;
                           <.lcell.>, <.llines.>, <aRows>, <uBack>, [upper(<(bckmode)>)], ;
                           [ If( ValType( <child> ) == 'B', <child>, <{child}> ) ], <.transp.>,;
                           <.noborder.>, [<(oBrw)>], [Upper(<"c2KStyle">)] )

#xcommand REDEFINE [ COLUMN ] CTOXBROWSE  <oBrw> [<clauses,...>] ID <nID> [<moreClauses,...>] ;
      => @ 0,0 CTOXBROWSE <oBrw> [<clauses>] ID <nID> [<moreClauses>]
 
Best Regards,

Gilbert Kuhnert
CTO Software GmbH
http://www.ctosoftware.de
User avatar
nageswaragunupudi
Posts: 8017
Joined: Sun Nov 19, 2006 5:22 am
Location: India
Contact:

Re: Error when using inherited Class from xBrowse and xBrowse si

Post by nageswaragunupudi »

We are looking into this.
Regards

G. N. Rao.
Hyderabad, India
User avatar
nageswaragunupudi
Posts: 8017
Joined: Sun Nov 19, 2006 5:22 am
Location: India
Contact:

Re: Error when using inherited Class from xBrowse and xBrowse si

Post by nageswaragunupudi »

It is compulsory to have this class data declared

Code: Select all

CLASSDATA lRegistered INIT .f.
 
in every class derived from any control, including txbrowse. If you include this declaration in the derived class you do not have this problem.

XBrowse is created to make it very easy to use any number of derived classes in the same application.

More important points for you to note are:

1) You do not have to create a new function similar to XBrowseNew() to create the derived class. The present function XBrowseNew() in the xbrowse.prg can handle any derived class and it is designed to do that.

2) You do not have to create a new command to create a browse with the derived class. The existing XBROWSE command can handle derived classes also.

Syntax:

Code: Select all

REDEFINE XBROWSE <clauses> CLASS DerivedClass() <otherClauses>
 
Please see \fwh\samples\xbrchild.prg which demonstrates how to create and use classes derived from txbrowse. This is a very important advice.

We have modified the sample program you posted above. Please remove all the changes you made to xbrowse.prg and also the new include file.

No need for "ctoxbrowse.ch".
No need for the function CtoXbrowseNew()

Please use the original xbrowse.prg as provided by the FWH in its release and test this program with the same rc file you posted. Please remove all your changes.

Code: Select all

#include "FiveWin.ch"

function Main()

   local oDlg, oFld, oBrw1, oBrw2
   local aDat1, aDat2

   aDat1:={{"Row1-Col1","Row1-Col2","Row1-Col3"},;
                 {"Row2-Col1","Row2-Col2","Row2-Col3"},;
                 {"Row3-Col1","Row3-Col2","Row3-Col3"},;
                 {"Row4-Col1","Row4-Col2","Row4-Col3"}}

   aDat2:={{"ROW1-COL1","ROW1-COL2","ROW1-COL3"},;
                 {"ROW2-COL1","ROW2-COL2","ROW2-COL3"},;
                 {"ROW3-COL1","ROW3-COL2","ROW3-COL3"},;
                 {"ROW4-COL1","ROW4-COL2","ROW4-COL3"}}

   DEFINE DIALOG oDlg RESOURCE "Test"

   REDEFINE FOLDER oFld ;
      PROMPTS "One", "Two" ;
      DIALOGS "One", "Two" ;
      ID 100 OF oDlg

   REDEFINE XBROWSE oBrw1 ID 10 OF oFld:aDialogs[ 1 ] ARRAY aDat1 AUTOCOLS CLASS TCtoXBrowse()

   REDEFINE XBROWSE oBrw2 ID 10 OF oFld:aDialogs[ 2 ] ARRAY aDat2 AUTOCOLS

   oBrw1:aCols[ 2 ]:nEdittype := EDIT_BUTTON
   oBrw1:aCols[ 2 ]:bEditBlock := { || MsgYesNo( "Please select" ) }

   oBrw2:aCols[ 2 ]:nEdittype := EDIT_GET

   ACTIVATE DIALOG oDlg CENTERED

return nil

//----------------------------------------------------------------------------//

CLASS TCtoXBrowse FROM TXbrowse

   CLASSDATA lRegistered INIT .F.

   METHOD Hello() INLINE MsgInfo("Hello")

ENDCLASS
 
This is all that you need. This program is working correctly.

Please always indicate the fwh version you are using, in your posts. That helps us to reply based on the version you are using.
Regards

G. N. Rao.
Hyderabad, India
User avatar
gkuhnert
Posts: 274
Joined: Fri Apr 04, 2008 1:25 pm
Location: Aachen - Germany // Kerkrade - Netherlands
Contact:

Re: Error when using inherited Class from xBrowse and xBrowse si

Post by gkuhnert »

Dear Mr. Rao,

thanks for your competent help, it works perfectly! I didn't know about the functionality of class data "lRegistered".
Best Regards,

Gilbert Kuhnert
CTO Software GmbH
http://www.ctosoftware.de
Post Reply