MSGItem 2007

Silvio · Post by **Silvio** » Thu Nov 08, 2007 7:07 pm

Perhaps I resolve
this is ttabs look 2007

#include "FiveWin.ch"
#include "Constant.ch"
// #include "WColors.ch"

#define COLOR_ACTIVECAPTION   2
#define COLOR_INACTIVECAPTION 3
#define COLOR_WINDOW          5
#define COLOR_WINDOWTEXT      8
#define COLOR_BTNFACE        15
#define COLOR_BTNSHADOW      16
#define COLOR_INACTIVECAPTIONTEXT  19
#define COLOR_BTNHIGHLIGHT   20


#define FD_BORDER             8
#define FD_HEIGHT            22

#define DT_CENTER             1
#define DT_LEFT               0
#define DT_VCENTER            4
#define DT_TOP                0

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

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

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

CLASS TTabs FROM TControl

   CLASSDATA lRegistered AS LOGICAL
   CLASSDATA aProperties INIT { "aPrompts", "nAlign", "nClrText", "nClrPane",;
                                "nOption", "nTop", "nLeft", "nWidth",;
                                "nHeight", "Cargo" }

   DATA   aPrompts, aSizes
   DATA   nOption
   DATA   bAction

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

   METHOD ReDefine( nId, aPrompts, bAction, oWnd, nOption, nClrFore,;
                    nClrBack ) CONSTRUCTOR

   METHOD Display()
   METHOD Paint()
   METHOD Initiate( hDlg )
   METHOD LButtonDown( nRow, nCol, nFlags )
   METHOD Default()
   METHOD AddItem( cItem )

   METHOD DelItem()

   METHOD SetOption( nOption )

   METHOD SetTabs( aTabs, nOption )

   METHOD GetHotPos( nChar )

   METHOD SysCommand( nType, nLoWord, nHiWord )

   METHOD Inspect( cData )

   METHOD EditPrompts()

ENDCLASS

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

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

   #ifdef __XPP__
      #undef New
   #endif

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

   ::nStyle    = nOR( WS_CHILD, WS_VISIBLE,;
                      If( lDesign, WS_CLIPSIBLINGS, 0 ), WS_TABSTOP )
   ::nId       = ::GetNewId()
   ::oWnd      = oWnd
   ::aPrompts  = aPrompts
   ::bAction   = bAction
   ::nOption   = nOption
   ::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( GetDefaultFontName(), 0, GetDefaultFontHeight(),, )
   // ::oFont     = TFont():New( "Ms Sans Serif", 0, -9 )
   ::nClrText  = nClrFore
   ::nClrPane  = nClrBack

   ::oBrush := TBrush():New(,GetSysColor(15)-RGB(30,30,30))

   #ifdef __XPP__
      DEFAULT ::lRegistered := .f.
   #endif

   ::Register()

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

   ::Default()

   if lDesign
      ::CheckDots()
   endif

return Self

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

METHOD ReDefine( nId, aPrompts, bAction, oWnd, nOption, nClrFore,;
                 nClrBack ) CLASS TTabs

   local n, oDlg

   DEFAULT nOption  := 1,;
           nClrFore := oWnd:nClrText,;
           nClrBack := GetSysColor( COLOR_BTNFACE )

   ::nId      = nId
   ::oWnd     = oWnd
   ::aPrompts = aPrompts
   ::bAction  = bAction
   ::nOption  = nOption
   ::oFont    = TFont():New( "Ms Sans Serif", 0, -9 )
   ::nClrText = nClrFore
   ::nClrPane = nClrBack

   ::Register()

   oWnd:DefControl( Self )

return Self

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

METHOD Display() CLASS TTabs

   ::BeginPaint()
   ::Paint()
   ::EndPaint()

return 0

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

