FiveTech Software tech support forums

www.FiveTechSoft.com
https://forums.fivetechsupport.com/

Existe Clase para dibujar?

https://forums.fivetechsupport.com/viewtopic.php?f=6&t=25661

Page 1 of 1

Existe Clase para dibujar?

PostPosted: Fri Feb 15, 2013 11:29 am
by llambion
Estoy haciendo un programa que necesitaría poder dibujar dentro de un rectangulo circulos y cuadrados y poderlos mover por todo el cuadrado. Estos cuadrados y círculos son depósitos de distintas sustancias.
A su vez cada circulo/cuadrado al pinchar en el debería salir un menu.
He echado un vistazo la clase tgantt pero solo mueve los rectangulos horizontalmente y no dibuja circulos.
Hay algo que haga esto o hay que hacer una clase nueva??
Gracias de antemano

Re: Existe Clase para dibujar?

PostPosted: Fri Feb 15, 2013 11:56 am
by Carles
Llambion,

Hace tiempo hice algo similar. Lo q hize fue usar la clase TBitmap en modo diseño, y la puedes posicionar en cualquier punto de la pantalla y con un dibujo q puede ser un deposito, tanque,... Puedes programar q al pichar boton derecho aparezca un popup con tus diferentes opciones. Cuando termines salvas las posiciones de cada objeto y listos.

Re: Existe Clase para dibujar?

PostPosted: Fri Feb 15, 2013 12:04 pm
by Antonio Linares
@ nRow, nCol BITMAP oBmp FILE cFileName OF oDlg DESIGN

Re: Existe Clase para dibujar?

PostPosted: Fri Feb 15, 2013 12:20 pm
by llambion
Muchas gracias.
Haré una prueba a ver que tal, pero me convence más hacerlos dibujos desde código porque esos depósitos tienen que cambiar de color y/o textura
Y también voy a probar hacer una clase nueva, hace tiempo que no lo intento pero partiré de la clase gantt a ver que consigo

Re: Existe Clase para dibujar?

PostPosted: Fri Feb 15, 2013 3:24 pm
by carlos vargas
me parece que the full habia hecho una clase para tal efecto llamada TCanvas

por favor buscala.

salu2
carlos vargas

Re: Existe Clase para dibujar?

PostPosted: Mon Feb 18, 2013 10:32 am
by llambion
La he buscado y no la encuentro. Alguien la tiene??

Re: Existe Clase para dibujar?

PostPosted: Mon Feb 18, 2013 2:51 pm
by carlos vargas
no es esta, pero p}la pongo por si te sive, aun busco la que te comente
Code: Select all  Expand view

#include "fivewin.ch"

    #define DT_TOP                      0x00000000
    #define DT_LEFT                     0x00000000
    #define DT_CENTER                   0x00000001
    #define DT_RIGHT                    0x00000002
    #define DT_VCENTER                  0x00000004
    #define DT_BOTTOM                   0x00000008
    #define DT_WORDBREAK                0x00000010
    #define DT_SINGLELINE               0x00000020
    #define DT_EXPANDTABS               0x00000040
    #define DT_TABSTOP                  0x00000080
    #define DT_NOCLIP                   0x00000100
    #define DT_EXTERNALLEADING          0x00000200
    #define DT_CALCRECT                 0x00000400
    #define DT_NOPREFIX                 0x00000800
    #define DT_INTERNAL                 0x00001000

#xcommand ASSERT <uAction,...>  ;
       => ;
          if( eval({||<uAction>}), (MsgAlert( "Assert error : " +  <(uAction)> + chr(10)+chr(13) + "Fichero:  " + ProcFile() + chr(10)+chr(13) + "Funcion:  " + ProcName() + chr(10)+chr(13) + "Línea: " + str(ProcLine()) + chr(10)+chr(13) ),__quit()), )

