FiveTech Software tech support forums

by **Silvio** » Tue Dec 02, 2008 9: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 Expand view: #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 Expand view: *-- 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 Expand view: #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

by **Antonio Linares** » Tue Dec 02, 2008 9:46 am

Silvio,

You also need:

CLASSDATA lRegistered AS LOGICAL

in Class TBox

by **Silvio** » 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)

by **Silvio** » Tue Dec 02, 2008 10:19 am

this is the new class box

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

by **Antonio Linares** » Tue Dec 02, 2008 11:13 pm

Silvio,

Please provide a single and complete PRG to test, thanks

by **Silvio** » Wed Dec 03, 2008 8:16 am

I sent you a minimal prg

by **Antonio Linares** » Wed Dec 03, 2008 8:49 am

Silvio,

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

by **Silvio** » Wed Dec 03, 2008 9:08 am

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

FiveTech Software tech support forums

I WANT UNDERSTAND HOW !!!!!!!!!!!!!!

I WANT UNDERSTAND HOW !!!!!!!!!!!!!!

Who is online