home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l391 / 2.ddi / GRAPDRAW.BA$ / GRAPDRAW.bin
Encoding:
Text File  |  1992-08-19  |  8.6 KB  |  306 lines
  1. ' ------------------------------------------------------------------------
  2. ' Visual Basic for MS-DOS Graphics Program Support Module
  3. '
  4. ' Provides routines for creating bar chart and pattern
  5. ' editor.
  6. '
  7. ' Copyright (C) 1982-1992 Microsoft Corporation
  8. '
  9. ' You have a royalty-free right to use, modify, reproduce
  10. ' and distribute the sample applications and toolkits provided with
  11. ' Visual Basic for MS-DOS (and/or any modified version)
  12. ' in any way you find useful, provided that you agree that
  13. ' Microsoft has no warranty, obligations or liability for
  14. ' any of the sample applications or toolkits.
  15. ' ------------------------------------------------------------------------
  16.  
  17. CONST FALSE = 0
  18. CONST TRUE = NOT FALSE
  19.  
  20. ' Bar Graph Declarations:
  21. ' Define type for the titles:
  22. TYPE TitleType
  23.    MainTitle AS STRING * 40
  24.    XTitle AS STRING * 40
  25.    YTitle AS STRING * 18
  26. END TYPE
  27. DIM Titles AS TitleType, Label$(1 TO 5), Value(1 TO 5)
  28. DECLARE FUNCTION DrawGraph (T AS TitleType, Label$(), Value!(), N%)
  29.  
  30. ' Shared variable passes pattern from the Pattern Editor to
  31. ' the Bar Chart demo.
  32. DIM SHARED Tile$
  33.  
  34. 'Pattern Editor Declarations:
  35. DIM SHARED Bit%(0 TO 7)
  36. DECLARE SUB DrawPattern (Pattern$)
  37. DECLARE SUB EditPattern (Pattern$, PatternSize%)
  38.  
  39. ' ======================== DRAWGRAPH ======================
  40. ' Draws a bar graph
  41. ' =========================================================
  42. STATIC FUNCTION DrawGraph (T AS TitleType, Label$(), Value(), N%)
  43.  
  44.    ' Set size of graph:
  45.    CONST GRAPHTOP = 24, GRAPHBOTTOM = 171
  46.    CONST GRAPHLEFT = 48, GRAPHRIGHT = 624
  47.    CONST YLENGTH = GRAPHBOTTOM - GRAPHTOP
  48.  
  49.    ' Calculate maximum and minimum values:
  50.    YMax = 0
  51.    YMin = 0
  52.    FOR I% = 1 TO N%
  53.       IF Value(I%) < YMin THEN YMin = Value(I%)
  54.       IF Value(I%) > YMax THEN YMax = Value(I%)
  55.    NEXT I%
  56.  
  57.    ' Calculate width of bars and space between them:
  58.    BarWidth = (GRAPHRIGHT - GRAPHLEFT) / N%
  59.    BarSpace = .2 * BarWidth
  60.    BarWidth = BarWidth - BarSpace
  61.  
  62.    SCREEN 2
  63.    CLS
  64.  
  65.    ' Draw y-axis:
  66.    LINE (GRAPHLEFT, GRAPHTOP)-(GRAPHLEFT, GRAPHBOTTOM), 1
  67.  
  68.    ' Draw main graph title:
  69.    Start% = 44 - (LEN(RTRIM$(T.MainTitle)) / 2)
  70.    LOCATE 2, Start%
  71.    PRINT RTRIM$(T.MainTitle);
  72.  
  73.    ' Annotate y-axis:
  74.    Start% = CINT(13 - LEN(RTRIM$(T.YTitle)) / 2)
  75.    FOR I% = 1 TO LEN(RTRIM$(T.YTitle))
  76.       LOCATE Start% + I% - 1, 1
  77.       PRINT MID$(T.YTitle, I%, 1);
  78.    NEXT I%
  79.  
  80.    ' Calculate scale factor so labels aren't bigger than four digits:
  81.    IF ABS(YMax) > ABS(YMin) THEN
  82.       Power = YMax
  83.    ELSE
  84.       Power = YMin
  85.    END IF
  86.    Power = CINT(LOG(ABS(Power) / 100) / LOG(10))
  87.    IF Power < 0 THEN Power = 0
  88.  
  89.    ' Scale minimum and maximum values down:
  90.    ScaleFactor = 10 ^ Power
  91.    YMax = CINT(YMax / ScaleFactor)
  92.    YMin = CINT(YMin / ScaleFactor)
  93.    ' If power isn't zero then put scale factor on chart:
  94.    IF Power <> 0 THEN
  95.       LOCATE 3, 2
  96.       PRINT "x 10^"; LTRIM$(STR$(Power))
  97.    END IF
  98.  
  99.    ' Put tic mark and number for Max point on y-axis:
  100.    LINE (GRAPHLEFT - 3, GRAPHTOP)-STEP(3, 0)
  101.    LOCATE 4, 2
  102.    PRINT USING "####"; YMax
  103.  
  104.    ' Put tic mark and number for Min point on y-axis:
  105.    LINE (GRAPHLEFT - 3, GRAPHBOTTOM)-STEP(3, 0)
  106.    LOCATE 22, 2
  107.    PRINT USING "####"; YMin
  108.  
  109.    YMax = YMax * ScaleFactor ' Scale minimum and maximum back
  110.    YMin = YMin * ScaleFactor ' up for charting calculations.
  111.  
  112.    ' Annotate x-axis:
  113.    Start% = 44 - (LEN(RTRIM$(T.XTitle)) / 2)
  114.    LOCATE 25, Start%
  115.    PRINT RTRIM$(T.XTitle);
  116.  
  117.    ' Calculate the pixel range for the y-axis:
  118.    YRange = YMax - YMin
  119.  
  120.    ' If no pattern has been created using the Pattern Editor...
  121.    IF Tile$ = "" THEN
  122.     ' Define a diagonally striped pattern:
  123.     Tile$ = CHR$(1) + CHR$(2) + CHR$(4) + CHR$(8) + CHR$(16) + CHR$(32) + CHR$(64) + CHR$(128)
  124.    END IF
  125.    ' Draw a zero line if appropriate:
  126.    IF YMin < 0 THEN
  127.       Bottom = GRAPHBOTTOM - ((-YMin) / YRange * YLENGTH)
  128.       LOCATE INT((Bottom - 1) / 8) + 1, 5
  129.       PRINT "0";
  130.    ELSE
  131.       Bottom = GRAPHBOTTOM
  132.    END IF
  133.  
  134.    ' Draw x-axis:
  135.    LINE (GRAPHLEFT - 3, Bottom)-(GRAPHRIGHT, Bottom)
  136.    ' Draw bars and labels:
  137.    Start% = GRAPHLEFT + (BarSpace / 2)
  138.    FOR I% = 1 TO N%
  139.  
  140.       ' Draw a bar label:
  141.       BarMid = Start% + (BarWidth / 2)
  142.       CharMid = INT((BarMid - 1) / 8) + 1
  143.       LOCATE 23, CharMid - INT(LEN(RTRIM$(Label$(I%))) / 2)
  144.       PRINT Label$(I%);
  145.  
  146.       ' Draw the bar and fill it with the striped pattern:
  147.       BarHeight = (Value(I%) / YRange) * YLENGTH
  148.       LINE (Start%, Bottom)-STEP(BarWidth, -BarHeight), , B
  149.       PAINT (BarMid, Bottom - (BarHeight / 2)), Tile$, 1
  150.  
  151.       Start% = Start% + BarWidth + BarSpace
  152.    NEXT I%
  153.    LOCATE 1, 1
  154.    PRINT "Press any key to return";
  155.    Answer$ = INPUT$(1)
  156.  
  157. END FUNCTION
  158.  
  159. ' ======================= DRAWPATTERN ====================
  160. ' Draws a patterned rectangle on the right side of screen
  161. ' ========================================================
  162. STATIC SUB DrawPattern (Pattern$)
  163.    VIEW (320, 24)-(622, 160), 0, 1  ' Set view to rectangle.
  164.    PAINT (1, 1), Pattern$       ' Use PAINT to fill it.
  165.    VIEW                 ' Set view to full screen.
  166.    Tile$ = Pattern$     ' Set Tile$ for Bar Chart Demo.
  167. END SUB
  168.  
  169. ' ======================= EDITPATTERN =====================
  170. ' Edits a tile-byte pattern
  171. ' =========================================================
  172. STATIC SUB EditPattern (Pattern$, PatternSize%)
  173.  
  174.    ByteNum% = 1     ' Starting position.
  175.    BitNum% = 7
  176.    Null$ = CHR$(0)  ' CHR$(0) is the first byte of the
  177.                     ' two-byte string returned when a
  178.                     ' direction key such as UP or DOWN is
  179.                     ' pressed.
  180.    DO
  181.  
  182.       ' Calculate starting location on screen of this bit:
  183.       X% = ((7 - BitNum%) * 16) + 80
  184.       Y% = (ByteNum% + 2) * 8
  185.  
  186.       ' Wait for a key press (flash cursor each 3/10 second):
  187.       State% = 0
  188.       RefTime = 0
  189.       DO
  190.  
  191.      ' Check timer and switch cursor state if 3/10 second:
  192.      IF ABS(TIMER - RefTime) > .3 THEN
  193.         RefTime = TIMER
  194.         State% = 1 - State%
  195.  
  196.         ' Turn the  border of bit on and off:
  197.         LINE (X% - 1, Y% - 1)-STEP(15, 8), State%, B
  198.      END IF
  199.  
  200.      Check$ = INKEY$    ' Check for keystroke.
  201.  
  202.       LOOP WHILE Check$ = ""    ' Loop until a key is pressed.
  203.  
  204.       ' Erase cursor:
  205.       LINE (X% - 1, Y% - 1)-STEP(15, 8), 0, B
  206.  
  207.       SELECT CASE Check$    ' Respond to keystroke.
  208.  
  209.       CASE CHR$(27)     ' ESC key pressed:
  210.          EXIT SUB       ' exit this subprogram.
  211.       CASE CHR$(32)     ' SPACEBAR pressed:
  212.                         ' reset state of bit.
  213.  
  214.          ' Invert bit in pattern string:
  215.          CurrentByte% = ASC(MID$(Pattern$, ByteNum%, 1))
  216.          CurrentByte% = CurrentByte% XOR Bit%(BitNum%)
  217.          MID$(Pattern$, ByteNum%) = CHR$(CurrentByte%)
  218.  
  219.          ' Redraw bit on screen:
  220.          IF (CurrentByte% AND Bit%(BitNum%)) <> 0 THEN
  221.              CurrentColor% = 1
  222.          ELSE
  223.              CurrentColor% = 0
  224.          END IF
  225.          LINE (X% + 1, Y% + 1)-STEP(11, 4), CurrentColor%, BF
  226.  
  227.       CASE CHR$(13)      ' ENTER key pressed: draw
  228.          DrawPattern Pattern$         ' pattern in box on right.
  229.  
  230.       CASE Null$ + CHR$(75)  ' LEFT key: move cursor left.
  231.  
  232.          BitNum% = BitNum% + 1
  233.          IF BitNum% > 7 THEN BitNum% = 0
  234.  
  235.       CASE Null$ + CHR$(77)  ' RIGHT key: move cursor right.
  236.  
  237.          BitNum% = BitNum% - 1
  238.          IF BitNum% < 0 THEN BitNum% = 7
  239.  
  240.       CASE Null$ + CHR$(72)  ' UP key: move cursor up.
  241.  
  242.          ByteNum% = ByteNum% - 1
  243.          IF ByteNum% < 1 THEN ByteNum% = PatternSize%
  244.  
  245.       CASE Null$ + CHR$(80)  ' DOWN key: move cursor down.
  246.  
  247.          ByteNum% = ByteNum% + 1
  248.          IF ByteNum% > PatternSize% THEN ByteNum% = 1
  249.       END SELECT
  250.    LOOP
  251. END SUB
  252.  
  253. ' ======================= INITIALIZE ======================
  254. ' Sets up starting pattern and screen for pattern editor
  255. ' =========================================================
  256. STATIC SUB Initialize (Pattern$, PatternSize%)
  257. SHARED Bit%()
  258.    ' Set up an array holding bits in positions 0 to 7:
  259.    FOR I% = 0 TO 7
  260.       Bit%(I%) = 2 ^ I%
  261.    NEXT I%
  262.  
  263.    CLS
  264.  
  265. ' Set initial pattern to all bits set:
  266.    Pattern$ = STRING$(PatternSize%, 255)
  267.  
  268.    SCREEN 2     ' 640 x 200 monochrome graphics mode
  269.  
  270.    ' Draw dividing lines:
  271.    LINE (0, 10)-(635, 10), 1
  272.    LINE (300, 0)-(300, 199)
  273.    LINE (302, 0)-(302, 199)
  274.  
  275.    ' Print titles:
  276.    LOCATE 1, 13: PRINT "Pattern Bytes"
  277.    LOCATE 1, 53: PRINT "Pattern View"
  278.  
  279.  
  280. ' Draw editing screen for pattern:
  281.    FOR I% = 1 TO PatternSize%
  282.  
  283.       ' Print label on left of each line:
  284.       LOCATE I% + 3, 8
  285.       PRINT USING "##:"; I%
  286.  
  287.       ' Draw "bit" boxes:
  288.       X% = 80
  289.       Y% = (I% + 2) * 8
  290.       FOR J% = 1 TO 8
  291.         LINE (X%, Y%)-STEP(13, 6), 1, BF
  292.         X% = X% + 16
  293.       NEXT J%
  294.    NEXT I%
  295.  
  296.    DrawPattern Pattern$     ' Draw  "Pattern View" box.
  297.  
  298.    LOCATE 21, 1
  299.    PRINT "DIRECTION keys........Move cursor"
  300.    PRINT "SPACEBAR............Changes point"
  301.    PRINT "ENTER............Displays pattern"
  302.    PRINT "ESC.........................Quits";
  303.  
  304. END SUB
  305.  
  306.