Mich würde mal interessieren, ob man mit xBase selbst auch Klassen machen kann.
Code: Alles auswählen
function Main()
local oWnd, oPickDate
SET DATE FRENCH
DEFINE WINDOW oWnd TITLE "Calendar"
oPickDate := TPickDate():New( 10, 10,,, oWnd )
oPickDate:bSelect = { | dStart, dEnd | MsgInfo( Str( dEnd - dStart + 1 ) + " days" ) }
oPickDate:bPainted = { | hDC, dStart, dEnd | ;
oPickDate:Say( 17, 20, Str( dEnd - dStart + 1 ) + " days",,,, .T., .T. ) }
oWnd:oClient = oPickDate
ACTIVATE WINDOW oWnd MAXIMIZED
//ON INIT TestDialog()
return nil
//----------------------------------------------------------------------------//
function TestDialog()
local oDlg, oPickDate
DEFINE DIALOG oDlg RESOURCE "Test"
oPickDate = TPickDate():Redefine( 10, oDlg )
oPickDate:bSelect = { | dStart, dEnd | MsgInfo( Str( dEnd - dStart + 1 ) + " days" ) }
ACTIVATE DIALOG oDlg CENTERED
return nil
//----------------------------------------------------------------------------//
CLASS TPickDate FROM TControl
DATA dStart, dEnd, dTemp, lMove
DATA nYear
DATA oBrushSunday, oBrushSelected, oFontHeader
DATA nLeftStart, nTopStart
DATA bSelect ,oBitmap,oBitmap2,oBitmap3,oBitmap4
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()
DEFINE BITMAP ::oBitmap FILE "go.bmp"
DEFINE BITMAP ::oBitmap2 FILE "go2.bmp"
DEFINE BITMAP ::oBitmap3 FILE "go3.bmp"
DEFINE BITMAP ::oBitmap4 FILE "go4.bmp"
::lMove = .F.
::nTopStart = 60 // for header
::nLeftStart = 150 // col header
::nTop = nTop
::nLeft = nLeft
::nBottom = nTop + nHeight - 1
::nRight = nLeft + nWidth - 1
::nYear = Year( Date() )
::oWnd = oWnd
::dStart := ::dEnd := ::dTemp := Date()
::nClrText = nClrFore
::nClrPane = nClrBack
::nStyle = nOr( WS_CHILD, WS_VISIBLE, WS_TABSTOP, WS_BORDER )
DEFINE BRUSH ::oBrushSunday COLOR nRGB( 183, 249, 185 ) // Sundays column green brush
DEFINE BRUSH ::oBrushSelected COLOR nRGB( 240, 232, 188 ) // Selected days orange brush
DEFINE FONT ::oFont NAME "Tahoma" SIZE 0, -12 BOLD
DEFINE FONT ::oFontHeader NAME "Tahoma" SIZE 0, -12
#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()
::nId = nId
::oWnd = oWnd
::lMove = .F.
::nTopStart = 60 // for header
::nLeftStart = 150 // col header
::dStart := ::dEnd := ::dTemp := Date()
::nYear = Year( Date() )
DEFINE BRUSH ::oBrushSunday COLOR nRGB( 183, 249, 185 ) // Sundays column green brush
DEFINE BRUSH ::oBrushSelected COLOR nRGB( 240, 232, 188 ) // Selected days orange brush
DEFINE FONT ::oFont NAME "Tahoma" SIZE 0, -12 BOLD
DEFINE FONT ::oFontHeader NAME "Tahoma" SIZE 0, -12
::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
FillRect( hDC, GetClientRect( ::hWnd ), ::oBrush:hBrush )
nRowStep = ( ::nHeight - ::nTopStart ) / 13
GradientFill( hDC, 0, 0, ::nHeight, ::nWidth, { { 1, nRGB( 128, 217, 255 ), nRGB( 54, 147, 255 ) } } )
dDate = CToD( "01/01/" + Str( ::nYear, 4 ) )
dDate += 8 - DoW( dDate )
nColStep = ( ::nWidth - ::nLeftStart ) / 37
GradientFill( hDC, 0, 0, nRowStep - 1, ::nWidth, { { 1, nRGB( 128, 217, 255 ), nRGB( 54, 147, 255 ) } } )
::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 ) )
cDay = SubStr( CDoW( dDate++ ), 1, 2 )
::Say( ( ::nTopStart + nRowStep * 0.4 ),;
::nLeftStart + ( nColStep * n ) + ( nColStep / 2 ) - ( GetTextWidth( hDC, cDay, ::oFont:hFont ) / 2 ) + 1,;
cDay, 0, 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 ) ) )
::Say( ( ::nTopStart + nMonth * nRowStep ),;
::nLeftStart + ( nColStep * nDay ) + ( nColStep / 2 ) - ( GetTextWidth( hDC, cDay, ::oFont:hFont ) / 2 ) + 1,;
cDay, 0, 0, ::oFontHeader, .T., .T. )
::SayBitmap( ( ::nTopStart + nMonth * nRowStep + ( nRowStep * 0.4 ) ),;
::nLeftStart + ( nColStep * nDay++ ) + ( nColStep / 6 ) - ( GetTextWidth( hDC, cDay, ::oFont:hFont ) / 2 ) + 1, ::oBitmap2 , , 1 )
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 )