CLASS TDC

    DATA m_lCompatible             INIT .f.
    DATA m_hDC
    DATA m_hWnd                    INIT nil
    DATA m_hOldPen                 INIT -1
    DATA m_hOldBrush               INIT -1
    DATA m_hOldBmp                 INIT -1
    DATA m_nOldTop, m_nOldLeft
    DATA m_nOldMode
    DATA m_nOldColor
    DATA m_aGdis          AS ARRAY INIT {}        

    METHOD GetDC       ( hWnd ) CONSTRUCTOR                     // Ok
    METHOD CompatibleDC( hDC  ) CONSTRUCTOR                     // Ok

    METHOD End()

    METHOD SetTransparent()                                     // Ok
    METHOD SetSolid()                                           // Ok

    // Pen
    METHOD CreatePen( nColor, nWidth, nStyle )                  // Ok
    METHOD SelectPen( hPen )                                    // Ok
    METHOD DeletePen( hPen )                                    // Ok
    METHOD BlackPen ( nWidth )      INLINE ::CreatePen( 0, nWidth, 0 )
    METHOD GrayPen  ( nWidth )      INLINE ::CreatePen( RGB( 128, 128, 128 ), nWidth, 0 )
    METHOD LtGrayPen( nWidth )      INLINE ::CreatePen( RGB( 192, 192, 192 ), nWidth, 0 )
    METHOD WhitePen ( nWidth )      INLINE ::CreatePen( RGB( 255, 255, 255 ), nWidth, 0 )

    // Brush
    METHOD CreateBrush( nColor )                                // Ok
    METHOD SelectBrush( hBrush )                                // Ok
    METHOD DeleteBrush( hBrush )                                // Ok
    METHOD GrayBrush()              INLINE ::CreateBrush( RGB( 128, 128, 128 ) )
    METHOD LtGrayBrush()            INLINE ::CreateBrush( RGB( 192, 192, 192 ) )
    METHOD WhiteBrush()             INLINE ::CreateBrush( RGB( 255, 255, 255 ) )

    // Images
    METHOD LoadImage( cResName )                                // Ok
    METHOD ReadImage( cFileName )                               // Ok
    METHOD CreateCmpBitmap( nWidth, nHeight )                   // Ok
    METHOD SelectBitmap( hBitmap )                              // Ok
    METHOD DeleteBitmap( hBitmap )                              // Ok
    METHOD DrawImage( hImage, nTop, nLeft, nWidth, nHeight )    // Ok
    METHOD DrawImageEx( hImage, nTop, nLeft )                   // Ok
    METHOD DrawDisable( hImage, nTop, nLeft )                   // Ok
    METHOD DrawTransparent( hImage, nTop, nLeft )               // Ok

    METHOD MoveTo( nTop, nLeft )    INLINE MoveTo( ::m_hDC, nLeft, nTop )

    METHOD Line( nTop, nLeft, nBottom, nRight )                 // Ok
    METHOD Rectangle( nTop, nLeft, nBottom, nRight )            // Ok
    METHOD RectangleEx( nTop, nLeft, nWidth, nHeight )          // Ok
    //METHOD BlackBox( nTop, nLeft, nBottom, nRight )
    //METHOD BlackBoxEx( nTop, nLeft, nWidth, nHeight )

    METHOD Circle( nTop, nLeft, nRadius )                       // Ok
    METHOD Ellipse( nTop, nLeft, nBottom, nRight )              // Ok
    METHOD EllipseEx( nTop, nLeft, nWidth, nHeight )            // Ok

    //METHOD DrawText( cText, nTop, nLeft, nBottom, nRight, nStyle )
    //METHOD TextOut( cText, nTop, nLeft )
       
   
   
   
ENDCLASS

/********************************************************************************************/
   METHOD GetDC( hWnd ) CLASS TDC
/********************************************************************************************/

    DEFAULT hWnd := 0

    ::m_hWnd      := hWnd
    ::m_hDC       := GetDC( hWnd )
    ::m_nOldMode  := GetBkMode( ::m_hDC )
    ::m_nOldColor := GetBkColor( ::m_hDC )

return self

