#include "fivewin.ch"
static dDate, dBOM, dOffSet
static nMonth, cMonth, nYear
static oBrw, oDate
//----------------------------------------------------------------------------//
function XBrDtPicker( dParam, cTitle, nSize )
local oDlg, oFont, oFontD, oCbx, d, a, oCol, nTop, nLeft
local aMth[ 12 ]
local aWeek[ 7 ]
local lOk := .f.
if ValType( dParam ) == "O" .and. dParam:IsKindOf( "TXBrwColumn" )
oCol := dParam
dParam := oCol:Value
DEFAULT cTitle := oCol:cHeader, nSize := 0.6
a := oCol:oBrw:aCellCoor()
nTop := a[ 3 ]
nLeft := a[ 2 ]
a := ClientToScreen( oCol:oBrw:hWnd, { nTop, nLeft } )
nTop := a[ 1 ]
nLeft := a[ 2 ]
else
DEFAULT nSize := 1.0
endif
nSize := Min( 1.5, Max( 0.6, nSize ) )
SET CENTURY ON
SET DATE ITALIAN
AEval( aMth, { |c,i| aMth[ i ] := NToCMonth( i ) } )
AEval( aWeek, { |c,i| aWeek[ i ] := Left( NToCDOW( i ), 3 ) } )
SetDate( dDate := IfNil( dParam, Date() ) )
DEFINE FONT oFont NAME "Segoe UI" SIZE 0,-20*nSize
DEFINE FONT oFontD NAME "COPPERPLATE GOTHIC BOLD" SIZE 0,-36*nSize
DEFINE DIALOG oDlg SIZE 542*nSize,490*nSize PIXEL TRUEPIXEL ;
FONT oFont TITLE IfNil( cTitle, "CALENDAR WITH XBROWSE" )
@ 20*nSize, 20*nSize COMBOBOX oCbx VAR nMonth ITEMS aMth SIZE 150*nSize,300 PIXEL OF oDlg UPDATE ;
ON CHANGE ResetCal()
@ 20*nSize,190*nSize GET nYear PICTURE "9999" SIZE 60*nSize,34*nSize PIXEL OF oDlg UPDATE ;
SPINNER MAX 2999 MIN 1900 ;
ON CHANGE ReSetCal()
@ 20*nSize,280*nSize GET oDate VAR dDate SIZE 120*nSize,34*nSize PIXEL OF oDlg ;
SPINNER ;
; //ON CHANGE SetDate( dDate ) ;
VALID SetDate( dDate )
@ 20*nSize,435*nSize BTNBMP RESOURCE 0x200CD SIZE 40*nSize,34*nSize PIXEL OF oDlg FLAT ;
ACTION oDlg:End()
@ 20*nSize,480*nSize BTNBMP RESOURCE 0x100FC SIZE 40*nSize,34*nSize PIXEL OF oDlg FLAT ;
ACTION ( lOk := .t., oDlg:End() )
if nSize < 0.6
AEval( oDlg:aControls, { |o| o:nTop -= 5, o:nHeight += 5 } )
endif
@ 60*nSize,20*nSize XBROWSE oBrw SIZE 502*nSize,-20*nSize PIXEL OF oDlg ;
DATASOURCE Array( 6 ) COLUMNS 1,2,3,4,5,6,7 ;
HEADERS aWeek ;
NOBORDER CLASS TDtXBrowse()
AEval( oBrw:aCols, { |o| SetupCol( o ) } )
WITH OBJECT oBrw
:lRecordSelector := .f.
:lHScroll := .f.
:lVScroll := .f.
:lDisplayZeros := .f.
:lColChangeNotify := .t.
:lRelyOnKeyNo := .f.
:nRowHeight := 60*nSize
:nwidths := 70*nSize
:nRowDividerStyle := ;
:nColDividerStyle := LINESTYLE_LIGHTGRAY
:oDataFonts := oFontD
:nDataStrAligns:= AL_CENTER
:bChange := { || dDate := dOffSet + oBrw:nColSel + 7 * ( oBrw:nRowSel - 1 ), oDate:Refresh() }
:bLDClickDatas := { || lOk := .t., oDlg:End() }
//
:CreateFromCode()
END
oDlg:bStart := { || SetDate( dDate ) }
if nTop != nil
if nTop > ScreenHeight() * 0.9 - oDlg:nHeight
nTop -= ( oDlg:nHeight + oCol:oBrw:nRowHeight + 30 )
endif
if ( a := ( nLeft + oDlg:nWidth - ( ScreenWidth() - 50 ) ) ) > 0
nLeft -= a
endif
oDlg:bInit := { || oDlg:Move( nTop, nLeft ) }
endif
ACTIVATE DIALOG oDlg CENTERED
RELEASE FONT oFont, oFontD
return If( lOk, dDate, nil )
//----------------------------------------------------------------------------//
function SetUpCol( oCol )
local nClrPane := oCol:oBrw:oWnd:nClrPane
oCol:bEditValue := { || dOffSet + 7 * ( oCol:oBrw:nArrayAt - 1 ) + oCol:nArrayCol }
oCol:bStrData := { |x,o| DAY( o:Value ) }
if oCol:nArrayCol == 1
oCol:bClrStd := { || If( MONTH( oCol:Value ) == nMonth, { CLR_HRED, CLR_WHITE }, ;
{ CLR_HGRAY, nClrPane } ) }
oCol:bClrHeader:= { || { CLR_HRED, CLR_WHITE } }
else
oCol:bClrStd := { || If( MONTH( oCol:Value ) == nMonth, { CLR_BLACK, CLR_WHITE }, ;
{ CLR_HGRAY, nClrPane } ) }
endif
return nil
//----------------------------------------------------------------------------//
function SetDate( dDate )
local nDays, nRow, nCol, nLen
if dBOM != BOM( dDate )
dBOM := BOM( dDate )
dOffSet := dBOM - DOW( dBOM )
nMonth := Month( dDate )
cMonth := CMONTH( dDate )
nYear := Year( dDate )
endif
if oBrw != nil
nDays := dDate - dOffSet
nRow := Int( nDays / 7 ) + 1
if ( nCol := nDays % 7 ) == 0
nCol := 7
nRow--
endif
WITH OBJECT oBrw
:nRowSel := ;
:nArrayAt := nRow
:nColSel := nCol
nLen := Ceiling( ( EOM( dDate ) - dOffSet ) / 7 )
:bKeyCount := { || nLen }
:Refresh()
:oWnd:Update()
:SetFocus()
END
endif
return .t.
//----------------------------------------------------------------------------//
function ResetCal()
local dNewDate := STOD( STRZERO( nYear, 4 ) + STRZERO( nMonth, 2 ) + "01" )
dDate := dNewDate + MIN( DAY( dDate ), LASTDAYOM( dNewDate ) ) - 1
oDate:Refresh()
SetDate( dDate )
return .t.
//----------------------------------------------------------------------------//
//----------------------------------------------------------------------------//
CLASS TDtXBrowse FROM TXBrowse
CLASSDATA lRegistered INIT .f.
METHOD GoLeft()
METHOD GoRight()
METHOD GoUp()
METHOD GoDown()
ENDCLASS
//----------------------------------------------------------------------------//
METHOD GoLeft() CLASS TDtXBrowse
if ::nColSel == 1
if ::nArrayAt == 1
SetDate( dDate - 1 )
else
::nColSel := 7
::GoUp()
endif
return nil
endif
return ::Super:GoLeft()
//----------------------------------------------------------------------------//
METHOD GoRight() CLASS TDtXBrowse
if ::nColSel == 7
if ::nArrayAt == ::nLen
SetDate( dDate + 1 )
else
::nColSel := 1
::GoDown()
endif
return nil
endif
return ::Super:GoRight()
//----------------------------------------------------------------------------//
METHOD GoUp( n ) CLASS TDtXBrowse
if ::nArrayAt == 1
SetDate( dDate - 7 )
return nil
endif
return ::Super:GoUp( n )
//----------------------------------------------------------------------------//
METHOD GoDown( n ) CLASS TDtXBrowse
if ::nArrayAt == ::nLen
SetDate( dDate + 7 )
return nil
endif
return ::Super:GoDown( n )
//----------------------------------------------------------------------------//
Posted: Wed May 09, 2018 4:16 pm
