home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / BARGRAPH.ZIP / BARGRAPH.PRG
Encoding:
Text File  |  1993-04-12  |  6.7 KB  |  169 lines
  1. program Bargraph;  {Draw bar graphs}
  2.    uses crt, graph;
  3.  
  4. const
  5.    ArraySize     = 50;                                  {Mod. #1}
  6.    TextSize      = ArraySize;
  7.    MaxNumAxisAnn = ArraySize;
  8.  
  9. type
  10.    LineSize      = string[80];
  11.    ArrayType     = array[1..ArraySize] of real;
  12.    TextArrayType = array[1..TextSize] of LineSize;
  13.    AnnArrayType  = array[0..ArraySize] of LineSize;
  14.  
  15. var
  16.    NumArray                                     : ArrayType;
  17.    TempTextArr                                  : TextArrayType;
  18.    XTextArr, YTextArr                           : AnnArrayType;
  19.    XOrigin, YOrigin, XAxisL, YAxisL, NumTicks   : integer;
  20.    SubTicksX, SubTicksY, Count, Code, TextCount : integer;
  21.    LoYAxis, HiYAxis, NumSegsX, NumSegsY         : integer;
  22.    UpLeftX, UpLeftY, LoRightX, LoRightY, J      : integer;
  23.    ShadingType, ShadingColor, FlipFlop          : integer;
  24.    GraphDriver, GraphMode, ErrorCode            : integer;
  25.    DriverPath                                   : string;
  26.    Unused, LowestY, HighestY, WidthX, ScaleY    : real;
  27.    Depth                                        : word;
  28.    CharFlag, Reply, Reply2                      : char;
  29.    RealFormatY, MidX, MidY, Top                 : boolean;
  30.  
  31. {$I AnnXAxis.PSL}
  32. {$I AnnYAxis.PSL}
  33. {$I AxisText.PSL}
  34. {$I DoXAxis.PSL}
  35. {$I DoYAxis.PSL}
  36. {$I GetNumI.PSL}
  37. {$I GetReply.PSL}
  38. {$I KeyHit.PSL}
  39. {$I LoadArr.PSL}
  40. {$I LoadTxt.PSL}
  41. {$I Stats.PSL}
  42.  
  43. BEGIN
  44.    clrscr;
  45.    writeln('BarChart - Create bar charts');
  46.    XOrigin     := 100;                                  {Mod. #2}
  47.    YOrigin     := 148;                                  {Mod. #2}
  48.    XAxisL      := 480;                                  {Mod. #3}
  49.    YAxisL      := 120;                                  {Mod. #3}
  50.    RealFormatY := false;                                {Mod. #4}
  51.    MidX        := true;
  52.    MidY        := false;
  53.    SubTicksX   := 0;                                    {Mod. #5}
  54.    SubTicksY   := 1;                                    {Mod. #5}
  55.    LoYAxis     := 0;                                    {Mod. #6}
  56.    Depth       := 0;                                    {Mod. #7}
  57.    Top         := topon;                                {Mod. #7}
  58.    GraphDriver := cga;                                  {Mod. #8}
  59.    GraphMode   := cgahi;                                {Mod. #8}
  60.    DriverPath  := '\TP';                                {Mod. #9}
  61.    Count       := 0;
  62.    writeln;
  63.    writeln('The input data must be on a disk file.');
  64.    LoadArr(NumArray, Count, Code);
  65.    if (Code <> 0) or (Count < 1) then
  66.       begin
  67.          writeln('Error in reading data - program aborted.');
  68.          halt
  69.       end;
  70.    NumSegsX := Count;
  71.    Stats(NumArray, Count, Unused, Unused, Unused,
  72.                           LowestY, HighestY);
  73.    writeln;
  74.    writeln('Y value at bottom of axis is set to ', LoYAxis:1);
  75.    if LowestY < LoYAxis then
  76.       writeln('Warning - some data is less than ', LoYAxis:1);
  77.    writeln;
  78.    writeln('Largest value in data file = ', HighestY:12);
  79.    repeat
  80.       writeln;
  81.       writeln('Y value at top of axis?  (integer please)');
  82.       GetNumI(HiYAxis, CharFlag, Code)                  {Mod. #4}
  83.    until
  84.       (Code = 0) and (HiYAxis > LoYAxis) and
  85.                      (HiYAxis >= HighestY);
  86.    repeat
  87.       writeln;
  88.       writeln('Number of primary tick marks on y-axis?');
  89.       GetNumI(NumTicks, CharFlag, Code)
  90.    until
  91.       (Code = 0) and (NumTicks >= 0);
  92.    if NumTicks < 2 then
  93.       NumSegsY := 0
  94.    else
  95.       NumSegsY := NumTicks - 1;
  96.    AxisText(YTextArr, NumSegsY, LoYAxis, HiYAxis, RealFormatY);
  97.    writeln;
  98.    writeln('Label for y-axis?');
  99.    write('? ');
  100.    readln(YTextArr[0]);
  101.    writeln;
  102.    writeln('If you want annotations for the x-axis tick marks,');
  103.    writeln('the annotations must be retrieved from a disk');
  104.    writeln('file.  Provide the filespec of that file now, or');
  105.    writeln('press [Enter] to skip labeling of the tick marks.');
  106.    writeln;
  107.    TextCount := 0;
  108.    LoadTxt(TempTextArr, TextCount, Code);
  109.    for J := 1 to Count do
  110.       XTextArr[J] := '';
  111.    for J := 1 to TextCount do
  112.       XTextArr[J] := TempTextArr[J];
  113.    writeln;
  114.    writeln('Label for x-axis?');
  115.    write('? ');
  116.    readln(XTextArr[0]);
  117.    writeln;
  118.    writeln('Shading style options');                   {Mod. #10}
  119.    writeln(' 0 - No shading       3 - Crosshatch');    {Mod. #10}
  120.    writeln(' 1 - Solid fill       4 - Dot fill');      {Mod. #10}
  121.    writeln(' 2 - Diagonal         5 - Herringbone');   {Mod. #10}
  122.    GetReply('0', '5', Reply);                          {Mod. #10}
  123.    writeln(Reply);                                     {Mod. #10}
  124.    case Reply of                                       {Mod. #10}
  125.       '0': ShadingType := 0;                           {Mod. #10}
  126.       '1': ShadingType := 1;                           {Mod. #10}
  127.       '2': ShadingType := 3;                           {Mod. #10}
  128.       '3': ShadingType := 8;                           {Mod. #10}
  129.       '4': ShadingType := 11;                          {Mod. #10}
  130.       '5': ShadingType := 5                            {Mod. #10}
  131.    end;                                                {Mod. #10}
  132.    FlipFlop := 0;                                   {Mod. #10,11}
  133.    if ShadingType = 5 then                          {Mod. #10,11}
  134.       FlipFlop := 1;                                {Mod. #10,11}
  135.    writeln;
  136.    writeln('Press a key to see the bar chart.  When finished,');
  137.    writeln('press a key to clear the screen.');
  138.    repeat until KeyHit(Reply, Reply2);
  139.    initgraph(GraphDriver, GraphMode, DriverPath);
  140.    ErrorCode := graphresult;
  141.    if ErrorCode <> 0 then
  142.       begin
  143.          write(chr(7));
  144.          writeln('Graph initialization error - program aborted');
  145.          halt
  146.       end;
  147.    DoXAxis(XOrigin, YOrigin, XAxisL, NumSegsX, SubTicksX);
  148.    DoYAxis(XOrigin, YOrigin, YAxisL, NumSegsY, SubTicksY);
  149.    AnnXAxis(XOrigin, YOrigin, XAxisL, NumSegsX, XTextArr, MidX);
  150.    AnnYAxis(XOrigin, YOrigin, YAxisL, NumSegsY, YTextArr, MidY);
  151.    ScaleY       := YAxisL / (HiYAxis - LoYAxis);
  152.    WidthX       := XAxisL / Count;
  153.    LoRightY     := YOrigin;
  154.    ShadingColor := getmaxcolor;                        {Mod. #12}
  155.    for J := 1 to Count do
  156.       begin
  157.          UpLeftX := XOrigin + trunc(WidthX * (J - 1));
  158.          UpLeftY := round(YOrigin - (NumArray[J] - LoYAxis) *
  159.                                      ScaleY);
  160.          LoRightX    := XOrigin + trunc(WidthX * J);
  161.          FlipFlop    := - FlipFlop;
  162.          ShadingType := ShadingType + FlipFlop;        {Mod. #10}
  163.          setfillstyle(ShadingType, ShadingColor);
  164.          bar3d(UpLeftX, UpLeftY, LoRightX, LoRightY, Depth, Top)
  165.       end;
  166.    repeat until KeyHit(Reply, Reply2);
  167.    textmode(bw80)
  168. END.
  169.