/********************************************************************************************/
   METHOD CompatibleDC( hDC ) CLASS TDC
/********************************************************************************************/

    ASSERT empty( hDC )

    if valtype( hDC ) == "O"
       hDC := hDC:m_hDC
    endif

    ::m_hDC := CreateCompatibleDC( hDC )
    ::m_lCompatible := .t.
    ::m_nOldMode    := GetBkMode( ::m_hDC )
    ::m_nOldColor   := GetBkColor( ::m_hDC )

return Self

/********************************************************************************************/
   METHOD End() CLASS TDC
/********************************************************************************************/
   
    local i

    for i := 1 to len( ::m_aGdis )
        DeleteObject( ::m_aGdis  ) 
    next

    if ::m_lCompatible
       DeleteDC( ::m_hDC )
    else
       ReleaseDC( ::m_hWnd, ::m_hDC )
    endif   

return nil

/********************************************************************************************/
  METHOD SelectPen( hPen ) CLASS TDC
/********************************************************************************************/
   
    if ::m_hOldPen > 0
       SelectObject( ::m_hDC, ::m_hOldPen )
    endif

    ::m_hOldPen := SelectObject( ::m_hDC, hPen )

return nil

/********************************************************************************************/
   METHOD DeletePen( hPen ) CLASS TDC
/********************************************************************************************/

    ASSERT empty( hPen )

    if ::m_hOldPen > 0
       SelectObject( ::m_hDC, ::m_hOldPen )   
       ::m_hOldPen := -1
    endif

    DeleteObject( hPen )

    return nil

/********************************************************************************************/
    METHOD SelectBrush( hBrush )
/********************************************************************************************/

    ASSERT empty( hBrush )

    if ::m_hOldBrush > 0
       SelectObject( ::m_hDC, ::m_hOldBrush )
    endif

    ::m_hOldBrush := SelectObject( ::m_hDC, hBrush )

return nil

/********************************************************************************************/
   METHOD DeleteBrush( hBrush ) CLASS TDC
/********************************************************************************************/

    ASSERT empty( hBrush )

    if ::m_oldBrush > 0
           SelectObject( ::m_hDC, ::m_hOldBrush )
    endif

    DeleteObject( hBrush )

return nil

/********************************************************************************************/
    METHOD SelectBitmap( hBitmap )
/********************************************************************************************/

    ASSERT empty( hBitmap )

    if ::m_hOldBmp > 0
       SelectObject( ::m_hDC, ::m_hOldBmp )
    endif

    ::m_hOldBmp := SelectObject( ::m_hDC, hBitmap )

return nil

/********************************************************************************************/
   METHOD DeleteBitmap( hBitmap ) CLASS TDC
/********************************************************************************************/

    ASSERT empty( hBitmap )

    if ::m_oldBitmap > 0
       SelectObject( ::m_hDC, ::m_hOldBitmap )
    endif

    DeleteObject( hBitmap )

return nil


/********************************************************************************************/
    METHOD SetTransparent() CLASS TDC
/********************************************************************************************/

if ::m_oldMode != nil
   SetBkMode( ::m_hDC, ::m_oldMode )
endif
::m_oldMode := SetBkMode( ::m_hDC, 1 ) // TRANSPARENT

return nil

/********************************************************************************************/
    METHOD  SetSolid() CLASS TDC
/********************************************************************************************/

if ::m_oldMode != nil
   SetBkMode( ::m_hDC, ::m_oldMode )
endif
::m_oldMode := SetBkMode( ::m_hDC, 2 ) // SOLID

return nil




/********************************************************************************************/
  METHOD Line( nTop, nLeft, nBottom, nRight ) CLASS TDC
/********************************************************************************************/

    if pcount() == 2
       // nTop y nLeft son en realidad el destino de la línea
       nBottom := nTop
       nRight  := nLeft
       nTop    := ::nOldTop
       nLeft   := ::nOldLeft
    endif

    LineTo( ::m_hDC, nTop, nLeft, nBottom, nRight )

