' ********************************************************************************
' Program: APPLIBHU.PF2
' ********************************************************************************

'FUNCTION DEFINITIONS  Last change 6/10/96
EXTERNAL $$fct  '<---- RAD variable
public xtoday
public tcal() 'Calander Function
public automenu() 'Automaticly pops up data file menu
PUBLIC print_cal() ' part of the calander program prints calander to screen
public working()
public flag()

'calendar working variables
GLOBAL $start, $end, $daynum, $rw, $col, $mnth, $cntr, $tday, $first_day,
GLOBAL $yr, $pr, $pc, choice, f, b, $spr, $spc, dhead,
GLOBAL $path, $ext, nl1, nl2, nl3, nl4, nl5, nl6, nl7, nl8, sf, sb, $ctr,
GLOBAL sc, sr, $monam, $yrnam, stormt, $chandle, ##rblank


'**********************************************************************
'FUNCTIONS
'**********************************************************************

function automenu()
'**********************************************************************
'MAKES DB MENU POP UP DURING ENTER OR UPDATE, ENTER AS DEFALT EQUATION
'SET automenu() AS THE DEFAULT CALCULATION ON A FIELD WITH A DB MENU ATTACHED
smartpoke $_KEY {ALT-F5}
return blank
end function


function tcal()
' ********************************************************************************
' Pop Up Calendar
' ********************************************************************************

'Last update 11/18/94 edited  to run under RAD
'Displays calendar for current month + or - changes 8/5/91
'position can be changed fg & bg colors can be changed parameters can be
'saved to a file
'functions used in this program have been moved to the top of this file
'to keep this function from recalcing when you exit update/entry mode from
'a RAD menu create the following calculation for the field calling this
'function --> if dbinfo(db_recalc) <> true then tcal() else nochange

quiet on
repaint off
single-step off
f1help off

$pr = int(scrheight/2)-6
$pc = int(scrwidth/2)-9
f = 15
b = 1
##rblank = blank
xtoday = today

print_cal()

label start

'get value for control variables
key name inchar choice
choice = upper(choice)
case choice

'increments calendar by 1 year
when "+"
   xtoday = addyears(xtoday,1)
   print_cal()
'increments calendar by 1 month

when "PGDN"
   xtoday = addmonths(xtoday,1)
   print_cal()

'decrements calendar by 1 year
when "-"
   xtoday = addyears(xtoday,-1)
   print_cal()
'decrements calendar by 1 month

when "PGUP"
   xtoday = addmonths(xtoday,-1)
   print_cal()


when "UP" ' Up arrow
   xtoday = adddays(xtoday,-7)
   print_cal()

when "DOWN" ' Down arrow
   xtoday = adddays(xtoday,7)
   print_cal()

when "LEFT" ' Left arrow
   xtoday = adddays(xtoday,-1)
   print_cal()

when "RIGHT" ' Right arrow
   xtoday = adddays(xtoday,1)
   print_cal()


when "1"
'Puts calendar in upper left corner. The scrheight/scrwidth functions allow
'for the calendar to be properly positioned when screen drivers other then
'24x80 are used. NOTE: when you change screen drivers you will need to 'teach'
'the calendar the new positions.
     repaint
     $pr = scrheight-(scrheight-2)
     $pc = scrwidth-(scrwidth-5)
     print_cal()

when "2"
'puts calendar in upper right corner
     repaint
     $pr = scrheight-(scrheight-2)
     $pc = scrwidth-23
     print_cal()

when "3"
'puts calendar in lower left corner
     repaint
     $pr = scrheight-15
     $pc = scrwidth-(scrwidth-5)
     print_cal()

when "4"
'puts calendar in lower right corner
     repaint
     $pr = scrheight-15
     $pc = scrwidth-23
     print_cal()

when "5"
'Puts calendar in center of the screen
     repaint
     $pr = int(scrheight/2)-6
     $pc = int(scrwidth/2)-9
     print_cal()

when "F"
'changes foreground color
     f = f+1
          if f > 15
            f = 0
          end if
     print_cal()

when "B"
'changes background color
     b = b+1
          if b > 15
            b = 0
          end if
     print_cal()

when "N"
' sets ##rblank to N so date will be returned blank
	##rblank  = "N"
	beep
	SCREEN PRINT $pr+9 $pc b f  " Date will be blank  "
	SCREEN PRINT $pr+10 $pc+2 f b  "[ Press Any Key ]"
	inchar
	jump $quit


when "F1"
'displays 'help' screen, the 'normal' f1 help is turned off at the beginning
'and is turned back on as the program is exited
SCREEN clear BOX $pr $pc-2 $pr+10 $pc+21 f b
SCREEN draw BOX $pr $pc-2 $pr+10 $pc+21 f b
SCREEN PRINT $pr+1 $pc f b  " PGUP-PGDN change MO "
SCREEN PRINT $pr+2 $pc f b  " + or - change YEAR  "
SCREEN PRINT $pr+3 $pc f b  " ARROWS change date  "
SCREEN PRINT $pr+4 $pc f b  "1 Upr Left   2 Upr Rt"
SCREEN PRINT $pr+5 $pc f b  "       5 Center      "
SCREEN PRINT $pr+6 $pc f b  "3 Lwr Left   4 Lwr Rt"
SCREEN PRINT $pr+7 $pc f b  " f Change F G color  "
SCREEN PRINT $pr+8 $pc f b  " b Change B G color  "
SCREEN PRINT $pr+9 $pc f b  " n returns blank date"
SCREEN PRINT $pr+10 $pc+2 f b  "[ Press Any Key ]"
inchar
print_cal()


