OK...
B4X:
///////////////////////////
function CalStuff( TODAY )
///////////////////////////
LOCAL dToday_Is,i,last,row,col,day,cal_buf
LOCAL cDateString,dItsTodaysDate,nTTLJob
LOCAL xKey_Hit,GetList:={}
LOCAL x[42],y[42],aWhere := { {},{},{},{} }
LOCAL xoffset := 6, yoffset := 3
LOCAL x1 := 3, y1 := 5
LOCAL cOldMouseArea := MouseDefArea(0,0,24,79)
LOCAL nDayPercent := 0,lOldIns := READINSERT(.T.)
LOCAL ECOL,EROW,TCOL,TROW,BCOL
local aAdd2UpdateCal
PUBLIC nJobPage := 1
SET KEY K_F9 to
set century off
TAKE_OUT_THE_TRASH
DEFAULT today TO DATE()
dToday_Is := DOW(today)
DAY := DAY(today)
IF !OpenDBFS() ; RETURN Nil ; ENDIF
aCalNumInfo := ARead("caldata.arr")
ActivateCal(aCalNumInfo[13,1])
SCR( PUSH )
DrawScreen( aCalNumInfo )
do while TRUE
ClearWin(04,02,22,44,aClr[CLR_BOX,3])
ClearWin(04,50,22,77,aClr[CLR_BOX,3])
FOR i = 1 TO 7
x[i] = x1 + ( xoffset * (i - 1) )
NEXT
FOR i = 1 TO 6
y[i] = y1 + ( yoffset * (i - 1) )
NEXT
COL := dow( today - (day(today)-1))
BCOL := COL
ROW := 1
DAY := ROW
TCOL := 0
TROW := TCOL
*-- Call udf TO find the lastday of the current month --*
LAST := LASTDAY(TODAY)
aWhere := ARRAY(LAST,4)
*-- Make calendar --*
Scr( PUSH,8,5,13,42)
SD_Box(8,5,12,40,aClr[CLR_A1_BOX])
@ 10,7 say "Please Wait, Calculating Month." COLOR aClr[CLR_A1_BOX,1]
DispBegin()
Scr( POP )
do while row <=6 .and. DAY <= LAST
do while col <= 7 .and. DAY <= LAST
IF DAY == DAY(TODAY)
tcol := col //*-- remember today --*//
trow := row //*-- remember today --*//
ENDIF
IF NEXTKEY() == K_PGUP .or. NEXTKEY() == K_PGDN
// nothing...
else
UpdateDays(ctod(strzero(month(today),2)+"/"+strzero(day,2)+"/"+;
strzero(year(today),4)),row,col,y,x,DAY)
ENDIF
aWhere[DAY][1] := y[row] ; aWhere[DAY][2] := x[col]
aWhere[DAY][3] := row ; aWhere[DAY][4] := col
DAY += 1
COL += 1
enddo
ECOL := COL - 1
col := 1
ROW += 1
enddo
DispEnd()
DAY := DAY(today)
EROW := ROW -1
ROW := TROW
COL := TCOL
*-- display box around day position --*
do while .t.
DispBegin()
dItsTodaysDate := ctod(strzero(month(today),2)+"/"+strzero(day,2)+"/"+strzero(year(today),4))
UpdateDays(dItsTodaysDate,row,col,y,x,DAY)
@ 3,47 say PADC(CDOW(dItsTodaysDate),31) COLOR aClr[CLR_BOX,3]
@ 1,01 say PADC( PrettyDate( dItsTodaysDate,6 ),45) COLOR aClr[CLR_BOX,2]
@ y[row]-1,x[col]-1 say "ÚÄÄÄÄÄ¿" color aClr[ CLR_BOX,3 ]
@ y[row],x[col]-1 say "³" color aClr[ CLR_BOX,3 ]
@ y[row],x[col]+5 say "³" color aClr[ CLR_BOX,3 ]
@ y[row]+1,x[col]-1 say "³" color aClr[ CLR_BOX,3 ]
@ y[row]+1,x[col]+5 say "³" color aClr[ CLR_BOX,3 ]
@ y[row]+2,x[col]-1 say "ÀÄÄÄÄÄÙ" color aClr[ CLR_BOX,3 ]
DispEnd()
//** get mouse and keys **//
xKey_Hit = GetCalKey( dItsTodaysDate )
IF valtype(xKey_Hit) == 'A'
xKey_Hit := ProcessMouse(aWhere,xKey_Hit,x,y,@ROW,@DAY,@COL)
IF xKey_Hit == _MOUSE_PICK_
//** mouse move to another day **//
//** so reset job page to 1
pRESET_TO_JOB_PAGE_1
loop
ENDIF
IF xKey_Hit == _DATE_SELECTED_
xKey_Hit := K_ENTER
ENDIF
ENDIF
IF !EMPTY(aJobsToDo)
ChkExtraKeys(xKey_Hit) // check ext keys //
ENDIF
EraseCalHilite(y,x,col,row)
DO CASE
case xKey_Hit == K_ESC
MouseDefArea( cOldMouseArea )
DBCloseAll()
SD_DBF( POP )
Scr( POP )
READINSERT( lOldIns )
AWrite("caldata.arr",aCalNumInfo)
RELEASE nJobPage
SET KEY K_F9 to GenericToDoCAL()
RETURN( pBLANK_DATE )
case xKey_Hit == K_DOWN
IF .not. ((row+1 == EROW .and. COL > ECOL) .or. row == EROW)
IF row <= 5
row += 1 ; day += 7
ENDIF
pRESET_TO_JOB_PAGE_1
ENDIF
case xKey_Hit == K_UP
IF .not. (row-1 == 1 .and. COL < BCOL)
IF row > 1
day -= 7 ; row -= 1
ENDIF
pRESET_TO_JOB_PAGE_1
ENDIF
case xKey_Hit == K_LEFT
IF .not. (row == 1 .and. COL -1 < BCOL)
IF col > 1
col -= 1 ; day -= 1
else
IF row > 1
day -= 1 ; row -= 1 ; col := 7
ENDIF
ENDIF
pRESET_TO_JOB_PAGE_1
ENDIF
case xKey_Hit == K_RIGHT
IF .not. (row == EROW .and. COL +1 > ECOL)
IF col <= 6
col += 1 ; day += 1
else
IF row <= 5
row += 1 ; day += 1 ; col := 1
ENDIF
ENDIF
pRESET_TO_JOB_PAGE_1
ENDIF
case xKey_Hit == K_ENTER
JobsMenu(dItsTodaysDate,y,x,aWhere)
case xKey_Hit == K_TAB
aAdd2UpdateCal := {}
MakePhoneCalls(dItsTodaysDate,@aCallsToDo,aAdd2UpdateCal)
ChkUpdateCal(dItsTodaysDate,aAdd2UpdateCal,aWhere,y,x)
case xKey_Hit <= K_ALT_F1 .and. xKey_Hit >= K_ALT_F10 .or. ;
xKey_Hit == K_ALT_F11 .or. xKey_Hit == K_ALT_F12
IF CheckCalNumKeys(xKey_Hit,@aCalNumInfo)
pRESET_TO_JOB_PAGE_1
exit
ENDIF
case xKey_Hit == K_CTRL_BS
//** this is the show & select all valid calendar
IF ShowChangeCal(@aCalNumInfo)
pRESET_TO_JOB_PAGE_1
exit
ENDIF
case xKey_Hit == K_PGDN
today := ADDMONTH(dItsTodaysDate,1)
pRESET_TO_JOB_PAGE_1
exit
case xKey_Hit == K_PGUP
today := ADDMONTH(dItsTodaysDate,-1)
pRESET_TO_JOB_PAGE_1
exit
case xKey_Hit == K_ALT_Y
MultiView(dItsTodaysDate,aCalNumInfo)
case xKey_Hit == K_ALT_W
WeeklyView(dItsTodaysDate,aCalNumInfo)
case xKey_Hit == K_CTRL_PGUP
nTTLJob := LEN(aJobsToDo)
if nJobPage == 1
SD_EBeep()
else
nJobPage--
endif
ShowWhatCal(aCalNumInfo)
case xKey_Hit == K_CTRL_PGDN
nTTLJob := LEN(aJobsToDo)
DO CASE
CASE nTTLJob >= 18 .AND. nJobPage == 1
nJobPage++
CASE nTTLJob >= 35 .AND. nJobPage == 2
nJobPage++
CASE nTTLJob >= 52 .AND. nJobPage == 3
nJobPage++
OTHERWISE
SD_EBeep()
ENDCASE
ShowWhatCal(aCalNumInfo)
endcase
enddo
enddo