Hola a todos,

A ver... como lo explico.

Usando funciones, soy capaz de dibujar un código de barras en una Window, pero cuando ésta pierde el foco y lo recupera, el código de barras desaparece.

Alguién sabría construir una clase para poder dibujar líneas en una ventana como un control más de la Window? Y a ser posible que acepte las cláusulas PIXEL, DESIGN, UPDATE y BOX (además claro está de las coordenas, color, altura y anchura).

Yo no se construir esa clase, no acabo de entender como se disparan los diferentes métodos que tiene WINDOW y TCONTROL. Entiendo que debería heredar de la clase TCONTROL.

Saludos
Carlos G.

antolin wrote:Para que el dibujo permanezca tras cada refresco de pantalla tienes que pintarlo en el método ::Paint() de tu Diálogo mediante ::bPainted.

Por ejemplo:

Code (fw): Select all Collapse

DEFINE DIALOG oDlg .......
   ...
   ...
   oDlg:bPainted := { |hdc| PintDiag(hdc, <params>...) }
ACTIVATE DIALOG oDlg ...


FUNCTION PintDiag(hdc, <params>...)
   ...
   AQUI PINTO EL CODIGO DE BARRAS
   ...
RETRUN NIL

Signifca que tienes que meter los datos del código de barras en variables y arrays para poder pasarlos a la función de pintado.

Espero te sea útili
Un saludo

La segunda opción es crear tu propia clase y entonces el código se dibujaría en el ::Paint() de la clase y se refrescaría automáticamente con la pantalla, pero eso es harina de otro costal.

Puedes intentar modificar la clase TSAY (con otro nombre) para adaptarla a tus necesidades, sería lo más rápido.

Un saludo.

antolin wrote:La segunda opción es crear tu propia clase y entonces el código se dibujaría en el ::Paint() de la clase y se refrescaría automáticamente con la pantalla, pero eso es harina de otro costal.

Carlos,

Puedes usar la Clase TPanel de FWH (source\classes\tpanel.prg) como guía de como construir una nueva clase de control.

La Clase TPanel es muy simple y muy fácil de entenderla, así que es idónea para lo que quieres

Antonio Linares wrote:Carlos,

Puedes usar la Clase TPanel de FWH (source\classes\tpanel.prg) como guía de como construir una nueva clase de control.

La Clase TPanel es muy simple y muy fácil de entenderla, así que es idónea para lo que quieres

bueno creo que el agua tibia ya la inventaron, busca la clase tslines del maestro mercado, creo viene con la tsbutton y tambien ya existe ua de codigo de barras pero eso si no me acuerdo, pero debe estar aqui en utilidades para bajarla

con el permiso del maestro mercado

• ============================================================================
• CLASS TSLines Version 6.0 Mar/1/2008
• Author: Manuel Mercado
• Freeware, you can freely use this class just by respecting the authorïs name.
• ============================================================================

include "FiveWin.ch"

define WM_NCHITTEST 132 // 0x84

define GRP_CHARPIX_H 14 // height of a char in pixels

define GRP_CHARPIX_W 7 // width of a char in pixels

define COLOR_BTNHIGHLIGHT 20

define COLOR_BTNSHADOW 16

define COLOR_BTNTEXT 18

define WS_EX_TRANSPARENT 32

define GWL_STYLE -16

define GWL_EXSTYLE -20

ifdef XPP

#define Super ::TControl
#define New _New

endif

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

CLASS TSLines FROM TControl

DATA aRect
DATA lRounded, lRepaint
DATA cType, cLabel
DATA nClrLite, nClrDark, nTextClr, nSAlign

CLASSDATA lRegistered AS LOGICAL

METHOD New( nTop, nLeft, nBottom, nRight, cType, oWnd, nClrLite, nClrDark, nClrText, lPixel, lUpdate, lRounded, ;
cLabel, oFont, nSAlign, lDesign ) CONSTRUCTOR

METHOD ReDefine( cType, nId, oWnd, nClrLite, nClrDark, nClrText, lUpdate, lRounded, cLabel, oFont, ;
nSAlign ) CONSTRUCTOR

METHOD BeginPaint() INLINE If( ::lRepaint, Super:BeginPaint(), 0 )