METHOD Paint() CLASS TTabs

  
   local hDarkPen  := CreatePen( PS_SOLID, 1, GetSysColor( COLOR_BTNSHADOW ) )
   local hGrayPen  := CreatePen( PS_SOLID, 1, GetSysColor( COLOR_BTNFACE ) )
   local hLightPen := CreatePen( PS_SOLID, 1, GetSysColor( COLOR_ACTIVECAPTION ) )
   local n, nCol := 8
   local hOldFont, hOldBrush, hOldPen
   local hDC := ::GetDC()
   local hGrayBrush := CreateSolidBrush( GetSysColor(15) )
   local hDarkBrush := CreateSolidBrush( CLR_WHITE )

   hOldFont  = SelectObject( hDC, ::oFont:hFont )
   hOldPen   = SelectObject( hDC, hDarkPen )
   hOldBrush = SelectObject( hDC, hDarkBrush )

   MoveTo( hDC, 0, 0 )
   LineTo( hDC, ::nWidth(), 0 )

   SetBlackPen( hDC )
   MoveTo( hDC, 0, 1 )
   LineTo( hDC, ::nWidth(), 1 )

   SetTextColor( hDC, CLR_WHITE )

   if Len( ::aSizes ) < Len( ::aPrompts )
      ::Default()
   endif

   for n = 1 to Len( ::aPrompts )
      SelectObject( hDC, If( n != ::nOption, hGrayBrush, hDarkBrush ) )
      SetBlackPen( hDC )
/*
      PolyPolygon( hDC, { { nCol , 2 },;
                          { nCol , 20 },;
                          { nCol + 2, 22 },;
                          { nCol + 08 + ::aSizes[ n ], 22 },;
                          { nCol + 18 + ::aSizes[ n ], 12 },;
                          { nCol + 18 + ::aSizes[ n ], 1 },;
                          { nCol , 1 } } )
*/
      if n == 1 .or. n == ::nOption
         PolyPolygon( hDC, { { nCol , 2 },;
                             { nCol , 20 },;
                             { nCol + 2, 22 },;
                             { nCol + 08 + ::aSizes[ n ], 22 },;
                             { nCol + 29 + ::aSizes[ n ], 1  },;
                             { nCol , 1 } } )
      else
         PolyPolygon( hDC, { { nCol , 13 },;
                             { nCol , 20 },;
                             { nCol + 2, 22 },;
                             { nCol + 08 + ::aSizes[ n ], 22 },;
                             { nCol + 29 + ::aSizes[ n ], 1  },;
                             { nCol + 12, 1 }  } )
      endif
      If n == ::noption
         SelectObject( hDC, hLightPen )
         MoveTo( hDC, nCol+1, 19 )
         LineTo( hDC, nCol+9+::aSizes[n]+2, 19 )
         MoveTo( hDC, nCol+1, 20 )
         LineTo( hDC, nCol+9+::aSizes[n]+1, 20 )
         MoveTo( hDC, nCol+2, 21 )
         LineTo( hDC, nCol+9+::aSizes[n]  , 21 )
         //MoveTo( hDC, nCol + 3 , 23 )
         //LineTo( hDC, nCol + 8 + ::aSizes[ n ] - 2, 23 )

         SetTextColor( hDC, ::nClrText )
         SetBkColor( hDC, ::nClrPane )
         SetBkColor( hDC, CLR_WHITE )
         DrawText( hDC, ::aPrompts[ n ],;
                   { iif(largefonts(),4,5), nCol+7, 19, nCol + 8 + ::aSizes[ n ] },;
                    nOr( DT_LEFT, DT_VCENTER ) )
      else
         SetTextColor( hDC, ::nClrText )
         SetBkColor( hDC, GetSysColor(15) )
         DrawText( hDC, ::aPrompts[ n ],;
                   { iif(largefonts(),4,5), nCol+6 , 19, nCol + 8 + ::aSizes[ n ] },;
                    nOr( DT_CENTER, DT_VCENTER ) )
      endif
      if n > 1 .AND. n != ::nOption
         SetBlackPen( hDC )
         MoveTo( hDC, nCol, 13 )
         LineTo( hDC, nCol+12, 1 )
      endif
      nCol += ::aSizes[ n ] + 17 // + 4 + 6
   next

   SelectObject( hDC, hOldPen )
   SelectObject( hDC, hOldFont )
   SelectObject( hDC, hOldBrush )

   DeleteObject( hDarkPen )
   DeleteObject( hGrayPen )
   DeleteObject( hLightPen )
   DeleteObject( hDarkBrush )
   DeleteObject( hGrayBrush )

   ::ReleaseDC()
   sysrefresh()
return nil

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

METHOD Initiate( hDlg ) CLASS TTabs

   Super:Initiate( hDlg )

   if ::oBrush == nil
      ::oBrush := TBrush():New(,CLR_WHITE)
      // DEFINE BRUSH ::oBrush STYLE TABS
   endif

   ::Default()

return nil

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

