there's some problems... I an in Holyday and I not have here my manuals and lib
Code: Select all | Expand
#include "FiveWin.ch"
//----------------------------------------------------------------------------//
function Main()
LOCAL oPickDate
Local oWnd
SET DATE GERMAN
DEFINE WINDOW oWnd TITLE "Kalender" ;
VSCROLL ;
FROM 5, 5 TO 24, 98
oPickDate := TPickdate():New(30,50,20,30,oWnd)
oWnd:oVScroll:bGoUp := {|| oPickDate:PreviousYear() }
oWnd:oVScroll:bGoDown := {|| oPickDate:NextYear() }
ACTIVATE WINDOW oWnd;
ON RESIZE oPickDate:Paint()
return nil
CLASS Tpickdate FROM TControl
DATA nStartRow, nStartCols
DATA nWidth,nHeight
DATA oplanFont,sy,sx
DATA ClickRow,syTemp,sxTemp,ClickCol
DATA startDay,endDay,oBrush
DATA hBru,hPen1,hPen3
DATA nClrText,nClrPane
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 Line( nTop, nLeft, nBottom, nRight, oPen )
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()
ENDCLASS
METHOD New(nTop,nLeft,nWidth,nHeight,oWnd,nYear,lBorder,oplanFont,nClrFore,;
nClrBack,nVersion ) CLASS Tpickdate
DEFAULT nWidth := 10 ,;
nHeight := 10 ,;
nLeft := 50 ,;
nTop := 30 ,;
nYear := YEAR( DATE() ) ,;
nVERSION := "1.0.0" ,;
oWnd := GetWndDefault() ,;
lBorder := .t.
::nWidth := nWidth
::nHeight := nHeight
::nStartCols := nLeft
::nStartRow := nTop
::nYear := nYear
::lBorder :=lBorder
::nStyle = nOR( WS_CHILD, WS_VISIBLE, WS_CLIPSIBLINGS,;
WS_CLIPCHILDREN, WS_TABSTOP )
::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 I, nCurrentRows, iZeile
local nCurrentCol
local cHeader1 := ""
* local oSay
* local hdc
local aDays := {;
"So","Mo","Di", "Mi", "Do", "Fr", "Sa","So",;
"Mo","Di", "Mi", "Do", "Fr", "Sa","So",;
"Mo","Di", "Mi", "Do", "Fr", "Sa","So",;
"Mo","Di", "Mi", "Do", "Fr", "Sa","So",;
"Mo","Di", "Mi", "Do", "Fr", "Sa","So","Mo" }
local cYear := STR( ::nYear, 4 )
local dDate, nStart
local lSchaltJahr := ( DAY( CTOD( "29.02." + cYear ) ) <> 0 )
local aDaysInMonth := { 31, IIF( lSchaltJahr, 29, 28 ), 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 }
local aRect1
local IMonate := 0
local ITemp := 0
local cTest := ""
* local nEnde
local iSpalte := 0
local nRight
local nBottom
local nLeft
local nTop
::hBru := CreateSolidBrush( RGB(217,230,246) )
::hPen := CreatePen( 0, 1, 12632256 )
::hPen1 := CreatePen( 0, 1, 280 )
::hPen3 := CreatePen( 0, ::nWidth,RGB(183,249,185) ) //Sonntagsspalte
DEFINE BRUSH ::oBrush COLOR RGB(255,255,255)
FOR IMonate := 1 TO 12
aadd(::aPlan,{"","","", "", "", "", "","",;
"","", "", "", "", "","",;
"","", "", "", "", "","",;
"","", "", "", "", "","",;
"","", "", "", "", "","","",0,0,0 } )
NEXT
aRect1 := { 0,0, ::nStartRow + (13 * ::nHeight) ,::nStartCols ;
+ (38 * ::nWidth) + ::nWidth} //procl
FillRect( ::hDC,aRect1,::oBrush:hBrush)
iZeile := 0
nCurrentCol := ::nStartCols
FOR I := 1 TO 38
::SelectPen ( ::hPen )
IF iZeile = 5
::SelectPen ( ::hPen1 )
iZeile := 0
ENDIF
//vertikale Linie zw. Tage
::oWnd:line( 10, ::nWidth + nCurrentCol, ::nStartRow + (13 * ::nHeight), ::nWidth + nCurrentCol,::hPen )
nCurrentCol := nCurrentCol + ::nWidth
iZeile := iZeile + 1
NEXT
nCurrentCol := ::nStartCols
FOR I := 1 TO len(aDays)
if aDays[I] = "So"
//Farbhintergrund Sonntag
::SelectPen ( ::hPen3 )
// Sonntag erste fette Linie
// ::oWnd:line (0, ::nWidth + ::nWidth/2 + nCurrentCol,::nStartRow + (13 * ::nHeight), ::nWidth + ::nWidth/2 + nCurrentCol )
::LINE (0, ::nWidth + ::nWidth/2 + nCurrentCol,::nStartRow + (13 * ::nHeight), ::nWidth + ::nWidth/2 + nCurrentCol )
::SelectPen ( ::hPen )
::oWnd:say( 8, ::nWidth+36+I* ::nWidth,aDays[I],RGB(255,128,0), RGB(125,236,175),::oplanFont,.T.)
else
::oWnd:say( 8, ::nWidth+36+I*::nWidth,aDays[I],RGB(255,128,0),16777215,::oplanFont,.T.)
endif
nCurrentCol := nCurrentCol + ::nWidth
NEXT
nCurrentRows := ::nStartRow
FOR I := 1 TO 13
::SelectPen ( ::hPen )
IF iZeile = 5
::SelectPen ( ::hPen1 )
iZeile := 0
ENDIF
//Lines
::oWnd:line (nCurrentRows, 1,nCurrentRows, ::nStartCols+ 38 * ::nWidth ) //726
nCurrentRows := nCurrentRows + ::nHeight
iZeile := iZeile + 1
NEXT
nCurrentRows := 12
FOR I := 1 TO 12
SelectObject( ::oWnd:hDc, ::hPen )
IF iZeile = 5
SelectObject( ::oWnd:hDc, ::hPen1 )
iZeile := 0
ENDIF
nCurrentRows := nCurrentRows + ::nHeight
dDate := CTOD( "01." + PADL( ALLTRIM(STR( i, 2 )), 2, "0" ) + "." + cYear )
nStart := DOW( dDate )
::aPlan[I,38] := nStart
::aPlan[I,39] := ::nStartCols + ::nWidth * nStart //- ::nWidth //col begin of month
::aPlan[I,40] := nStart + aDaysInMonth[i] //col end of month
FOR iSpalte := nStart TO aDaysInMonth[i] + nStart - 1
::aPlan[I,iSpalte] = ( PADL( ALLTRIM(STR( (iSpalte-nStart+1), 2 )), 2, "0" )+ "." + PADL( ALLTRIM(STR( (I), 2 )), 2, "0" ) + "." + cYear )
NEXT
cHeader1 := OemToAnsi( CMONTH( dDate ) )//Monate
::oWnd:say( nCurrentRows+1, 2, cHeader1,RGB(63,63,63),16777215,::oplanFont,.T.)
NEXT
IF (::sx > 0 .AND. ::sx < 13) .AND. (::sy > 0 .AND. ::sy < 38)
IF ::lMove = .t.
IZeile := ::sx
::aTemp[IZeile,1] := 10
FOR ITemp := IZeile+1 TO 12
::aTemp[ITemp,1] := 0
NEXT
FOR ITemp := 1 TO 12
if ::aTemp[ITemp,1] > 0
IF ctod(::aPlan[::sx,::sy]) > ctod(" . . ")
FillRect( ::oWnd:hDc, {::ClickRow,;
::ClickCol,;
::ClickRow+::nHeight,;
::ClickCol+::nWidth}, ::hBru )
IF ::nStartRow-::nHeight + (::nHeight*(ITemp)) = ::ClickRow .OR. IZeile=1
nTop := ::nStartRow - ::nHeight + (::nHeight*(ITemp))
nLeft := ::ClickCol
IF ::ClickCol < ::aPlan[ITemp,39]
nLeft := ::aPlan[ITemp,39]
ENDIF
nBottom := ::nStartRow + (::nHeight*(ITemp))
nRight := ::syTemp
IF ::syTemp > nLeft
IF ::syTemp <= ::nStartCols+::aPlan[ITemp,40]*::nWidth
FillRect( ::oWnd:hDc, {nTop,;
nLeft,;
nBottom,;
nRight },::hBru)
ENDIF
ENDIF
ELSEIF ITemp > ::nStartZeile
**********
IF ITemp > ::nStartZeile+1
nTop := ::nStartRow - ::nHeight + (::nHeight*(ITemp-1))
nLeft := ::aPlan[ITemp-1,39]
nBottom := ::nStartRow + (::nHeight*(ITemp-1))
nRight := ::nStartCols +( ::nWidth*(::aPlan[ITemp-1,40]))
IF ::syTemp >= ::aPlan[ITemp,39]
IF ::syTemp <= ::nStartCols+::aPlan[ITemp,40]*::nWidth
FillRect( ::oWnd:hDc, {nTop,;
nLeft,;
nBottom,;
nRight },::hBru)
ENDIF
ENDIF
ENDIF
***********
nTop := ::nStartRow - ::nHeight + (::nHeight*(ITemp))
nLeft := ::aPlan[ITemp,39]
nBottom := ::nStartRow + (::nHeight*(ITemp))
nRight := ::syTemp
IF ::syTemp >= ::aPlan[ITemp,39]
IF ::syTemp <= ::nStartCols+::aPlan[ITemp,40]*::nWidth
FillRect( ::oWnd:hDc, {nTop,;
nLeft,;
nBottom,;
nRight },::hBru)
ENDIF
ENDIF
nTop := ::nStartRow-::nHeight+ (::nHeight*(ITemp-1))
nLeft := ::ClickCol
IF ::ClickCol < ::aPlan[ITemp-1,39]
nLeft := ::aPlan[ITemp-1,39]
ENDIF
nBottom := ::nStartRow +(::nHeight*(ITemp-1))
nRight := ::nStartCols +( ::nWidth*(::aPlan[ITemp-1,40]))
FillRect( ::oWnd:hDc, {nTop,;
nLeft,;
nBottom,;
nRight }, ::hBru )
else
ENDIF
ENDIF
endif
NEXT
ENDIF
ENDIF
nCurrentRows := 12
FOR I := 1 TO 12
SelectObject( ::oWnd:hDc, ::hPen )
IF iZeile = 5
SelectObject( ::oWnd:hDc, ::hPen1 )
iZeile := 0
ENDIF
nCurrentRows := nCurrentRows + ::nHeight
dDate := CTOD( "01." + PADL( ALLTRIM(STR( i, 2 )), 2, "0" ) + "." + cYear )
nStart := DOW( dDate )
FOR iZeile := nStart TO aDaysInMonth[i] + nStart - 1
cHeader1 := ALLTRIM(str(iZeile-nStart+1)) //Tage
if aDays[iZeile] = "So"
::oWnd:say( nCurrentRows+3,36 + ::nWidth + (iZeile) * ::nWidth, cHeader1, RGB(63,63,63),RGB(125,236,175),::oplanFont,.T.,.T.)
else
::oWnd:say( nCurrentRows+3,36 + ::nWidth + (iZeile) * ::nWidth, cHeader1, RGB(63,63,63),16777215,::oplanFont,.T., .T.)
ENDIF
NEXT
NEXT
IF (::sx > 0 .AND. ::sx < 13) .AND. (::sy > 0 .AND. ::sy < 38)
::oWnd:say(::sxTemp+20, ::syTemp-20, ::aPlan[::sx,::sy] + " # "+str(ctod(::aPlan[::sx,::sy])-ctod(::startDay)+ 1), RGB(63,63,63), RGB(125,236,175), ::oplanFont, .T. )
endif
::ReleaseDC()
sysrefresh()
return nil
//----------------------------------------------------------------------------//
METHOD Line( nTop, nLeft, nBottom, nRight, hPen ) CLASS Tpickdate
* local hPen := if( oPen = nil, 0, oPen:hPen )
::GetDC()
MoveTo( ::hDC, nLeft, nTop )
LineTo( ::hDC, nRight, nBottom, hPen )
::ReleaseDC()
return nil
//----------------------------------------------------------------------------//
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.
a) the methods oPickDate:PreviousYear() and oPickDate:NextYear() not refresh the object