METHOD cToChar() INLINE Super:cToChar( "STATIC" )

METHOD Default()

METHOD Display() INLINE ::BeginPaint(), ::Paint(), ::EndPaint()

METHOD EndPaint() INLINE If( ::lRePaint, Super:EndPaint(), ( ::lRePaint := .T., 0) )

METHOD HandleEvent( nMsg, nWParam, nLParam )

METHOD Initiate( hDlg ) INLINE Super:Initiate( hDlg ), ::Default()

METHOD Paint()

METHOD Refresh( lRepaint ) INLINE ::Hide(), ::Show(), Super:Refresh( lRepaint )

ENDCLASS

• ============================================================================
• METHOD TSLines:New() Version 6.0 Mar/1/2008
• ============================================================================

METHOD New( nTop, nLeft, nWidth, nHeight, cType, oWnd, nClrLite, nClrDark, nClrText, lPixel, lUpdate, lRounded, ;
cLabel, oFont, nSAlign, lDesign ) CLASS TSLines

Local aRect, lBox, ;
aTypes := { "HORZ LINE", "HLINE", "VERT LINE", "VLINE", "WHITE BOX", "WBOX", "GRAY BOX", "GBOX", ;
"BLACK BOX", "BBOX" }, ;
acTypes := { "HLINE", "HLINE", "VLINE", "VLINE", "WBOX", "WBOX", "GBOX", "GBOX", "BBOX", "BBOX" }

Default oWnd := GetWndDefault(), ;
nClrLite := GetSysColor( COLOR_BTNHIGHLIGHT ), ;
nClrDark := GetSysColor( COLOR_BTNSHADOW ), ;
nClrText := GetSysColor( COLOR_BTNTEXT ), ;
lPixel := .T., ;
lUpdate := .T., ;
cLabel := "", ;
nSAlign := 0, ;
lDesign := .F., ;
lRounded := .F.

aRect := GetClientRect( oWnd:hWnd )

cType := acTypes[ Max( 1, AScan( aTypes, cType ) ) ]
lBox := "BOX" $ cType

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

If cType == "HLINE"
nHeight := If( ! lDesign, 2, 11 )
EndIf

If cType == "VLINE" .and. Empty( nHeight )
nHeight := nWidth
nWidth := If( ! lDesign, 2, 11 )
ElseIf cType == "VLINE"
nWidth := If( ! lDesign, 2, 11 )
EndIf

Default nWidth := If( cType == "HLINE", aRect[ 4 ] - ::nLeft, If( cType == "VLINE", 2, 100 ) ), ;
nHeight := If( cType == "VLINE", aRect[ 3 ] - ::nTop, If( cType == "HLINE", 2, 100 ) )

::aRect := { nTop, nLeft, nTop + nHeight, nLeft + nWidth }

::nBottom = nTop + nHeight - 1
::nRight = nLeft + nWidth - 1
::oWnd = oWnd
::cType = cType
::cLabel = cLabel
::oFont = oFont
::nSAlign = nSAlign
::nStyle = nOR( WS_CHILD, WS_VISIBLE, If( lDesign, WS_TABSTOP, 0 ) )
::nId = ::GetNewId()
::lUpdate = lUpdate
::lRounded = lRounded
::lDrag = lDesign
::nClrLite = nClrLite
::nClrDark = nClrDark
::nTextClr = nClrText
::lActive = .T.
::lRepaint = .F.

#ifdef XPP
Default ::lRegistered := .F.
::lProcessing = .F.
#EndIf

::Register( nOR( CS_VREDRAW, CS_HREDRAW ) )

If ::oFont != Nil
::SetFont( ::oFont )
EndIf

If ! Empty( oWnd:hWnd )
::Create( "STATIC" )
SetWindowLong( ::hWnd, GWL_EXSTYLE, nOr( GetWindowLong( ::hWnd, GWL_EXSTYLE ), WS_EX_TRANSPARENT ) )
oWnd:AddControl( Self )
::Default()
Else
oWnd:DefControl( Self )
EndIf

If lDesign
::CheckDots()
EndIf

Return Self

