Modifying tGroup class

[Silvio.Falconi]

I wish modify tgroup class inserting a color panel on the top of the group sample :




any solution ?

[Silvio.Falconi]

Antonio,
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  Expand view  RUN

#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
 

[Silvio.Falconi]

New version with new #xcommand

Code: Select all  Expand view  RUN

#xcommand @ <nTop>, <nLeft> GROUPEX [ <oGroup> ] ;
             [ TO <nBottom>, <nRight> ] ;
             [ <label:LABEL,PROMPT> <cLabel> ] ;
             [ OF <oWnd> ] ;
             [ COLOR <nClrFore> [,<nClrBack>] ] ;
             [ <lPixel: PIXEL> ] ;
             [ <lDesign: DESIGN> ] ;
             [ FONT <oFont> ] ;
             [ <lTransparent: TRANSPARENT> ] ;
             [ SIZE <nWidth>, <nHeight> ] ;
             [ IMAGE <cImage> ] ;
             [ MARGIN <nMargin> ] ;
             [ COLORHEADER <nClrfrom>  ] ;
       => ;
          [ <oGroup> := ] TGroupEx():New( <nTop>, <nLeft>, <nBottom>, <nRight>,;
             <cLabel>, <oWnd>, <nClrFore>, <nClrBack>, <.lPixel.>,;
             [<.lDesign.>], [<oFont>], [<.lTransparent.>], <nWidth>, <nHeight>,<cImage>,<nMargin>,<nClrfrom> )

the test with class Groupex

Code: Select all  Expand view  RUN

#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


#xcommand @ <nTop>, <nLeft> GROUPEX [ <oGroup> ] ;
             [ TO <nBottom>, <nRight> ] ;
             [ <label:LABEL,PROMPT> <cLabel> ] ;
             [ OF <oWnd> ] ;
             [ COLOR <nClrFore> [,<nClrBack>] ] ;
             [ <lPixel: PIXEL> ] ;
             [ <lDesign: DESIGN> ] ;
             [ FONT <oFont> ] ;
             [ <lTransparent: TRANSPARENT> ] ;
             [ SIZE <nWidth>, <nHeight> ] ;
             [ IMAGE <cImage> ] ;
             [ MARGIN <nMargin> ] ;
             [ COLORHEADER <nClrfrom>  ] ;
       => ;
          [ <oGroup> := ] TGroupEx():New( <nTop>, <nLeft>, <nBottom>, <nRight>,;
             <cLabel>, <oWnd>, <nClrFore>, <nClrBack>, <.lPixel.>,;
             [<.lDesign.>], [<oFont>], [<.lTransparent.>], <nWidth>, <nHeight>,<cImage>,<nMargin>,<nClrfrom> )


Function Main()
   Local oDlg,oGr
   Local oFont
   local oget
   local cget:= space(30)
    DEFINE FONT oFont NAME "CALIBRI" SIZE 0,-20 bold


    DEFINE DIALOG oDlg SIZE 400,400


             @ 10,5 GROUPEX oGr  TO 100,175  OF oDlg LABEL "Anagrafica cliente "  PIXEL FONT oFont  IMAGE "test.bmp"

              @ 40,12 SAY "Name : " of oDlg   PIXEL COLOR CLR_BLACK,CLR_WHITE
              @ 40,35 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,cImage,nMargin,nClrfrom ) 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,cImage, nMargin,nClrfrom,lRound ) CLASS TGroupeX

   DEFAULT nTop     := 0, nLeft := 0, nBottom := 3, nRight := 3,;
           oWnd     := GetWndDefault(),;
           nClrText := oWnd:nClrText, nClrPane := oWnd:nClrPane,;
           lPixel   := .f., lDesign := .f.,;
           lTransparent := .t., oFont := oWnd:oFont ,;
           nMargin  := 2 , nClrfrom:= CLR_BLUE ,  lRound := .T.

   ::lUnicode = FW_SetUnicode()

   ::nTop  = nTop  * If( lPixel, 1, GRP_CHARPIX_H ) // 14
   ::nLeft = nLeft * If( lPixel, 1, GRP_CHARPIX_W ) //  7


    ::nMargin = nMargin
    ::lRound  = lRound
    ::cImage  = cImage

    ::nTextAlign = 1
    ::nImgAlign  = 2
    ::nColorText = CLR_WHITE




   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 ) )   //BS_GROUPBOX



   ::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]+15, aRect[2], aRect[3]-4, aRect[4], ::nBorderColor)
    DeleteObject( hPen )
    aRect[1]+=1
    aRect[2]+=1
    aRect[3]-=1
    aRect[4]-=1
 ENDIF



 ::nColorFrom:= CLR_HBLUE
 ::nColorTo:=  CLR_WHITE
 ::lVertical := .t.

* Gradient( ::hDC,  { 0, 0, aRect[ 2 ] + 22, aRect[ 4 ]  }, ::nColorFrom, ::nColorTo, ::lVertical )
  Gradient( ::hDC,  { 0, 0, aRect[ 2 ] + 25, aRect[ 4 ]  }, ::nColorFrom, ::nColorFrom )

 *  FillRect( ::hDC, { 0, 7, aSize[ 2 ] + 2, aSize[ 1 ] + 11 }, ::oBrush:hBrush )


 *  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


   ::PaintH (aRect)

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
  LOCAL nRad :=  5
  LOCAL hBrush, hPen, hOldPen
  LOCAL nClrBorder  := CLR_BLACK
  LOCAL nBmpWidth := 0, nRow, nCol
  Local hOldBrush ,hPen2
  Local aRound := AClone (aRect)
  Local nTop:= aRound[1]

IF ::lBorder
  IF ::lRound
      hOldBrush := SelectObject( ::hDC, ::oWnd:oBrush:hBrush )
      hPen2      := CreatePen( 0, 1, ::oWnd:nClrPane )
      hOldPen    := SelectObject( ::hDC, hPen2 )
      PolyPolygon( ::hDC, { {0,nTop+nRad},{0,nTop+0},{nRad,nTop+0},{0,nTop+nRad}} )
      PolyPolygon( ::hDC, { {::nWidth-nRad-1,nTop+0},{::nWidth-1,nTop+0},{::nWidth-1,nTop+nRad},{::nWidth-nRad-1,nTop+0}} )
      SelectObject( ::hDC, hOldPen )
      DeleteObject( hPen2 )
      SelectObject( ::hDC, hOldBrush )

            hPen2      := CreatePen( 0, 1, nClrBorder )
            hOldPen    := SelectObject( ::hDC, hPen2 )
            hBrush     := GetStockObject( 5 )           // BRUSH_NULL
            hOldBrush  := SelectObject( ::hDC, hBrush )

             PolyPolygon( ::hDC, {{          0, aRound[3] },;
                               {          0, aRound[1]+nRad   },;
                               {          nRad, aRound[1]     },;
                               { ::nWidth-nRad-1, aRound[1]     },;
                               { ::nWidth-1, aRound[1] +nRad  },;
                               { ::nWidth-1, aRound[3] },;
                               {          0, aRound[3] } } )

            SelectObject( ::hDC, hOldPen )
            DeleteObject( hPen2 )
            SelectObject( ::hDC, hOldBrush )


         else

             aRect[3] := aRect[3] + 1
             BoxEx( ::hDC, aRect, nClrBorder )


        Endif
   Endif


  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


  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









 

