Page 1 of 1

Pregunta esta clase dibuja la regla a cm

Posted: Fri Aug 21, 2009 5:40 am
by Vladimir Zorrilla
Amigos un favor me puedean ayudar a poner esta regla centimetros .Mil gracias

#include "FiveWin.ch"
#include "Constant.ch"

#define COLOR_BTNFACE 15

#ifdef __XPP__
#define Super ::TControl
#define New _New
#endif

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

CLASS TRegla FROM TControl

CLASSDATA lRegistered AS LOGICAL

DATA nClrPane, nClrText
DATA nZoom // Zoom
DATA Pix2mm // Relacion de 1 pixel en pantalla (imagen) a mm
DATA nMin,nMax,lHorizontal
DATA nPosMarca
DATA nGap // Porcion de la regla sin marcar
DATA oFont,oPen
DATA lInches // .T. Pulgadas .F. centimetros
DATA nMinDib // Minimo cm en el dibujo (puede ser negativo)
DATA nMaxDib // Maximo numero a dibujar
DATA stepcm // Espaciado en cm
DATA stepmm // Espaciado en mm

METHOD New( oWnd,nRow, nCol, nWidth, nHeight,lPixel,nMin,nMax,lHorizontal,oFont,;
oPen,lInches,nClrText,nClrBack) CONSTRUCTOR
METHOD ReDefine( nId,oWnd,nMin,nMax,lHorizontal,;
oFont,oPen,lInches,nClrText,nClrBack, lUpdate ) CONSTRUCTOR
METHOD End() INLINE ::Destroy()

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

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

METHOD Paint()

METHOD SetPix2mm(Pix2mm) INLINE ::Pix2mm:=IIF(::lInches,Pix2mm/2.54,Pix2mm)
METHOD Destroy()

METHOD ScrollDown(nPixels)
METHOD ScrollUp(nPixels)

ENDCLASS

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

METHOD New( oWnd,nRow, nCol, nWidth, nHeight,lPixel,nMin,nMax,lHorizontal,;
oFont,oPen,lInches,nClrText,nClrBack,stepcm,stepmm) CLASS TRegla

DEFAULT nRow := 0, nCol := 0, oWnd := GetWndDefault(),;
nMin := 0, nMax :=100, lHorizontal:=.T.,lInches:=.F.

DEFAULT nWidth := 100,;
nHeight := 28,nClrText:=CLR_BLACK,nClrBack:=GetSysColor( COLOR_BTNFACE ),;
stepcm :=1,stepmm:=1

::nTop = If( lPixel, nRow, nRow * WIN_CHARPIX_H ) //16
::nLeft = If( lPixel, nCol, nCol * WIN_CHARPIX_W ) //8
::nBottom = ::nTop + nHeight
::nRight = ::nLeft + nWidth
::oWnd = oWnd
::nStyle = nOR( WS_BORDER, WS_CHILD, WS_VISIBLE )
::nId = ::GetNewId()
::lDrag = .f.
::lCaptured = .f.
::nClrPane = nClrBack

::nZoom =1.0
::Pix2mm =1.0
::nMin =nMin
::nMax =nMax
::lHorizontal =lHorizontal
::nGap = 0
::lInches = lInches
::nMaxDib =::nMax-::nMin
::nMinDib =0
::stepcm = stepcm
::stepmm = stepmm

IF oFont==NIl
DEFINE FONT ::oFont NAME "MS Sans Serif" SIZE 0, -8
ELSE
::oFont:=oFont
ENDIF

IF oPen==NIl
DEFINE PEN ::oPen WIDTH 1 COLOR nClrText
ELSE
::oPen:=oPen
ENDIF


#ifdef __XPP__
DEFAULT ::lRegistered := .f.
#endif

::SetColor( ::nClrText, ::nClrPane )

::Register( nOR( CS_VREDRAW, CS_HREDRAW ) )

if ! Empty( oWnd:hWnd )
::Create()
oWnd:AddControl( Self )
else
oWnd:DefControl( Self )
endif

return Self

