'JD BUSINESS SOLUTIONS INC.
'DALE WEBER
'935 PLUM STREET
'LINCOLN, NE 68502
'402 475 2262
'AUGUST 24, 1996
'Revised February 17, 2002
'======================================================================
'ELECTRONIC CALENDAR - A POP UP CALENDAR FOR USE WITH CUSTOM VIEWS AND PROJECTS
'
'
'
'CREDIT TO LAWRENCE SOBILO
'3L DEVELOPMENT CORP
'628 SOUTH STREET
'MUNSTER, IN 46321
'SMART TIMES AUGUST 1991
'======================================================================
public electronicalendar()
'public wincal() 'Remove this comment if used as a function call in db field calculation
public weekday(1)
public menukeys(1)
public FG, BG $pp
public $keypress, $currow, $oldday, $dispday, $dispmonth, $dispyear, $currmonth
public $curryear, $n $dispdate, $nextmonth, $numdays, $dayofweek, $dispmname
public $datestring $module $choice
public daysmon[31,2] movecal() draw_cal()
public $sb $sb_bmp $l_arrow $l_arrowo $r_arrow $r_arrowo
public $calx1 $caly1 $calx2 $caly2 $calwidth $calheight
public $helpbmp $calbmp $move $buty1 $keyhelpbmp $contsave
public $x1 $y1 $x2 $y2 $border $calx_dif $caly_dif
public $red $green $blue $color_change
public $graph_set $lstkey
public help_frame() gr_cal_help()
public $hx1 $hx2 $hy1 $hy2 $ctr $textstr $spacer $ctr1
public $editstr $line_length $image
public frame(4)
public setrgb()
'================================================================================
'function wincal() 'Remove this comment if used as a function call in a db field
main 'Comment out main if used as function call in a db field
quiet on
if not(gr_mode = 2)
	graphics open screen
end if
graphics bitmap save $image 0 0 gr_x2 gr_y2
electronicalendar()
smartpeek $_modl $module
if $module = 1
	evaluate("window border")
	evaluate("window border")
end if
if not($datestring = null or $module = 0 or $datestring = 0 or $datestring = blank)
	clear $pp
	if $module = 3
		return days($datestring)
	end if
	let $datestring = replacestr(date1($datestring)," ",chr(255)) & replacestr(date2($datestring)," ",chr(255)) & replacestr(date3($datestring)," ",chr(255)) & "cancel"
	screen clear box scrheight/2-3 scrwidth/2-12 scrheight/2+2 scrwidth/2+10 15 1
	menukeys("+")
	screen menu scrheight/2-2 scrwidth/2-11 scrheight/2+1 scrwidth/2+9 15 1 1 15 1 $datestring $pp
	menukeys("clear")
	$datestring = group($datestring,$pp)
	if not($datestring = "cancel")
		if $module = 1
			let $module = "rc"
			evaluate("let rc = $datestring")
		elseif $module = 2
			evaluate "wpput($datestring)"
		end if
	end if
else
	return blank
end if

'end function 'wincal() 'Remove this comment if used as a function call in a db fieled
end main 'Comment out end main if used as a function call in a db field
'================================================================================

'----------------------------------------------------------------------
function electronicalendar()
'----------------------------------------------------------------------
local $sys
mouseinfo(m_cursoron,1)
'let $barside = ""
f1help off
if not(gr_mode = 2)
	graphics open screen
end if
'graphics palette restore
smartpeek ($_os) $sys
if $sys = 5
	graphics set text-font gr_fontopen("Times New Roman",(charinfo(char_h)),1)
else
	graphics set text-font gr_fontopen("SFF-Standard",20,0)
end if
graphics set save $graph_set
graphics set foreground 12
graphics set background 0
draw_cal()
FG = 0
BG = 7

$dispmonth = month(today)
$dispyear = YEAR(TODAY)
$dispday = DAY(TODAY)
$keypress = BLANK


'SET UP DAYS IN THE MONTH, START WITH CURRENT MONTH.

