' ********************************************************************************
' Program: PICTURE.PF3
' ********************************************************************************
' Functions used to associate a picture with a database record

global #bmp_lib

public picture_field()
public draw_text()
public show_pict()
public pic_db_event()

' APPLIBHU Externals
external choose_font()

' ANGOSS Externals
external $$homedir $$dirsep ##comfg ##combg
external display_message()
external app_event()
external module_event()

main
	"@(#)picture.pf3	3.2 - 95/02/11" '	SID
end main

' ************************************************
function picture_field($field,$id)
' ************************************************
local #row #col
	#row = dbfldinfo("["|$field|"]",dbf_startrow)
	#col = dbfldinfo("["|$field|"]",dbf_startcol)
	show_pict(#row+1,#col,$id)
	return blank
end function

' ************************************************
function show_pict(#row,#col,$id)
' ************************************************
local #x #y $b $file
	if sysvar($_paint)=0 or dbinfo(db_browse) or\
		(dbinfo(db_enter) and dbinfo(db_recalc)) or \
		(sysvar($_os)<>4 and sysvar($_os)<>5) ' Windows & X11 Only
		return blank
	end if
	$file = $$homedir|"pictures"|$$dirsep|$id|".bmp"
	if file($file)
		#x = charinfo(char_col_to_x,#col)
		#y = charinfo(char_row_to_y,#row+1)
		graphics bmplib read #bmp_lib $id $b direct
		if bmpinfo(bmp_ncolors,$b)>16
			graphics bitmap draw $b #x+3 #y+3
		else
			graphics bitmap draw $b #x+3 #y+3 remap
		end if
		graphics set foreground c_blue
		graphics set line-width 2
		graphics draw rectangle #x #y #x+bmpinfo(bmp_width,$b)+6 #y+bmpinfo(bmp_height,$b)+6
	else
		screen print #row+1 #col 15 0 "No Picture"
	end if
	return blank
end function

' ************************************************
function draw_text($field,#color,$str,#rows)
' ************************************************
local #row #col #dots_high #points #inches

	#row = dbfldinfo("["|$field|"]",dbf_startrow)
	#col = dbfldinfo("["|$field|"]",dbf_startcol)

	if (sysvar($_os)<>4 and sysvar($_os)<>5) ' Windows & X11 Only
		screen print #row #col #color 1 $str
		return blank
	end if
	if sysvar($_paint)=0 or dbinfo(db_browse) or \
		(dbinfo(db_enter) and dbinfo(db_recalc))
		return blank
	end if
	#dots_high = #rows * charinfo(char_h)
	' 1 point = 1/72 inch
	#inches = #dots_high / gr_ydpi
	#points = #inches * 72
	choose_font(#points * .8)
	graphics set foreground #color
	graphics draw text \
		charinfo(char_col_to_x,#col+1) \
		charinfo(char_row_to_y,#row)+gr_textascent \
		$str
	return blank
end function

' ************************************************************
function pic_db_event(#key,#mnu,#choice,#mode,$data1,$data2)
' ************************************************************
local $g #retval

	if NOT(sysvar($_os)=4 or sysvar($_os)=5) ' Not Windows or X11
		' Process event normally
		return module_event(#key,#mnu,#choice,#mode,$data1,$data2)
	elseif #key={MenuInit} ' Initialize
		if gr_mode<>2
			graphics open screen
		end if
		graphics bmplib open #bmp_lib $$homedir|"pictures" constant
		screen clear box scrheight-3 1 scrheight scrwidth ##comfg ##combg no-border
		repaint on
		repaint
		recalc ' This draws the graphics (called from calculated fields)
'                data goto record next 'the data goto's repaint big text when recalc throws into browze
'                data goto record previous

	elseif #key={MenuSelect}
		' User selected menu item, call application event handler
		#retval = app_event(#key,#mnu,#choice,#mode,$data1,$data2)
		if #retval = 1 ' A command of some sort
		'	recalc ' This draws the graphics (called from calculated fields)
                        data goto record next
                        data goto record previous
			screen clear box scrheight-3 1 scrheight-2 scrwidth ##comfg ##combg no-border
		elseif #retval = 2 ' Terminating
			graphics bmplib close #bmp_lib
		end if
		' Note: The above code segment is required so the screen
		' can be repaint correctly after order, is changed or
		' field values changed, etc.
		return #retval
	elseif #key = {f10} or #key={esc}
		graphics bmplib close #bmp_lib
		return module_event(#key,#mnu,#choice,#mode,$data1,$data2)
	else
		return module_event(#key,#mnu,#choice,#mode,$data1,$data2)
	end if
	return 1 ' This event was handled
end function