METHOD LButtonDown( nRow, nCol, nFlags ) CLASS TTabs

   local n := 1, nPos := 5, nDesp := 18

   if ::lDrag
      return Super:LButtonDown( nRow, nCol, nFlags )
   else
      if nRow <= FD_HEIGHT
         while nCol > nPos + ::aSizes[ n ] + nDesp .and. n < Len( ::aPrompts )
            nPos += ::aSizes[ n ] + nDesp // + 10
            n++
         end
         ::SetOption( n )
      endif
   endif

return nil

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

METHOD Default() CLASS TTabs

   local n

   ::aSizes = Array( Len( ::aPrompts ) )

   for n = 1 to Len( ::aPrompts )
      ::aSizes[ n ] = GetTextWidth( 0, StrTran( ::aPrompts[ n ], "&", "" ),;
                                    ::oFont:hFont )
   next

return nil

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

METHOD AddItem( cItem ) CLASS TTabs

   AAdd( ::aPrompts, cItem )
   ::Default()
   ::Refresh()

return nil

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

METHOD DelItem() CLASS TTabs

   if Len( ::aPrompts ) > 1
      ::aPrompts = ADel( ::aPrompts, ::nOption )
      ::aPrompts = ASize( ::aPrompts, Len( ::aPrompts ) - 1 )
   else
      ::aPrompts = { "No Defined" }
   endif
   ::Default()
   ::Refresh()

return nil

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

METHOD SetOption( nOption ) CLASS TTabs

   if nOption != ::nOption
      ::nOption = nOption
      ::Paint()
      if ! Empty( ::bAction )
         Eval( ::bAction, nOption )
      endif
   endif

return nil

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

METHOD GetHotPos( nChar ) CLASS TTabs

   local n := 1
   local nAt

   while n <= Len( ::aPrompts )
     if ( nAt := At( "&", ::aPrompts[ n ] ) ) != 0 .and. ;
        Lower( SubStr( ::aPrompts[ n ], nAt + 1, 1 ) ) == Chr( nChar )
        return n
     endif
     n++
   end

return 0

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

METHOD SysCommand( nType, nLoWord, nHiWord ) CLASS TTabs

   local nItem

   do case
      case nType == SC_KEYMENU      // Alt+... control accelerator pressed
           if ( nItem := ::GetHotPos( nLoWord ) ) > 0
              ::SetOption( nItem )
              return 0
           endif
   endcase

return nil

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

METHOD SetTabs( aTabs, nOption ) CLASS TTabs

   DEFAULT aTabs := { "&One", "&Two", "T&hree" }, nOption := 1

   ::aPrompts = aTabs
   ::nOption  = nOption
   ::Default()
   ::Refresh()

return nil

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

METHOD Inspect( cData ) CLASS TTabs

   if cData == "aPrompts"
      return { || ::EditPrompts() }
   endif

return nil

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

METHOD EditPrompts() CLASS TTabs

   local oDlg, n
   local cPrompts := ""
   local oFont
   local lOk := .f.
   local aPrompts := {}

   for n = 1 to Len( ::aPrompts )
      cPrompts += ::aPrompts[ n ] + CRLF
   next

   DEFINE FONT oFont NAME "Ms Sans Serif" SIZE 0, -8

   DEFINE DIALOG oDlg SIZE 300, 178 TITLE "Edit prompts" FONT oFont

   @ 0.2, 0.3 GET cPrompts MEMO SIZE 145, 70

   @ 7.5, 10.1 BUTTON "&Ok"     SIZE 30, 11 ACTION ( lOk := .t., oDlg:End() )
   @ 7.5, 22.1 BUTTON "&Cancel" SIZE 30, 11 ACTION oDlg:End()

   ACTIVATE DIALOG oDlg CENTERED

   if lOk
      for n = 1 to MLCount( cPrompts )
         AAdd( aPrompts, AllTrim( MemoLine( cPrompts,, n ) ) )
      next
      ::SetTabs( aPrompts, 1 )
   endif

return nil

//----------------------------------------------------------------------------//
#pragma BEGINDUMP
#include "Windows.h"
#include "hbapi.h"

HB_FUNC( GETDEFAULTFONTNAME )
{
   LOGFONT lf;
   GetObject( ( HFONT ) GetStockObject( DEFAULT_GUI_FONT )  , sizeof( LOGFONT ), &lf );
   hb_retc( lf.lfFaceName );
}

HB_FUNC( GETDEFAULTFONTHEIGHT )
{
   LOGFONT lf;
   GetObject( ( HFONT ) GetStockObject( DEFAULT_GUI_FONT )  , sizeof( LOGFONT ), &lf );
   hb_retni( lf.lfHeight );
}

