FiveTech Support Forums

FiveWin / Harbour / xBase community
Board indexAll discussionsLogin (GitHub)
Board index FiveWin for Harbour/xHarbour I WANT UNDERSTAND HOW !!!!!!!!!!!!!!
Silvio
Posts: 3107
Joined: Fri Oct 07, 2005 06:28 PM
I WANT UNDERSTAND HOW !!!!!!!!!!!!!!
Posted: Tue Dec 02, 2008 09:28 AM
I made a small class to draw ona dialog or window a box

this class is a subclass from another class : I need it because I need for each control an Id an I make a list of Items into a dialog

when I call the box class I not see the dots I need to draw the box and change all coordinates.


Can You help me please





From Test.prg

to call the class

npiece:=1
piece:=TBox():New( nTop, nLeft, nBottom, nRight,oParent)






the General class

Code: Select all Collapse
#define LINE          1
#define BOX           2

CLASS TItems  FROM TControl


   CLASSDATA lRegistered AS LOGICAL


      DATA nTop,  nLeft,  nBottom,  nRight
      DATA nPTop, nPLeft, nPBottom, nPRight

      DATA nPen, nStylePen, nClrPen
      DATA nClrBrush, cStyleBrush, cBmpBrush, cResBrush
      DATA oMenu
      DATA nId

      DATA nLastTop, nLastLeft, nLastBottom, nLastRight
      DATA oParent
      DATA aItems
      DATA ltransparent
      DATA nType
      DATA oFont
      DATA cTexto
      DATA   aRect

      METHOD New ( nTop, nLeft, nBottom, nRight, oParent,;
                   nType, ltransparent ) CONSTRUCTOR
      METHOD AddItem ( oItem )
      METHOD Paint ( hDC )
 METHOD Move ( nRow, nCol, nRow2, nCol2 ) CLASS TItems
ENDCLASS

METHOD New ( nTop, nLeft, nBottom, nRight, oParent,;
              nType, ltransparent) CLASS TItems




 DEFAULT  oParent:= GetWndDefault(), ;
                 nType := BOX,;
                 ltransparent:= .f.


  ::nTop     := nTop
  ::nLeft    := nLeft
  ::nBottom  := nBottom
  ::nRight   := nRight
  ::aItems   := {}

  ::oParent  := oParent

  ::nLastTop    := ::nTop
  ::nLastLeft   := ::nLeft
  ::nLastBottom := ::nBottom
  ::nLastRight  := ::nRight

  ::nType    := nType
  ::nStyle   = nOR( WS_CHILD, WS_VISIBLE, WS_TABSTOP )
  ::nId:= ::GetNewId() // give the id of the object

  ::ltransparent := ltransparent

  ::Register( nOR( CS_VREDRAW, CS_HREDRAW ) )




   If ! Empty( oParent:hWnd )
     * ::Create()
        ::oParent:AddItem ( Self )
      oParent:AddControl( Self )
   Else
      oParent:DefControl( Self )
   EndIf


      ::CheckDots()

Return self


METHOD AddItem ( oItem ) CLASS TItems
 AADD ( ::aItems, oItem )
Return nil

METHOD Paint ( hDC ) CLASS TItems

Local nLen := Len ( ::aItems )

If nLen > 0
   aeval ( ::aItems, { |Piece| Piece:Paint( hDC ) } )
endif

Return nil


 METHOD Move ( nRow, nCol, nRow2, nCol2 ) CLASS TItems

Local nLen := Len (::aItems)
 Local n
 Local nIncRow, nIncCol

DEFAULT nRow2 := nRow + ::nBottom - ::nTop  ,;
         nCol2 := nCol + ::nRight  - ::nLeft


 nIncRow := nRow - ::nTop
 nIncCol := nCol - ::nLeft

 ::nLastTop    := ::nTop
 ::nLastLeft   := ::nLeft
 ::nLastBottom := ::nBottom
 ::nLastRight  := ::nRight

 ::nTop    := nRow
 ::nLeft   := nCol
 ::nBottom := nRow2
 ::nRight  := nCol2
         */

If nLen > 0

  *For n := 1 to nLen

   *    ::aItems[n]:Move ( ::aItems[n]:nTop  + nIncRow,;
*                          ::aItems[n]:nLeft + nIncCol  )

   *next
    aeval ( ::aItems, {|Piece| Piece:Move ( Piece:nTop  + nIncRow,;
                                           Piece:nLeft + nIncCol ) } )

 endif



     Super:Move( nRow, nCol, nRow2, nCol2 ,.t. )