while true
label redraw

    $dispdate = str($dispmonth)|"/01/"|str($dispyear)
    $nextmonth = str(@if($dispmonth<12,$dispmonth+1,1))|"/01/"|str(@if($dispmonth=12,$dispyear+1,$dispyear))

    $numdays =  DATE($nextmonth) - DATE($dispdate)
    $dayofweek = weekday($dispdate)
    $dispmname = monthname($dispdate)

'WHEN SWITCHING TO PRIOR MONTH, CALCULATE DISPLAY DAY.

	case $keypress
	when {LEFT}
		$dispday = $numdays
	when {1}
        	$dispday = $numdays
	when {UP}
		$dispday = $numdays + $dispday
	when {3}
		$dispday = $numdays + $dispday
	otherwise
	end case

'SET UP AN ARRAY FOR EACH DAY OF THE MONTH. ARRAY HAS 2 VALUES
'THE DAY OF THE WEEK (1 THRU 7), AND THE ROW IT IS TO BE DISPLAYED
'ON.  WHEN THE DAY OF THE WEEK IS 7, START A NEW ROW.

    $currow = charinfo(char_y_to_row,$caly1+(charinfo(char_h)*4.7))
    for $n = 1 to $numdays
      daysmon[$n,1] = $dayofweek
      daysmon[$n,2] = $currow
      if $dayofweek = 7
       $dayofweek = 1
       $currow = ($currow + 1)
      else
       $dayofweek = ($dayofweek + 1)
      end if
    end for