[Antonio Linares]

Is it already working fine ?

have you solved those issues ?

[Silvio.Falconi]

no here not run ok
the left and right angles are not showed good

[Antonio Linares]

Remove this line:

// Rectangle (::hDC, aRect[1], aRect[2], aRect[3], aRect[4], hPen)

[Silvio.Falconi]

I tried to rem it but the result is this



on the top I see a line black

[fafi]

Code: Select all  Expand view  RUN

#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 800,400 pixel title "New Class TGroup from Mr. Silvio"


              oGr := TGroupeX():New( 10, 12, 100, 175, "Anagrafica cliente", oDlg,,, .T.,,,,, )
              oGr:cImage:="case.bmp"

              @ 30,22 SAY "Name : " of oDlg   PIXEL
              @ 30,45 get oget var cget  of oDlg  size 100,12  PIXEL
             
             
              oGr1 := TGroupeX():New( 10, 180, 100, 350, "Hello World !!!", oDlg,,, .T.,,,,, )
              oGr1:cImage:="case.bmp"
             
             
              oGr1 := TGroupeX():New( 110, 12, 180, 350, "Hello FiveWin", oDlg,,, .T.,,,,, )
              oGr1:cImage:="case.bmp"
             
             


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

   

   ::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
   

   ::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 )
   
   
    rectdraw( ::hDC, aRect[1]+22, aRect[2], aRect[3], aRect[4]-1, ::nBorderColor, 1 )
   
   
   
    DeleteObject( hPen )
    aRect[1]+=1
    aRect[2]+=1
    aRect[3]-=1
    aRect[4]-=1
 ENDIF

 ::nColorFrom:= nRGB(0,0,150)
 ::nColorTo:=  CLR_WHITE
 ::lVertical := .t.
   
   
   
    ellipsedraw( ::hDC, 0, 0, 23, 23, ::nColorFrom, 1, ::nColorFrom, .t., 0,0,150 )
   
    ellipsedraw( ::hDC, 0, aRect[ 4 ]-23, 23, aRect[ 4 ] , ::nColorFrom, 1, ::nColorFrom, .t., 0,0,150 )
   
   
    Gradient( ::hDC,  { 0, 11, aRect[ 2 ] + 22, aRect[ 4 ]-11  }, ::nColorFrom, ::nColorFrom )
   
    Gradient( ::hDC,  { 10, 0, aRect[ 2 ] + 22, aRect[ 4 ]-0.5  }, ::nColorFrom, ::nColorFrom )

   

 ::PaintH (aRect)




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  := nRGB(0,0,150)
  LOCAL nBmpWidth := 0, nRow, nCol


  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
 
 
 #pragma BEGINDUMP                      

#include <hbvm.h>                                                                                                        
#include <hbstack.h>                                                                                                      
#include <WinTen.h>                                                                                                      
#include <Windows.h>                                                                                                      
#include <hbApi.h>                                                                                                        
#include <commctrl.h>                                                                                                    
#include <StdLib.h>                                                                                                      
#include <ClipApi.h>          


HB_FUNC( ELLIPSEDRAW )
{
   
     HDC hDC = ( HDC ) _parnl( 1 );
   HGDIOBJ  hgdiobj1, hgdiobj2;
   HPEN     hpen;
   HBRUSH   hbrush;
   LOGBRUSH br;

   
   hpen     = CreatePen( PS_SOLID, ( int ) hb_parni( 7 ), ( COLORREF ) RGB( ( int ) hb_parni( 6, 1 ), ( int ) hb_parni( 6, 2 ), ( int ) hb_parni( 6, 3 ) ) );
   hgdiobj1 = SelectObject( hDC, hpen );
   if( hb_parl( 9 ) )
   {
     
      hbrush   = CreateSolidBrush( ( COLORREF ) RGB( ( int ) hb_parni( 10 ), ( int ) hb_parni( 11 ), ( int ) hb_parni( 12 ) ) );
      hgdiobj2 = SelectObject( hDC, hbrush );
   }
   else
   {
      br.lbStyle = BS_HOLLOW;
      hbrush     = CreateBrushIndirect( &br );
      hgdiobj2   = SelectObject( hDC, hbrush );
   }

   Ellipse( hDC, ( int ) hb_parni( 3 ), ( int ) hb_parni( 2 ), ( int ) hb_parni( 5 ), ( int ) hb_parni( 4 ) );
   SelectObject( hDC, hgdiobj1 );
   SelectObject( hDC, hgdiobj2 );
   DeleteObject( hpen );
   DeleteObject( hbrush );
   
}

HB_FUNC( RECTDRAW )
{
   HDC hDC = ( HDC ) _parnl( 1 );
   HGDIOBJ  hgdiobj1, hgdiobj2;
   HPEN     hpen;
   HBRUSH   hbrush;
   LOGBRUSH br;

   hpen  = CreatePen( PS_SOLID, ( int ) hb_parni( 7 ), ( COLORREF ) RGB( ( int ) hb_parni( 6, 1 ), ( int ) hb_parni( 6, 2 ), ( int ) hb_parni( 6, 3 ) ) );

   hgdiobj1 = SelectObject( hDC, hpen );
   
   br.lbStyle = BS_HOLLOW;
   hbrush     = CreateBrushIndirect( &br );
   hgdiobj2   = SelectObject( hDC, hbrush );
   Rectangle( hDC, ( int ) hb_parni( 3 ), ( int ) hb_parni( 2 ), ( int ) hb_parni( 5 ), ( int ) hb_parni( 4 ) );
   SelectObject( hDC, hgdiobj1 );
   SelectObject( hDC, hgdiobj2 );
   DeleteObject( hpen );
   DeleteObject( hbrush );
   
}

#pragma ENDDUMP      

Best Regards,
Fafi

[Silvio.Falconi]

good mr fafi

[Silvio.Falconi]

New release
the Gradient option not work good !!

sample command

@ 10,5 GROUPEX oGr TO 100,175 OF oDlg ;
LABEL "Anagrafica cliente " PIXEL FONT oFont;
IMAGE "case.bmp" POSITION 1 MARGIN 2 ;
COLORHEADER METRO_TEAL,METRO_CYAN ;
GRADIENT TEXTALIGN 0 COLORTEXT CLR_RED


Include file

Code: Select all  Expand view  RUN