Return nil




the box class

Code: Select all Collapse
*-- CLASS DEFINITION ---------------------------------------------------------
*         Name:  TBox
*  Description:
*       Author: Silvio Falconi
*-----------------------------------------------------------------------------

CLASS TBox FROM TItems

      METHOD New (nTop, nLeft, nBottom, nRight, oParent,;
                  nPen, nClrPen, nStylePen,;
                  nClrBrush, cStyleBrush, cBmpBrush, cResBrush, ltransparent,;
                  oDefFont, cTexto ) CONSTRUCTOR

      METHOD Paint ( hDC, oDevice )
      METHOD Nome() INLINE "BOX"
    ENDCLASS

*-- METHOD -------------------------------------------------------------------
*         Name:    New
*  Description:
*       Author: Silvio Falconi
*-----------------------------------------------------------------------------
METHOD New (nTop, nLeft, nBottom, nRight, oParent,;
            nPen, nClrPen, nStylePen,;
            nClrBrush, cStyleBrush, cBmpBrush, cResBrush, ltransparent,;
            oDefFont, cTexto ) CLASS TBox


DEFAULT nPen := 1, nClrPen := CLR_BLACK, nStylePen := PS_SOLID,;
        nClrBrush := CLR_CYAN, ltransparent := .f., cTexto := ""


  ::nTop        := nTop
  ::nLeft       := nLeft
  ::nBottom     := nBottom
  ::nRight      := nRight
  ::oParent     := oParent

  ::nPen        := nPen
  ::nClrPen     := nClrPen
  ::nStylePen   := nStylePen

  ::nClrBrush   := nClrBrush
  ::cStyleBrush := cStyleBrush
  ::cBmpBrush   := cBmpBrush
  ::cResBrush   := cResBrush

 

  ::cTexto      := cTexto

  ::nType       := BOX
  ::ltransparent      := ltransparent


   Super:New (nTop, nLeft, nBottom, nRight, oParent, BOX, ltransparent)

Return Self
  *-- METHOD -------------------------------------------------------------------
*         Name:    Paint ( hDC, oDevice )
*  Description:
*       Author: Silvio Falconi
*-----------------------------------------------------------------------------

METHOD Paint ( hDC, oDevice ) CLASS TBox

Local hBrush, hOldBrush
Local oBrush
Local nOldBack, nOldColor

::SetCoors ( oDevice )

DEFAULT hDC := ::oParent:hDC

  hPen      := CreatePen    (::nStylePen, ::nPen, ::nClrPen)
  hOldPen   := SelectObject (hDC, hPen)

  hBrush    := CreateSolidBrush (::nClrBrush)
  hOldBrush := SelectObject     ( hDC, hBrush)

  If ::ltransparent

     Moveto (hDC, ::nPLeft, ::nPTop)

     LineTo( hDC, ::nPRight          ,             ::nPTop)
     LineTo( hDC, ::nPRight          , ::nPBottom         )
     LineTo( hDC,            ::nPLeft, ::nPBottom         )
     LineTo( hDC,            ::nPLeft,             ::nPTop)

  else

     oBrush := TBrush():New (::cStyleBrush, ::nClrBrush, ::cBmpBrush, ::cResBrush)

     hOldBrush := SelectObject(hDC, oBrush:hBrush )

     Rectangle (hDC, ::nPTop, ::nPLeft, ::nPBottom, ::nPRight)

     SelectObject (hDC, hOldBrush)
     oBrush:End()

  endif



     
  SelectObject( hDC, hOldPen )
  DeleteObject( hPen )

Return nil

**********************************************************












here there is a run test.prg to try



Code: Select all Collapse
 


#include "fivewin.ch"

#define LINE          1 
#define BOX           2 


Function main()
Local ownd
Public piece
public npiece

DEFINE WINDOW oWND

TBox():New( 10, 20, 300, 500,oWnd)

ACTIVATE WINDOW oWNd
RETURN NIL







CLASS TItems  FROM TControl


   CLASSDATA lRegistered AS LOGICAL


      DATA nTop,  nLeft,  nBottom,  nRight
      DATA nPTop, nPLeft, nPBottom, nPRight

      DATA nPen, nStylePen, nClrPen
      DATA nClrBrush, cStyleBrush, cBmpBrush, cResBrush
      DATA oMenu
      DATA nId

      DATA nLastTop, nLastLeft, nLastBottom, nLastRight
      DATA oParent
      DATA aItems
      DATA ltransparent
      DATA nType
      DATA oFont
      DATA cTexto
      DATA   aRect

      METHOD New ( nTop, nLeft, nBottom, nRight, oParent,;
                   nType, ltransparent ) CONSTRUCTOR
      METHOD AddItem ( oItem )
      METHOD Paint ( hDC )
        METHOD Move ( nRow, nCol, nRow2, nCol2 )