'DISPLAY THE DAYS OF THE MONTH IN THE CALENDAR.

	button finished
	button init 0 7
	graphics bitmap draw $calbmp $calx1-$border $caly1-$border
	for $n = 1 to $numdays

	$buty1 = charinfo(char_x_to_col,$calx1+(charinfo(char_w)*5))
	clearerror
	error off

	case $n
		when 1
			button create auto-size daysmon[$n,2] $buty1+((daysmon[$n,1]-1)*3) {�} str($n)
		when 2
			button create auto-size daysmon[$n,2] $buty1+((daysmon[$n,1]-1)*3) {�} str($n)
		when 3
			button create auto-size daysmon[$n,2] $buty1+((daysmon[$n,1]-1)*3) {�} str($n)
		when 4
			button create auto-size daysmon[$n,2] $buty1+((daysmon[$n,1]-1)*3) {�} str($n)
		when 5
			button create auto-size daysmon[$n,2] $buty1+((daysmon[$n,1]-1)*3) {�} str($n)
		when 6
			button create auto-size daysmon[$n,2] $buty1+((daysmon[$n,1]-1)*3) {�} str($n)
		when 7
			button create auto-size daysmon[$n,2] $buty1+((daysmon[$n,1]-1)*3) {�} str($n)
		when 8
			button create auto-size daysmon[$n,2] $buty1+((daysmon[$n,1]-1)*3) {�} str($n)
		when 9
			button create auto-size daysmon[$n,2] $buty1+((daysmon[$n,1]-1)*3) {�} str($n)
		when 10
			button create auto-size daysmon[$n,2] $buty1+((daysmon[$n,1]-2)*3)+2 {�} str($n)
		when 11
			button create auto-size daysmon[$n,2] $buty1+((daysmon[$n,1]-2)*3)+2 {�} str($n)
		when 12
			button create auto-size daysmon[$n,2] $buty1+((daysmon[$n,1]-2)*3)+2 {�} str($n)
		when 13
			button create auto-size daysmon[$n,2] $buty1+((daysmon[$n,1]-2)*3)+2 {�} str($n)
		when 14
			button create auto-size daysmon[$n,2] $buty1+((daysmon[$n,1]-2)*3)+2 {�} str($n)
		when 15
			button create auto-size daysmon[$n,2] $buty1+((daysmon[$n,1]-2)*3)+2 {�} str($n)
		when 16
			button create auto-size daysmon[$n,2] $buty1+((daysmon[$n,1]-2)*3)+2 {�} str($n)
		when 17
			button create auto-size daysmon[$n,2] $buty1+((daysmon[$n,1]-2)*3)+2 {�} str($n)
		when 18
			button create auto-size daysmon[$n,2] $buty1+((daysmon[$n,1]-2)*3)+2 {�} str($n)
		when 19
			button create auto-size daysmon[$n,2] $buty1+((daysmon[$n,1]-2)*3)+2 {�} str($n)
		when 20
			button create auto-size daysmon[$n,2] $buty1+((daysmon[$n,1]-2)*3)+2 {�} str($n)
		when 21
			button create auto-size daysmon[$n,2] $buty1+((daysmon[$n,1]-2)*3)+2 {�} str($n)
		when 22
			button create auto-size daysmon[$n,2] $buty1+((daysmon[$n,1]-2)*3)+2 {�} str($n)
		when 23
			button create auto-size daysmon[$n,2] $buty1+((daysmon[$n,1]-2)*3)+2 {�} str($n)
		when 24
			button create auto-size daysmon[$n,2] $buty1+((daysmon[$n,1]-2)*3)+2 {�} str($n)
		when 25
			button create auto-size daysmon[$n,2] $buty1+((daysmon[$n,1]-2)*3)+2 {�} str($n)
		when 26
			button create auto-size daysmon[$n,2] $buty1+((daysmon[$n,1]-2)*3)+2 {�} str($n)
		when 27
			button create auto-size daysmon[$n,2] $buty1+((daysmon[$n,1]-2)*3)+2 {�} str($n)
		when 28
			button create auto-size daysmon[$n,2] $buty1+((daysmon[$n,1]-2)*3)+2 {�} str($n)
		when 29
			button create auto-size daysmon[$n,2] $buty1+((daysmon[$n,1]-2)*3)+2 {�} str($n)
		when 30
			button create auto-size daysmon[$n,2] $buty1+((daysmon[$n,1]-2)*3)+2 {�} str($n)
		when 31
			button create auto-size daysmon[$n,2] $buty1+((daysmon[$n,1]-2)*3)+2 {�} str($n)
	end case
     end for
	button create xy $calx1+3 $caly1+(charinfo(char_h)*.5) $calx1+(4+charinfo(char_w)) $caly1+(charinfo(char_h)*1.16) {PgUp} '" PREVIOUS MONTH "
	button create xy $calx2-(charinfo(char_w)+5) $caly1+(charinfo(char_h)*.5) $calx2-(charinfo(char_w)*.3) $caly1+(charinfo(char_h)*1.15) {PgDn} '" NEXT MONTH "
	button create xy $calx1+4 $caly2-(charinfo(char_h)*1.5) $calx1+(4+charinfo(char_w)) $caly2-(charinfo(char_h)*.5) {^PgUp} '" PREVIOUS YEAR "
	button create xy $calx2-(charinfo(char_w)+5) $caly2-(charinfo(char_h)*1.5) $calx2+(charinfo(char_w)*.3) $caly2-(charinfo(char_h)*.5) {^PgDn} '" NEXT YEAR "
	button create xy $calx1+(charinfo(char_w)*6.5) $caly1+gr_textheight $calx1+(charinfo(char_w)*6.5+gr_text_width("M")) $caly1+gr_textheight*1.8 {M} '" MOVE "

repaint on
button draw all

'DISPLAY THE MONTH AND YEAR ON THE FIRST/LAST LINES OF CALENDAR
graphics set foreground 12
if $sys = 5
	graphics draw text (($calx1+($calx_dif/2))-(gr_text_width($dispmname)/2)) $caly1+(gr_textheight*.7) $dispmname
	graphics draw text (($calx1+($calx_dif/2))-(gr_text_width(str($dispyear))/2)) $caly1+(bmpinfo(0,$calbmp)-gr_textheight*.6) str($dispyear)
else
	graphics draw text ($calx1+(90-charinfo(char_col_to_x,(len($dispmname)/2)))) $caly1+22 $dispmname
	graphics draw text $calx1+82 $caly1+175 str($dispyear)
end if