#xcommand @ <nTop>, <nLeft> GROUPEX [ <oGroup> ] ;
             [ TO <nBottom>, <nRight> ] ;
             [ <label:LABEL,PROMPT> <cLabel> ] ;
             [ OF <oWnd> ] ;
             [ COLOR <nClrFore> [,<nClrBack>] ] ;
             [ <lPixel: PIXEL> ] ;
             [ <lDesign: DESIGN> ] ;
             [ FONT <oFont> ] ;
             [ <lTransparent: TRANSPARENT> ] ;
             [ SIZE <nWidth>, <nHeight> ] ;
             [ IMAGE <cImage> ] ;
             [ POSITION <nImgAlign> ] ;
             [ MARGIN <nMargin> ] ;
             [ COLORHEADER <nClrfrom> ,<nClrto> ] ;
             [ <lGradient: GRADIENT> ] ;
             [ TEXTALIGN <nTextAlign> ] ;
             [ COLORTEXT <nColorText> ] ;
       => ;
          [ <oGroup> := ] TGroupEx():New( <nTop>, <nLeft>, <nBottom>, <nRight>,;
             <cLabel>, <oWnd>, <nClrFore>, <nClrBack>, <.lPixel.>,;
             [<.lDesign.>], [<oFont>], [<.lTransparent.>], <nWidth>, <nHeight>,;
             <cImage>,<nImgAlign>,<nMargin>,<nClrfrom>,<nClrto>,<.lGradient.>, <nTextAlign>,<nColorText> )

class tGroupex

Code: Select all  Expand view  RUN

#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

/*
==================================================================
This Groupex  class is based on the Group class of Fivetech.

  13.05.2017  Fafi.
  12.05.2017  create ch file  by Silvio

*/

CLASS TGroupEx FROM TControl


  DATA lTransparent INIT .f.
  DATA lRound
  DATA lBorder
  DATA nBorderColor
  DATA nMargin   INIT  2
  DATA nClrfrom
  DATA nClrTo
  DATA lGradient
  DATA lVertical
  DATA cImage
  DATA nTextAlign INIT 0
  DATA nImgAlign INIT 0
  DATA nColorText



   METHOD New( nTop, nLeft, nBottom, nRight, cLabel, oWnd, nClrText,;
               nClrPane, lPixel, lDesign, oFont, lTransparent, nWidth, nHeight, cImage,nMargin,nClrfrom  ) 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 PaintHeader (aRect)

ENDCLASS

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

METHOD New( nTop, nLeft, nBottom, nRight, cLabel, oWnd, nClrText, nClrPane,;
            lPixel, lDesign, oFont, lTransparent, nWidth, nHeight,;
               cImage,nImgAlign,nMargin,nClrfrom,nClrTo,lGradient,nTextAlign,nColorText,;
               lRound,lBorder,nBorderColor ) 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 , ;
           nMargin  := 2 , nClrfrom:= CLR_BLUE ,  nClrTo := CLR_WHITE ,;
           nTextAlign  := 1, nImgAlign:= 2 ,nColorText := CLR_WHITE , lRound:= .T. ,;
           nBorderColor:= CLR_BLACK, lBorder:=.T. ,lGradient:= .f.

   ::nTop  = nTop  * If( lPixel, 1, GRP_CHARPIX_H ) // 14
   ::nLeft = nLeft * If( lPixel, 1, GRP_CHARPIX_W ) //  7


   ::nMargin     =  nMargin
   ::nClrfrom    =  nClrfrom
   ::nClrTo      =  nClrTo
   ::lGradient   =  lGradient
   ::lRound      =  lRound
   ::cImage      =  cImage
   ::nTextAlign  =  nTextAlign
   ::nImgAlign   =  nImgAlign
   ::nColorText  =  nColorText
   ::lBorder     =  lBorder
   ::nBorderColor  = CLR_BLACK


   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,cImage,nMargin,nClrfrom,nClrTo,lGradient,nTextAlign,;
                 nImgAlign,nColorText,lRound,lBorder,nBorderColor ) CLASS TGroupeX

   DEFAULT nId      := ::GetNewId(),;
           nClrText := oWnd:nClrText, nClrPane := oWnd:nClrPane,;
           lTransparent:= .f., oWnd := GetWndDefault() ,;
            nMargin  := 2 , nClrfrom:= CLR_BLUE ,  nClrTo := CLR_WHITE ,;
           nTextAlign  := 1, nImgAlign:= 2 ,nColorText := CLR_WHITE , lRound:= .T. ,;
           nBorderColor:= CLR_BLACK, lBorder:=.T.,lGradient:= .f.

   ::nId      = nId
   ::cCaption = cLabel
   ::hWnd     = 0
   ::oWnd     = oWnd
   ::lUpdate  = .f.
   ::lTransparent = lTransparent

   ::nMargin     =  nMargin
   ::nClrfrom    =  nClrfrom
   ::nClrTo      =  nClrTo
   ::lGradient   =  lGradient
   ::lRound      =  lRound
   ::cImage      =  cImage
   ::nTextAlign  =  nTextAlign
   ::nImgAlign   =  nImgAlign
   ::nColorText  =  nColorText
   ::lBorder     =  lBorder
   ::nBorderColor  = CLR_BLACK

   ::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 + ;
           ' GROUPEX 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


 IF ::lBorder
    hPen := CreatePen( 0, 1,::nBorderColor )
    rectdraw( ::hDC, aRect[1]+22, aRect[2], aRect[3], aRect[4]-1, ::nBorderColor, 1 )
    DeleteObject( hPen )
    aRect[1]+=1
    aRect[2]+=1
    aRect[3]-=1
    aRect[4]-=1
 ENDIF


 if ::lGradient
    ellipsedraw( ::hDC, 0, 0, 23, 23, ::nClrfrom, 1, ::nClrto, .t., 0,0,150 )
    ellipsedraw( ::hDC, 0, aRect[ 4 ]-23, 23, aRect[ 4 ] , ::nClrfrom, 1, ::nClrto, .t., 0,0,150 )
    Gradient( ::hDC,  { 0, 11, aRect[ 2 ] + 22, aRect[ 4 ]-11  }, ::nClrfrom, ::nClrto  )
    Gradient( ::hDC,  { 10, 0, aRect[ 2 ] + 22, aRect[ 4 ]-0.5  }, ::nClrfrom, ::nClrto )
 else
    ellipsedraw( ::hDC, 0, 0, 23, 23, ::nClrfrom, 1, ::nClrfrom, .t., 0,0,150 )
    ellipsedraw( ::hDC, 0, aRect[ 4 ]-23, 23, aRect[ 4 ] , ::nClrfrom, 1, ::nClrfrom, .t., 0,0,150 )
     Gradient( ::hDC,  { 0, 11, aRect[ 2 ] + 22, aRect[ 4 ]-11  }, ::nClrfrom, ::nClrfrom  )
     Gradient( ::hDC,  { 10, 0, aRect[ 2 ] + 22, aRect[ 4 ]-0.5  }, ::nClrfrom, ::nClrfrom )

   Endif

 ::PaintHeader (aRect)


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 PaintHeader (aRect)  CLASS TGroupeX

  LOCAL hImage, aRound
  LOCAL nRad :=  2
  LOCAL hBrush, hPen, hOldPen
  LOCAL nClrBorder  := nRGB(0,0,150)
  LOCAL nBmpWidth := 0, nRow, nCol


  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