//----------------------------------------------------------------------------//
METHOD ReDefine( nId,oWnd,nMin,nMax,lHorizontal,;
oFont,oPen,lInches,nClrText,nClrBack, lUpdate,stepcm,stepmm ) CLASS TRegla

DEFAULT nMin := 0, nMax :=100, lHorizontal:=.T.,lInches:=.F.
DEFAULT nClrText:=CLR_BLACK,nClrBack:=GetSysColor( COLOR_BTNFACE )

DEFAULT lUpdate := .f.

::nId = nId
::oWnd = oWnd
::lUpdate = lUpdate
::lDrag = .f.
::lCaptured = .f.
::nClrPane = nClrBack

::nZoom =1.0
::Pix2mm =1.0
::nMin =nMin
::nMax =nMax
::lHorizontal =lHorizontal
::nGap = 0
::lInches = lInches
::nMaxDib =::nMax-::nMin
::nMinDib =0
::stepcm = stepcm
::stepmm = stepmm


IF oFont==NIl
DEFINE FONT ::oFont NAME "MS Sans Serif" SIZE 0, -8
ELSE
::oFont:=oFont
ENDIF

IF oPen==NIl
DEFINE PEN ::oPen WIDTH 1 COLOR nClrText
ELSE
::oPen:=oPen
ENDIF


::Register( nOR( CS_VREDRAW, CS_HREDRAW ) )

if oWnd != nil
oWnd:DefControl( Self )
endif

return Self

//----------------------------------------------------------------------------//
METHOD Destroy() CLASS TRegla

::oFont:End()
::oPen:End()

Super:End()

RETURN (Nil)
//----------------------------------------------------------------------------//
METHOD Paint() CLASS TRegla

local hOldPen, n := 1,pos,j,posmm
local hLightPen,hOldFont
local texto,finmm

WNDRAISED(::hWnd,::hDC)

hOldPen = SelectObject( ::hDC, ::oPen:hPen )
hOldFont= SelectObject( ::hDC, ::oFont:hFont )
SetTextColor(::hDC, ::oPen:nColor)
SetBkColor( ::hDC, ::nClrPane )
::nPosMarca = IIF(::lHorizontal,::nHeight,::nWidth)
finmm:=(10*::stepcm)-1.0
IF ::lHorizontal
FOR n=::nMinDib to ::nMaxDib step ::stepcm
pos:=::nGap*::nZoom+(10*((n*::nZoom))/::Pix2mm)
MoveTo( ::hDC, pos, ::nPosMarca-3 )
LineTo( ::hDC, pos, ::nPosMarca-10 )
texto:= str(::nMin+n,3,0)
TextOut(::hDC,3,pos-::GetWidth(texto,::oFont)/2,texto)
FOR j=::stepmm to finmm step ::stepmm
posmm:=pos+(((j*::nZoom))/::Pix2mm)
MoveTo( ::hDC, posmm, ::nPosMarca-3 )
LineTo( ::hDC, posmm, ::nPosMarca-6 )
NEXT j
NEXT n
ELSE
FOR n=::nMinDib to ::nMaxDib step ::stepcm
pos:=::nGap*::nZoom+(10*((n*::nZoom))/::Pix2mm)
MoveTo( ::hDC, ::nPosMarca-3,pos )
LineTo( ::hDC, ::nPosMarca-10,pos )
texto:= str(::nMin+n,3,0)
TextOut(::hDC,pos-::GetWidth(texto,::oFont)/2,3,texto)
FOR j=::stepmm to finmm step ::stepmm
posmm:=pos+(((j*::nZoom))/::Pix2mm)
MoveTo( ::hDC, ::nPosMarca-3,posmm )
LineTo( ::hDC, ::nPosMarca-6,posmm )
NEXT j
NEXT n
ENDIF
SelectObject( ::hDC, hOldPen )
SelectObject( ::hDC, hOldFont )

return NIL

//----------------------------------------------------------------------------//
METHOD ScrollUp(nPixels) CLASS TRegla

::nGap-=nPixels
::Refresh()

RETURN NIL
//----------------------------------------------------------------------------//
METHOD ScrollDown(nPixels) CLASS TRegla

::nGap+=nPixels
::Refresh()

RETURN NIL
//----------------------------------------------------------------------------//