return nil


/********************************************************************************************/
  METHOD Rectangle( nTop, nLeft, nBottom, nRight ) CLASS TDC
/********************************************************************************************/

    if pcount() == 2
       // nTop y nLeft son en realidad el destino de la línea
       nBottom := nTop
       nRight  := nLeft
       nTop    := ::nOldTop
       nLeft   := ::nOldLeft
    endif

    Rectangle( ::m_hDC, nTop, nLeft, nBottom, nRight )

return nil

/********************************************************************************************/
  METHOD RectangleEx( nTop, nLeft, nWidth, nHeight ) CLASS TDC
/********************************************************************************************/

    Rectangle( ::m_hDC, nTop, nLeft, nTop + nHeight, nLeft + nWidth )

return nil

/********************************************************************************************/
    METHOD Circle( nTCenter, nLCenter, nRadius ) CLASS TDC
/********************************************************************************************/

    Ellipse( ::m_hDC, nLCenter-nRadius, nTCenter - nRadius,  nLCenter + nRadius, nTCenter + nRadius )

return nil

/********************************************************************************************/
    METHOD Ellipse( nTCenter, nLCenter, nWidth, nHeight ) CLASS TDC
/********************************************************************************************/

local nMedW := nWidth / 2
local nMedH := nHeight / 2

    Ellipse( ::m_hDC, nLCenter - nMedW, nTCenter - nMedH,  nLCenter + nMedW, nTCenter + nMedH )

return nil
/********************************************************************************************/
    METHOD EllipseEx( nTop, nLeft, nBottom, nRight ) CLASS TDC
/********************************************************************************************/

    Ellipse( ::m_hDC, nLeft, nTop,  nRight, nBottom )

return nil

/********************************************************************************************/
    METHOD CreatePen( nColor, nWidth, nStyle ) CLASS TDC
/********************************************************************************************/

    DEFAULT nStyle := 0     // PS_SOLID
    DEFAULT nWidth := 1
    DEFAULT nColor := 0     // negro

local hPen

hPen := CreatePen( nStyle, nWidth, nColor )

aadd( ::m_aGdis, {hPen,.f.} )

return

/********************************************************************************************/
    METHOD CreateBrush( nColor ) CLASS TDC
/********************************************************************************************/
    DEFAULT nColor := RGB( 255, 255, 255 )
local hBrush

hBrush := CreateSolidBrush( nColor )

aadd( ::m_aGdis, {hBrush,.f.} )

return hBrush

/********************************************************************************************/
    METHOD LoadImage( cResName ) CLASS TDC
/********************************************************************************************/
local hBmp

hBmp := PalBmpLoad( cResName )[1]

aadd( ::m_aGdis, {hBmp,.f.} )

return  hBmp

/********************************************************************************************/
    METHOD ReadImage( cFileName ) CLASS TDC
/********************************************************************************************/

local hBmp

if at( ".BMP", upper( cFileName ) ) > 0
   hBmp := ReadBitmap( 0, cFileName )
else
   hBmp := NViewLib32( AllTrim( cFileName ), 0 )
endif

aadd( ::m_aGdis, {hBmp,.f.} )

return hBmp


/********************************************************************************************/
    METHOD CreateCmpBitmap( nWidth, nHeight ) CLASS TDC
/********************************************************************************************/

    ASSERT empty( ::m_hDC )

local hBmp

hBmp := CreateCompatibleBitmap( ::m_hDC, nWidth, nHeight )

aadd( ::m_aGdis, {hBmp,.f.} )

return

/********************************************************************************************/
    METHOD DrawImage( hImage, nTop, nLeft, nWidth, nHeight ) CLASS TDC
/********************************************************************************************/

    DrawState( ::m_hDC, nil, hImage, nLeft, nTop, nWidth, nHeight, 4 )

return nil

/********************************************************************************************/
    METHOD DrawTransparent( hImage, nTop, nLeft )  CLASS TDC
/********************************************************************************************/