// Label
  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


 #pragma BEGINDUMP

#include <hbvm.h>
#include <hbstack.h>
#include <WinTen.h>
#include <Windows.h>
#include <hbApi.h>
#include <commctrl.h>
#include <StdLib.h>
#include <ClipApi.h>


HB_FUNC( ELLIPSEDRAW )
{

     HDC hDC = ( HDC ) _parnl( 1 );
   HGDIOBJ  hgdiobj1, hgdiobj2;
   HPEN     hpen;
   HBRUSH   hbrush;
   LOGBRUSH br;


   hpen     = CreatePen( PS_SOLID, ( int ) hb_parni( 7 ), ( COLORREF ) RGB( ( int ) hb_parni( 6, 1 ), ( int ) hb_parni( 6, 2 ), ( int ) hb_parni( 6, 3 ) ) );
   hgdiobj1 = SelectObject( hDC, hpen );
   if( hb_parl( 9 ) )
   {

      hbrush   = CreateSolidBrush( ( COLORREF ) RGB( ( int ) hb_parni( 10 ), ( int ) hb_parni( 11 ), ( int ) hb_parni( 12 ) ) );
      hgdiobj2 = SelectObject( hDC, hbrush );
   }
   else
   {
      br.lbStyle = BS_HOLLOW;
      hbrush     = CreateBrushIndirect( &br );
      hgdiobj2   = SelectObject( hDC, hbrush );
   }

   Ellipse( hDC, ( int ) hb_parni( 3 ), ( int ) hb_parni( 2 ), ( int ) hb_parni( 5 ), ( int ) hb_parni( 4 ) );
   SelectObject( hDC, hgdiobj1 );
   SelectObject( hDC, hgdiobj2 );
   DeleteObject( hpen );
   DeleteObject( hbrush );

}

HB_FUNC( RECTDRAW )
{
   HDC hDC = ( HDC ) _parnl( 1 );
   HGDIOBJ  hgdiobj1, hgdiobj2;
   HPEN     hpen;
   HBRUSH   hbrush;
   LOGBRUSH br;

   hpen  = CreatePen( PS_SOLID, ( int ) hb_parni( 7 ), ( COLORREF ) RGB( ( int ) hb_parni( 6, 1 ), ( int ) hb_parni( 6, 2 ), ( int ) hb_parni( 6, 3 ) ) );

   hgdiobj1 = SelectObject( hDC, hpen );

   br.lbStyle = BS_HOLLOW;
   hbrush     = CreateBrushIndirect( &br );
   hgdiobj2   = SelectObject( hDC, hbrush );
   Rectangle( hDC, ( int ) hb_parni( 3 ), ( int ) hb_parni( 2 ), ( int ) hb_parni( 5 ), ( int ) hb_parni( 4 ) );
   SelectObject( hDC, hgdiobj1 );
   SelectObject( hDC, hgdiobj2 );
   DeleteObject( hpen );
   DeleteObject( hbrush );

}

#pragma ENDDUMP
 

sample test

Code: Select all  Expand view  RUN

#include "FiveWin.ch"
#include "tgroupex.ch"



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 800,400 pixel title "New Class TGroup from Mr. Silvio"

             @ 10,5 GROUPEX oGr  TO 100,175  OF oDlg ;
                   LABEL "Anagrafica cliente "  PIXEL FONT oFont;
                     IMAGE "case.bmp" POSITION 1  MARGIN 2   ;
                        COLORHEADER METRO_TEAL,METRO_CYAN ;
                             GRADIENT TEXTALIGN 0  COLORTEXT CLR_RED

              @ 30,22 SAY "Name : " of oDlg   PIXEL
              @ 30,45 get oget var cget  of oDlg  size 100,12  PIXEL


              oGr1 := TGroupeX():New( 10, 180, 100, 350, "Hello World !!!", oDlg,,, .T.,,,,, )
              oGr1:cImage:="case.bmp"
               oGr1:nImgAlign := 2

              oGr1 := TGroupeX():New( 110, 12, 180, 350, "Hello FiveWin", oDlg,,, .T.,,,,, )
              oGr1:cImage:="case.bmp"
              oGr1:nImgAlign := 0






ACTIVATE DIALOG oDlg CENTER
RETURN NIL

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

[fafi]

with Shadow :

Code: Select all  Expand view  RUN

#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 800,400 pixel title "New Class TGroup from Mr. Silvio"


              oGr := TGroupeX():New( 10, 12, 100, 175, "Anagrafica cliente", oDlg,,, .T.,,,,, )
              oGr:cImage:="case.bmp"

              @ 30,22 SAY "Name : " of oDlg   PIXEL
              @ 30,45 get oget var cget  of oDlg  size 100,12  PIXEL
             
             
              oGr1 := TGroupeX():New( 10, 180, 100, 350, "Hello World !!!", oDlg,,, .T.,,,,, )
              oGr1:cImage:="case.bmp"
             
             
              oGr1 := TGroupeX():New( 110, 12, 180, 350, "Hello FiveWin", oDlg,,, .T.,,,,, )
              oGr1:cImage:="case.bmp"
             
             


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

   

   ::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
   

   ::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 )
   
   
    rectdraw( ::hDC, aRect[1]+22, aRect[2], aRect[3], aRect[4]-1, ::nBorderColor, 1 )
   
    rectdraw( ::hDC, aRect[1]+24, aRect[2]+3, aRect[3]-2, aRect[4]-3, CLR_WHITE, 2 )
   
   
    linedraw( ::hDC, aRect[1]+11, aRect[4]-1, aRect[3]+4, aRect[4]-1, nRGB(110,110,110), 1 )
   
    linedraw( ::hDC, aRect[1]+14, aRect[4], aRect[3]+4, aRect[4], nRGB(180,160,160), 1 )
   
    linedraw( ::hDC, aRect[1]+18, aRect[4]+1, aRect[3]+4, aRect[4]+1, nRGB(190,190,190), 1 )
   
    linedraw( ::hDC, aRect[1]+22, aRect[4]+2, aRect[3]+4, aRect[4]+2, nRGB(210,210,210), 1 )
   
   
    linedraw( ::hDC, aRect[3], aRect[2], aRect[3], aRect[4], nRGB(80,80,80), 1 )
   
    for i := 1 to 5
       linedraw( ::hDC, aRect[3]+i, aRect[2]+i, aRect[3]+i, aRect[4], nRGB(80+(i*30),80+(i*30),80+(i*30)), 1 )
    next  
   
   
    DeleteObject( hPen )
    aRect[1]+=1
    aRect[2]+=1
    aRect[3]-=1
    aRect[4]-=1
 ENDIF

 ::nColorFrom:= nRGB(0,0,150)
 ::nColorTo:=  CLR_WHITE
 ::lVertical := .t.
   
   
   
    ellipsedraw( ::hDC, 0, 0, 23, 23, ::nColorFrom, 1, ::nColorFrom, .t., 0,0,150 )
   
    ellipsedraw( ::hDC, 0, aRect[ 4 ]-23, 23, aRect[ 4 ] , ::nColorFrom, 1, ::nColorFrom, .t., 0,0,150 )
   
   
    Gradient( ::hDC,  { 0, 11, aRect[ 2 ] + 22, aRect[ 4 ]-11  }, ::nColorFrom, ::nColorFrom )
   
    Gradient( ::hDC,  { 10, 0, aRect[ 2 ] + 22, aRect[ 4 ]-0.5  }, ::nColorFrom, ::nColorFrom )

   

    ::PaintH (aRect)




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  := nRGB(0,0,150)
  LOCAL nBmpWidth := 0, nRow, nCol


  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
 
 
 #pragma BEGINDUMP                      