'PROCESS KEYS, HIGHLIGHTING APPROPRIATE DAY.

    $currmonth = $dispmonth
    $curryear = $dispyear
    while $currmonth = $dispmonth AND $curryear = $dispyear
      $oldday = $dispday
	if len(str($dispday)) = 1
		screen print daysmon[$dispday,2] $buty1+((daysmon[$dispday,1]-1)*3) BG FG format "0M1" $dispday
	else
		screen print daysmon[$dispday,2] $buty1+((daysmon[$dispday,1]-2)*3)+2 BG FG format "0M2" $dispday
	end if
	clearerror
	error on

      $keypress = inevent
	 smartpeek ($_lastkey) $lstkey
		if $lstkey = 61964 '= LeftDoubleUp
			f1help on
			button finished
			repaint
	          $datestring = str($dispmonth)|"/"|str($dispday)|"/"|str($dispyear)
			return $datestring
		end if
      case $keypress
       when {ESC}
		f1help on
		button finished
		repaint
		let $datestring = null
          return $datestring
       when {ENTER}
		f1help on
		button finished
		repaint
          $datestring = str($dispmonth)|"/"|str($dispday)|"/"|str($dispyear)
		return $datestring
       when {LeftDoubleUp}
		f1help on
		button finished
		repaint
          $datestring = str($dispmonth)|"/"|str($dispday)|"/"|str($dispyear)
		return $datestring
       when {Left}
          $dispday = ($dispday - 1)
	when {1}		'Previous Day - Button On SideBar
          $dispday = ($dispday - 1)

	when {Right}
          $dispday = ($dispday + 1)

	when {2}		'Next Day - Button On SideBar
          $dispday = ($dispday + 1)

	when {Up}	'Previous Week
          $dispday = ($dispday - 7)

	when {3}		'Previous Week - Button On SideBar
          $dispday = ($dispday - 7)

	when {Down}	'Next Week
          $dispday = ($dispday + 7)

	when {4}		'Next Week - Button On SideBar
          $dispday = ($dispday + 7)

	when {PgUp}	'Previous Month - Button On Calendar
		mouseinfo(m_cursoron,0)
		graphics set text-font font_dingbat2
		graphics set text-height charinfo(char_h)
		graphics set foreground 1
		graphics draw text $calx1+3 $caly1+(charinfo(char_h)*1.15) chr(206)
		graphics set restore $graph_set
		milli-wait 100
'		graphics bitmap draw $calbmp $calx1-$border $caly1-$border
		mouseinfo(m_cursoron,1)
		$dispmonth = ($dispmonth - 1)

	when {5}	'Previous Month Button On SideBar
          $dispmonth = ($dispmonth - 1)

	when {PgDn}	'Next Month - Button On Calendar
		mouseinfo(m_cursoron,0)
		graphics set text-font font_dingbat1
		graphics set text-height charinfo(char_h)
		graphics set foreground 1
		graphics draw text $calx2-(charinfo(char_w)+6) $caly1+(charinfo(char_h)*1.14) chr(234)
		graphics set restore $graph_set
		milli-wait 100
		mouseinfo(m_cursoron,1)
		$dispmonth = ($dispmonth + 1)

	when {6}	'Next Month - Button On SideBar
          $dispmonth = ($dispmonth + 1)

	when {Home}	'First Day Of Month
          $dispday = 1

	when {End}	'Last Day of Month
          $dispday = $numdays

	when {^Home}	'First Month of Current Year
          $dispmonth = 1

	when {^End}	'Last Month of Current Year
          $dispmonth = 12

	when {^PgUp}	'Go To One Year Previous - Button On Calendar
		mouseinfo(m_cursoron,0)
		graphics set text-font font_dingbat2
		graphics set text-height charinfo(char_h)
		graphics set foreground 1
		graphics draw text $calx1+3 $caly2-(charinfo(char_h)*.5) chr(206)
		graphics set restore $graph_set
		milli-wait 100
		mouseinfo(m_cursoron,1)
          $dispyear = ($dispyear - 1)

	when {7}		'Go To One Year Previous - Button On SideBar
          $dispyear = ($dispyear - 1)

	when {8}		'Go To One Year Forward - Button On SideBar
          $dispyear = ($dispyear + 1)

	when {^PgDn}	'Go To One Year Forward - Button On Calendar
		mouseinfo(m_cursoron,0)
		graphics set text-font font_dingbat1
		graphics set text-height charinfo(char_h)
		graphics set foreground 1
		graphics draw text $calx2-(charinfo(char_w)+6) $caly2-(charinfo(char_h)*.5) chr(234)
		graphics set restore $graph_set
		milli-wait 100
		mouseinfo(m_cursoron,1)
          $dispyear = ($dispyear + 1)

	when {^Left}	'Go To First Day Of Week
          $dispday = $dispday - (daysmon[$dispday,1]-1)
          if $dispday < 1
             $dispday = 1
          end if

	when {^Right}	'Go To Last Day of Week
          $dispday = $dispday + (7-daysmon[$dispday,1])
          if $dispday > $numdays
             $dispday = $numdays
          end if

	when {M}		'This is the `M' (Monday) Button on Calendar
		mouseinfo(m_cursoron,0)
		graphics set foreground 8
		graphics draw text $calx1+(charinfo(char_w)*6.5) $caly1+gr_textheight*1.8 "M"
		graphics set restore $graph_set
		mouseinfo(m_cursoron,1)
		movecal()
		graphics bitmap draw $image 0 0
		jump redraw

	when {S}		'Switches SideBar from Side To Side - Button On SideBar
		jump redraw

	when {^S}		'Turns SideBar ON/OFF (Toggle) - Button On Calendar (Sunday)
		jump redraw

	when {F1}		'Calendar Help Prompts
		mouseinfo(m_cursoron,0)
		graphics bitmap save $contsave gr_x1 gr_y1 gr_x2 gr_y2
		gr_cal_help()
		mouseinfo(m_cursoron,1)
		inevent
		mouseinfo(m_cursoron,0)
		graphics bitmap draw $contsave gr_x1 gr_y1
		mouseinfo(m_cursoron,1)
     end case