ENDCLASS

METHOD New ( nTop, nLeft, nBottom, nRight, oParent,;
              nType, ltransparent) CLASS TItems




 DEFAULT  oParent:= GetWndDefault(), ;
                 nType := BOX,;
                 ltransparent:= .f.


  ::nTop     := nTop
  ::nLeft    := nLeft
  ::nBottom  := nBottom
  ::nRight   := nRight
  ::aItems   := {}

  ::oParent  := oParent

  ::nLastTop    := ::nTop
  ::nLastLeft   := ::nLeft
  ::nLastBottom := ::nBottom
  ::nLastRight  := ::nRight

  ::nType    := nType
  ::nStyle   = nOR( WS_CHILD, WS_VISIBLE, WS_TABSTOP )
  ::nId:= ::GetNewId() // give the id of the object

  ::ltransparent := ltransparent

  ::Register( nOR( CS_VREDRAW, CS_HREDRAW ) )




   If ! Empty( oParent:hWnd )
     * ::Create()
        ::AddItem ( Self )
      oParent:AddControl( Self )
   Else
      oParent:DefControl( Self )
   EndIf


     ::CheckDots()

Return self 


METHOD AddItem ( oItem ) CLASS TItems 
 AADD ( ::aItems, oItem ) 
Return nil 

METHOD Paint ( hDC ) CLASS TItems 

Local nLen := Len ( ::aItems ) 

If nLen > 0 
   aeval ( ::aItems, { |Piece| Piece:Paint( hDC ) } )
endif 

Return nil 


 METHOD Move ( nRow, nCol, nRow2, nCol2 ) CLASS TItems 

Local nLen := Len (::aItems) 

 Local nIncRow, nIncCol 

DEFAULT nRow2 := nRow + ::nBottom - ::nTop  ,; 
         nCol2 := nCol + ::nRight  - ::nLeft 


 nIncRow := nRow - ::nTop 
 nIncCol := nCol - ::nLeft 

 ::nLastTop    := ::nTop 
 ::nLastLeft   := ::nLeft
 ::nLastBottom := ::nBottom
 ::nLastRight  := ::nRight 

 ::nTop    := nRow 
 ::nLeft   := nCol 
 ::nBottom := nRow2
 ::nRight  := nCol2
         */ 

If nLen > 0 

  *For n := 1 to nLen

   *    ::aItems[n]:Move ( ::aItems[n]:nTop  + nIncRow,;
*                          ::aItems[n]:nLeft + nIncCol  )

   *next
    aeval ( ::aItems, {|Piece| Piece:Move ( Piece:nTop  + nIncRow,;
                                           Piece:nLeft + nIncCol ) } ) 

 endif



     Super:Move( nRow, nCol, nRow2, nCol2 ,.t. )

Return nil 








*-- CLASS DEFINITION --------------------------------------------------------- 
*         Name:  TBox
*  Description: 
*       Author: Silvio Falconi
*-----------------------------------------------------------------------------

CLASS TBox FROM TItems

      METHOD New (nTop, nLeft, nBottom, nRight, oParent,;
            nPen, nClrPen, nStylePen,;
            nClrBrush, cStyleBrush, cBmpBrush, cResBrush, ltransparent ) CONSTRUCTOR

      METHOD Paint ( hDC, oDevice )
      METHOD Nome() INLINE "BOX"
    ENDCLASS

*-- METHOD -------------------------------------------------------------------
*         Name:    New
*  Description:
*       Author: Silvio Falconi
*-----------------------------------------------------------------------------
METHOD New (nTop, nLeft, nBottom, nRight, oParent,;
            nPen, nClrPen, nStylePen,;
            nClrBrush, cStyleBrush, cBmpBrush, cResBrush, ltransparent ) CLASS TBox