HB_FUNC( GETDEFAULTFONTWIDTH )
{
   LOGFONT lf;
   GetObject( ( HFONT ) GetStockObject( DEFAULT_GUI_FONT )  , sizeof( LOGFONT ), &lf );
   hb_retni( lf.lfWidth );
}

HB_FUNC( GETDEFAULTFONTITALIC )
{
   LOGFONT lf;
   GetObject( ( HFONT ) GetStockObject( DEFAULT_GUI_FONT )  , sizeof( LOGFONT ), &lf );
   hb_retl( (BOOL) lf.lfItalic );
}

HB_FUNC( GETDEFAULTFONTUNDERLINE )
{
   LOGFONT lf;
   GetObject( ( HFONT ) GetStockObject( DEFAULT_GUI_FONT )  , sizeof( LOGFONT ), &lf );
   hb_retl( (BOOL) lf.lfUnderline );
}

HB_FUNC( GETDEFAULTFONTBOLD )
{
   LOGFONT lf;
   GetObject( ( HFONT ) GetStockObject( DEFAULT_GUI_FONT )  , sizeof( LOGFONT ), &lf );
   hb_retl( (BOOL) ( lf.lfWeight == 700 ) );
}

HB_FUNC( GETDEFAULTFONTSTRIKEOUT )
{
      LOGFONT lf;
      GetObject( ( HFONT ) GetStockObject( DEFAULT_GUI_FONT )  , sizeof( LOGFONT ), &lf );
      hb_retl( (BOOL) lf.lfStrikeOut );
}

#pragma ENDDUMP

[img=http://img215.imageshack.us/img215/2880/sociuz4.th.jpg][/img]

Post by **Antonio Linares** » Thu Nov 08, 2007 7:13 pm

> Can't you use the same technique used for the page number in rpreview.prg?

Yes, the idea is to force a background refresh

Silvio · Post by **Silvio** » Thu Nov 08, 2007 11:26 pm

yes Antonio I'd like create something of it
when the mouse is over the item must change color ( orange as 2003 style).

Silvio · Post by **Silvio** » Thu Nov 08, 2007 11:27 pm

Antonio, explain me How corrct background of msgitem

Post by **Antonio Linares** » Fri Nov 09, 2007 10:47 am

Silvio,

I am working on it to find a way

Silvio · Post by **Silvio** » Fri Nov 09, 2007 12:39 pm

thanks, antonio

Do you saw my changes into TTabs class ?

I now I'm trying to change the direction odf poligon and insert

define TAB oTAbs..... LEFT - RIGHT - TOP - BOTTOM command

richard-service · Post by **richard-service** » Fri Nov 09, 2007 1:45 pm

Hi Antonio,

Same as STATUSBAR component?
How to make it like MsgBar?
Ex. put bitmap or easy put item in STATUSBAR?

Regards,

Richard

Post by **Antonio Linares** » Sat Nov 10, 2007 9:28 pm

Silvio,

> Do you saw my changes into TTabs class ?

Please post a screenshot, thanks

Silvio · Post by **Silvio** » Sun Nov 11, 2007 1:02 am

OLD TTABS

TTABS 2003

TTABS 2007

Post by **Antonio Linares** » Sun Nov 11, 2007 9:41 am

This is how Tabs look in Office 2007:

Post by **nageswaragunupudi** » Sun Nov 11, 2007 11:52 am

Mr Antonio

Do you have Tabs 2007 style in your todo list ? We shall be too glad if you can provide it to us.

Silvio · Post by **Silvio** » Sun Nov 11, 2007 12:56 pm

Antonio,
Give me time I'm working on it

Do you want bitmaps also into ?

Post by **Antonio Linares** » Sun Nov 11, 2007 6:13 pm

NageswaraRao,

We are planning how it could be implemented

Silvio · Post by **Silvio** » Mon Nov 12, 2007 9:18 am

Antonio,
I trying to create it
I made the bar graph style 2007
But I not Know how refill each tab with the gradient function
perhaps we can create a new class Brush with the possibility to create color gradient , then we can modifiy the each prompts because the txt is not trasparent.
I think to insert also a image on each tab as we can with foldbmp

Post by **Antonio Linares** » Mon Nov 12, 2007 9:22 am

Silvio,

> But I not Know how refill each tab with the gradient function

Thats the real dificulty there