key name $keypress $pp
$dispday = case $pp("�",1)("�",2)("�",3)("�",4)("�",5)("�",6)("�",7)("�",8)("�",9)("�",10)("�",11)("�",12)("�",13)("�",14)("�",15)("�",16)("�",17)("�",18)("�",19)("�",20)("�",21)("�",22)("�",23)("�",24)("�",25)("�",26)("�",27)\
("�",28)("�",29)("�",30)("�",31) else $dispday
'screen print 1 1 15 4 format("m"|str(SCRWIDTH)) $pp & str($dispday)
'Above displays the key press on the screen for debugging purposes during developement

'SWITCH TO PREVIOUS MONTH OR YEAR.

     if $dispday < 1
        if $dispmonth > 1
           $dispmonth = ($dispmonth - 1)
        else
           $dispmonth = 12
           $dispyear = ($dispyear - 1)
        end if
     end if
     if $dispday > $numdays
        if $dispmonth < 12
           $dispmonth = ($dispmonth + 1)
        else
           $dispmonth = 1
           $dispyear = ($dispyear + 1)
        end if
        $dispday = 1
     end if
     if $dispmonth < 1
        $dispmonth = 12
        $dispyear = ($dispyear - 1)
     end if
     if $dispmonth > 12
        $dispmonth = 1
        $dispyear = ($dispyear + 1)
     end if

' REMOVE HIGHLIGHT OF DISPLAY DAY. NEXT PASS THROUGH THE LOOP WILL
' HIGHLIGHT A NEW ( OR SAME) DAY.
clearerror
error off
	if len(str($oldday)) = 1
		screen print daysmon[$oldday,2] $buty1+((daysmon[$oldday,1]-1)*3) FG BG format "0M1" $oldday
	else
		screen print daysmon[$oldday,2] $buty1+((daysmon[$oldday,1]-2)*3)+2 FG BG format "0M2" $oldday
	end if

   end while
 end while
clearerror
error on
end function 'electrinicalendar()
'----------------------------------------------------------------------


'----------------------------------------------------------------------
function weekday(daystr)
case dayname(daystr)
    when "Sunday"
     return 1
    when "Monday"
     return 2
    when "Tuesday"
     return 3
    when "Wednesday"
     return 4
    when "Thursday"
     return 5
    when "Friday"
     return 6
    when "Saturday"
     return 7
end case
end function 'weekday()
'----------------------------------------------------------------------