DEFAULT nPen := 1, nClrPen := CLR_BLACK, nStylePen := PS_SOLID,;
        nClrBrush := CLR_CYAN, ltransparent := .f.


  ::nTop        := nTop
  ::nLeft       := nLeft
  ::nBottom     := nBottom
  ::nRight      := nRight
  ::oParent     := oParent

  ::nPen        := nPen
  ::nClrPen     := nClrPen
  ::nStylePen   := nStylePen

  ::nClrBrush   := nClrBrush
  ::cStyleBrush := cStyleBrush
  ::cBmpBrush   := cBmpBrush
  ::cResBrush   := cResBrush





  ::nType       := BOX
  ::ltransparent      := ltransparent 


   Super:New (nTop, nLeft, nBottom, nRight, oParent, BOX, ltransparent) 

Return Self
  *-- METHOD ------------------------------------------------------------------- 
*         Name:    Paint ( hDC, oDevice ) 
*  Description: 
*       Author: Silvio Falconi
*----------------------------------------------------------------------------- 

METHOD Paint ( hDC, oDevice ) CLASS TBox

Local hBrush, hOldBrush
Local oBrush ,hpen , hOldPen
Local nOldBack, nOldColor

::SetCoors ( oDevice )

DEFAULT hDC := ::oParent:hDC

  hPen      := CreatePen    (::nStylePen, ::nPen, ::nClrPen)
  hOldPen   := SelectObject (hDC, hPen)

  hBrush    := CreateSolidBrush (::nClrBrush)
  hOldBrush := SelectObject     ( hDC, hBrush)

  If ::ltransparent

     Moveto (hDC, ::nPLeft, ::nPTop)

     LineTo( hDC, ::nPRight          ,             ::nPTop)
     LineTo( hDC, ::nPRight          , ::nPBottom         )
     LineTo( hDC,            ::nPLeft, ::nPBottom         )
     LineTo( hDC,            ::nPLeft,             ::nPTop)

  else

     oBrush := TBrush():New (::cStyleBrush, ::nClrBrush, ::cBmpBrush, ::cResBrush)

     hOldBrush := SelectObject(hDC, oBrush:hBrush )

     Rectangle (hDC, ::nPTop, ::nPLeft, ::nPBottom, ::nPRight)

     SelectObject (hDC, hOldBrush)
     oBrush:End() 

  endif 



      
  SelectObject( hDC, hOldPen ) 
  DeleteObject( hPen ) 

Return nil 

**********************************************************



if I rem ::checksdot on titem class I see the window but not the box class


thanks
Best Regards, Saludos



Falconi Silvio
Antonio Linares
Posts: 44158
Joined: Thu Oct 06, 2005 05:47 PM
I WANT UNDERSTAND HOW !!!!!!!!!!!!!!
Posted: Tue Dec 02, 2008 09:46 AM

Silvio,

You also need:

CLASSDATA lRegistered AS LOGICAL

in Class TBox

regards, saludos

Antonio Linares
www.fivetechsoft.com
Silvio
Posts: 3107
Joined: Fri Oct 07, 2005 06:28 PM
I WANT UNDERSTAND HOW !!!!!!!!!!!!!!
Posted: Tue Dec 02, 2008 10:16 AM

I insert it but i make error

Application

Path and name: C:\work\errori\errbox\test.Exe (32 bits)
Size: 1,296,384 bytes
Time from start: 0 hours 0 mins 0 secs
Error occurred at: 12/02/08, 11:17:42
Error description: Error FiveWin/6 Cannot create window or control:
Class: TWINDOW
Caption:
System Error: Impossibile creare una finestra secondaria di primo livello.

Stack Calls

Called from: WINDOW.PRG => WNDCREATEERROR(0)
Called from: WINDOW.PRG => TWINDOW:CREATE(0)
Called from: WINDOW.PRG => TWINDOW:NEW(0)
Called from: CONTROL.PRG => TBOX:CHECKDOTS(0)
Called from: test.prg => TITEMS:NEW(102)
Called from: test.prg => TBOX:NEW(225)
Called from: test.prg => MAIN(17)

Best Regards, Saludos



Falconi Silvio
Silvio
Posts: 3107
Joined: Fri Oct 07, 2005 06:28 PM
I WANT UNDERSTAND HOW !!!!!!!!!!!!!!
Posted: Tue Dec 02, 2008 10:19 AM
this is the new class box
Code: Select all Collapse
*-- CLASS DEFINITION ---------------------------------------------------------
*         Name:  TBox
*  Description:
*       Author: Silvio Falconi
*-----------------------------------------------------------------------------

CLASS TBox FROM TItems
   CLASSDATA lRegistered AS LOGICAL

      METHOD New (nTop, nLeft, nBottom, nRight, oParent,;
            nPen, nClrPen, nStylePen,;
            nClrBrush, cStyleBrush, cBmpBrush, cResBrush, ltransparent ) CONSTRUCTOR

      METHOD Paint ( hDC, oDevice )
      METHOD Nome() INLINE "BOX"
    ENDCLASS