#include <hbvm.h>                                                                                                        
#include <hbstack.h>                                                                                                      
#include <WinTen.h>                                                                                                      
#include <Windows.h>                                                                                                      
#include <hbApi.h>                                                                                                        
#include <commctrl.h>                                                                                                    
#include <StdLib.h>                                                                                                      
#include <ClipApi.h>          


HB_FUNC( ELLIPSEDRAW )
{
   
     HDC hDC = ( HDC ) _parnl( 1 );
   HGDIOBJ  hgdiobj1, hgdiobj2;
   HPEN     hpen;
   HBRUSH   hbrush;
   LOGBRUSH br;

   
   hpen     = CreatePen( PS_SOLID, ( int ) hb_parni( 7 ), ( COLORREF ) RGB( ( int ) hb_parni( 6, 1 ), ( int ) hb_parni( 6, 2 ), ( int ) hb_parni( 6, 3 ) ) );
   hgdiobj1 = SelectObject( hDC, hpen );
   if( hb_parl( 9 ) )
   {
     
      hbrush   = CreateSolidBrush( ( COLORREF ) RGB( ( int ) hb_parni( 10 ), ( int ) hb_parni( 11 ), ( int ) hb_parni( 12 ) ) );
      hgdiobj2 = SelectObject( hDC, hbrush );
   }
   else
   {
      br.lbStyle = BS_HOLLOW;
      hbrush     = CreateBrushIndirect( &br );
      hgdiobj2   = SelectObject( hDC, hbrush );
   }

   Ellipse( hDC, ( int ) hb_parni( 3 ), ( int ) hb_parni( 2 ), ( int ) hb_parni( 5 ), ( int ) hb_parni( 4 ) );
   SelectObject( hDC, hgdiobj1 );
   SelectObject( hDC, hgdiobj2 );
   DeleteObject( hpen );
   DeleteObject( hbrush );
   
}

HB_FUNC( RECTDRAW )
{
   HDC hDC = ( HDC ) _parnl( 1 );
   HGDIOBJ  hgdiobj1, hgdiobj2;
   HPEN     hpen;
   HBRUSH   hbrush;
   LOGBRUSH br;

   hpen  = CreatePen( PS_SOLID, ( int ) hb_parni( 7 ), ( COLORREF ) RGB( ( int ) hb_parni( 6, 1 ), ( int ) hb_parni( 6, 2 ), ( int ) hb_parni( 6, 3 ) ) );

   hgdiobj1 = SelectObject( hDC, hpen );
   
   br.lbStyle = BS_HOLLOW;
   hbrush     = CreateBrushIndirect( &br );
   hgdiobj2   = SelectObject( hDC, hbrush );
   Rectangle( hDC, ( int ) hb_parni( 3 ), ( int ) hb_parni( 2 ), ( int ) hb_parni( 5 ), ( int ) hb_parni( 4 ) );
   SelectObject( hDC, hgdiobj1 );
   SelectObject( hDC, hgdiobj2 );
   DeleteObject( hpen );
   DeleteObject( hbrush );
   
}

HB_FUNC( LINEDRAW )
{
   HDC hDC = ( HDC ) _parnl( 1 );
   HGDIOBJ hgdiobj1;
   HPEN    hpen;

   hpen     = CreatePen( PS_SOLID, ( int ) hb_parni( 7 ), ( COLORREF ) RGB( ( int ) hb_parni( 6, 1 ), ( int ) hb_parni( 6, 2 ), ( int ) hb_parni( 6, 3 ) ) );
   hgdiobj1 = SelectObject( hDC, hpen );
   MoveToEx( hDC, ( int ) hb_parni( 3 ), ( int ) hb_parni( 2 ), NULL );
   LineTo( hDC, ( int ) hb_parni( 5 ), ( int ) hb_parni( 4 ) );
   SelectObject( hDC, hgdiobj1 );
   DeleteObject( hpen );
   
}

#pragma ENDDUMP      

[Silvio.Falconi]

fafi,
please can use the last release I insert before . thanks
can insert your notes on the header of class

[fafi]

gradient

Code: Select all  Expand view  RUN

