#include "FiveWin.ch"
//----------------------------------------------------------------------------//
function Main()
local oWnd, oPickDate
DEFINE WINDOW oWnd TITLE "Calendar"
oPickDate := TPickDate():New( 10, 10,,, oWnd )
ACTIVATE WINDOW oWnd
return nil
//----------------------------------------------------------------------------//
CLASS TPickDate FROM TControl
DATA nStartRow, nStartCols
DATA oPlanFont, sy, sx
DATA ClickRow, syTemp, sxTemp, ClickCol
DATA StartDay, EndDay, oBrush
DATA hBru, hPen1, hPen3
DATA lMove AS LOGIC INIT .F.
DATA aPlan AS ARRAY INIT {}
DATA aTemp AS ARRAY INIT {}
DATA nStartZeile INIT 0
DATA nVersion
DATA nYear
DATA lBorder
DATA hPen
CLASSDATA lRegistered AS LOGICAL
METHOD New( nTop, nLeft, nWidth, nHeight, oWnd, nYear, lBorder, oPlanFont, nClrFore, nClrBack, nVersion )
METHOD Initiate( hDlg ) INLINE Super:Initiate( hDlg ), ::Default()
METHOD Paint()
METHOD Display() INLINE ::BeginPaint(), ::Paint(), ::EndPaint(), 0
METHOD SelectPen( hPen ) INLINE SelectObject( ::hDC, hPen )
METHOD End() INLINE ::Destroy()
METHOD Destroy()
METHOD LButtonUp( nRow, nCol, nKeyFlags )
METHOD Ldblclick( nRow, nCol, nKeyFlags )
// METHOD MouseMove( nRow, nCol, nKeyFlags )
METHOD PreviousYear()
METHOD NextYear()
METHOD EraseBkGnd( hDC ) INLINE 0
ENDCLASS
//----------------------------------------------------------------------------//
METHOD New( nTop, nLeft, nWidth, nHeight, oWnd, nYear, lBorder, oPlanFont, nClrFore,;
nClrBack, nVersion ) CLASS TPickDate
DEFAULT nWidth := 800,;
nHeight := 300,;
nLeft := 0,;
nTop := 0,;
nYear := Year( Date() ),;
nVersion := "1.0.0",;
oWnd := GetWndDefault(),;
lBorder := .T.
::nTop = nTop
::nLeft = nLeft
::nBottom = nTop + nHeight - 1
::nRight = nLeft + nWidth - 1
::nStartCols := nLeft
::nStartRow := nTop
::nYear := nYear
::lBorder := lBorder
::nStyle = nOr( WS_CHILD, WS_VISIBLE, WS_TABSTOP, WS_BORDER )
::oWnd := oWnd
if ::oPlanFont == nil
DEFINE FONT ::oPlanFont NAME "ARIAL" SIZE 0,-11
else
::oPlanFont := oPlanFont
endif
::nClrText = nClrFore
::nClrPane = nClrBack
::sy := 1
::sx := 1
::syTemp := 0
::sxTemp := 0
::aPlan := {}
::ClickCol := 0
::ClickRow := 0
::startDay := ""
::endDay := ""
::lMove := .f.
::aTemp := {}
::nStartZeile := 0
AAdd( ::aTemp, { 0, 0 } ) // 1
AAdd( ::aTemp, { 0, 0 } ) // 2
AAdd( ::aTemp, { 0, 0 } ) // 3
AAdd( ::aTemp, { 0, 0 } ) // 4
AAdd( ::aTemp, { 0, 0 } ) // 5
AAdd( ::aTemp, { 0, 0 } ) // 6
AAdd( ::aTemp, { 0, 0 } ) // 7
AAdd( ::aTemp, { 0, 0 } ) // 8
AAdd( ::aTemp, { 0, 0 } ) // 9
AAdd( ::aTemp, { 0, 0 } ) // 10
AAdd( ::aTemp, { 0, 0 } ) // 11
AAdd( ::aTemp, { 0, 0 } ) // 12
#ifdef __XPP__
DEFAULT ::lRegistered := .f.
#endif
::Register( nOR( CS_VREDRAW, CS_HREDRAW ) )
if ! Empty( oWnd:hWnd )
::Create()
oWnd:AddControl( Self )
else
oWnd:DefControl( Self )
endif
return self
//----------------------------------------------------------------------------//
METHOD Paint() CLASS TPickDate
local aInfo := ::DispBegin(), hPen, hOld, oFont, nStep, n
FillRect( ::hDC, GetClientRect( ::hWnd ), ::oBrush:hBrush )
hPen = CreatePen( PS_SOLID, 1, CLR_BLACK )
hOld = SelectObject( ::hDC, hPen )
DEFINE FONT oFont NAME "Tahoma" SIZE 0, -12
nStep = ::nHeight / 13
for n = 1 to 12
::Line( n * nStep, 0, n * nStep, ::nWidth - 1 )
::Say( n * nStep + 4, 3, cMonth( CToD( Str( n, 2 ) + "/01/" + Str( Year( Date() ), 4 ) ) ),,, oFont, .T. )
next
nStep = ( ::nWidth - 60 ) / 36
for n = 1 to 35
::Line( 0, 60 + ( nStep * n ), ::nHeight - 1, 60 + ( nStep * n ) )
::Say( 4, 60 + ( nStep * n ), SubStr( CDoW( CToD( Str( n, 2 ) + "/01/" + Str( Year( Date() ), 4 ) ) ), 1, 2 ),,, oFont, .T. )
next
SelectObject( ::hDC, hOld )
DeleteObject( hPen )
::DispEnd( aInfo )
return 0
//----------------------------------------------------------------------------//
METHOD LButtonUp( nRow, nCol, nKeyFlags ) CLASS TPickDate
::endDay := ::aPlan[::sx,::sy]
IF ::sy > 0 .AND. ::sx > 0
if msgYesNo(::startDay + " -- " + ::endDay + " Tage: " +;
str( ctod(::endDay)-ctod(::startDay) +1 ))=.t.
endif
ENDIF
::lMove:=.f.
return nil
//----------------------------------------------------------------------------//
METHOD Ldblclick( nRow, nCol, nKeyFlags ) CLASS TPickDate
local ITemp := 0
::sx := INT((nRow - ::nStartRow)/::nHeight ) + 1
::sy := INT((nCol - ::nStartCols)/::nWidth )
IF ::sy > 0 .AND. ::sx > 0
::startDay := ::aPlan[::sx,::sy]
::nStartZeile := ::sx
::ClickRow := (INT((nRow-::nStartRow)/::nHeight ))*::nHeight + ::nStartRow
::ClickCol := ::nStartCols + ::sy * ::nWidth
FOR ITemp := 1 TO 12
::aTemp[ITemp,1]:=0
NEXT
sysrefresh()
::lMove:=.t.
ENDIF
Super:LDblClick( nRow, nCol, nKeyFlags )
return nil
//----------------------------------------------------------------------------//
/*
METHOD MouseMove( nRow, nCol, nKeyFlags ) CLASS TPickDate
Super:MouseMove( nRow, nCol, nKeyFlags )
if IsOverWnd( ::hWnd, nRow, nCol )
if !::lCaptured
::Capture()
endif
else
if !::lCaptured
ReleaseCapture()
endif
ENDIF
if ::lMove
IF ::sx <> (INT((nRow-::nStartRow)/::nHeight ) + 1) .OR.;
::sx <> (INT((nCol-::nStartCols )/::nHeight ) + 1 )
::sx := INT((nRow-::nStartRow)/::nHeight ) + 1
::sy := INT((nCol -::nStartCols )/::nWidth )
IF nRow < ::nStartRow
::sx := 0
nRow := 0
ENDIF
::sxTemp := ::nStartRow + ::sx * ::nHeight
::syTemp := ::nStartCols + ::sy * ::nWidth + ::nWidth
ENDIF
endif
return nil
*/
//-----------------------------------------------------------------//
METHOD Destroy() CLASS TPickDate
RELEASE FONT ::oplanFont
::hBru:end()
::hPen:end()
::hPen1:end()
::hPen3:end()
return nil
//-----------------------------------------------------------------//
method PreviousYear() CLASS TPickDate
::nYear := ::nYear - 1
::Paint()
*::oWnd:refresh()
::oWnd:cTitle := "Kalender [ " + str(::nYear,4) + " ]"
return .T.
//-----------------------------------------------------------------//
method NextYear() CLASS TPickDate
::nYear := ::nYear + 1
::Paint()
*::oWnd:refresh()
::oWnd:cTitle := "Kalender [ " + str(::nYear,4) + " ]"
return .T.
//-----------------------------------------------------------------//
#include "FiveWin.ch"
//----------------------------------------------------------------------------//
function Main()
local oWnd, oPickDate
DEFINE WINDOW oWnd TITLE "Calendar"
oPickDate := TPickDate():New( 10, 10,,, oWnd )
oWnd:oClient = oPickDate // here!
ACTIVATE WINDOW oWnd
return nil
METHOD Paint() CLASS TPickDate
local aInfo := ::DispBegin(), hPen, hOld, oFont, nRowStep, nColStep, n
FillRect( ::hDC, GetClientRect( ::hWnd ), ::oBrush:hBrush )
hPen = CreatePen( PS_SOLID, 1, CLR_BLACK )
hOld = SelectObject( ::hDC, hPen )
DEFINE FONT oFont NAME "Tahoma" SIZE 0, -12
nRowStep = ::nHeight / 13
for n = 1 to 12
::Line( n * nRowStep, 0, n * nRowStep, ::nWidth - 1 )
::Say( n * nRowStep + ( nRowStep * 0.3 ), 3, cMonth( CToD( Str( n, 2 ) + "/01/" + Str( Year( Date() ), 4 ) ) ),,, oFont, .T. )
next
nColStep = ( ::nWidth - 60 ) / 36
for n = 1 to 35
::Line( 0, 60 + ( nColStep * n ), ::nHeight - 1, 60 + ( nColStep * n ) )
::Say( nRowStep * 0.5, 60 - 3 + ( nColStep * n ) + ( nColStep * 0.3 ),;
SubStr( CDoW( CToD( "01/" + Str( n, 2 ) + "/" + Str( Year( Date() ), 4 ) ) ), 1, 2 ),,, oFont, .T. )
next
SelectObject( ::hDC, hOld )
DeleteObject( hPen )
::DispEnd( aInfo )
return 0
Why a new class?Otto wrote:It was Silvios idea to make a “User defined new control”
#include "FiveWin.ch"
//----------------------------------------------------------------------------//
function Main()
local oWnd, oPickDate
DEFINE WINDOW oWnd TITLE "Calendar"
oPickDate := TPickDate():New( 10, 10,,, oWnd )
oWnd:oClient = oPickDate
ACTIVATE WINDOW oWnd MAXIMIZED
return nil
//----------------------------------------------------------------------------//
CLASS TPickDate FROM TControl
DATA nStartRow, nStartCols
DATA oPlanFont, sy, sx
DATA ClickRow, syTemp, sxTemp, ClickCol
DATA StartDay, EndDay, oBrush
DATA hBru, hPen1, hPen3
DATA lMove AS LOGIC INIT .F.
DATA aPlan AS ARRAY INIT {}
DATA aTemp AS ARRAY INIT {}
DATA nStartZeile INIT 0
DATA nVersion
DATA nYear
DATA lBorder
DATA hPen
CLASSDATA lRegistered AS LOGICAL
METHOD New( nTop, nLeft, nWidth, nHeight, oWnd, nYear, lBorder, oPlanFont, nClrFore, nClrBack, nVersion )
METHOD Initiate( hDlg ) INLINE Super:Initiate( hDlg ), ::Default()
METHOD Paint()
METHOD Display() INLINE ::BeginPaint(), ::Paint(), ::EndPaint(), 0
METHOD SelectPen( hPen ) INLINE SelectObject( ::hDC, hPen )
METHOD End() INLINE ::Destroy()
METHOD Destroy()
METHOD LButtonUp( nRow, nCol, nKeyFlags )
METHOD Ldblclick( nRow, nCol, nKeyFlags )
// METHOD MouseMove( nRow, nCol, nKeyFlags )
METHOD PreviousYear()
METHOD NextYear()
METHOD EraseBkGnd( hDC ) INLINE 0
ENDCLASS
//----------------------------------------------------------------------------//
METHOD New( nTop, nLeft, nWidth, nHeight, oWnd, nYear, lBorder, oPlanFont, nClrFore,;
nClrBack, nVersion ) CLASS TPickDate
DEFAULT nWidth := 800,;
nHeight := 300,;
nLeft := 0,;
nTop := 0,;
nYear := Year( Date() ),;
nVersion := "1.0.0",;
oWnd := GetWndDefault(),;
lBorder := .T.
::nTop = nTop
::nLeft = nLeft
::nBottom = nTop + nHeight - 1
::nRight = nLeft + nWidth - 1
::nStartCols := nLeft
::nStartRow := nTop
::nYear := nYear
::lBorder := lBorder
::nStyle = nOr( WS_CHILD, WS_VISIBLE, WS_TABSTOP, WS_BORDER )
::oWnd := oWnd
if ::oPlanFont == nil
DEFINE FONT ::oPlanFont NAME "ARIAL" SIZE 0,-11
else
::oPlanFont := oPlanFont
endif
::nClrText = nClrFore
::nClrPane = nClrBack
::sy := 1
::sx := 1
::syTemp := 0
::sxTemp := 0
::aPlan := {}
::ClickCol := 0
::ClickRow := 0
::startDay := ""
::endDay := ""
::lMove := .f.
::aTemp := {}
::nStartZeile := 0
AAdd( ::aTemp, { 0, 0 } ) // 1
AAdd( ::aTemp, { 0, 0 } ) // 2
AAdd( ::aTemp, { 0, 0 } ) // 3
AAdd( ::aTemp, { 0, 0 } ) // 4
AAdd( ::aTemp, { 0, 0 } ) // 5
AAdd( ::aTemp, { 0, 0 } ) // 6
AAdd( ::aTemp, { 0, 0 } ) // 7
AAdd( ::aTemp, { 0, 0 } ) // 8
AAdd( ::aTemp, { 0, 0 } ) // 9
AAdd( ::aTemp, { 0, 0 } ) // 10
AAdd( ::aTemp, { 0, 0 } ) // 11
AAdd( ::aTemp, { 0, 0 } ) // 12
#ifdef __XPP__
DEFAULT ::lRegistered := .f.
#endif
::Register( nOR( CS_VREDRAW, CS_HREDRAW ) )
if ! Empty( oWnd:hWnd )
::Create()
oWnd:AddControl( Self )
else
oWnd:DefControl( Self )
endif
return self
//----------------------------------------------------------------------------//
METHOD Paint() CLASS TPickDate
local aInfo := ::DispBegin(), hPen, hOld, oFont, nRowStep, nColStep, n, dDate
local hDC := ::hDC, cDay
FillRect( hDC, GetClientRect( ::hWnd ), ::oBrush:hBrush )
hPen = CreatePen( PS_SOLID, 1, CLR_BLACK )
hOld = SelectObject( hDC, hPen )
DEFINE FONT oFont NAME "Tahoma" SIZE 0, -12
nRowStep = ::nHeight / 13
for n = 1 to 12
::Line( n * nRowStep, 0, n * nRowStep, ::nWidth - 1 )
::Say( n * nRowStep + ( nRowStep * 0.3 ), 3, cMonth( CToD( Str( n, 2 ) + "/01/" + Str( Year( Date() ), 4 ) ) ),,, oFont, .T. )
next
dDate = CToD( "06/01/2008" )
nColStep = ( ::nWidth - 60 ) / 36
for n = 1 to 35
::Line( 0, 60 + ( nColStep * n ), ::nHeight - 1, 60 + ( nColStep * n ) )
cDay = SubStr( CDoW( dDate++ ), 1, 2 )
::Say( nRowStep * 0.5,;
60 + ( nColStep * n ) + ( nColStep / 2 ) - ( GetTextWidth( hDC, cDay, oFont:hFont ) / 2 ) + 1,;
cDay,,, oFont, .T. )
next
SelectObject( hDC, hOld )
DeleteObject( hPen )
::DispEnd( aInfo )
return 0
//----------------------------------------------------------------------------//
METHOD LButtonUp( nRow, nCol, nKeyFlags ) CLASS TPickDate
::endDay := ::aPlan[::sx,::sy]
IF ::sy > 0 .AND. ::sx > 0
if msgYesNo(::startDay + " -- " + ::endDay + " Tage: " +;
str( ctod(::endDay)-ctod(::startDay) +1 ))=.t.
endif
ENDIF
::lMove:=.f.
return nil
//----------------------------------------------------------------------------//
METHOD Ldblclick( nRow, nCol, nKeyFlags ) CLASS TPickDate
local ITemp := 0
::sx := INT((nRow - ::nStartRow)/::nHeight ) + 1
::sy := INT((nCol - ::nStartCols)/::nWidth )
IF ::sy > 0 .AND. ::sx > 0
::startDay := ::aPlan[::sx,::sy]
::nStartZeile := ::sx
::ClickRow := (INT((nRow-::nStartRow)/::nHeight ))*::nHeight + ::nStartRow
::ClickCol := ::nStartCols + ::sy * ::nWidth
FOR ITemp := 1 TO 12
::aTemp[ITemp,1]:=0
NEXT
sysrefresh()
::lMove:=.t.
ENDIF
Super:LDblClick( nRow, nCol, nKeyFlags )
return nil
//----------------------------------------------------------------------------//
/*
METHOD MouseMove( nRow, nCol, nKeyFlags ) CLASS TPickDate
Super:MouseMove( nRow, nCol, nKeyFlags )
if IsOverWnd( ::hWnd, nRow, nCol )
if !::lCaptured
::Capture()
endif
else
if !::lCaptured
ReleaseCapture()
endif
ENDIF
if ::lMove
IF ::sx <> (INT((nRow-::nStartRow)/::nHeight ) + 1) .OR.;
::sx <> (INT((nCol-::nStartCols )/::nHeight ) + 1 )
::sx := INT((nRow-::nStartRow)/::nHeight ) + 1
::sy := INT((nCol -::nStartCols )/::nWidth )
IF nRow < ::nStartRow
::sx := 0
nRow := 0
ENDIF
::sxTemp := ::nStartRow + ::sx * ::nHeight
::syTemp := ::nStartCols + ::sy * ::nWidth + ::nWidth
ENDIF
endif
return nil
*/
//-----------------------------------------------------------------//
METHOD Destroy() CLASS TPickDate
RELEASE FONT ::oplanFont
::hBru:end()
::hPen:end()
::hPen1:end()
::hPen3:end()
return nil
//-----------------------------------------------------------------//
method PreviousYear() CLASS TPickDate
::nYear := ::nYear - 1
::Paint()
*::oWnd:refresh()
::oWnd:cTitle := "Kalender [ " + str(::nYear,4) + " ]"
return .T.
//-----------------------------------------------------------------//
method NextYear() CLASS TPickDate
::nYear := ::nYear + 1
::Paint()
*::oWnd:refresh()
::oWnd:cTitle := "Kalender [ " + str(::nYear,4) + " ]"
return .T.
//-----------------------------------------------------------------//
METHOD Paint() CLASS TPickDate
local aInfo := ::DispBegin(), hPen, hOld, oFont, nRowStep, nColStep, n, dDate
local hDC := ::hDC, cDay, oBrush
FillRect( hDC, GetClientRect( ::hWnd ), ::oBrush:hBrush )
DEFINE BRUSH oBrush COLOR nRGB( 183, 249, 185 )
hPen = CreatePen( PS_SOLID, 1, CLR_BLACK )
hOld = SelectObject( hDC, hPen )
DEFINE FONT oFont NAME "Tahoma" SIZE 0, -12
nRowStep = ::nHeight / 13
for n = 1 to 12
::Line( n * nRowStep, 0, n * nRowStep, ::nWidth - 1 )
::Say( n * nRowStep + ( nRowStep / 2 ) - ( oFont:nHeight / 2 ), 3, cMonth( CToD( Str( n, 2 ) + "/01/" + Str( Year( Date() ), 4 ) ) ),,, oFont, .T. )
next
dDate = CToD( "06/01/2008" )
nColStep = ( ::nWidth - 60 ) / 36
for n = 1 to 35 step 7
FillRect( hDC, { 0, 60 + ( nColStep * n ), ::nHeight - 1, 60 + ( nColStep * ( n + 1 ) ) }, oBrush:hBrush )
next
for n = 1 to 35
::Line( 0, 60 + ( nColStep * n ), ::nHeight - 1, 60 + ( nColStep * n ) )
cDay = SubStr( CDoW( dDate ), 1, 2 )
::Say( nRowStep * 0.5,;
60 + ( nColStep * n ) + ( nColStep / 2 ) - ( GetTextWidth( hDC, cDay, oFont:hFont ) / 2 ) + 1,;
cDay,, If( DoW( dDate++ ) == 1, nRGB( 128, 233, 176 ),), oFont, .T. )
next
SelectObject( hDC, hOld )
DeleteObject( hPen )
::DispEnd( aInfo )
oBrush:End()
return 0
CLASS CALENDAR
DATA aDATEBUTTONS
DATA aDOW
DATA dAnchorDate
DATA iLastBlank
DATA iDaysInMonth
DATA iStartOfMonth
DATA iEndOfMonth
METHOD New() CONSTRUCTOR
METHOD Show()
METHOD HideButtons()
ENDCLASS
METHOD New() CLASS CALENDAR
::dAnchorDate := DATE()
::aDATEBUTTONS := ARRAY( 37 )
::aDOW := { "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat" }
Return self
METHOD Show() CLASS CALENDAR
LOCAL dlg_CALENDAR
LOCAL sTitle
LOCAL ii
LOCAL sLabel
LOCAL oGrp
sTitle := "Calendar"
DEFINE DIALOG dlg_CALENDAR TITLE sTitle SIZE 400, 400
dBOM := BOM( ::dAnchorDate )
::iStartOfMonth := DOW( dBOM )
::iLastBlank := ::iStartOfMonth - 1
::iDaysInMonth := DaysInMonth( MONTH( ::dAnchorDate ), IsLeap( ::dAnchorDate ) )
::iEndOfMonth := ::iDaysInMonth + ::iLastBlank
sLabel := CMONTH( ::dAnchorDate ) + " " + STR( YEAR( ::dAnchorDate ) )
@ 9, 1 GROUP oGrp LABEL sLabel OF dlg_CALENDAR SIZE 370, 250 PIXEL
iRow := 120
iCol = 20
FOR ii = -6 TO 37
IF ii > 0
@ iRow, iCol BUTTON ::aDATEBUTTONS[ii] PROMPT "Test" OF dlg_CALENDAR PIXEL SIZE 40, 25
ELSE
@ iRow, iCol BUTTON ::aDOW[ii + 7] OF dlg_CALENDAR PIXEL SIZE 40, 25 WHEN .F.
ENDIF
iCol += 50
IF iCol > 330
iRow += 30
iCol := 20
ENDIF
NEXT
ACTIVATE DIALOG dlg_CALENDAR ON INIT ::HideButtons()
RETURN nil
METHOD HideButtons() CLASS CALENDAR
FOR ii = 1 TO ::iLastBlank
::aDATEBUTTONS[ii]:Hide()
NEXT
FOR ii = ::iStartOfMonth TO ::iEndOfMonth
::aDATEBUTTONS[ii]:SetText( ALLTRIM( STR( ii - ::iLastBlank ) ) )
::aDATEBUTTONS[ii]:Show()
NEXT
FOR ii = ( ::iEndOfMonth + 1 ) TO 37
::aDATEBUTTONS[ii]:Hide()
NEXT
RETURN nil
Return to FiveWin for Harbour/xHarbour
Users browsing this forum: cmsoft, Google [Bot] and 68 guests