home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Basic / Q_BASIC.450 / BAR.BAS < prev    next >
BASIC Source File  |  1987-09-23  |  6KB  |  220 lines
  1. ' Define type for the titles:
  2. TYPE TitleType
  3.    MainTitle AS STRING * 40
  4.    XTitle AS STRING * 40
  5.    YTitle AS STRING * 18
  6. END TYPE
  7.  
  8. DECLARE SUB InputTitles (T AS TitleType)
  9. DECLARE FUNCTION DrawGraph$ (T AS TitleType, Label$(), Value!(), N%)
  10. DECLARE FUNCTION InputData% (Label$(), Value!())
  11.  
  12. ' Variable declarations for titles and bar data:
  13. DIM Titles AS TitleType, Label$(1 TO 5), Value(1 TO 5)
  14.  
  15. CONST FALSE = 0, TRUE = NOT FALSE
  16.  
  17. DO
  18.    InputTitles Titles
  19.    N% = InputData%(Label$(), Value())
  20.    IF N% <> FALSE THEN
  21.       NewGraph$ = DrawGraph$(Titles, Label$(), Value(), N%)
  22.    END IF
  23. LOOP WHILE NewGraph$ = "Y"
  24.  
  25. END
  26. REM $STATIC
  27. '
  28. ' ========================== DRAWGRAPH =========================
  29. '   Draws a bar graph from the data entered in the INPUTTITLES
  30. '   and INPUTDATA procedures.
  31. ' ==============================================================
  32. '
  33. FUNCTION DrawGraph$ (T AS TitleType, Label$(), Value(), N%) STATIC
  34.  
  35.    ' Set size of graph:
  36.    CONST GRAPHTOP = 24, GRAPHBOTTOM = 171
  37.    CONST GRAPHLEFT = 48, GRAPHRIGHT = 624
  38.    CONST YLENGTH = GRAPHBOTTOM - GRAPHTOP
  39.  
  40.    ' Calculate max/min values:
  41.    YMax = 0
  42.    YMin = 0
  43.    FOR I% = 1 TO N%
  44.       IF Value(I%) < YMin THEN YMin = Value(I%)
  45.       IF Value(I%) > YMax THEN YMax = Value(I%)
  46.    NEXT I%
  47.  
  48.    ' Calculate width of bars and space between them:
  49.    BarWidth = (GRAPHRIGHT - GRAPHLEFT) / N%
  50.    BarSpace = .2 * BarWidth
  51.    BarWidth = BarWidth - BarSpace
  52.  
  53.    SCREEN 2
  54.    CLS
  55.  
  56.    ' Draw y axis:
  57.    LINE (GRAPHLEFT, GRAPHTOP)-(GRAPHLEFT, GRAPHBOTTOM), 1
  58.  
  59.    ' Draw main graph title:
  60.    Start% = 44 - (LEN(RTRIM$(T.MainTitle)) / 2)
  61.    LOCATE 2, Start%
  62.    PRINT RTRIM$(T.MainTitle);
  63.  
  64.    ' Annotate Y axis:
  65.    Start% = CINT(13 - LEN(RTRIM$(T.YTitle)) / 2)
  66.    FOR I% = 1 TO LEN(RTRIM$(T.YTitle))
  67.       LOCATE Start% + I% - 1, 1
  68.       PRINT MID$(T.YTitle, I%, 1);
  69.    NEXT I%
  70.  
  71.    ' Calculate scale factor so labels aren't bigger than 4 digits:
  72.    IF ABS(YMax) > ABS(YMin) THEN
  73.       Power = YMax
  74.    ELSE
  75.       Power = YMin
  76.    END IF
  77.    Power = CINT(LOG(ABS(Power) / 100) / LOG(10))
  78.    IF Power < 0 THEN Power = 0
  79.  
  80.    ' Scale min and max down:
  81.    ScaleFactor = 10 ^ Power
  82.    YMax = CINT(YMax / ScaleFactor)
  83.    YMin = CINT(YMin / ScaleFactor)
  84.  
  85.    ' If power isn't zero then put scale factor on chart:
  86.    IF Power <> 0 THEN
  87.       LOCATE 3, 2
  88.       PRINT "x 10^"; LTRIM$(STR$(Power))
  89.    END IF
  90.  
  91.    ' Put tic mark and number for Max point on Y axis:
  92.    LINE (GRAPHLEFT - 3, GRAPHTOP)-STEP(3, 0)
  93.    LOCATE 4, 2
  94.    PRINT USING "####"; YMax
  95.  
  96.    ' Put tic mark and number for Min point on Y axis:
  97.    LINE (GRAPHLEFT - 3, GRAPHBOTTOM)-STEP(3, 0)
  98.    LOCATE 22, 2
  99.    PRINT USING "####"; YMin
  100.  
  101.    ' Scale min and max back up for charting calculations:
  102.    YMax = YMax * ScaleFactor
  103.    YMin = YMin * ScaleFactor
  104.  
  105.    ' Annotate X axis:
  106.    Start% = 44 - (LEN(RTRIM$(T.XTitle)) / 2)
  107.    LOCATE 25, Start%
  108.    PRINT RTRIM$(T.XTitle);
  109.  
  110.    ' Calculate the pixel range for the Y axis:
  111.    YRange = YMax - YMin
  112.  
  113.    ' Define a diagonally striped pattern:
  114.    Tile$ = CHR$(1) + CHR$(2) + CHR$(4) + CHR$(8) + CHR$(16) + CHR$(32) + CHR$(64) + CHR$(128)
  115.  
  116.    ' Draw a zero line if appropriate:
  117.    IF YMin < 0 THEN
  118.       Bottom = GRAPHBOTTOM - ((-YMin) / YRange * YLENGTH)
  119.       LOCATE INT((Bottom - 1) / 8) + 1, 5
  120.       PRINT "0";
  121.    ELSE
  122.       Bottom = GRAPHBOTTOM
  123.    END IF
  124.  
  125.    ' Draw x axis:
  126.    LINE (GRAPHLEFT - 3, Bottom)-(GRAPHRIGHT, Bottom)
  127.  
  128.    ' Draw bars and labels:
  129.    Start% = GRAPHLEFT + (BarSpace / 2)
  130.    FOR I% = 1 TO N%
  131.  
  132.       ' Draw a bar label:
  133.       BarMid = Start% + (BarWidth / 2)
  134.       CharMid = INT((BarMid - 1) / 8) + 1
  135.       LOCATE 23, CharMid - INT(LEN(RTRIM$(Label$(I%))) / 2)
  136.       PRINT Label$(I%);
  137.  
  138.       ' Draw the bar and fill it with the striped pattern:
  139.       BarHeight = (Value(I%) / YRange) * YLENGTH
  140.       LINE (Start%, Bottom)-STEP(BarWidth, -BarHeight), , B
  141.       PAINT (BarMid, Bottom - (BarHeight / 2)), Tile$, 1
  142.  
  143.       Start% = Start% + BarWidth + BarSpace
  144.    NEXT I%
  145.  
  146.    LOCATE 1, 1, 1
  147.    PRINT "New graph? ";
  148.    DrawGraph$ = UCASE$(INPUT$(1))
  149.  
  150. END FUNCTION
  151. '
  152. ' ========================= INPUTDATA ========================
  153. '         Gets input for the bar labels and their values
  154. ' ============================================================
  155. '
  156. FUNCTION InputData% (Label$(), Value()) STATIC
  157.  
  158.    ' Initialize the number of data values:
  159.    NumData% = 0
  160.  
  161.    ' Print data-entry instructions:
  162.    CLS
  163.    PRINT "Enter data for up to 5 bars:"
  164.    PRINT "   * Enter the label and value for each bar."
  165.    PRINT "   * Values can be negative."
  166.    PRINT "   * Enter a blank label to stop."
  167.    PRINT
  168.    PRINT "After viewing the graph, press any key ";
  169.    PRINT "to end the program."
  170.  
  171.    ' Accept data until blank label or 5 entries:
  172.    Done% = FALSE
  173.    DO
  174.       NumData% = NumData% + 1
  175.       PRINT
  176.       PRINT "Bar("; LTRIM$(STR$(NumData%)); "):"
  177.       INPUT ; "        Label? ", Label$(NumData%)
  178.  
  179.       ' Only input value if label isn't blank:
  180.       IF Label$(NumData%) <> "" THEN
  181.          LOCATE , 35
  182.          INPUT "Value? ", Value(NumData%)
  183.  
  184.       ' If label was blank, decrement data counter and
  185.       ' set Done flag equal to TRUE:
  186.       ELSE
  187.          NumData% = NumData% - 1
  188.          Done% = TRUE
  189.       END IF
  190.    LOOP UNTIL (NumData% = 5) OR Done%
  191.  
  192.    ' Return the number of data values input:
  193.    InputData% = NumData%
  194.  
  195. END FUNCTION
  196. '
  197. ' ======================= INPUTTITLES ========================
  198. '       Accepts input for the three different graph titles
  199. ' ============================================================
  200. '
  201. SUB InputTitles (T AS TitleType) STATIC
  202.  
  203.    ' Set text screen:
  204.    SCREEN 0, 0
  205.  
  206.    ' Input Titles
  207.    DO
  208.       CLS
  209.       INPUT "Enter main graph title: ", T.MainTitle
  210.       INPUT "Enter X-Axis title    : ", T.XTitle
  211.       INPUT "Enter Y-Axis title    : ", T.YTitle
  212.  
  213.       ' Check to see if titles are OK:
  214.       LOCATE 7, 1
  215.       PRINT "OK (Y to continue, N to change)? ";
  216.       LOCATE , , 1
  217.       OK$ = UCASE$(INPUT$(1))
  218.    LOOP UNTIL OK$ = "Y"
  219. END SUB
  220.