#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 800,400 pixel title "New Class TGroup from Mr. Silvio"


              oGr := TGroupeX():New( 10, 12, 100, 175, "Anagrafica cliente", oDlg,,, .T.,,,,, )
              oGr:cImage:="case.bmp"
             
              @ 30,22 SAY "Name : " of oDlg   PIXEL
              @ 30,45 get oget var cget  of oDlg  size 100,12  PIXEL
             
             
              oGr1 := TGroupeX():New( 10, 180, 100, 350, "Hello World !!!", oDlg,,, .T.,,,,, )
              oGr1:cImage:="case.bmp"
             
             
              oGr1 := TGroupeX():New( 110, 12, 180, 350, "Hello FiveWin", oDlg,,, .T.,,,,, )
              oGr1:cImage:="case.bmp"
             
             


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

   

   ::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
   ::cToolTip  = "Hello"

   ::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
   

   ::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 )
   
    rectdraw( ::hDC, aRect[1]+26, aRect[2], aRect[3]+1, aRect[4], CLR_WHITE, 2 )
   
   
    linedraw( ::hDC, aRect[1]+6, aRect[4], aRect[3]+4, aRect[4], nRGB(180,160,160), 1 )
   
    linedraw( ::hDC, aRect[1]+10, aRect[4]+1, aRect[3]+4, aRect[4]+1, nRGB(190,190,190), 1 )
   
    linedraw( ::hDC, aRect[1]+14, aRect[4]+2, aRect[3]+4, aRect[4]+2, nRGB(210,210,210), 1 )
   
   
    for i := 1 to 5
       linedraw( ::hDC, aRect[3]+i, aRect[2]+i, aRect[3]+i, aRect[4], nRGB(80+(i*30),80+(i*30),80+(i*30)), 1 )
    next  

 ::nColorFrom:= CLR_BLUE
 ::nColorTo:=  CLR_WHITE
 ::lVertical := .T.
 
 ::nColorFrom:= nRGB(34,110,0)
 ::nColorTo:=  nRGB(204,255,181)
 
    Gradient( ::hDC,  { 0, 0, aRect[ 2 ] + 22, aRect[ 4 ]  }, ::nColorFrom, ::nColorTo, ::lVertical )    
   
   
    DeleteObject( hPen )
   
    aRect[1]+=1
    aRect[2]+=1
    aRect[3]-=1
    aRect[4]-=1
 ENDIF

 ::nColorFrom:= nRGB(0,0,150)
 ::nColorTo:=  CLR_WHITE
 ::lVertical := .t.
   
   
    ::PaintH (aRect)




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 nMargin := -1
  LOCAL hBrush, hPen, hOldPen
  LOCAL nClrBorder  := nRGB(0,0,150)
  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] -= 2
   
    /* Left */
   
    nrow := 0
    ncol := 0
    nrow1 := 0
    ncol1 := 10
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
    nrow := 1
    ncol := 0
    nrow1 := 1
    ncol1 := 7
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
    nrow := 2
    ncol := 0
    nrow1 := 2
    ncol1 := 5
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
   
    nrow := 3
    ncol := 0
    nrow1 := 3
    ncol1 := 4
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
    nrow := 4
    ncol := 0
    nrow1 := 4
    ncol1 := 3.5
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
   
    nrow := 5
    ncol := 0
    nrow1 := 5
    ncol1 := 2
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
    nrow := 5
    ncol := 0
    nrow1 := 5
    ncol1 := 2
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
   
    nrow := 6
    ncol := 0
    nrow1 := 6
    ncol1 := 1
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
   
    nrow := 7
    ncol := 0
    nrow1 := 7
    ncol1 := 1
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
    **
   
    /*
    ** right
   
    aRound[4] += 3
   
    nrow := 0
    ncol := aRound[4] - 10
    nrow1 := 0
    ncol1 := aRound[4]
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
    nrow := 1
    ncol := aRound[4] - 7
    nrow1 := 1
    ncol1 := aRound[4]
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
    nrow := 2
    ncol := aRound[4] - 5
    nrow1 := 2
    ncol1 := aRound[4]
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
   
    nrow := 3
    ncol := aRound[4] -4
    nrow1 := 3
    ncol1 := aRound[4]
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
    nrow := 4
    ncol := aRound[4]-3.5
    nrow1 := 4
    ncol1 := aRound[4]
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
   
    nrow := 5
    ncol := aRound[4]-2
    nrow1 := 5
    ncol1 := aRound[4]
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
    nrow := 5
    ncol := aRound[4] - 2
    nrow1 := 5
    ncol1 := aRound[4]
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
   
    nrow := 6
    ncol := aRound[4] - 1
    nrow1 := 6
    ncol1 := aRound[4]
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
   
    nrow := 7
    ncol := aRound[4]-1
    nrow1 := 7
    ncol1 := aRound[4]
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
    */
   
   
   
    ** right
   
    aRound[4] += 3
   
    nrow := 0
    ncol := aRound[4] - 9
    nrow1 := 0
    ncol1 := aRound[4]
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
    nrow := 1
    ncol := aRound[4] - 6
    nrow1 := 1
    ncol1 := aRound[4]
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
    nrow := 2
    ncol := aRound[4] - 4
    nrow1 := 2
    ncol1 := aRound[4]
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
   
    nrow := 3
    ncol := aRound[4] - 3
    nrow1 := 3
    ncol1 := aRound[4]
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
    nrow := 4
    ncol := aRound[4]- 1
    nrow1 := 4
    ncol1 := aRound[4]
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
   
    nrow := 5
    ncol := aRound[4]-1
    nrow1 := 5
    ncol1 := aRound[4]
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
    nrow := 5
    ncol := aRound[4] - 1
    nrow1 := 5
    ncol1 := aRound[4]
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
   
   
   
   
   
   
   
    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
 
 
 #pragma BEGINDUMP                      

#include <hbvm.h>                                                                                                        
#include <hbstack.h>                                                                                                      
#include <WinTen.h>                                                                                                      
#include <Windows.h>                                                                                                      
#include <hbApi.h>                                                                                                        
#include <commctrl.h>                                                                                                    
#include <StdLib.h>                                                                                                      
#include <ClipApi.h>          


HB_FUNC( ELLIPSEDRAW )
{
   
     HDC hDC = ( HDC ) _parnl( 1 );
   HGDIOBJ  hgdiobj1, hgdiobj2;
   HPEN     hpen;
   HBRUSH   hbrush;
   LOGBRUSH br;

   
   hpen     = CreatePen( PS_SOLID, ( int ) hb_parni( 7 ), ( COLORREF ) RGB( ( int ) hb_parni( 6, 1 ), ( int ) hb_parni( 6, 2 ), ( int ) hb_parni( 6, 3 ) ) );
   hgdiobj1 = SelectObject( hDC, hpen );
   if( hb_parl( 9 ) )
   {
     
      hbrush   = CreateSolidBrush( ( COLORREF ) RGB( ( int ) hb_parni( 10 ), ( int ) hb_parni( 11 ), ( int ) hb_parni( 12 ) ) );
      hgdiobj2 = SelectObject( hDC, hbrush );
   }
   else
   {
      br.lbStyle = BS_HOLLOW;
      hbrush     = CreateBrushIndirect( &br );
      hgdiobj2   = SelectObject( hDC, hbrush );
   }

   Ellipse( hDC, ( int ) hb_parni( 3 ), ( int ) hb_parni( 2 ), ( int ) hb_parni( 5 ), ( int ) hb_parni( 4 ) );
   SelectObject( hDC, hgdiobj1 );
   SelectObject( hDC, hgdiobj2 );
   DeleteObject( hpen );
   DeleteObject( hbrush );
   
}

HB_FUNC( RECTDRAW )
{
   HDC hDC = ( HDC ) _parnl( 1 );
   HGDIOBJ  hgdiobj1, hgdiobj2;
   HPEN     hpen;
   HBRUSH   hbrush;
   LOGBRUSH br;

   hpen  = CreatePen( PS_SOLID, ( int ) hb_parni( 7 ), ( COLORREF ) RGB( ( int ) hb_parni( 6, 1 ), ( int ) hb_parni( 6, 2 ), ( int ) hb_parni( 6, 3 ) ) );

   hgdiobj1 = SelectObject( hDC, hpen );
   
   br.lbStyle = BS_HOLLOW;
   hbrush     = CreateBrushIndirect( &br );
   hgdiobj2   = SelectObject( hDC, hbrush );
   Rectangle( hDC, ( int ) hb_parni( 3 ), ( int ) hb_parni( 2 ), ( int ) hb_parni( 5 ), ( int ) hb_parni( 4 ) );
   SelectObject( hDC, hgdiobj1 );
   SelectObject( hDC, hgdiobj2 );
   DeleteObject( hpen );
   DeleteObject( hbrush );
   
}