'----------------------------------------------------------------------
function movecal()
'----------------------------------------------------------------------
local $control $cal
$control = inevent
clearerror
error off
button finished
'repaint
while true
  while mouseinfo(m_leftdown)
	let $calx1 = mouseinfo(m_x)
	let $caly1 = mouseinfo(m_y)
  end while
  if mouseinfo(m_leftup)
	let $calx1 = mouseinfo(m_x)
	let $caly1 = mouseinfo(m_y)
'	screen clear box scrheight-4 1 scrheight scrwidth 0 0 NO-BORDER
     exit while
  end if
end while
clearerror
error on
let $calx2 = ($calx1+$calx_dif)
let $caly2 = ($caly1+$caly_dif)
return
end function 'movecal()
'----------------------------------------------------------------------


'---------------------------------------------------------------------------
function draw_cal()
if not(gr_mode = 2)
	graphics open screen
end if

let $calwidth = charinfo(char_w)*len("20 21 22 23 24 25 26 ")+50
let $calheight = charinfo(char_h)*12
let $border = charinfo(char_w)*.81

let $calx1 = gr_x2/2-($calwidth/2)
let $caly1 = gr_y2/2-($calheight/2)
let $calx2 = gr_x2/2+($calwidth/2)
let $caly2 = gr_y2/2+($calheight/2)


let $calx_dif = ($calx2-$calx1)
let $caly_dif = ($caly2-$caly1)
graphics set foreground 7
graphics set fill-type fill_solid
graphics fill rectangle $calx1 $caly1 $calx2 $caly2
frame($calx1-10,$caly1-10,$calx2+10,$caly2+10)

graphics set text-font gr_fontopen("Times New Roman",(charinfo(char_h)),1)

graphics set foreground 15
graphics draw line $calx1+2 $caly1+gr_textheight $calx2-1 $caly1+gr_textheight
graphics set foreground 8
graphics draw line $calx1+2 $caly1+gr_textheight+1 $calx2-1 $caly1+gr_textheight+1

graphics set foreground 15
graphics draw line $calx1+2 $caly1+gr_textheight*2 $calx2-1 $caly1+gr_textheight*2
graphics set foreground 8
graphics draw line $calx1+2 $caly1+gr_textheight*2+1 $calx2-1 $caly1+gr_textheight*2+1


graphics set foreground 15
graphics draw line $calx1+2 $caly2-gr_textheight $calx2-1 $caly2-gr_textheight
graphics set foreground 8
graphics draw line $calx1+2 $caly2-gr_textheight+1 $calx2-1 $caly2-gr_textheight+1



'==========================================================================
'Draw Day Names Onto Calendar
graphics set foreground 0
graphics set text-font gr_fontopen("Times New Roman",charinfo(char_h),1)
graphics draw text $calx1+(charinfo(char_w)*3.3) $caly1+gr_textheight*1.8 "S"
graphics set foreground 9
graphics draw text $calx1+(charinfo(char_w)*6.5) $caly1+gr_textheight*1.8 "M"
graphics set foreground 0
graphics draw text $calx1+(charinfo(char_w)*9.9) $caly1+gr_textheight*1.8 "T"
graphics draw text $calx1+(charinfo(char_w)*12.3) $caly1+gr_textheight*1.8 "W"
graphics draw text $calx1+(charinfo(char_w)*15) $caly1+gr_textheight*1.8 "Th"
graphics draw text $calx1+(charinfo(char_w)*19) $caly1+gr_textheight*1.8 "F"
graphics draw text $calx1+(charinfo(char_w)*22) $caly1+gr_textheight*1.8 "S"
'==========================================================================
'Draw Arrows for buttons Onto the Calendar
graphics set text-font font_dingbat2
graphics set text-height charinfo(char_h)
graphics set foreground 9
graphics draw text $calx1+4 $caly1+(charinfo(char_h)*1.15) chr(206)
graphics draw text $calx1+4 $caly2-(charinfo(char_h)*.5) chr(206)
graphics set text-font font_dingbat1
graphics draw text $calx2-(charinfo(char_w)+5) $caly1+(charinfo(char_h)*1.15) chr(234)
graphics draw text $calx2-(charinfo(char_w)+5) $caly2-(charinfo(char_h)*.5) chr(234)


