Antonio,
Great, I like it!
I do notice that the group captions are not transparent but seem to be using the first color of the gradient. It would be better if they were transparent.
James
James,
Yes, I also noticed it, we need to find whats going on with them 
Hello Antonio ,
The problem of the GROUP persist in FW 12.01 to .
Regards MAurizio
#include "FiveWin.ch"
#include "Constant.ch"
#define WM_NCHITTEST 132 // 0x84
#define WM_UPDATEUISTATE 296 // 0x0128
//----------------------------------------------------------------------------//
CLASS TGroup FROM TControl
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 )
ENDCLASS
//----------------------------------------------------------------------------//
METHOD New( nTop, nLeft, nBottom, nRight, cLabel, oWnd, nClrText, nClrPane,;
lPixel, lDesign, oFont, lTransparent, nWidth, nHeight ) CLASS TGroup
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
::nTop = nTop * If( lPixel, 1, GRP_CHARPIX_H ) // 14
::nLeft = nLeft * If( lPixel, 1, GRP_CHARPIX_W ) // 7
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 TGroup
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
::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 TGroup
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 = GetWindowText( ::hWnd )
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 TGroup
Super:Initiate( hDlg )
if Empty( ::cCaption )
::cCaption = GetWindowText( ::hWnd )
else
SetWindowText( ::hWnd, ::cCaption )
endif
return nil
//----------------------------------------------------------------------------//
METHOD HandleEvent( nMsg, nWParam, nLParam ) CLASS TGroup
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 TGroup
local aSize, hOldFont
CallWindowProc( ::nOldProc, ::hWnd, WM_PAINT, ::hDC, 0 )
if IsAppThemed()
aSize = GetLabelDim( ::hWnd, ::cCaption, ::oWnd:oFont:hFont )
hOldFont = SelectObject( ::hDC, ::oWnd: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 TGroup
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
//----------------------------------------------------------------------------//#include "FiveWin.ch"
function Main()
local oDlg, oGrp
SetDlgGradient( { { 1, RGB( 199, 150, 237 ), RGB( 237, 242, 248 ) } } )
DEFINE DIALOG oDlg RESOURCE "Test"
REDEFINE GROUP oGrp ID 4001 OF oDlg PROMPT "This is a test"
ACTIVATE DIALOG oDlg CENTERED
return nil#include <windows.h>
#ifdef __FLAT__
1 24 "WinXP/WindowsXP.Manifest"
#endif
test DIALOGEX DISCARDABLE 6, 18, 322, 174
STYLE DS_SHELLFONT|WS_POPUP|DS_MODALFRAME|DS_CONTEXTHELP|DS_3DLOOK|WS_CAPTION|WS_SYSMENU|WS_VISIBLE
CAPTION "Dialog"
FONT 8, "Tahoma"
{
CONTROL "OK", IDOK, "Button", WS_TABSTOP, 268, 8, 45, 15
CONTROL "Cancel", IDCANCEL, "Button", WS_TABSTOP, 268, 28, 45, 15
CONTROL "Group-box", 4001, "Button", BS_GROUPBOX, 20, 80, 236, 80
}
Antonio ,
it works if I declare In the source
REDEFINE GROUP oGrp ID 4001 OF oDlg PROMPT "This is a test"
but usually the group is not declared ,anyway so is Ok
Thanks
Maurizio
METHOD Paint() CLASS TGroup
local aSize, hOldFont
local oFont := IIF (::oFont <>nil, ::oFont, ::oWnd:oFont) // added , use local font if not nil, SH 31.01.12
CallWindowProc( ::nOldProc, ::hWnd, WM_PAINT, ::hDC, 0 )
if IsAppThemed()
// aSize = GetLabelDim( ::hWnd, ::cCaption, ::hFont )
// hOldFont = SelectObject( ::hDC, ::hFont )
aSize = GetLabelDim( ::hWnd, ::cCaption, oFont:hFont ) // changed SH 31.01.12
hOldFont = SelectObject( ::hDC, oFont:hFont ) // changed SH 31.01.12
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 1Will it work on dialogs from resources.
Also will it overide the dialog color if a color is already assigned to the dialog?
METHOD Paint() CLASS TGroup
local aSize, hOldFont
local oFont := IIF (::oFont <>nil, ::oFont, ::oWnd:oFont) // added , use local font if not nil, SH 31.01.12
CallWindowProc( ::nOldProc, ::hWnd, WM_PAINT, ::hDC, 0 )
if IsAppThemed()
// aSize = GetLabelDim( ::hWnd, ::cCaption, ::hFont )
// hOldFont = SelectObject( ::hDC, ::hFont )
aSize = GetLabelDim( ::hWnd, ::cCaption, oFont:hFont ) // changed SH 31.01.12
hOldFont = SelectObject( ::hDC, oFont:hFont ) // changed SH 31.01.12
SetBrushOrgEx( ::hDC, nBmpWidth( ::oBrush:hBitmap ) - ::nLeft, nBmpHeight( ::oBrush:hBitmap ) - ::nTop )
If !Empty(::cCaption) //Bayron Landaverry 27.02.2013
FillRect( ::hDC, { 0, 7, aSize[ 2 ] + 2, aSize[ 1 ] + 11 }, ::oBrush:hBrush )
EndIf
SetBkMode( ::hDC, 1 )
TextOut( ::hDC, 0, 9, ::cCaption, Len( ::cCaption ) )
SelectObject( ::hDC, hOldFont )
endif
return 1=====>
Bayron Landaverry
xBasePHP.com
(215)2226600 Philadelphia,PA, USA
MayaBuilders@gMail.com
Guatemala
FWH25.06--Harbour 3.0.0--BCC7.7--UEstudio 10.10
Windows 10
FiveWin, One line of code and it's done...