*-- METHOD -------------------------------------------------------------------
*         Name:    New
*  Description:
*       Author: Silvio Falconi
*-----------------------------------------------------------------------------
METHOD New (nTop, nLeft, nBottom, nRight, oParent,;
            nPen, nClrPen, nStylePen,;
            nClrBrush, cStyleBrush, cBmpBrush, cResBrush, ltransparent ) CLASS TBox


DEFAULT nPen := 1, nClrPen := CLR_BLACK, nStylePen := PS_SOLID,;
        nClrBrush := CLR_CYAN, ltransparent := .f.


  ::nTop        := nTop
  ::nLeft       := nLeft
  ::nBottom     := nBottom
  ::nRight      := nRight
  ::oParent     := oParent

  ::nPen        := nPen
  ::nClrPen     := nClrPen
  ::nStylePen   := nStylePen

  ::nClrBrush   := nClrBrush
  ::cStyleBrush := cStyleBrush
  ::cBmpBrush   := cBmpBrush
  ::cResBrush   := cResBrush





  ::nType       := BOX
  ::ltransparent      := ltransparent


   Super:New (nTop, nLeft, nBottom, nRight, oParent, BOX, ltransparent)

Return Self
  *-- METHOD -------------------------------------------------------------------
*         Name:    Paint ( hDC, oDevice )
*  Description:
*       Author: Silvio Falconi
*-----------------------------------------------------------------------------

METHOD Paint ( hDC, oDevice ) CLASS TBox

Local hBrush, hOldBrush
Local oBrush ,hpen , hOldPen
Local nOldBack, nOldColor

::SetCoors ( oDevice )

DEFAULT hDC := ::oParent:hDC

  hPen      := CreatePen    (::nStylePen, ::nPen, ::nClrPen)
  hOldPen   := SelectObject (hDC, hPen)

  hBrush    := CreateSolidBrush (::nClrBrush)
  hOldBrush := SelectObject     ( hDC, hBrush)

  If ::ltransparent

     Moveto (hDC, ::nPLeft, ::nPTop)

     LineTo( hDC, ::nPRight          ,             ::nPTop)
     LineTo( hDC, ::nPRight          , ::nPBottom         )
     LineTo( hDC,            ::nPLeft, ::nPBottom         )
     LineTo( hDC,            ::nPLeft,             ::nPTop)

  else

     oBrush := TBrush():New (::cStyleBrush, ::nClrBrush, ::cBmpBrush, ::cResBrush)

     hOldBrush := SelectObject(hDC, oBrush:hBrush )

     Rectangle (hDC, ::nPTop, ::nPLeft, ::nPBottom, ::nPRight)

     SelectObject (hDC, hOldBrush)
     oBrush:End()

  endif




  SelectObject( hDC, hOldPen )
  DeleteObject( hPen )

Return nil

**********************************************************
Best Regards, Saludos



Falconi Silvio
Antonio Linares
Posts: 44158
Joined: Thu Oct 06, 2005 05:47 PM
I WANT UNDERSTAND HOW !!!!!!!!!!!!!!
Posted: Tue Dec 02, 2008 11:13 PM

Silvio,

Please provide a single and complete PRG to test, thanks

regards, saludos

Antonio Linares
www.fivetechsoft.com
Silvio
Posts: 3107
Joined: Fri Oct 07, 2005 06:28 PM
I WANT UNDERSTAND HOW !!!!!!!!!!!!!!
Posted: Wed Dec 03, 2008 08:16 AM

I sent you a minimal prg

Best Regards, Saludos



Falconi Silvio
Antonio Linares
Posts: 44158
Joined: Thu Oct 06, 2005 05:47 PM
I WANT UNDERSTAND HOW !!!!!!!!!!!!!!
Posted: Wed Dec 03, 2008 08:49 AM

Silvio,

Why don't you post it here ? :-)

regards, saludos

Antonio Linares
www.fivetechsoft.com
Silvio
Posts: 3107
Joined: Fri Oct 07, 2005 06:28 PM
I WANT UNDERSTAND HOW !!!!!!!!!!!!!!
Posted: Wed Dec 03, 2008 09:08 AM

because it is an alpha project test and I think I post the sample test up these messages

Best Regards, Saludos



Falconi Silvio

Continue the discussion

Static archive · New replies & topics via GitHub Discussions