Error en TTABS desde código

[Manuel Aranda]

Estoy pasando una vieja aplicación en FW a FWH y me encuentro con el problema de que TTABS me da error desde código (no desde recursos)

En el ejemplo de SAMPLES/testtabs.prg:

Code: Select all  Expand view  RUN

......
   @ 8, 0 TABS oTabs PROMPTS "&One", "&Two", "T&hree", "&Four" OF oWnd ;
      ACTION oWnd:Say( 5, 5, oTabs:nOption )

   oWnd:oBottom = oTabs
........


me da el siguiente error:

Time from start: 0 hours 0 mins 1 secs
Error occurred at: 24-09-2008, 20:04:00
Error description: Error BASE/1004 Message not found: TTABS:DEFCONTROL

Stack Calls
===========
Called from: => TTABS:ERROR(179)
Called from: tobject.prg => (b)HBOBJECT:HBOBJECT(105)
Called from: => TTABS:MSGNOTFOUND(0)
Called from: TABS.PRG => TTABS:DEFCONTROL(167)
Called from: BTNBMP.PRG => TBTNBMP:NEW(0)
Called from: TABS.PRG => TTABS:NEW(0)

Alguien sabe la razón ?

[Antonio Linares]

Manuel,

El ejemplo TestTabs.prg, usando los nuevos Tabs (tipo Office 2007) aqui funciona bien con FWH 8.09. Lo acabo de probar.

Que versión de FWH estás usando ?

Por el error que muestras parece que se está intentado construir un TBtnBmp (posiblemente los botones pequeños que se usan en los Tabs para navegar hacia los lados) y que no encuentra el handle del control TTab por lo que intenta llamar a DefControl() (como si fuese a ser situado sobre un diálogo).

Si copias aqui el código de la Clase TTabs que usas, podemos indicarte cual es el error que tenga.

[Manuel Aranda]

Hola Antonio, gracias por contestar:

La versión de FWH que uso es la 2.8 (Octubre/2006). El ejemplo testtabs.prg lo he compilado y funciona perfectamente. Sin embargo dentro de mi código

@ 8, 0 TABS oTabs PROMPTS "&One", "&Two", "T&hree", "&Four" OF oDlg

me da el error ya comentado.


Este es el código de la clase

Code: Select all  Expand view  RUN

#include "FiveWin.ch"
#include "Constant.ch"

#define COLOR_WINDOW         5
#define COLOR_WINDOWTEXT     8
#define COLOR_BTNFACE       15
#define COLOR_BTNSHADOW     16
#define COLOR_BTNHIGHLIGHT  20

#define FD_BORDER            8
#define FD_HEIGHT           22

#define DT_CENTER            1
#define DT_VCENTER           4

#define WINDING              2
#define SC_KEYMENU       61696   // 0xF100

#define TCM_FIRST         4864   // 0x1300
#define TCM_DELETEITEM   ( TCM_FIRST +  8 )
#define TCM_GETCURSEL    ( TCM_FIRST + 11 )
#define TCM_SETCURSEL    ( TCM_FIRST + 12 )
#define TCM_SETBKCOLOR    4865
#define TCM_GETITEMCOUNT  4868

#define NM_FIRST             0
#define NM_CLICK          ( NM_FIRST - 2 )
#define NM_SETFOCUS       ( NM_FIRST - 7 )
#define NM_KILLFOCUS      ( NM_FIRST - 8 )

#ifdef __XPP__
   #define Super ::TControl
   #define New _New
#endif

#ifdef __CLIPPER__
   #define CTRL_CLASS  "SysTabControl"
#else
   #define CTRL_CLASS  "SysTabControl32"
#endif

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