HB_FUNC( LINEDRAW )
{
   HDC hDC = ( HDC ) _parnl( 1 );
   HGDIOBJ hgdiobj1;
   HPEN    hpen;

   hpen     = CreatePen( PS_SOLID, ( int ) hb_parni( 7 ), ( COLORREF ) RGB( ( int ) hb_parni( 6, 1 ), ( int ) hb_parni( 6, 2 ), ( int ) hb_parni( 6, 3 ) ) );
   hgdiobj1 = SelectObject( hDC, hpen );
   MoveToEx( hDC, ( int ) hb_parni( 3 ), ( int ) hb_parni( 2 ), NULL );
   LineTo( hDC, ( int ) hb_parni( 5 ), ( int ) hb_parni( 4 ) );
   SelectObject( hDC, hgdiobj1 );
   DeleteObject( hpen );
   
}



#pragma ENDDUMP      

[fafi]

my color border and gradient :

Code: Select all  Expand view  RUN

#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 brush oBrush color nRGB(0,0,126)



    DEFINE DIALOG oDlg SIZE 800,400 pixel title "New Class TGroup from Mr. Silvio" // brush oBrush


              oGr := TGroupeX():New( 10, 12, 100, 175, "Anagrafica cliente", oDlg,,, .T.,,,,, )
              oGr:cImage:="case.bmp"
             
              @ 30,22 SAY "Name : " of oDlg   PIXEL
              @ 30,45 get oget var cget  of oDlg  size 100,12  PIXEL
             
             
              oGr1 := TGroupeX():New( 10, 180, 100, 350, "Hello World !!!", oDlg,,, .T.,,,,, )
              oGr1:cImage:="case.bmp"
             
             
              oGr1 := TGroupeX():New( 110, 12, 180, 350, "Hello FiveWin", oDlg,,, .T.,,,,, )
              oGr1:cImage:="case.bmp"
             
             


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
  DATA lGradient
  DATA lShadow


   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

   

   ::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
 
 ::lVertical := .T.
 ::lGradient := .T.
 ::nColorFrom:= nRGB(0,0,0)
 ::nColorTo  :=  nRGB(255,255,255)
 ::lBorder   := .t.
 ::lShadow   := .t.
 ::lRound    := .t.
 
 if ::lShadow
   ::nBorderColor  := nRGB(190,190,190)
 else
    ::nBorderColor  := nRGB(150,150,150)
 endif


   ::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
   

   ::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

   


   
    if ::lShadow
   
            linedraw( ::hDC, aRect[1]+6, aRect[4], aRect[3]+6, aRect[4], nRGB(130,130,130), 1 )
           
            linedraw( ::hDC, aRect[1]+8, aRect[4]+1, aRect[3]+6, aRect[4]+1, nRGB(160,160,160), 1 )
           
            linedraw( ::hDC, aRect[1]+10, aRect[4]+2, aRect[3]+6, aRect[4]+2, nRGB(190,190,190), 1 )
           
            linedraw( ::hDC, aRect[1]+12, aRect[4]+3, aRect[3]+6, aRect[4]+3, nRGB(210,210,210), 1 )
           
            linedraw( ::hDC, aRect[1]+16, aRect[4]+4, aRect[3]+6, aRect[4]+4, nRGB(210,210,210), 1 )
           
           
            for i := 1 to 8
               linedraw( ::hDC, aRect[3]+i, aRect[2]+i, aRect[3]+i, aRect[4]+i, nRGB(85+(i*20),85+(i*20),85+(i*20)), 1 )
            next
     
    endif

 
 
 IF ::lGradient
    Gradient( ::hDC,  { 0, 0, aRect[ 2 ] + 24, aRect[ 4 ]  }, ::nColorFrom, ::nColorTo, ::lVertical )    
   
    Gradient( ::hDC,  { 24, 0, aRect[ 2 ] + 29, aRect[ 4 ]  }, nRGB(190,190,190), nRGB(255,255,255), ::lVertical )    
 endif    


   
   
    //DeleteObject( hPen )
   
    aRect[1]+=1
    aRect[2]+=1
    aRect[3]-=1
    aRect[4]-=1

    IF ::lBorder
       //hPen := CreatePen( 0, 1,::nBorderColor )
       rectdraw( ::hDC, aRect[1]+26, aRect[2]+1, aRect[3]+1, aRect[4], CLR_WHITE, 2 )
    endif  
   
   
 ::PaintH (aRect)




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 nMargin := -1
  LOCAL hBrush, hPen, hOldPen
  LOCAL nClrBorder  := nRGB(0,0,150)
  LOCAL nBmpWidth := 0, nRow, nCol
 


 
 
 

  IF ::lRound
    aRound := AClone (aRect)
   
    hBrush := SelectObject( ::hDC, ::oWnd:oBrush:hBrush )
    hPen   := CreatePen( 0, 1,::oWnd:nClrPane )
    hOldPen := SelectObject( ::hDC, hPen )
   
    aRound[4] -= 2
   
    /* Left */



   
    nrow := 0
    ncol := 0
    nrow1 := 0
    ncol1 := 10
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
    nrow := 1
    ncol := 0
    nrow1 := 1
    ncol1 := 7
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
    nrow := 2
    ncol := 0
    nrow1 := 2
    ncol1 := 5
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
   
    nrow := 3
    ncol := 0
    nrow1 := 3
    ncol1 := 4
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
    nrow := 4
    ncol := 0
    nrow1 := 4
    ncol1 := 3.5
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
   
    nrow := 5
    ncol := 0
    nrow1 := 5
    ncol1 := 2
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
    nrow := 5
    ncol := 0
    nrow1 := 5
    ncol1 := 2
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
   
    nrow := 6
    ncol := 0
    nrow1 := 6
    ncol1 := 1
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
   
    nrow := 7
    ncol := 0
    nrow1 := 7
    ncol1 := 1
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
    **
   
    /*
    ** right
   
    aRound[4] += 3
   
    nrow := 0
    ncol := aRound[4] - 10
    nrow1 := 0
    ncol1 := aRound[4]
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
    nrow := 1
    ncol := aRound[4] - 7
    nrow1 := 1
    ncol1 := aRound[4]
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
    nrow := 2
    ncol := aRound[4] - 5
    nrow1 := 2
    ncol1 := aRound[4]
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
   
    nrow := 3
    ncol := aRound[4] -4
    nrow1 := 3
    ncol1 := aRound[4]
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
    nrow := 4
    ncol := aRound[4]-3.5
    nrow1 := 4
    ncol1 := aRound[4]
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
   
    nrow := 5
    ncol := aRound[4]-2
    nrow1 := 5
    ncol1 := aRound[4]
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
    nrow := 5
    ncol := aRound[4] - 2
    nrow1 := 5
    ncol1 := aRound[4]
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
   
    nrow := 6
    ncol := aRound[4] - 1
    nrow1 := 6
    ncol1 := aRound[4]
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
   
    nrow := 7
    ncol := aRound[4]-1
    nrow1 := 7
    ncol1 := aRound[4]
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
    */
   
   
   
    ** right
   
    aRound[4] += 3
   
    nrow := 0
    ncol := aRound[4] - 9
    nrow1 := 0
    ncol1 := aRound[4]
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
    nrow := 1
    ncol := aRound[4] - 6
    nrow1 := 1
    ncol1 := aRound[4]
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
    nrow := 2
    ncol := aRound[4] - 4
    nrow1 := 2
    ncol1 := aRound[4]
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
   
    nrow := 3
    ncol := aRound[4] - 3
    nrow1 := 3
    ncol1 := aRound[4]
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
    nrow := 4
    ncol := aRound[4]- 1
    nrow1 := 4
    ncol1 := aRound[4]
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
   
    nrow := 5
    ncol := aRound[4]-1
    nrow1 := 5
    ncol1 := aRound[4]
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
    nrow := 5
    ncol := aRound[4] - 1
    nrow1 := 5
    ncol1 := aRound[4]
    linedraw( ::hDC, nrow, ncol, nrow1, ncol1, ::oWnd:nClrPane, 1 )
   
   
   
   
   
    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
 
 
 #pragma BEGINDUMP                      