'graphics bitmap save $calbmp $calx1-(charinfo(char_w)*.5) $caly1-(charinfo(char_w)*.5) $calx2+(charinfo(char_w)*.5) $caly2+(charinfo(char_w)*.5)
graphics bitmap save $calbmp $calx1-10 $caly1-10 $calx2+10 $caly2+10
graphics window cursor cursor_default
graphics set restore $graph_set
return
end function 'draw_cal()
'---------------------------------------------------------------------------

'-------------------------------------------------------------------------
function gr_cal_help()
'graphics set text-font gr_fontopen("Courier New",charinfo(char_h)*.7,0)
'graphics set text-font gr_fontopen("Arial",charinfo(char_h)*.8,0)
graphics set text-font gr_fontopen("Times New Roman",charinfo(char_h)*.6,0)

let $line_length = gr_x2*.33
let $hx1 = gr_x2*.33
let $hx2 = $hx1+$line_length
let $hy1 = gr_y1+(gr_textheight*4)
if sysvar($_modl) = 3
	let $hy2 = (gr_textheight*23)
elseif sysvar($_modl) = 3
	let $hy2 = (gr_textheight*24)
elseif sysvar($_modl) < 3
	let $hy2 = (gr_textheight*23)
else
	let $hy2 = (gr_textheight*21)
end if
graphics set foreground 7
graphics set fill-type fill_solid
graphics fill rectangle $hx1-3 $hy1 $hx2+3 $hy2
help_frame()

graphics set foreground 15
graphics draw text $hx1+($line_length/2-(gr_text_width("Electronic Calendar Quick Keys")*.5)) $hy1 "Electronic Calendar Quick Keys"
let $spacer = gr_textheight
graphics set foreground 0

for $ctr = 1 to 20 step 1
$textstr = case $ctr\
(1,"Left Arrow.Previous Day")\
(2,"Right Arrow.Next Day")\
(3,"Up Arrow.Previous Week")\
(4,"Dn Arrow.Next Week")\
(5,"PgUp.Previous Month")\
(6,"PgDn.Next Month")\
(7,"Home.1st Day Of Month")\
(8,"End.Last Day Of Month")\
(9,"Ctrl Home.1st Day Of Year")\
(10,"Ctrl End.Last Day Of Year")\
(11,"Ctrl PgUp.Previous Year")\
(12,"Ctrl PgDn.Next Year")\
(13,"Ctrl Left Arrow.1st Day Of Week")\
(14,"Ctrl Right Arrow.Last Day Of Week")\
(15,"b.Blank Field")\
(16,"Esc.Finished")\
(17,"Enter.Return Displayed Date")\
(18,"F1.This Help Screen")\
(19,"S.Toggle SideBar Sides")\
(20,"Ctrl S.Toggle SideBar On/Off")

let $ctr1 = 1
let $editstr = $textstr
	while true
		let $editstr = replacestr($editstr,".",repeat(".",$ctr1))
		if gr_text_width($editstr) >= $line_length
			exit while
		end if
		let $editstr = $textstr
		let $ctr1 = ($ctr1 + 1)
	end while
	let $textstr = replacestr($textstr,".",repeat(".",$ctr1))
		if $textstr ! "Toggle SideBar"
			exit for
'		elseif sysvar($_modl) <> 3
'			continue for
		else
			graphics draw text $hx1 $hy1+$spacer $textstr
		end if
		let $spacer = ($spacer + gr_textheight)
end for
graphics set restore $graph_set
return
end function 'gr_cal_help()
'-------------------------------------------------------------------------

'-------------------------------------------------------------------------
function help_frame()
local $y1 $y2 $x1 $x2 $ctr
local $frame_width

let $frame_width = 10
setrgb()

if not(gr_mode = 2)
	graphics open screen
end if
mouseinfo(m_cursoron,0)
clearerror
error off
$x1 = $hx1-14
$x2 = $hx2+15
$y1 = $hy1-10
$y2 = $hy1-10
'top of frame
for $ctr = 0 to $frame_width step 1
	graphics set foreground gr_rgbcolor($red,$green,$blue)
	graphics draw line $x1 $y1 $x2 $y2
	$x1 = ($x1 + 1)
	$x2 = ($x2 - 1)
	$y1 = ($y1 + 1)	
	$y2 = ($y2 + 1)
	$red = ($red + $color_change)
	$green = ($green + $color_change)
	$blue = ($blue + $color_change)
