FiveTech Support Forums

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

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

#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

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

ACTIVATE DIALOG oDlg ;
   ON INIT CreaTabs( oDlg )

...

function CreaTabs( oDlg )

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

return nil