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