end for

setrgb()

$x1 = $hx1-14
$x2 = $hx1-14
$y1 = $hy1-10
$y2 = $hy2+10
'left side of frame
for $ctr = 0 to $frame_width step 1
	graphics set foreground gr_rgbcolor($red,$green,$blue)
	graphics draw line $x1 $y1 $x2 $y2
	$x1 = ($x1 + 1)
	$x2 = ($x2 + 1)
	$y1 = ($y1 + 1)	
	$y2 = ($y2 - 1)
	$red = ($red + $color_change)
	$green = ($green + $color_change)
	$blue = ($blue + $color_change)
end for

setrgb()

$x1 = $hx2+14
$x2 = $hx2+14
$y1 = $hy1-10
$y2 = $hy2+10
'right side of frame
for $ctr = 0 to $frame_width step 1
	graphics set foreground gr_rgbcolor($red,$green,$blue)
	graphics draw line $x1 $y1 $x2 $y2
	$x1 = ($x1 - 1)
	$x2 = ($x2 - 1)
	$y1 = ($y1 + 1)	
	$y2 = ($y2 - 1)
	$red = ($red + $color_change)
	$green = ($green + $color_change)
	$blue = ($blue + $color_change)
end for

setrgb()

$x1 = $hx1-14
$x2 = $hx2+15
$y1 = $hy2+10
$y2 = $hy2+10
'bottom of frame
for $ctr = 0 to $frame_width step 1
	graphics set foreground gr_rgbcolor($red,$green,$blue)
	graphics draw line $x1 $y1 $x2 $y2
	$x1 = ($x1 + 1)
	$x2 = ($x2 - 1)
	$y1 = ($y1 - 1)	
	$y2 = ($y2 - 1)
	$red = ($red + $color_change)
	$green = ($green + $color_change)
	$blue = ($blue + $color_change)
end for


mouseinfo(m_cursoron,1)
clearerror
error on
end function 'help_frame()
'-------------------------------------------------------------------------

'------------------------------------------------------------------------
function setrgb()
	let $color_change = .05
	$red = .1
	$green = .1
	$blue = .1
end function 'setrgb()
'------------------------------------------------------------------------

'-----------------------------------------------------------------------
function menukeys(add)
'-----------------------------------------------------------------------
if add = "+"
 key define "up" "-"
 key define "down" "+"
elseif add = "LR"
 key define "right" "+"
 key define "left" "-"
elseif add = "clear"
 key remove "up"
 key remove "down"
 key remove "left"
 key remove "right"
 tools macros clear all
end if
end function 'menukeys(1)
'-----------------------------------------------------------------------
'-------------------------------------------------------------------------------------------------
function frame($x1,$y1,$x2,$y2)
local $fred $fgreen $fblue $fctr $fchange $fset $faction
if not(gr_mode = 2)
	graphics open screen
end if
graphics set save $fset
let $fred = .3
let $fgreen = .3
let $fblue = .3
let $fchange = .1
graphics set line-type line_solid
graphics set line-width 1
for $fctr = 0 to 5 step 1
	graphics set foreground gr_rgbcolor($fred,$fgreen,$fblue)
	graphics draw rectangle $x1+$fctr $y1+$fctr $x2-$fctr $y2-$fctr
	let $fred = ($fred + $fchange)
	let $fgreen = ($fgreen + $fchange)
	let $fblue = ($fblue + $fchange)
end for
for $fctr = $fctr to 10 step 1
	graphics set foreground gr_rgbcolor($fred,$fgreen,$fblue)
	graphics draw rectangle $x1+$fctr $y1+$fctr $x2-$fctr $y2-$fctr
	let $fred = ($fred - $fchange)
	let $fgreen = ($fgreen - $fchange)
	let $fblue = ($fblue - $fchange)
end for
graphics set restore $fset
end function 'frame()
'-------------------------------------------------------------------------------------------------