home *** CD-ROM | disk | FTP | other *** search
/ DTP Toolbox / DTPToolbox.iso / propage4.0 / arexx / makebarchart_vert.pprx < prev    next >
Encoding:
Text File  |  1992-07-19  |  3.6 KB  |  170 lines
  1. /*@BMakeBarChart_Vert  @P@ICopyright Michael S. Fahrion. Jan., 1992
  2. Makes a simple vertical bar chart from data entered by the user.
  3. (This version debugged/enhanced by Don Cox).
  4. */
  5. numeric digits 8
  6. cr = '0a'x
  7. call SafeEndEdit.rexx()
  8. call ppm_AutoUpdate(0)
  9. call ppm_NewGroup()
  10.  
  11. units = ppm_GetUnits()
  12. call ppm_SetUnits(1)
  13.  
  14. signal on halt
  15. signal on break_c
  16. signal on break_e
  17. signal on break_d
  18.  
  19. box = ppm_ClickOnBox("Click on box to make chart..")
  20.  
  21. if box = 0 then
  22. do
  23.     call ppm_Inform(1, "No box selected",)
  24.     call ppm_ClearStatus()
  25.     exit
  26. end
  27.  
  28. /*  extract box attributes  */
  29. boxsize = ppm_GetBoxSize(box)
  30. boxpos = ppm_GetBoxPosition(box)
  31.  
  32. if ppm_Inform(2, "Delete box?",) = 1 then call ppm_DeleteBox(box)
  33.  
  34. boxwidth = word(boxsize, 1)
  35. boxheight = word(boxsize, 2)
  36. boxleft = word(boxpos, 1)
  37. boxtop = word(boxpos, 2)
  38. /*trace(results)*/
  39.  
  40. nmbars = GetUserText(4, "Number of Bars")
  41. if nmbars > 12 then exit_msg("Max number of bars is 12")
  42.  
  43. form = ' Bar 1' 
  44. do x = 2 while x <= nmbars 
  45.   form = form cr 'Bar' x
  46. end
  47. form = form cr 'Top scale #'
  48.  
  49. form = ppm_GetForm("Chart Data",6,form)
  50. if form = "" then exit_msg("Operation Cancelled")
  51.  
  52. x = 1
  53. do forever
  54.   parse var form bdata.x '0a'x form
  55.   if bdata.x = "" then leave
  56.   x = x + 1
  57. end
  58. tchart = nmbars + 1
  59. topchart = bdata.tchart
  60.  
  61. form = ' Bar label 1'
  62. do x = 2 while x <= nmbars
  63.   form = form cr 'Bar label' x
  64. end
  65.  
  66. form = ppm_GetForm("Chart Label",8,form)
  67. if form = "" then exit_msg("Operation Cancelled")
  68.  
  69. x = 1
  70. do forever
  71.   parse var form blabel.x '0a'x form
  72.   if bdata.x = "" then leave
  73.   x = x + 1
  74. end
  75.  
  76. facelist = ppm_GetTypeFaceList()
  77. facelist = substr(facelist, pos('0a'x, facelist) +1) /*strip off the number*/
  78. face = ppm_SelectFromList("Select Typeface",32,18,0,facelist)
  79.  
  80. /* Draw background chart and grid lines */
  81.  
  82. barbottom = boxtop + boxheight
  83.  
  84. call ppm_ShowStatus("Creating Chart Grid")
  85. linespace = boxheight / 10
  86. yline = linespace + boxtop
  87.  
  88. call ppm_SetLineWeight(.5)
  89. do 9
  90.   call ppm_DrawLine(boxleft, yline, boxleft + boxwidth, yline)
  91.   yline = yline + linespace
  92.   call ppm_AddToGroup()
  93. end
  94.  
  95. call ppm_SetLineWeight(1)
  96. call ppm_SetFillPattern(0)
  97. call ppm_DrawRect(boxleft, boxtop, boxleft + boxwidth, boxtop + boxheight)
  98. call ppm_AddToGroup()
  99.  
  100. call ppm_MergeGroup()
  101.  
  102. /* add chart numbers */
  103.  
  104. call ppm_SetFont(face)
  105. call ppm_SetSize(10)
  106. call ppm_SetStyle(N)
  107. call ppm_SetJustification(1)
  108.  
  109. bleft = boxleft - .55
  110. btop = boxtop - .01
  111. ctext = topchart
  112. ctextadjust = topchart / 10
  113. i = 1
  114.  
  115. do 11
  116.   cbox = ppm_CreateBox(bleft, btop, .5, .25, 0)
  117.   btop = btop + linespace
  118.   call ppm_TextIntoBox(cbox, ctext)
  119.   ctext = topchart - (ctextadjust * i)
  120.   i = i + 1
  121. end
  122.  
  123. /* Draw chart bars and put on labels */
  124.  
  125. barcalc = boxheight / topchart
  126. barspace = (nmbars + 1) * .125
  127. barwidth = (boxwidth - barspace) / nmbars
  128. barpos = boxleft + .125
  129. call ppm_SetFillPattern(5)
  130. call ppm_SetJustification(2)
  131. call ppm_SetLineSpacing(2,100)
  132. i = 1
  133.  
  134. do nmbars
  135.   call ppm_ShowStatus("Working on bar:" i)
  136.   barheight = bdata.i * barcalc
  137.   bartop = barbottom - barheight
  138.   call ppm_DrawRect(barpos, bartop, barpos + barwidth, barbottom)
  139.   
  140.   cbox = ppm_CreateBox(barpos, barbottom + .03, barwidth, .4, 0)
  141.   call ppm_TextIntoBox(cbox, upper(blabel.i))
  142.   cbox = ppm_CreateBox(barpos, bartop - .2, barwidth, .15, 0)
  143.   call ppm_SetBoxTransparent(cbox, 0)
  144.   call ppm_TextIntoBox(cbox, bdata.i)
  145.   barpos = barpos + barwidth + .125
  146.   i = i + 1
  147. end
  148.  
  149. exit_msg("Done")
  150. break_d:
  151. break_e:
  152. break_c:
  153. halt:
  154.     call exit_msg("User aborted Genie!")
  155.  
  156. exit_msg: procedure expose units
  157. do
  158.    parse arg message
  159.  
  160.     call ppm_ClearStatus()
  161.  
  162.    if message ~= '' then
  163.        call ppm_Inform(1, message,)
  164.  
  165.    call ppm_SetUnits(units)
  166.    call ppm_ClearStatus()
  167.    call ppm_AutoUpdate(1)
  168.    exit
  169. end
  170.