DrawMasked( ::m_hDC, hImage, nTop, nLeft )

return nil

/********************************************************************************************/
    METHOD DrawImageEx( hImage, nTop, nLeft ) CLASS TDC
/********************************************************************************************/

   DrawState( ::m_hDC, nil, hImage, nLeft, nTop, bmpWidth( hImage ), bmpHeight( hImage ), 4 )

return nil

/********************************************************************************************/
    METHOD DrawDisable( hImage, nTop, nLeft ) CLASS TDC
/********************************************************************************************/

    DrawState( ::m_hDC, nil, hImage, nLeft, nTop, bmpWidth( hImage ), bmpHeight( hImage ), nOr( 4, 32 ) )

 return nil








DLL32 Function NViewLib32( cName AS STRING, nShow AS LONG ) AS LONG PASCAL FROM "NViewLibLoad" LIB "nviewlib.dll"



#pragma BEGINDUMP

#include <windows.h>
#include <winuser.h>
#include "hbapi.h"


// #define DST_COMPLEX     0x0000
// #define DST_TEXT        0x0001
// #define DST_PREFIXTEXT  0x0002
// #define DST_ICON        0x0003
// #define DST_BITMAP      0x0004

HB_FUNC( DRAWSTATE )
{

hb_retl( DrawState( ( HDC )  hb_parnl( 1 ),
                    (HBRUSH) hb_parnl( 2 ),
                                      NULL,
                    (LPARAM) hb_parnl( 3 ),
                    (WPARAM)           0  ,
                             hb_parni( 4 ),
                             hb_parni( 5 ),
                             hb_parni( 6 ),
                             hb_parni( 7 ),
                             hb_parnl( 8 ) ) );
}

HB_FUNC ( BMPHEIGHT )
{
    BITMAP bm;

    GetObject( ( HGDIOBJ ) hb_parnl( 1 ), sizeof( BITMAP ), ( LPSTR ) &bm );

    hb_retnl( bm.bmHeight );

}

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

HB_FUNC ( BMPWIDTH )
{

    BITMAP bm;

    GetObject( ( HGDIOBJ ) hb_parnl( 1 ), sizeof( BITMAP ), ( LPSTR ) &bm );

    hb_retnl( bm.bmWidth );

}

HB_FUNC( CREATECOMPATIBLEBITMAP )
{
     hb_retnl( (LONG) CreateCompatibleBitmap( ( HDC ) hb_parnl( 1 ), hb_parni( 2 ), hb_parni( 3 ) ));
 
}
 
HB_FUNC( CREATECOMPATIBLEDC )
{
     hb_retnl( (LONG) CreateCompatibleDC( ( HDC ) hb_parnl( 1 )));
 
}
 
HB_FUNC( GETBKMODE )
{
     hb_retni( GetBkMode( ( HDC ) hb_parnl( 1 )));
}  


#pragma ENDDUMP



 

Re: Existe Clase para dibujar?

PostPosted: Wed Feb 20, 2013 2:58 pm
by llambion
Voy a probar esta clase, a ver si puedo hacer lo que busco
Muchas gracias por le aporte

Re: Existe Clase para dibujar?

PostPosted: Wed Feb 20, 2013 3:14 pm
by mastintin
Llambion , yo tengo una beta2 de Tcanvas de thefull ,es del 2002 y no se si compila bien con el fw actual ( supongo que si ) .si quieres te la envio a tu mail.
Saludos desde Gijón.

Re: Existe Clase para dibujar?

PostPosted: Mon Feb 25, 2013 8:13 am
by llambion
Pues te lo agradecería un montón porque tengo funcionando de gestión de llagares (mi mujer es enóloga) y quiero hacerlo mas intuitivo con los depósitos y demás instalaciones dibujadas...
mi correo es llambion@llambion.com
La verdad es que es al primer asturiano que encuentro por aquí... Yo soy de Oviedo
Muchas gracias...
Héctor
All times are UTC
Page 1 of 1
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
http://www.phpbb.com/