#include <hbvm.h>                                                                                                        
#include <hbstack.h>                                                                                                      
#include <WinTen.h>                                                                                                      
#include <Windows.h>                                                                                                      
#include <hbApi.h>                                                                                                        
#include <commctrl.h>                                                                                                    
#include <StdLib.h>                                                                                                      
#include <ClipApi.h>          


HB_FUNC( ELLIPSEDRAW )
{
   
     HDC hDC = ( HDC ) _parnl( 1 );
   HGDIOBJ  hgdiobj1, hgdiobj2;
   HPEN     hpen;
   HBRUSH   hbrush;
   LOGBRUSH br;

   
   hpen     = CreatePen( PS_SOLID, ( int ) hb_parni( 7 ), ( COLORREF ) RGB( ( int ) hb_parni( 6, 1 ), ( int ) hb_parni( 6, 2 ), ( int ) hb_parni( 6, 3 ) ) );
   hgdiobj1 = SelectObject( hDC, hpen );
   if( hb_parl( 9 ) )
   {
     
      hbrush   = CreateSolidBrush( ( COLORREF ) RGB( ( int ) hb_parni( 10 ), ( int ) hb_parni( 11 ), ( int ) hb_parni( 12 ) ) );
      hgdiobj2 = SelectObject( hDC, hbrush );
   }
   else
   {
      br.lbStyle = BS_HOLLOW;
      hbrush     = CreateBrushIndirect( &br );
      hgdiobj2   = SelectObject( hDC, hbrush );
   }

   Ellipse( hDC, ( int ) hb_parni( 3 ), ( int ) hb_parni( 2 ), ( int ) hb_parni( 5 ), ( int ) hb_parni( 4 ) );
   SelectObject( hDC, hgdiobj1 );
   SelectObject( hDC, hgdiobj2 );
   DeleteObject( hpen );
   DeleteObject( hbrush );
   
}

HB_FUNC( RECTDRAW )
{
   HDC hDC = ( HDC ) _parnl( 1 );
   HGDIOBJ  hgdiobj1, hgdiobj2;
   HPEN     hpen;
   HBRUSH   hbrush;
   LOGBRUSH br;

   hpen  = CreatePen( PS_SOLID, ( int ) hb_parni( 7 ), ( COLORREF ) RGB( ( int ) hb_parni( 6, 1 ), ( int ) hb_parni( 6, 2 ), ( int ) hb_parni( 6, 3 ) ) );

   hgdiobj1 = SelectObject( hDC, hpen );
   
   br.lbStyle = BS_HOLLOW;
   hbrush     = CreateBrushIndirect( &br );
   
   //hbrush   = CreateSolidBrush( ( COLORREF ) RGB( ( int ) hb_parni( 8, 1 ), ( int ) hb_parni( 8, 2 ), ( int ) hb_parni( 8, 3 ) ) );
   
   //hbrush   = CreateSolidBrush( ( COLORREF ) RGB( 204,255,181 ) );
   
   hgdiobj2   = SelectObject( hDC, hbrush );
   Rectangle( hDC, ( int ) hb_parni( 3 ), ( int ) hb_parni( 2 ), ( int ) hb_parni( 5 ), ( int ) hb_parni( 4 ) );
   SelectObject( hDC, hgdiobj1 );
   SelectObject( hDC, hgdiobj2 );
   DeleteObject( hpen );
   DeleteObject( hbrush );
   
}

HB_FUNC( LINEDRAW )
{
   HDC hDC = ( HDC ) _parnl( 1 );
   HGDIOBJ hgdiobj1;
   HPEN    hpen;

   hpen     = CreatePen( PS_SOLID, ( int ) hb_parni( 7 ), ( COLORREF ) RGB( ( int ) hb_parni( 6, 1 ), ( int ) hb_parni( 6, 2 ), ( int ) hb_parni( 6, 3 ) ) );
   hgdiobj1 = SelectObject( hDC, hpen );
   MoveToEx( hDC, ( int ) hb_parni( 3 ), ( int ) hb_parni( 2 ), NULL );
   LineTo( hDC, ( int ) hb_parni( 5 ), ( int ) hb_parni( 4 ) );
   SelectObject( hDC, hgdiobj1 );
   DeleteObject( hpen );
   
}



#pragma ENDDUMP      

I hope you like it ..

Best Regards
Fafi

[Silvio.Falconi]

good mr fafi
I inserted also the ch file with the possibility to set values from user

Now you can try to make this if you Know how make it



Antonio sad me this :
--------------------------------------------------------------------------------------------------------------------------

When the group is closed, its controls are hidden ( oControl:Hide() ) and all the controls
below the group, are moved upwards ( oControl:SetPos( nTop, nLeft ) ).

When it gets opened, all the controls below the group are moved again downwards
( oControl:SetPos( nTop, nLeft ) ) and its controls are shown ( oControl:Show() ).

The group itself does not contain any control. When I say its controls, I mean the
controls whose coordinates are inside the group coordinates.

------------------------------------------------------------------------------------------------------------------------------