#Include "FiveWin.ch"
MemVar nClrM // Color principal usado en toda la aplicación
// por definición GetSysColor(2)
CLASS TPickDate FROM TControl
DATA dStart, dEnd, dTemp, lMove
DATA nYear
DATA oBrushSunday, oBrushSelected, oFontHeader
DATA nLeftStart, nTopStart
DATA bSelect
DATA aFIng, aFBaj, aDVac, aDFal, aDInc, aDFes, aDSan, aDNLb // días especiales
CLASSDATA lRegistered AS LOGICAL
METHOD New( nTop, nLeft, nWidth, nHeight, oWnd, nYear, nClrFore, nClrBack )
METHOD Redefine( nId, oWnd )
METHOD Paint()
METHOD Display() INLINE ::BeginPaint(), ::Paint(), ::EndPaint(), 0
METHOD Destroy()
METHOD LButtonDown( nRow, nCol, nKeyFlags )
METHOD LButtonUp( nRow, nCol, nKeyFlags )
METHOD PreviousYear() INLINE ::nYear--, ::Refresh()
METHOD NextYear() INLINE ::nYear++, ::Refresh()
METHOD EraseBkGnd( hDC ) INLINE 0
METHOD MouseMove( nRow, nCol, nKeyFlags )
ENDCLASS
//----------------------------------------------------------------------------//
METHOD New( nTop, nLeft, nWidth, nHeight, oWnd, nYear, nClrFore, nClrBack ) CLASS TPickDate
DEFAULT nWidth := 800,;
nHeight := 300,;
nLeft := 0,;
nTop := 0,;
nYear := Year( Date() ), ;
oWnd := GetWndDefault(),;
nClrm := GetSysColor( 2 )
::lMove = .F.
::nTopStart = 0 // for header
::nLeftStart = 75 // col header
::nTop = nTop
::nLeft = nLeft
::nBottom = nTop + nHeight - 1
::nRight = nLeft + nWidth - 1
::nYear = Year( Date() )
::oWnd = oWnd
::aFIng = {} // arreglos de días especiales
::aFBaj = {}
::aDVac = {}
::aDFal = {}
::aDInc = {}
::aDFes = {}
::aDSan = {}
::aDNLb = {}
::dStart := ::dEnd := ::dTemp := Date()
::nClrText = nClrFore
::nClrPane = nClrBack
::nStyle = nOr( WS_CHILD, WS_VISIBLE, WS_TABSTOP, WS_BORDER )
DEFINE BRUSH ::oBrushSunday COLOR LightColor(240,nClrM) // Sundays column green brush
DEFINE BRUSH ::oBrushSelected COLOR nRGB( 240, 232, 188 ) // Selected days orange brush
DEFINE FONT ::oFont NAME "MS Sans Serif" SIZE 0, -10 BOLD
DEFINE FONT ::oFontHeader NAME "MS Sans Serif" SIZE 0, -10
#ifdef __XPP__
DEFAULT ::lRegistered := .F.
#endif
::Register()
if ! Empty( oWnd:hWnd )
::Create()
oWnd:AddControl( Self )
else
oWnd:DefControl( Self )
endif
return self
//----------------------------------------------------------------------------//
METHOD Redefine( nId, oWnd ) CLASS TPickDate
DEFAULT oWnd := GetWndDefault(), ;
nClrm:= GetSysColor( 2 )
::nId = nId
::oWnd = oWnd
::lMove = .F.
::nTopStart = 0 // for header
::nLeftStart = 75 // col header
::dStart := ::dEnd := ::dTemp := Date()
::nYear = Year( Date() )
::aFIng = {} // arreglos de días especiales
::aFBaj = {}
::aDVac = {}
::aDFal = {}
::aDInc = {}
::aDFes = {}
::aDSan = {}
::aDNLb = {}
DEFINE BRUSH ::oBrushSunday COLOR LightColor(240,nClrM) // nRGB( 183, 249, 185 ) // Sundays column green brush
DEFINE BRUSH ::oBrushSelected COLOR nRGB( 240, 232, 188 ) // Selected days orange brush
DEFINE FONT ::oFont NAME "MS Sans Serif" SIZE 0, -10 BOLD
DEFINE FONT ::oFontHeader NAME "MS Sans Serif" SIZE 0, -10
::SetColor( 0, 0 )
::Register()
oWnd:DefControl( Self )
return Self
//----------------------------------------------------------------------------//
METHOD Paint() CLASS TPickDate
local aInfo := ::DispBegin()
local hDC := ::hDC, cDay, nDay, n, dDate, nColStep, nRowStep
local dTmpDate, nMonth := 0, nLeftCol := 0
local nColor, cDate // para evaluar días especiales
local lBrush, nBrush, oBrush
FillRect( hDC, GetClientRect( ::hWnd ), ::oBrush:hBrush )
nRowStep = ( (::nHeight-3) - ::nTopStart ) / 13
// Uso de Gradient() en vez de GradientFill()
Gradient( ::hDC, { 0, 0, ::nHeight, ::nWidth }, LightColor(250,nClrM), LightColor(200,nClrM), .T. )
dDate = CToD( "01/01/" + Str( ::nYear, 4 ) )
dDate += 8 - DoW( dDate )
nColStep = ( ::nWidth - ::nLeftStart - 3 ) / 37
Gradient( ::hDC, { 0, 0, nRowStep - 1, ::nWidth }, LightColor(225,nClrM), LightColor(175,nClrM), .T. )
::Say( ( ::nTopStart + ( nRowStep / 2 ) - ( ::oFont:nHeight / 2 )),;
( ( ::nLeftStart + nColStep ) / 2 ) - ( GetTextWidth( hDC, Str( ::nYear, 4 ), ::oFont:hFont ) / 2 ),;
Str( ::nYear, 4 ),,, ::oFont, .T., .T. )
// Paint Sunday background color
for n = 1 to 36 step 7
FillRect( hDC, { 0, ::nLeftStart + ( nColStep * n ),;
::nHeight - 1, ::nLeftStart + ( nColStep * ( n + 1 ) ) }, ::oBrushSunday:hBrush )
next
for nMonth = 1 to 12
::Line( ::nTopStart + nMonth * nRowStep, 0,(::nTopStart + nMonth * nRowStep), ::nWidth - 1 )
::Say( ::nTopStart + nMonth * nRowStep + ( nRowStep / 2 ) - ( ::oFont:nHeight / 2 ), 3, cMonth( RegionDate(nMonth, Str( Year( Date() ), 4 ))) ,,, ::oFont, .T., .T. )
next
// fill selected days
if ::lMove
dTmpDate = Min( ::dStart, ::dEnd )
while dTmpDate <= Max( ::dStart, ::dEnd )
nMonth = Month( dTmpDate )
nLeftCol = ::nLeftStart + ( nColStep * ( DOW( RegionDate( nMonth, Str( ::nYear, 4 ) ) ) ) ) + ;
nColStep * ( Day( dTmpDate ) - 1 )
FillRect( hDC, { ::nTopStart + month(dTmpDate) * nRowStep + 1,;
nLeftCol, ::nTopStart + Month( dTmpDate ) * nRowStep + nRowStep,;
nLeftCol + nColStep}, ::oBrushSelected:hBrush )
dTmpDate++
end
endif
// Draw days
for n = 1 to 36
::Line( 0, ::nLeftStart + ( nColStep * n ), ::nHeight - 1, ::nLeftStart + ( nColStep * n ) )
nColor := if( DoW( dDate ) ==1, CLR_RED, 0 )
cDay = SubStr( CDoW( dDate++ ), 1, 1 )
::Say( ( ::nTopStart + nRowStep * 0.4 )-2,;
::nLeftStart + ( nColStep * n ) + ( nColStep / 2 ) - ( GetTextWidth( hDC, cDay, ::oFont:hFont ) / 2 ) + 1,;
cDay, nColor, 0, ::oFont, .T., .T. )
next
// Draw months
for nMonth = 1 to 12
dDate = RegionDate(nMonth,Str( ::nYear, 4 ) )
nDay = DoW( dDate )
while Month( dDate ) == nMonth
cDay = AllTrim( Str( Day( dDate ) ) )
nColor := 0
lBrush :=.F.
cDate := DtoS( dDate)
do case // identifica el día y define el pintado
case DoW( dDate ) == 1; nColor := CLR_RED
case AScan( ::aFIng, cDate ) <> 0; nColor := CLR_WHITE ; lBrush := .T.; nBrush := 2
case AScan( ::aFBaj, cDate ) <> 0; nColor := CLR_WHITE ; lBrush := .T.; nBrush := 3
case AScan( ::aDFal, cDate ) <> 0; nColor := CLR_HRED ; lBrush := .T.; nBrush := 4
case AScan( ::aDInc, cDate ) <> 0; nColor := CLR_YELLOW ; lBrush := .T.; nBrush := 4
case AScan( ::aDVac, cDate ) <> 0; nColor := CLR_BLUE ; lBrush := .T.; nBrush := 5
case AScan( ::aDNLb, cDate ) <> 0; nColor := CLR_HRED ; lBrush := .T.; nBrush := 1
case AScan( ::aDFes, cDate ) <> 0; nColor := CLR_HGREEN ; lBrush := .T.; nBrush := 1
case AScan( ::aDSan, cDate ) <> 0; nColor := CLR_HGREEN ; lBrush := .T.; nBrush := 1
endcase
if lBrush
nMonth = Month( dDate )
nLeftCol = ::nLeftStart + ( nColStep * ( DOW( RegionDate( nMonth, Str( ::nYear, 4 ) ) ) ) ) + ;
nColStep * ( Day( dDate ) - 1 )
do case
case nBrush == 1 ; DEFINE BRUSH oBrush COLOR LightColor(240,nClrM)
case nBrush == 2 ; DEFINE BRUSH oBrush COLOR CLR_BLUE
case nBrush == 3 ; DEFINE BRUSH oBrush COLOR CLR_HRED
case nBrush == 4 ; DEFINE BRUSH oBrush COLOR CLR_RED
case nBrush == 5 ; DEFINE BRUSH oBrush COLOR CLR_HMAGENTA
endcase
FillRect( hDC, { ::nTopStart + month(dDate) * nRowStep + 1,;
nLeftCol + 1, ::nTopStart + Month( dDate ) * nRowStep + nRowStep,;
nLeftCol + nColStep}, oBrush:hBrush )
oBrush:End()
endif
::Say( ( ::nTopStart + nMonth * nRowStep + ( nRowStep * 0.4 ) )-2,;
::nLeftStart + ( nColStep * nDay++ ) + ( nColStep / 2 ) - ( GetTextWidth( hDC, cDay, ::oFont:hFont ) / 2 ) + 1,;
cDay, nColor, 0, ::oFontHeader, .T., .T. )
dDate++
end
next
if ValType( ::bPainted ) == "B"
Eval( ::bPainted, hDC, Min( ::dStart, ::dEnd ), Max( ::dStart, ::dEnd ), Self )
endif
::DispEnd( aInfo )
return 0
//----------------------------------------------------------------------------//
METHOD Destroy() CLASS TPickDate
::oBrushSunday:End()
::oBrushSelected:End()
::oFontHeader:End()
return Super:Destroy()
//----------------------------------------------------------------------------//
METHOD LButtonDown( nRow, nCol, nKeyFlags ) CLASS TPickDate
local nMonth := Int( ( nRow - ::nTopStart ) / ( ( ::nHeight - ::nTopStart ) / 13 ) )
local nDay := Int( ( nCol - ::nLeftStart ) / ( ( ::nWidth - ::nLeftStart ) / 37 ) ) - ;
DoW( RegionDate( nMonth, Str( ::nYear, 4 ) ) ) + 1
if nDay > 0 .and. nMonth > 0 // to work with valid dates only
::dStart := CToD( AllTrim( AllTrim( Str( nDay ) )+ "/" + Str( nMonth ) ) + "/" + Str( ::nYear, 4 ) )
::lMove := .T.
::Refresh( .F. )
endif
return Super:LButtonDown( nRow, nCol, nKeyFlags )
//-----------------------------------------------------------------//
METHOD LButtonUp( nRow, nCol, nKeyFlags ) CLASS TPickDate
if ValType( ::bSelect ) == "B"
Eval( ::bSelect, Min( ::dStart, ::dEnd ), Max( ::dStart, ::dEnd ), Self )
endif
::lMove := .F.
return Super:LButtonUp( nRow, nCol, nKeyFlags )
//-----------------------------------------------------------------//
METHOD MouseMove( nRow, nCol, nKeyFlags ) CLASS TPickDate
local nMonth := Int( ( nRow - ::nTopStart ) / ( ( ::nHeight - ::nTopStart ) / 13 ) )
local nDay := Int( ( nCol - ::nLeftStart ) / ( ( ::nWidth - ::nLeftStart ) / 37 ) ) - ;
DoW( RegionDate( nMonth, Str( ::nYear, 4 ) ) ) + 1
local dEnd
if nDay > 0 .and. nMonth > 0 // to work with valid dates only
dEnd = CToD( AllTrim( Str( nDay ) ) + "/" + AllTrim( Str( nMonth ) ) + "/" + Str( ::nYear, 4 ) )
if ! Empty( dEnd ) .and. dEnd != ::dTemp // for reducing continuous refreshes
::dTemp := dEnd
::dEnd = dEnd
::Refresh( .F. )
if ValType( ::bChange ) == "B"
Eval( ::bChange, Min( ::dStart, ::dEnd ), Max( ::dStart, ::dEnd ), Self )
endif
endif
endif
return Super:MouseMove( nRow, nCol, nKeyFlags )
//-----------------------------------------------------------------//
function RegionDate( nMonth, cYear )
return CToD( "01/" + AllTrim( Str( nMonth ) ) + "/" + cYear )
//-----------------------------------------------------------------//
// LightColor(nDegrade,nColor) para degradar o seleccionar color
#pragma BEGINDUMP
#include <Windows.h>
HARBOUR HB_FUN_LIGHTCOLOR( )
{
COLORREF lColor = hb_parnl(2);
LONG lScale = hb_parni(1);
long R = MulDiv(255-GetRValue(lColor),lScale,255)+GetRValue(lColor);
long G = MulDiv(255-GetGValue(lColor),lScale,255)+GetGValue(lColor);
long B = MulDiv(255-GetBValue(lColor),lScale,255)+GetBValue(lColor);
hb_retnl( RGB(R, G, B) );
}
#pragma ENDDUMP
Alfredo Arteaga wrote:Alguna vez se publicó el código para determinar las fechas que corresponden a la Semana Santa, me pregunto si alguien lo conserva y puede compartirlo?
//----------------------------------------------------------------------------------------------------//
Function dHollyFriday( nYear )
Local a, b, c, Aa, Bb
a := nYear % 19
b := nYear % 4
c := nYear % 7
Aa := ( ( 19 * a ) + 24 ) % 30
Bb := ( ( 2 * b ) + ( 4 * c ) + ( 6 * Aa ) + 5 ) % 7
Return StoD( LTrim( Str( nYear ) ) + "03" + StrZero( Aa, 2 ) ) + Bb + 22 - 2
Les tengo una mala noticia, mi rutina en FiveWin solo funcionará hasta el año 2099, por lo que les agradeceré recordarme con unos meses de anticipación para corregirla.Patricio Avalos Aguirre wrote:para quien quiera mas información
Les tengo una mala noticia, mi rutina en FiveWin solo funcionará hasta el año 2099, por lo que les agradeceré recordarme con unos meses de anticipación para corregirla.
Ricardo Ramirez E. wrote:Ya tomé nota de ello... te lo recordaré con antecedencia....
Function dHollyFriday( nYear )
Local a, b, c, Aa, Bb, n
n := If( nYear > 2099, 6, If( nYear > 2199, 0, 5 ) )
a := nYear % 19
b := nYear % 4
c := nYear % 7
Aa := ( ( 19 * a ) + 24 ) % 30
Bb := ( ( 2 * b ) + ( 4 * c ) + ( 6 * Aa ) + n ) % 7
Return StoD( LTrim( Str( nYear ) ) + "03" + StrZero( Aa, 2 ) ) + Bb + 22 - 2
Function dHollyFriday( nYear )
Local a, b, c, Aa, Bb, n
n := If( nYear > 2099, 6, If( nYear > 2199, 0, 5 ) )
a := nYear % 19
b := nYear % 4
c := nYear % 7
Aa := ( ( 19 * a ) + 24 ) % 30
Bb := ( ( 2 * b ) + ( 4 * c ) + ( 6 * Aa ) + n ) % 7
Return StoD( LTrim( Str( nYear ) ) + "03" + StrZero( Aa, 2 ) ) + Bb + 22 - 2
Tienes razón Carlos, ahora ya no me preocuparé hasta el 2199, la rutina quedó así:FiveWiDi wrote:Mejor así:
Function dHollyFriday( nYear )
Local a, b, c, Aa, Bb, m, n
m := If( nYear > 2199, 25, 24 )
n := If( nYear > 2099, 6, If( nYear > 2199, 0, 5 ) )
a := nYear % 19
b := nYear % 4
c := nYear % 7
Aa := ( ( 19 * a ) + m ) % 30
Bb := ( ( 2 * b ) + ( 4 * c ) + ( 6 * Aa ) + n ) % 7
Return StoD( LTrim( Str( nYear ) ) + "03" + StrZero( Aa, 2 ) ) + Bb + 20
Return to FiveWin para Harbour/xHarbour
Users browsing this forum: Google [Bot] and 48 guests