Modifying tGroup class

Modifying tGroup class

Postby Silvio.Falconi » Fri May 12, 2017 2:40 pm

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


Image

any solution ?
Since from 1991/1992 ( fw for clipper Rel. 14.4 - Momos)
I use : FiveWin for Harbour November 2023 - January 2024 - Harbour 3.2.0dev (harbour_bcc770_32_20240309) - Bcc7.70 - xMate ver. 1.15.3 - PellesC - mail: silvio[dot]falconi[at]gmail[dot]com
User avatar
Silvio.Falconi
 
Posts: 7034
Joined: Thu Oct 18, 2012 7:17 pm

Re: Modifying tGroup class

Postby Silvio.Falconi » Fri May 12, 2017 4:26 pm

Antonio,
Please help for this


the image is showed BUT the label is showed bad
the round corner are showed bad

Image


test.prg




Code: Select all  Expand view


#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
 
Since from 1991/1992 ( fw for clipper Rel. 14.4 - Momos)
I use : FiveWin for Harbour November 2023 - January 2024 - Harbour 3.2.0dev (harbour_bcc770_32_20240309) - Bcc7.70 - xMate ver. 1.15.3 - PellesC - mail: silvio[dot]falconi[at]gmail[dot]com
User avatar
Silvio.Falconi
 
Posts: 7034
Joined: Thu Oct 18, 2012 7:17 pm

Re: Modifying tGroup class

Postby Silvio.Falconi » Fri May 12, 2017 5:08 pm

New version with new #xcommand

Code: Select all  Expand view
#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
#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









 
Since from 1991/1992 ( fw for clipper Rel. 14.4 - Momos)
I use : FiveWin for Harbour November 2023 - January 2024 - Harbour 3.2.0dev (harbour_bcc770_32_20240309) - Bcc7.70 - xMate ver. 1.15.3 - PellesC - mail: silvio[dot]falconi[at]gmail[dot]com
User avatar
Silvio.Falconi
 
Posts: 7034
Joined: Thu Oct 18, 2012 7:17 pm

Re: Modifying tGroup class

Postby Antonio Linares » Sat May 13, 2017 8:41 am

Is it already working fine ?

have you solved those issues ?
regards, saludos

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

Re: Modifying tGroup class

Postby Silvio.Falconi » Sat May 13, 2017 10:40 am

no here not run ok
the left and right angles are not showed good
Since from 1991/1992 ( fw for clipper Rel. 14.4 - Momos)
I use : FiveWin for Harbour November 2023 - January 2024 - Harbour 3.2.0dev (harbour_bcc770_32_20240309) - Bcc7.70 - xMate ver. 1.15.3 - PellesC - mail: silvio[dot]falconi[at]gmail[dot]com
User avatar
Silvio.Falconi
 
Posts: 7034
Joined: Thu Oct 18, 2012 7:17 pm

Re: Modifying tGroup class

Postby Antonio Linares » Sat May 13, 2017 6:54 pm

Remove this line:

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

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

Re: Modifying tGroup class

Postby Silvio.Falconi » Sun May 14, 2017 10:45 am

I tried to rem it but the result is this

Image

on the top I see a line black
Since from 1991/1992 ( fw for clipper Rel. 14.4 - Momos)
I use : FiveWin for Harbour November 2023 - January 2024 - Harbour 3.2.0dev (harbour_bcc770_32_20240309) - Bcc7.70 - xMate ver. 1.15.3 - PellesC - mail: silvio[dot]falconi[at]gmail[dot]com
User avatar
Silvio.Falconi
 
Posts: 7034
Joined: Thu Oct 18, 2012 7:17 pm

Re: Modifying tGroup class

Postby fafi » Sun May 14, 2017 1:43 pm

Image
Code: Select all  Expand view
#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
User avatar
fafi
 
Posts: 169
Joined: Mon Feb 25, 2008 2:42 am

Re: Modifying tGroup class

Postby Silvio.Falconi » Sun May 14, 2017 2:31 pm

good mr fafi
Since from 1991/1992 ( fw for clipper Rel. 14.4 - Momos)
I use : FiveWin for Harbour November 2023 - January 2024 - Harbour 3.2.0dev (harbour_bcc770_32_20240309) - Bcc7.70 - xMate ver. 1.15.3 - PellesC - mail: silvio[dot]falconi[at]gmail[dot]com
User avatar
Silvio.Falconi
 
Posts: 7034
Joined: Thu Oct 18, 2012 7:17 pm

Re: Modifying tGroup class

Postby Silvio.Falconi » Sun May 14, 2017 3:28 pm

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

//----------------------------------------------------------------------------//
 
Last edited by Silvio.Falconi on Sun May 14, 2017 4:06 pm, edited 1 time in total.
Since from 1991/1992 ( fw for clipper Rel. 14.4 - Momos)
I use : FiveWin for Harbour November 2023 - January 2024 - Harbour 3.2.0dev (harbour_bcc770_32_20240309) - Bcc7.70 - xMate ver. 1.15.3 - PellesC - mail: silvio[dot]falconi[at]gmail[dot]com
User avatar
Silvio.Falconi
 
Posts: 7034
Joined: Thu Oct 18, 2012 7:17 pm

Re: Modifying tGroup class

Postby fafi » Sun May 14, 2017 3:59 pm

with Shadow :
Image
Code: Select all  Expand view
#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      
User avatar
fafi
 
Posts: 169
Joined: Mon Feb 25, 2008 2:42 am

Re: Modifying tGroup class

Postby Silvio.Falconi » Sun May 14, 2017 4:02 pm

fafi,
please can use the last release I insert before . thanks
can insert your notes on the header of class
Since from 1991/1992 ( fw for clipper Rel. 14.4 - Momos)
I use : FiveWin for Harbour November 2023 - January 2024 - Harbour 3.2.0dev (harbour_bcc770_32_20240309) - Bcc7.70 - xMate ver. 1.15.3 - PellesC - mail: silvio[dot]falconi[at]gmail[dot]com
User avatar
Silvio.Falconi
 
Posts: 7034
Joined: Thu Oct 18, 2012 7:17 pm

Re: Modifying tGroup class

Postby fafi » Mon May 15, 2017 1:21 am

gradient
Image

Code: Select all  Expand view
#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      
User avatar
fafi
 
Posts: 169
Joined: Mon Feb 25, 2008 2:42 am

Re: Modifying tGroup class

Postby fafi » Mon May 15, 2017 5:30 am

my color border and gradient :
Image

Code: Select all  Expand view
#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
User avatar
fafi
 
Posts: 169
Joined: Mon Feb 25, 2008 2:42 am

Re: Modifying tGroup class

Postby Silvio.Falconi » Mon May 15, 2017 11:18 am

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

Image

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.

------------------------------------------------------------------------------------------------------------------------------
Since from 1991/1992 ( fw for clipper Rel. 14.4 - Momos)
I use : FiveWin for Harbour November 2023 - January 2024 - Harbour 3.2.0dev (harbour_bcc770_32_20240309) - Bcc7.70 - xMate ver. 1.15.3 - PellesC - mail: silvio[dot]falconi[at]gmail[dot]com
User avatar
Silvio.Falconi
 
Posts: 7034
Joined: Thu Oct 18, 2012 7:17 pm

Next

Return to FiveWin for Harbour/xHarbour

Who is online

Users browsing this forum: Horizon and 41 guests