home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Frozen Fish 2: PC
/
frozenfish_august_1995.bin
/
bbs
/
d09xx
/
d0925.lha
/
DonsGenies
/
DonsGenies.lha
/
Don'sGenies
/
MakeBarChart_Horz.pprx
< prev
next >
Wrap
Text File
|
1992-07-16
|
4KB
|
176 lines
/*@BMakeBarChart_Horz @P@ICopyright Michael S. Fahrion. January, 1992
Makes a simple horizontal bar chart from data entered by the user.
(This version debugged/enhanced by Don Cox.)
*/
numeric digits 8
cr = '0a'x
call SafeEndEdit.rexx()
call ppm_AutoUpdate(0)
call ppm_NewGroup()
units = ppm_GetUnits()
call ppm_SetUnits(1)
signal on halt
signal on break_c
signal on break_e
signal on break_d
box = ppm_ClickOnBox("Click on box to make chart..")
if box = 0 then
do
call ppm_Inform(1, "No box selected",)
call ppm_ClearStatus()
exit
end
/* extract box attributes */
boxsize = ppm_GetBoxSize(box)
boxpos = ppm_GetBoxPosition(box)
if ppm_Inform(2, "Delete box?",) = 1 then call ppm_DeleteBox(box)
boxwidth = word(boxsize, 1)
boxheight = word(boxsize, 2)
boxleft = word(boxpos, 1)
boxtop = word(boxpos, 2)
/* trace(results) */
nmbars = GetUserText(4, "Number of Bars")
if nmbars > 12 then exit_msg("Max number of bars is 12")
form = ' Bar 1'
do x = 2 while x <= nmbars
form = form cr 'Bar' x
end
form = form cr 'Top scale #'
form = ppm_GetForm("Chart Data",6,form)
if form = "" then exit_msg("Operation Cancelled")
x = 1
do forever
parse var form bdata.x '0a'x form
if bdata.x = "" then leave
x = x + 1
end
tchart = nmbars + 1
topchart = bdata.tchart
form = ' Bar label 1'
do x = 2 while x <= nmbars
form = form cr 'Bar label' x
end
form = ppm_GetForm("Chart Label",8,form)
if form = "" then exit_msg("Operation Cancelled")
x = 1
do forever
parse var form blabel.x '0a'x form
if blabel.x = "" then leave
x = x + 1
end
facelist = ppm_GetTypeFaceList()
facelist = substr(facelist, pos('0a'x, facelist) +1) /*strip off the number*/
face = ppm_SelectFromList("Select Typeface",32,18,0,facelist)
/* Draw background chart and grid lines */
barbottom = boxtop + boxheight
call ppm_ShowStatus("Creating Chart Grid")
linespace = boxwidth / 10
gridline = linespace + boxleft
call ppm_SetLineWeight(.5)
do 9
call ppm_DrawLine(gridline, boxtop, gridline, boxtop + boxheight)
gridline = gridline + linespace
call ppm_AddToGroup()
end
call ppm_SetLineWeight(1)
call ppm_SetFillPattern(0)
call ppm_DrawRect(boxleft, boxtop, boxleft + boxwidth, boxtop + boxheight)
call ppm_AddToGroup()
call ppm_MergeGroup()
/* add chart numbers */
call ppm_ShowStatus("Adding chart scale")
call ppm_SetFont(face)
call ppm_SetSize(10)
call ppm_SetStyle(N)
call ppm_SetJustification(2)
bleft = (boxleft + boxwidth - .25)
btop = boxtop + boxheight + .05
ctext = topchart
ctextadjust = topchart / 10
i = 1
do 11
cbox = ppm_CreateBox(bleft, btop, .5, .25, 0)
bleft = bleft - linespace
call ppm_TextIntoBox(cbox, ctext)
ctext = topchart - (ctextadjust * i)
i = i + 1
end
/* Draw chart bars */
barcalc = boxwidth / topchart
barspace = (nmbars + 1) * .125
barwidth = (boxheight - barspace) / nmbars
barpos = boxtop + .125
call ppm_SetFillPattern(5)
i = 1
do nmbars
call ppm_ShowStatus("Working on bar:" i)
barlength = bdata.i * barcalc
barlength = boxleft + barlength
call ppm_DrawRect(boxleft, barpos, barlength, barpos + barwidth)
call ppm_SetJustification(1)
cbox = ppm_CreateBox(boxleft - .53, barpos, .5, .25, 0)
call ppm_TextIntoBox(cbox, upper(blabel.i))
call ppm_SetJustification(0)
cbox = ppm_CreateBox(barlength + .05, barpos, .3, .15, 0)
call ppm_SetBoxTransparent(cbox,0)
call ppm_TextIntoBox(cbox, bdata.i)
barpos = barpos + barwidth + .125
i = i + 1
end
exit_msg("Done")
break_d:
break_e:
break_c:
halt:
call exit_msg("User aborted Genie!")
exit_msg: procedure expose units
do
parse arg message
call ppm_ClearStatus()
if message ~= '' then
call ppm_Inform(1, message,)
call ppm_SetUnits(units)
call ppm_ClearStatus()
call ppm_AutoUpdate(1)
exit
end