New function SetDlgGradient() in FWH 11.11

New function SetDlgGradient() in FWH 11.11

Postby Antonio Linares » Thu Nov 24, 2011 9:22 am

* 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 ) } } )

Image
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 42092
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Re: New function SetDlgGradient() in FWH 11.11

Postby James Bott » Fri Nov 25, 2011 5:04 pm

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
User avatar
James Bott
 
Posts: 4840
Joined: Fri Nov 18, 2005 4:52 pm
Location: San Diego, California, USA

Re: New function SetDlgGradient() in FWH 11.11

Postby Antonio Linares » Fri Nov 25, 2011 6:34 pm

James,

Yes, I also noticed it, we need to find whats going on with them :-)
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 42092
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Re: New function SetDlgGradient() in FWH 11.11

Postby Maurizio » Mon Jan 30, 2012 1:44 pm

Hello Antonio ,
The problem of the GROUP persist in FW 12.01 to .
Regards MAurizio
User avatar
Maurizio
 
Posts: 824
Joined: Mon Oct 10, 2005 1:29 pm

Re: New function SetDlgGradient() in FWH 11.11

Postby Antonio Linares » Mon Jan 30, 2012 8:45 pm

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:
Image
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 42092
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Re: New function SetDlgGradient() in FWH 11.11

Postby Maurizio » Tue Jan 31, 2012 8:44 am

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
User avatar
Maurizio
 
Posts: 824
Joined: Mon Oct 10, 2005 1:29 pm

Re: New function SetDlgGradient() in FWH 11.11

Postby StefanHaupt » Tue Jan 31, 2012 9:11 am

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
kind regards
Stefan
StefanHaupt
 
Posts: 824
Joined: Thu Oct 13, 2005 7:39 am
Location: Germany

Re: New function SetDlgGradient() in FWH 11.11

Postby hag » Tue Jan 31, 2012 4:19 pm

Will it work on dialogs from resources.
Also will it overide the dialog color if a color is already assigned to the dialog?
Thank you
Harvey
hag
 
Posts: 598
Joined: Tue Apr 15, 2008 4:51 pm
Location: LOs Angeles, California

Re: New function SetDlgGradient() in FWH 11.11

Postby Bayron » Wed Feb 27, 2013 1:02 pm

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...
=====>

Bayron Landaverry
(215)2226600 Philadelphia,PA, USA
+(502)46727275 Guatemala
MayaBuilders@gMail.com

FWH12.04||Harbour 3.2.0 (18754)||BCC6.5||UEstudio 10.10||
Windows 7 Ultimate

FiveWin, One line of code and it's done...
User avatar
Bayron
 
Posts: 815
Joined: Thu Dec 24, 2009 12:46 am
Location: Philadelphia, PA


Return to FiveWin for Harbour/xHarbour

Who is online

Users browsing this forum: No registered users and 79 guests