this is ttabs look 2007
- Code: Select all Expand view
#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]
![[img=http://img215.imageshack.us/img215/2880/sociuz4.th.jpg]](http://img215.imageshack.us/my.php?image=sociuz4.jpg){kind=link}
![[img=http://img413.imageshack.us/img413/2860/ttab2007mu9.th.png]](http://img413.imageshack.us/my.php?image=ttab2007mu9.png){kind=link}