home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 2: PC / frozenfish_august_1995.bin / bbs / d09xx / d0925.lha / DonsGenies / FrenchGenies.lha / Rexx / HistogrammeVertical.pprx < prev    next >
Text File  |  1993-08-03  |  4KB  |  176 lines
  1. /*@BHistogrammeVertical  @P@I⌐ Michael S. Fahrion. Janvier 1992
  2. DebuggΘ et amΘliorΘ par Don Cox.
  3.  
  4. Ce Genie crΘe un histogramme vertical α partir des donnΘes fournies par l'utilisateur.
  5. */
  6.  
  7. /*@BMakeBarChart_Vert  @P@ICopyright Michael S. Fahrion. Jan., 1992
  8. Makes a simple vertical bar chart from data entered by the user.
  9. (This version debugged/enhanced by Don Cox).
  10. */
  11. numeric digits 8
  12. cr = '0a'x
  13. call SafeEndEdit.rexx()
  14. call ppm_AutoUpdate(0)
  15. call ppm_NewGroup()
  16.  
  17. units = ppm_GetUnits()
  18. call ppm_SetUnits(1)
  19.  
  20. signal on halt
  21. signal on break_c
  22. signal on break_e
  23. signal on break_d
  24.  
  25. box = ppm_ClickOnBox("Cliquez sur la boεte destinΘe α contenir l'histogramme...")
  26.  
  27. if box = 0 then
  28. do
  29.     call ppm_Inform(1, "Aucune boεte n'est sΘlectionnΘe",)
  30.     call ppm_ClearStatus()
  31.     exit
  32. end
  33.  
  34. /*  extract box attributes  */
  35. boxsize = ppm_GetBoxSize(box)
  36. boxpos = ppm_GetBoxPosition(box)
  37.  
  38. if ppm_Inform(2, "Effacer cette boεte ?",) = 1 then call ppm_DeleteBox(box)
  39.  
  40. boxwidth = word(boxsize, 1)
  41. boxheight = word(boxsize, 2)
  42. boxleft = word(boxpos, 1)
  43. boxtop = word(boxpos, 2)
  44. /*trace(results)*/
  45.  
  46. nmbars = GetUserText(4, "Nombre de donnΘes")
  47. if nmbars > 12 then exit_msg("Le nombre de donnΘes ne doit pas Ωtre supΘrieur α 12")
  48.  
  49. form = ' Valeur 1'
  50. do x = 2 while x <= nmbars
  51.   form = form cr 'Valeur' x
  52. end
  53. form = form cr 'Echelle'
  54.  
  55. form = ppm_GetForm("DonnΘes de l'histogramme",6,form)
  56. if form = "" then exit_msg("OpΘration annulΘe")
  57.  
  58. x = 1
  59. do forever
  60.   parse var form bdata.x '0a'x form
  61.   if bdata.x = "" then leave
  62.   x = x + 1
  63. end
  64. tchart = nmbars + 1
  65. topchart = bdata.tchart
  66.  
  67. form = ' LΘgende 1'
  68. do x = 2 while x <= nmbars
  69.   form = form cr 'LΘgende' x
  70. end
  71.  
  72. form = ppm_GetForm("LΘgende de l'histogramme",8,form)
  73. if form = "" then exit_msg("OpΘration annulΘe")
  74.  
  75. x = 1
  76. do forever
  77.   parse var form blabel.x '0a'x form
  78.   if bdata.x = "" then leave
  79.   x = x + 1
  80. end
  81.  
  82. facelist = ppm_GetTypeFaceList()
  83. facelist = substr(facelist, pos('0a'x, facelist) +1) /*strip off the number*/
  84. face = ppm_SelectFromList("Choix de la Police",32,18,0,facelist)
  85.  
  86. /* Draw background chart and grid lines */
  87.  
  88. barbottom = boxtop + boxheight
  89.  
  90. call ppm_ShowStatus("CrΘation de l'histogramme")
  91. linespace = boxheight / 10
  92. yline = linespace + boxtop
  93.  
  94. call ppm_SetLineWeight(.5)
  95. do 9
  96.   call ppm_DrawLine(boxleft, yline, boxleft + boxwidth, yline)
  97.   yline = yline + linespace
  98.   call ppm_AddToGroup()
  99. end
  100.  
  101. call ppm_SetLineWeight(1)
  102. call ppm_SetFillPattern(0)
  103. call ppm_DrawRect(boxleft, boxtop, boxleft + boxwidth, boxtop + boxheight)
  104. call ppm_AddToGroup()
  105.  
  106. call ppm_MergeGroup()
  107.  
  108. /* add chart numbers */
  109.  
  110. call ppm_SetFont(face)
  111. call ppm_SetSize(10)
  112. call ppm_SetStyle(N)
  113. call ppm_SetJustification(1)
  114.  
  115. bleft = boxleft - .55
  116. btop = boxtop - .01
  117. ctext = topchart
  118. ctextadjust = topchart / 10
  119. i = 1
  120.  
  121. do 11
  122.   cbox = ppm_CreateBox(bleft, btop, .5, .25, 0)
  123.   btop = btop + linespace
  124.   call ppm_TextIntoBox(cbox, ctext)
  125.   ctext = topchart - (ctextadjust * i)
  126.   i = i + 1
  127. end
  128.  
  129. /* Draw chart bars and put on labels */
  130.  
  131. barcalc = boxheight / topchart
  132. barspace = (nmbars + 1) * .125
  133. barwidth = (boxwidth - barspace) / nmbars
  134. barpos = boxleft + .125
  135. call ppm_SetFillPattern(5)
  136. call ppm_SetJustification(2)
  137. call ppm_SetLineSpacing(2,100)
  138. i = 1
  139.  
  140. do nmbars
  141.   call ppm_ShowStatus("Travail en cours sur la donnΘe : " i)
  142.   barheight = bdata.i * barcalc
  143.   bartop = barbottom - barheight
  144.   call ppm_DrawRect(barpos, bartop, barpos + barwidth, barbottom)
  145.  
  146.   cbox = ppm_CreateBox(barpos, barbottom + .03, barwidth, .4, 0)
  147.   call ppm_TextIntoBox(cbox, upper(blabel.i))
  148.   cbox = ppm_CreateBox(barpos, bartop - .2, barwidth, .15, 0)
  149.   call ppm_SetBoxTransparent(cbox, 0)
  150.   call ppm_TextIntoBox(cbox, bdata.i)
  151.   barpos = barpos + barwidth + .125
  152.   i = i + 1
  153. end
  154.  
  155. exit_msg("TerminΘ")
  156. break_d:
  157. break_e:
  158. break_c:
  159. halt:
  160.     call exit_msg("Abandon du Genie par l'utilisateur !")
  161.  
  162. exit_msg: procedure expose units
  163. do
  164.    parse arg message
  165.  
  166.     call ppm_ClearStatus()
  167.  
  168.    if message ~= '' then
  169.        call ppm_Inform(1, message,)
  170.  
  171.    call ppm_SetUnits(units)
  172.    call ppm_ClearStatus()
  173.    call ppm_AutoUpdate(1)
  174.    exit
  175. end
  176.