by QAZWSX2K » Tue May 25, 2010 7:16 pm
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
Software especializado para oficinas contables con grandes volumenes de Informacion
Impresion de todos los formularios del Seniat, Dian
alex_patino74@hotmail.comwhatsapp 57+3214777217