when "F10"
'end the program
jump $quit


end case
jump start


label $quit
f1help on
repaint on
repaint

if ##rblank = "N"
  xtoday = blank
end if

return xtoday

end function




'***************************************************************************
function print_cal()
'prints out calendar
SCREEN clear BOX $pr $pc-2 $pr+10 $pc+21 f b
SCREEN draw BOX $pr $pc-2 $pr+10 $pc+21 f b
'load month name and year name into string variables so they can be
'concatenated into on string for display, the '&' puts a space between
'the 2 concatenated strings
$monam = monthname(xtoday)
$yrnam = str(year(xtoday))
dhead = $monam & $yrnam
'center month and tear for display
SCREEN PRINT $pr+1 $pc+ (10-(.5*(len(dhead)))) f b dhead
SCREEN PRINT $pr+2 $pc f b  "S  M  T  W  T  F  S"
'change message displayed at the bottom of the calendar depending on
'whether or not you are in the screen saver mode
if choice <> "S"
        SCREEN PRINT $pr+9 $pc f b  "F10 = Quit  F1 = Help"
end if
if choice = "S"
        SCREEN PRINT $pr+9 $pc f b  "[>  Press Any Key  <]"
end if

'get today's numeric value
$daynum = day(xtoday)
'find out what month we are working with
$mnth = month(xtoday)
'find out what year we are working with
$yr = year(xtoday)

'sets the number of days in the month to be printed

CASE($mnth)
     WHEN 1
       $end = 31
     WHEN 2
'deal with LEAP YEARS through 2008
if year(xtoday) = 1992
       $end = 29
elseif year(xtoday) = 1996
       $end = 29
elseif year(xtoday) = 2000
       $end = 29
elseif year(xtoday) = 2004
       $end = 29
elseif year(xtoday) = 2008
       $end = 29
else
       $end = 28
end if

     WHEN 3
       $end = 31
     WHEN 4
       $end = 30
     WHEN 5
       $end = 31
     WHEN 6
       $end = 30
     WHEN 7
       $end = 31
     WHEN 8
       $end = 31
     WHEN 9
       $end = 30
     WHEN 10
       $end = 31
     WHEN 11
       $end = 30
       WHEN 12
       $end = 31
END CASE

'find where to print the first day of the month


CASE dayname(date(xtoday)-(day(xtoday)-1))

     WHEN "Sunday"
       $col=  $pc
       $start = 1
     WHEN "Monday"
       $col = $pc+3
        $start = 2
     WHEN "Tuesday"
       $col = $pc+6
       $start = 3
     WHEN "Wednesday"
       $col = $pc+9
       $start = 4
     WHEN "Thursday"
       $col = $pc+12
       $start = 5
     WHEN "Friday"
       $col = $pc+15
       $start = 6
     WHEN "Saturday"
       $col = $pc+18
       $start = 7

END CASE

'print out the month
$rw = $pr+3
'for next loop prints each day then moves over and down at the end of each
'calendar row
FOR $cntr = 1 to $end
          SCREEN PRINT $rw $col f b $cntr
'invert colors on today's date
      if val(MID(xtoday,4,2)) = $cntr
'       if $cntr = $daynum
          SCREEN PRINT $rw $col b f $cntr
'      end if
     end if
'increment counters
     $start = $start + 1
     $col = $col + 3
     IF $start > 7
          $start = 1
          $col = $pc
          $rw = $rw + 1
     END IF
END FOR

return
end function


'*************************************************************************
' displays working screen with message passed from $$fct
'*************************************************************************
function working()
local lmsg
$$fct = "  "|$$fct|"  "
lmsg = int(len($$fct))
REPAINT OFF
SCREEN CLEAR BOX 1 1 scrheight -4  scrwidth -1 15 1
SCREEN DRAW BOX int(scrheight*.5)-1 (int(int(scrwidth*.5)-(int(lmsg * .5)))-2)\
int(scrheight*.5)+1 int(scrwidth*.5)+(int(lmsg*.5)+1) 7 1
SCREEN PRINT  int(scrheight*.5)  int(scrwidth*.5)-int(lmsg *.5) 15 1 $$fct
$$fct = " "
end function


'*************************************************************************
' displays flag in center of the screen screen with message passed from $$fct
'*************************************************************************
function flag()
local lmsg
$$fct = "  "|$$fct|"  "
lmsg = int(len($$fct))
REPAINT OFF
SCREEN CLEAR BOX int(scrheight*.5)-1 (int(int(scrwidth*.5)-(int(lmsg * .5)))-2)\
int(scrheight*.5)+1 int(scrwidth*.5)+(int(lmsg*.5)+1) 7 1
SCREEN DRAW BOX int(scrheight*.5)-1 (int(int(scrwidth*.5)-(int(lmsg * .5)))-2)\
int(scrheight*.5)+1 int(scrwidth*.5)+(int(lmsg*.5)+1) 7 1
SCREEN PRINT  int(scrheight*.5)  int(scrwidth*.5)-int(lmsg *.5) 15 1 $$fct
$$fct = " "
end function