CLASS TTabControl FROM TControl

   CLASSDATA aProperties INIT { "aPrompts", "nAlign", "nClrText", "nClrPane",;
                                "nOption", "nTop", "nLeft", "nWidth",;
                                "nHeight", "Cargo" }
   DATA   aPrompts
   DATA   bAction

   METHOD New( nTop, nLeft, aPrompts, bAction, oWnd, nOption, nClrFore,;
               nClrBack, lPixel, lDesign, nWidth, nHeight,;
               cMsg ) CONSTRUCTOR

   METHOD ReDefine( nId, oWnd ) CONSTRUCTOR

   METHOD Add( cPrompt ) INLINE TabCtrlAdd( ::hWnd, cPrompt )

   METHOD DelItem( nItem ) INLINE SendMessage( ::hWnd, TCM_DELETEITEM, nItem - 1 )

   METHOD GetItemCount() INLINE SendMessage( ::hWnd, TCM_GETITEMCOUNT )

   METHOD nOption() INLINE SendMessage( ::hWnd, TCM_GETCURSEL ) + 1
   METHOD _nOption( nNewOption ) INLINE ;
                         SendMessage( ::hWnd, TCM_SETCURSEL, nNewOption - 1 )

   METHOD MouseMove( nRow, nCol, nFlags ) INLINE ;
      ( Super:MouseMove( nRow, nCol, nFlags ), nil ) // finally invoke default behavior

   METHOD Notify( nIdCtrl, nPtrNMHDR )

   METHOD SetBkColor( nColor ) INLINE ;
          SendMessage( ::hWnd, TCM_SETBKCOLOR, 0, nColor )

ENDCLASS

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

METHOD New( nTop, nLeft, aPrompts, bAction, oWnd, nOption, nClrFore,;
            nClrBack, lPixel, lDesign, nWidth, nHeight, cMsg ) CLASS TTabControl

   DEFAULT nTop     := 0, nLeft := 0,;
           aPrompts := { "&One", "&Two", "T&hree" },;
           oWnd     := GetWndDefault(),;
           nOption  := 1,;
           nClrFore := oWnd:nClrText,;
           nClrBack := GetSysColor( COLOR_BTNFACE ),;
           lPixel   := .f.,;
           lDesign  := .f.,;
           nWidth   := 200, nHeight := 21

   #ifdef __XPP__
      #undef New
   #endif

   ::nStyle    = nOR( WS_CHILD, WS_VISIBLE,;
                      If( lDesign, WS_CLIPSIBLINGS, 0 ), WS_TABSTOP )
   ::nId       = ::GetNewId()
   ::oWnd      = oWnd
   ::aPrompts  = aPrompts
   ::bAction   = bAction
   ::cMsg      = cMsg
   ::nTop      = If( lPixel, nTop, nTop * SAY_CHARPIX_H )
   ::nLeft     = If( lPixel, nLeft, nLeft * SAY_CHARPIX_W )
   ::nBottom   = ::nTop + nHeight - 1
   ::nRight    = ::nLeft + nWidth - 1
   ::lDrag     = lDesign
   ::lCaptured = .f.
   ::oFont     = TFont():New( "Ms Sans Serif", 0, -9 )
   ::nClrText  = nClrFore
   ::nClrPane  = nClrBack

   if ! Empty( oWnd:hWnd )
      ::Create( CTRL_CLASS )
      oWnd:AddControl( Self )
   else
      oWnd:DefControl( Self )
   endif

   ::Default()

   if lDesign
      ::CheckDots()
   endif

   ::nOption = nOption

return Self

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

METHOD ReDefine( nId, oWnd ) CLASS TTabControl

   ::nId     = nId
   ::oWnd    = oWnd
   oWnd:DefControl( Self )

return Self

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

METHOD Notify( nIdCtrl, nPtrNMHDR ) CLASS TTabControl

   local nCode := GetNMHDRCode( nPtrNMHDR )

   do case
      case nCode == NM_CLICK
           if ::bAction != nil
              Eval( ::bAction, Self )
           endif

      case nCode == NM_SETFOCUS
           if ::bGotFocus != nil
              Eval( ::bGotFocus, Self )
           endif

      case nCode == NM_KILLFOCUS
           if ::bLostFocus != nil
              Eval( ::bLostFocus, Self )
           endif

   endcase

return nil

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


[Antonio Linares]

Manuel,

Ese código no es el de la Clase TTabs. Revisa source\classes\tabs.prg

Una solución temporal sería crear ese control desde la claúsula ON INIT del diálogo:

Code: Select all  Expand view  RUN

ACTIVATE DIALOG oDlg ;
   ON INIT CreaTabs( oDlg )

...

function CreaTabs( oDlg )

   @ 8, 0 TABS oTabs PROMPTS "&One", "&Two", "T&hree", "&Four" OF oDlg

return nil


[Manuel Aranda]

Gracias Antonio. Temporalmente me vale, pues la idea es hacerlo desde recursos en cuanto pueda.