Modifying tGroup class
Posted: Fri May 12, 2017 2:40 pm
I wish modify tgroup class inserting a color panel on the top of the group sample :
any solution ?
any solution ?
Please help for this
the image is showed BUT the label is showed bad
the round corner are showed bad
test.prg
Code: Select all
#include "FiveWin.ch"
#include "Constant.ch"
#define WM_NCHITTEST 132 // 0x84
#define WM_UPDATEUISTATE 296 // 0x0128
#define DT_TOP 0
#define DT_LEFT 0
#define DT_CENTER 1
#define DT_RIGHT 2
#define DT_VCENTER 4
#define DT_BOTTOM 8
#define DT_WORDBREAK 16
#define DT_SINGLELINE 32
#define DT_EXPANDTABS 64
#define DT_TABSTOP 128
#define DT_NOCLIP 256
#define DT_EXTERNALLEADING 512
#define DT_CALCRECT 1024
#define DT_NOPREFIX 2048
#define DT_INTERNAL 4096
Function Main()
Local oDlg,oGr
Local oFont
local oget
local cget:= space(30)
DEFINE FONT oFont NAME "CALIBRI" SIZE 0,-12
DEFINE DIALOG oDlg SIZE 400,400
oGr := TGroupeX():New( 10, 2, 100, 175, "Anagrafica cliente", oDlg,,, .T.,,,,, )
oGr:cImage:="test.bmp"
@ 20,2 SAY "Name : " of oDlg PIXEL
@ 20,15 get oget var cget of oDlg size 100,12 PIXEL
ACTIVATE DIALOG oDlg CENTER
RETURN NIL
//----------------------------------------------------------------------------//
CLASS TGroupEx FROM TControl
DATA cImage
DATA nTextAlign INIT 0
DATA nImgAlign INIT 0
DATA lTransparent INIT .f.
DATA l2007
DATA lRound
DATA nMargin
DATA lBorder
DATA nBorderColor
DATA nColorFrom
DATA nColorTo
DATA nColorText
DATA lVertical
METHOD New( nTop, nLeft, nBottom, nRight, cLabel, oWnd, nClrText,;
nClrPane, lPixel, lDesign, oFont, lTransparent, nWidth, nHeight ) CONSTRUCTOR
METHOD ReDefine( nId, cLabel, oWnd, nClrText, nClrPane, oFont, lTransparent ) CONSTRUCTOR
METHOD cGenPRG( lDlgUnits )
METHOD cToChar() INLINE ::Super:cToChar( "BUTTON" )
METHOD HandleEvent( nMsg, nWParam, nLParam )
METHOD Initiate( hDlg )
METHOD Paint()
METHOD Display() INLINE ::BeginPaint(), ::Paint(), ::EndPaint(), 0
METHOD SaveToRC( nIndent )
METHOD LoadImage( cImage )
METHOD PaintH (aRect)
ENDCLASS
//----------------------------------------------------------------------------//
METHOD New( nTop, nLeft, nBottom, nRight, cLabel, oWnd, nClrText, nClrPane,;
lPixel, lDesign, oFont, lTransparent, nWidth, nHeight ) CLASS TGroupeX
DEFAULT nTop := 0, nLeft := 0, nBottom := 3, nRight := 3,;
oWnd := GetWndDefault(),;
nClrText := oWnd:nClrText, nClrPane := oWnd:nClrPane,;
lPixel := .f., lDesign := .f.,;
lTransparent := .f., oFont := oWnd:oFont
::lUnicode = FW_SetUnicode()
::nTop = nTop * If( lPixel, 1, GRP_CHARPIX_H ) // 14
::nLeft = nLeft * If( lPixel, 1, GRP_CHARPIX_W ) // 7
::nMargin := 2
if nWidth != nil
::nRight = ::nLeft + nWidth
else
::nRight = nRight * If( lPixel, 1, GRP_CHARPIX_W ) // 7
endif
if nHeight != nil
::nBottom = ::nTop + nHeight
else
::nBottom = nBottom * If( lPixel, 1, GRP_CHARPIX_H ) // 14
endif
::cCaption = cLabel
::oWnd = oWnd
::nStyle = nOR( WS_CHILD, WS_VISIBLE, BS_GROUPBOX,;
If( lDesign, nOr( WS_TABSTOP, WS_CLIPSIBLINGS ), 0 ) )
::nId = ::GetNewId()
::lUpdate = .f.
::lDrag = lDesign
::lTransparent = lTransparent
::SetColor( nClrText, nClrPane )
if lTransparent
::SetBrush( TBrush():New( "NULL" ) )
endIf
if ! Empty( oWnd:hWnd )
::Create( "BUTTON" )
oWnd:AddControl( Self )
else
oWnd:DefControl( Self )
endif
if oFont != nil
::SetFont( oFont )
endIf
if lDesign
::CheckDots()
endif
return Self
//----------------------------------------------------------------------------//
METHOD ReDefine( nId, cLabel, oWnd, nClrText, nClrPane, oFont,;
lTransparent ) CLASS TGroupeX
DEFAULT nId := ::GetNewId(),;
nClrText := oWnd:nClrText, nClrPane := oWnd:nClrPane,;
lTransparent:= .f., oWnd := GetWndDefault()
::nId = nId
::cCaption = cLabel
::hWnd = 0
::oWnd = oWnd
::lUpdate = .f.
::lTransparent = lTransparent
::lUnicode = FW_SetUnicode()
::SetColor( nClrText, nClrPane )
If lTransparent
::SetBrush( TBrush():New( "NULL" ) )
EndIf
if oFont != Nil
::SetFont( oFont )
endIf
oWnd:DefControl( Self )
return Self
//----------------------------------------------------------------------------//
METHOD cGenPRG( lDlgUnits ) CLASS TGroupeX
local cPrg := ""
local nFactorX, nFactorY
local cTop, cLeft, cWidth, cHeight
DEFAULT lDlgUnits := .F.
nFactorX = If( lDlgUnits, 4 / nLoWord( GetDlgBaseUnits() ), 1 )
nFactorY = If( lDlgUnits, 8 / nHiWord( GetDlgBaseUnits() ), 1 )
::CoorsUpdate()
if ::cCaption == nil
::cCaption = ::GetText()
endif
cTop = LTrim( Str( Int( ::nTop * nFactorX ) ) )
cLeft = LTrim( Str( Int( ::nLeft * nFactorY ) ) )
cWidth = LTrim( Str( Int( ::nWidth * nFactorY ) ) )
cHeight = LTrim( Str( Int( ::nHeight * nFactorX ) ) )
cPrg += CRLF + " @ " + cTop + ", " + cLeft + ;
' GROUP oGrp PROMPT "' + ::cCaption + '" SIZE ' + ;
cWidth + ", " + cHeight + ;
" PIXEL OF oWnd " + CRLF
return cPrg
//----------------------------------------------------------------------------//
METHOD Initiate( hDlg ) CLASS TGroupeX
::Super:Initiate( hDlg )
if Empty( ::cCaption )
::cCaption = ::GetText()
else
::SetText( ::cCaption )
endif
return nil
//----------------------------------------------------------------------------//
METHOD HandleEvent( nMsg, nWParam, nLParam ) CLASS TGroupeX
local nResult
if ::lDrag .and. nMsg == WM_NCHITTEST // To have a standard behavior on Clicks
return DefWindowProc( ::hWnd, nMsg, nWParam, nLParam )
endif
if nMsg == WM_UPDATEUISTATE // Groups and contained controls were erased when pressing ALT
nResult = ::Super:HandleEvent( nMsg, nWParam, nLParam )
::oWnd:Refresh( .f. ) // EMG: added .f. to alleviate flickering
return nResult
endif
return ::Super:HandleEvent( nMsg, nWParam, nLParam )
//----------------------------------------------------------------------------//
METHOD Paint() CLASS TGroupeX
local aSize, hOldFont, oFont
local aRect := GetClientRect( ::hWnd ), hPen
::lBorder:= .t.
::nBorderColor := CLR_BLACK
IF ::lBorder
hPen := CreatePen( 0, 1,::nBorderColor )
Rectangle (::hDC, aRect[1], aRect[2], aRect[3], aRect[4], hPen)
//WndBox2007 (::hDC, aRect[1], aRect[2], aRect[3], aRect[4], ::nBorderColor)
DeleteObject( hPen )
aRect[1]+=1
aRect[2]+=1
aRect[3]-=1
aRect[4]-=1
ENDIF
::nColorFrom:= CLR_BLUE
::nColorTo:= CLR_WHITE
::lVertical := .t.
// Gradient( ::hDC, { 0, 0, aRect[ 2 ] + 22, aRect[ 4 ] }, ::nColorFrom, ::nColorTo, ::lVertical )
Gradient( ::hDC, { 0, 0, aRect[ 2 ] + 22, aRect[ 4 ] }, ::nColorFrom, ::nColorFrom )
::PaintH (aRect)
/*
CallWindowProc( ::nOldProc, ::hWnd, WM_PAINT, ::hDC, 0 )
if IsAppThemed() .and. ! Empty( ::cCaption )
oFont = If( ::oFont != nil, ::oFont, ::oWnd:oFont )
ASize = GetLabelDim( ::hWnd, ::cCaption, oFont:hFont )
hOldFont = SelectObject( ::hDC, oFont:hFont )
SetBrushOrgEx( ::hDC, nBmpWidth( ::oBrush:hBitmap ) - ::nLeft, nBmpHeight( ::oBrush:hBitmap ) - ::nTop )
FillRect( ::hDC, { 0, 7, aSize[ 2 ] + 2, aSize[ 1 ] + 11 }, ::oBrush:hBrush )
SetBkMode( ::hDC, 1 )
TextOut( ::hDC, 0, 9, ::cCaption, Len( ::cCaption ) )
SelectObject( ::hDC, hOldFont )
endif
*/
return 1
//----------------------------------------------------------------------------//
METHOD SaveToRC( nIndent ) CLASS TGroupeX
local cRC := Space( nIndent ) + "GROUPBOX "
cRC += '"' + ::cCaption + '", '
cRC += AllTrim( Str( ::nId ) ) + ", "
cRC += AllTrim( Str( ::nTop ) ) + ", "
cRC += AllTrim( Str( ::nLeft ) ) + ", "
cRC += AllTrim( Str( ::nWidth ) ) + ", "
cRC += AllTrim( Str( ::nHeight ) )
cRC += ", BS_GROUPBOX"
return cRC
//----------------------------------------------------------------------------//
METHOD LoadImage( cImage ) CLASS TGroupeX
local hImage := 0
hImage := LoadBitmap( GetResources(), cImage )
if hImage == 0
hImage := ReadBitmap( 0, cImage )
endif
return (hImage)
//------------------------------------------------------------------------------//
METHOD PaintH (aRect) CLASS TGroupeX
LOCAL hImage, aRound
LOCAL nRad := 2
LOCAL hBrush, hPen, hOldPen
LOCAL nClrBorder := CLR_BLACK
LOCAL nBmpWidth := 0, nRow, nCol
::lRound := .T.
IF ::lRound
aRound := AClone (aRect)
hBrush := SelectObject( ::hDC, ::oWnd:oBrush:hBrush )
hPen := CreatePen( 0, 1,::oWnd:nClrPane )
hOldPen := SelectObject( ::hDC, hPen )
aRound[4] -= 1
PolyPolygon( ::hDC, { {0,aRound[1]+nRad},{0,aRound[1]},{nRad,aRound[1]},{0,aRound[1]+nRad}} ) //Angle LEFT
PolyPolygon( ::hDC, { {aRound[4]-nRad,0},{aRound[4],0},{aRound[4],nRad},{aRound[4]-nRad,0}} ) //ANgle RIght
aRound[3] -= 1
PolyPolygon( ::hDC, { {0,aRound[3]-nRad},{0,aRound[3]},{nRad,aRound[3]},{0,aRound[3]-nRad}} )
PolyPolygon( ::hDC, { {aRound[4]-nRad,aRound[3]},{aRound[4],aRound[3]},{aRound[4],aRound[3]-nRad},{aRound[4]-nRad,aRound[3]}} ) //ANgle RIght
SelectObject( ::hDC, hOldPen )
DeleteObject( hPen )
SelectObject( ::hDC, hBrush ) // DrawMasked( <hDC>, <hBitmap>, <nRow>, <nCol> )
ENDIF // <aRect>:{ nTop, nLeft, nBottom, nRight }
aRect[1]+=::nMargin // Margins
aRect[2]+=::nMargin
aRect[3]-=::nMargin
aRect[4]-=::nMargin
// Image
if !Empty (::cImage)
hImage := ::LoadImage( ::cImage )
nBmpWidth := nBmpWidth (hImage)
nCol := aRect[2]
nRow := aRect[1]
IF nAnd (::nImgAlign,DT_RIGHT) == DT_RIGHT
nCol := aRect[4]-nBmpWidth-10
ENDIF
IF nAnd (::nImgAlign,DT_CENTER) == DT_CENTER
nCol := (aRect[4]-aRect[2])/2-(nBmpWidth/2)
ENDIF
IF nAnd (::nImgAlign,DT_VCENTER) == DT_VCENTER
nRow := ((aRect[3]-aRect[1])/2)-(nBmpHeight(hImage)/2)
ENDIF
IF nAnd (::nImgAlign,DT_BOTTOM) == DT_BOTTOM
nRow := aRect[3]-nBmpHeight(hImage)
ENDIF
DrawMasked( ::hDC, hImage, nRow, nCol )
endif
// testo
::nTextAlign := 1
::nImgAlign := 2
::nColorText := CLR_WHITE
IF !Empty (::cCaption)
IF nAnd (::nImgAlign,DT_CENTER) != DT_CENTER .and. nAnd (::nImgAlign,DT_RIGHT) != DT_RIGHT
aRect[2]+= (nBmpWidth+3)
ENDIF
IF nAnd (::nImgAlign,DT_CENTER) == DT_CENTER
//::nTextAlign := IIF (::nTextAlign = DT_CENTER, DT_LEFT, ::nTextAlign)
IF nAnd (::nTextAlign,DT_RIGHT)==DT_RIGHT
aRect[2] := nCol+nBmpWidth+2
ELSE
aRect[4] := nCol-nBmpWidth-2
ENDIF
ENDIF
IF nAnd (::nImgAlign,DT_RIGHT) == DT_RIGHT
aRect[4]-= (nBmpWidth+3)
ENDIF
SetTextColor (::hDC, ::nColorText)
SetBkMode( ::hDC, 1 )
SelectObject( ::hDC, ::oFont:hFont )
DrawTextEx( ::hDC, ::cCaption, {aRect[1],aRect[2],aRect[3],aRect[4]}, ::nTextAlign)
ENDIF
return nil
