New function SetDlgGradient() in FWH 11.11

[Antonio Linares]

* New: function SetDlgGradient( aGradColors ) sets a gobal setting for all dialogs to use a
specific GRADIENT though each dialog can override it using is own GRADIENT colors. Example:

SetDlgGradient( { { 1, RGB( 199, 216, 237 ), RGB( 237, 242, 248 ) } } )

[James Bott]

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

[Antonio Linares]

James,

Yes, I also noticed it, we need to find whats going on with them

[Maurizio]

Hello Antonio ,
The problem of the GROUP persist in FW 12.01 to .
Regards MAurizio

[Antonio Linares]

Maurizio,

After so many tests, we have a solution. Its not a very nice one but it works fine

Here you have the modified Class TGroup:

group.prg

Code: Select all  Expand view

#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

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

And this is a test:

maurizi.prg

Code: Select all  Expand view

#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  

maurizi.rc

Code: Select all  Expand view

#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
}

And here the result:

[Maurizio]

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

[StefanHaupt]

Antonio,

good solution, but a small change is needed if you are using a different font for the grouptext

Code: Select all  Expand view

   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, ::oWnd:oFont:hFont )
//          hOldFont = SelectObject( ::hDC, ::oWnd:oFont: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 1

[hag]

Will it work on dialogs from resources.
Also will it overide the dialog color if a color is already assigned to the dialog?

[Bayron]

Another Change is also needed:

Code: Select all  Expand view

  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, ::oWnd:oFont:hFont )
//          hOldFont = SelectObject( ::hDC, ::oWnd:oFont: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
 

Without this condition, the controls within the group will disappear when ::cCaption is empty...