• ============================================================================
• METHOD TSLines:Redefine() Version 6.0 Mar/1/2008
• ============================================================================

METHOD ReDefine( cType, nId, oWnd, nClrLite, nClrDark, nClrText, lUpdate, lRounded, cLabel, oFont, ;
nSAlign ) CLASS TSLines

Local aTypes := { "HORZ LINE", "HLINE", "VERT LINE", "VLINE", "WHITE BOX", "WBOX", "GRAY BOX", "GBOX", ;
"BLACK BOX", "BBOX" }, ;
acTypes := { "HLINE", "HLINE", "VLINE", "VLINE", "WBOX", "WBOX", "GBOX", "GBOX", "BBOX", "BBOX" }, lBox

Default nId := ::GetNewId(),;
nClrLite := GetSysColor( COLOR_BTNHIGHLIGHT ), ;
nClrDark := GetSysColor( COLOR_BTNSHADOW ), ;
nClrText := GetSysColor( COLOR_BTNSHADOW ), ;
lUpdate := .F., ;
cLabel := "", ;
nSAlign := 0, ;
lRounded := .F.

cType := acTypes[ Max( 1, AScan( aTypes, cType ) ) ]
lBox := "BOX" $ cType

::cType = cType
::cLabel = cLabel
::oFont = oFont
::nSAlign = nSAlign
::nId = nId
::hWnd = 0
::oWnd = oWnd
::nClrLite = nClrLite
::nClrDark = nClrDark
::nTextClr = nClrText
::lUpdate = lUpdate
::lRounded = lRounded
::lActive = .T.
::lRepaint = .F.

::Register( nOR( CS_VREDRAW, CS_HREDRAW ) )

If ::oFont != Nil
::SetFont( ::oFont )
EndIf

oWnd:DefControl( Self )

Return Self

• ============================================================================
• METHOD TSLines:Default Version 6.0 Mar/1/2008
• ============================================================================

METHOD Default() CLASS TSLines

Local lBox := "BOX" $ ::cType

#ifndef XPP
::SetBrush( TBrush():New( "NULL" ) )
#else
::SetBrush( TBrush():New():_New( "NULL" ) )
#endif

If Upper( ::oWnd:ClassName() ) == "TDIALOG"
SetWindowLong( ::hWnd, GWL_STYLE, nOR( WS_CHILD, WS_VISIBLE ) )
SetWindowLong( ::hWnd, GWL_EXSTYLE, nOr( GetWindowLong( ::hWnd, GWL_EXSTYLE ), WS_EX_TRANSPARENT ) )
EndIf

Return Nil

• ============================================================================
• METHOD TSLines:HandleEvent() Version 6.0 Mar/1/2008
• ============================================================================

METHOD HandleEvent( nMsg, nWParam, nLParam ) CLASS TSLines

If nMsg == WM_LBUTTONDOWN .and. ::lDrag
Return ::LButtonDown( nHiWord( nLParam ), nLoWord( nLParam ), nWParam )
EndIf

If ( ::lDrag .and. nMsg == WM_NCHITTEST )
Return DefWindowProc( ::hWnd, nMsg, nWParam, nLParam )
EndIf

Return Super:HandleEvent( nMsg, nWParam, nLParam )

• ============================================================================
• METHOD TSLines:Paint() Version 6.0 Mar/1/2008
• ============================================================================

METHOD Paint() CLASS TSLines

Local aBoxType := { "WBOX", "GBOX", "BBOX", "HLINE", "VLINE" }
Local nBoxType := AScan( aBoxType, ::cType ) + If( ::lRounded .or. "LINE" $ ::cType, 3, 0 ), ;
hFont := If( Empty( ::cLabel ), Nil, If( ::oFont == Nil, 0, ::oFont:hFont ) )

If ! ::lRepaint .or. nBoxType == 0

  If Upper( ::oWnd:ClassName() ) != "TDIALOG" .and. nBoxType > 0
     ::Default()
  EndIf

  Return 0

EndIf

DrawBoxes( ::GetDC(), ::hWnd, nBoxtype, ::cLabel, hFont, ::nSAlign, ::nClrLite, ::nClrDark, ::nTextClr )
::ReleaseDC()

Return 0