home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l391 / 3.ddi / CHRTSUBS.BA$ / CHRTSUBS.bin
Encoding:
Text File  |  1992-08-19  |  28.6 KB  |  1,038 lines
  1. ' ------------------------------------------------------------------------
  2. ' Visual Basic for MS-DOS Presentation Graphics
  3. ' ToolKit Demo Program
  4. '
  5. ' CHRTSUBS.BAS - Chart demo support module.
  6. '
  7. ' Chart demo is a menu-driven, Multiple Document
  8. ' Interface (MDI) program that demonstrates how to
  9. ' use the Presentation Graphics Toolkit to create and modify
  10. ' charts. Refer to module-level comments in CHRTDEMO.FRM
  11. ' for more information about this sample program.
  12. '
  13. ' Copyright (C) 1982-1992 Microsoft Corporation
  14. '
  15. ' You have a royalty-free right to use, modify, reproduce
  16. ' and distribute the sample applications and toolkits provided with
  17. ' Visual Basic for MS-DOS (and/or any modified version)
  18. ' in any way you find useful, provided that you agree that
  19. ' Microsoft has no warranty, obligations or liability for
  20. ' any of the sample applications or toolkits.
  21. ' ------------------------------------------------------------------------
  22.  
  23. '$FORM frmChartType
  24. '$FORM frmFontDlg
  25. '$FORM frmChrtAttributes
  26. '$FORM frmChrtdemo
  27. '$FORM frmChrtData
  28.  
  29. DECLARE SUB ClearData ()
  30. DECLARE SUB ClearFonts ()
  31. DECLARE SUB GetBestMode ()
  32. DECLARE SUB InitChart ()
  33. DECLARE SUB InitColors ()
  34. DECLARE SUB InitFonts ()
  35. DECLARE SUB LoadDefaultData ()
  36. DECLARE SUB SaveChart (ChartName$)
  37.  
  38. '$INCLUDE: 'chrtdemo.bi'
  39. '$INCLUDE: 'cmndlg.bi'
  40.  
  41. CONST FALSE = 0
  42. CONST TRUE = NOT FALSE
  43.  
  44. TYPE ChartDataType
  45.     DataNeeded AS INTEGER
  46.     DataIndex AS INTEGER
  47.     TitleNeeded AS INTEGER
  48.     Title AS STRING * 64
  49. END TYPE
  50.  
  51. COMMON SHARED /ChartDataBlock/ saveFile$                        'chart file
  52. COMMON SHARED /ChartDataBlock/ savePath$                        'chart file
  53. COMMON SHARED /ChartDataBlock/ ChartData() AS ChartDataType
  54.  
  55.  
  56. ' Default Chart Data
  57. '
  58. DATA January, February, March, April, May, June, July, August, September, October, November, December
  59. DATA 1991, 1992, 1993
  60. DATA 120, 124, 140, 200, 330, 400, 410, 420, 430, 500, 510, 520
  61. DATA 450, 430, 400, 410, 500, 512, 505, 525, 550, 520, 490, 510
  62. DATA 520, 520, 515, 540, 535, 545, 550, 551, 559, 630, 555, 563
  63. DATA BigTime Software Inc.
  64. DATA Sales Records
  65. DATA Sales in Millions
  66. DATA Month
  67.  
  68. DEFINT A-Z
  69. ' Change chart type to that specified by ctype and
  70. ' allow user to change chart style via dialog.
  71. SUB ChangeChartType (ctype)
  72.     'Change type if user selected a different type
  73.     IF CEnv.ChartType <> ctype THEN
  74.         IF setNum > 0 THEN frmChrtdemo.Tag = "Changed"
  75.  
  76.         ' Check selected chart type.
  77.         FOR i = 0 TO 4
  78.             frmChrtdemo.mnuGalleryOptions(i).Checked = FALSE
  79.         NEXT
  80.         CEnv.ChartType = ctype
  81.         frmChrtdemo.mnuGalleryOptions(CEnv.ChartType - 1).Checked = TRUE
  82.     END IF
  83.  
  84.     ' Allow user to change chart style
  85.     ' Determine option button captions based on chart type.
  86.     SELECT CASE CEnv.ChartType
  87.         CASE cBar, cColumn
  88.             frmChartType.optChoice1.Caption = "Adjacent"
  89.             frmChartType.optChoice2.Caption = "Stacked"
  90.         CASE cLine, cScatter
  91.             frmChartType.optChoice1.Caption = "Lines"
  92.             frmChartType.optChoice2.Caption = "No Lines"
  93.         CASE cPie
  94.             frmChartType.optChoice1.Caption = "Percentages"
  95.             frmChartType.optChoice2.Caption = "No Percentages"
  96.     END SELECT
  97.  
  98.     frmChartType.Tag = "Cancel"
  99.     frmChartType.SHOW 1
  100.  
  101.     ' If not canceled then set new chart style
  102.     IF frmChartType.Tag <> "Cancel" THEN
  103.         IF setNum > 0 THEN frmChrtdemo.Tag = "Changed"
  104.         IF frmChartType.optChoice1.Value THEN
  105.             CEnv.ChartStyle = 1
  106.         ELSE
  107.             CEnv.ChartStyle = 2
  108.         END IF
  109.     END IF
  110.  
  111.     UNLOAD frmChartType
  112. END SUB
  113.  
  114. ' Clears all chart data.
  115. SUB ClearData ()
  116.     ' Clear categories
  117.     FOR i = 1 TO cMaxValues
  118.         Cat$(i) = ""
  119.     NEXT i
  120.     catLen = 0
  121.  
  122.     ' Clear set names and values
  123.     FOR i = 1 TO cMaxSets
  124.         setName$(i) = ""
  125.         setLen(i) = 0
  126.         FOR j = 1 TO cMaxValues
  127.             setVal!(j, i) = cMissingValue
  128.         NEXT j
  129.     NEXT i
  130.     setNum = 0
  131.  
  132.     ' Chart not changed
  133.     frmChrtdemo.Tag = ""
  134. END SUB
  135.  
  136. ' Sets all chart font pointers to 1.  This is called
  137. ' each time new fonts are loaded to ensure that
  138. ' all chart fonts specify a meaningful font
  139. SUB ClearFonts ()
  140.  
  141.     ' Reset all font pointers if don't map to current fonts.
  142.     IF CEnv.DataFont > numFonts THEN CEnv.DataFont = 1
  143.     IF CEnv.MainTitle.TitleFont > numFonts THEN CEnv.MainTitle.TitleFont = 1
  144.     IF CEnv.SubTitle.TitleFont > numFonts THEN CEnv.SubTitle.TitleFont = 1
  145.     IF CEnv.XAxis.AxisTitle.TitleFont > numFonts THEN CEnv.XAxis.AxisTitle.TitleFont = 1
  146.     IF CEnv.XAxis.TicFont > numFonts THEN CEnv.XAxis.TicFont = 1
  147.     IF CEnv.YAxis.AxisTitle.TitleFont > numFonts THEN CEnv.YAxis.AxisTitle.TitleFont = 1
  148.     IF CEnv.YAxis.TicFont > numFonts THEN CEnv.YAxis.TicFont = 1
  149.     IF CEnv.Legend.TextFont > numFonts THEN CEnv.Legend.TextFont = 1
  150.  
  151. END SUB
  152.  
  153. 'Creates a list of valid screen modes for use by charting functions
  154. 'and sets the initial screen mode to the highest resolution
  155. 'possible.  If no graphic screen modes are available then
  156. 'it causes the program to exit.
  157. SUB GetBestMode ()
  158.     ' Trap screen mode errors.
  159.     ON LOCAL ERROR GOTO badmode
  160.  
  161.     ' Find best screen mode available.
  162.     screenMode = 0
  163.     FOR i = 12 TO 1 STEP -1
  164.         valid = TRUE
  165.         SCREEN i
  166.         IF valid THEN
  167.             screenMode = i
  168.             EXIT FOR
  169.         END IF
  170.     NEXT i
  171.  
  172.     ' Reset screen mode.
  173.     SCREEN 0
  174.     WIDTH 80, 25
  175.  
  176. EXIT SUB
  177.  
  178. badmode:
  179.     valid = FALSE
  180.     RESUME NEXT
  181. END SUB
  182.  
  183. DEFSNG A-Z
  184. ' Sets up and shows the form frmChrtAttributes to
  185. ' display color information.
  186. SUB GetColors ()
  187.     REDIM ChartData(16) AS ChartDataType
  188.  
  189.     'Add Title names to lstItems
  190.     frmChrtAttributes.lstItems.ADDITEM "Main Title", 0
  191.     frmChrtAttributes.lstItems.ADDITEM "Sub Title", 1
  192.     frmChrtAttributes.lstItems.ADDITEM "X Axis Title", 2
  193.     frmChrtAttributes.lstItems.ADDITEM "Y Axis Title", 3
  194.     frmChrtAttributes.lstItems.ADDITEM "Legend Text", 4
  195.     frmChrtAttributes.lstItems.ADDITEM "X Axis Labels", 5
  196.     frmChrtAttributes.lstItems.ADDITEM "Y Axis Labels", 6
  197.     frmChrtAttributes.lstItems.ADDITEM "Chart Window", 7
  198.     frmChrtAttributes.lstItems.ADDITEM "Chart Border", 8
  199.     frmChrtAttributes.lstItems.ADDITEM "Data Window", 9
  200.     frmChrtAttributes.lstItems.ADDITEM "Data Border", 10
  201.  
  202.     'Add Color names to lstData
  203.     FOR i = 1 TO numColors
  204.         frmChrtAttributes.lstData.ADDITEM colors$(i)
  205.     NEXT
  206.  
  207.     'Set up Display
  208.     frmChrtAttributes.Caption = "Chart Colors"
  209.     frmChrtAttributes.lblitems.Visible = TRUE
  210.     frmChrtAttributes.lblitems.Caption = "&Chart Element:"
  211.     frmChrtAttributes.lstItems.ListIndex = 0
  212.     frmChrtAttributes.lstData.Visible = TRUE
  213.     frmChrtAttributes.lblData.Visible = TRUE
  214.     frmChrtAttributes.lblData.Caption = "C&olor:"
  215.     frmChrtAttributes.txtTitle.Visible = FALSE
  216.     frmChrtAttributes.Width = 45
  217.     frmChrtAttributes.cmdOK.Left = 10
  218.     frmChrtAttributes.cmdCancel.Left = 22
  219.     frmChrtAttributes.Left = (screen.Width - frmChrtAttributes.Width) / 2 - 1
  220.  
  221.     ChartData(0).DataIndex = CEnv.MainTitle.TitleColor
  222.     ChartData(1).DataIndex = CEnv.SubTitle.TitleColor
  223.     ChartData(2).DataIndex = CEnv.XAxis.AxisTitle.TitleColor
  224.     ChartData(3).DataIndex = CEnv.YAxis.AxisTitle.TitleColor
  225.     ChartData(4).DataIndex = CEnv.Legend.TextColor
  226.     ChartData(5).DataIndex = CEnv.XAxis.AxisColor
  227.     ChartData(6).DataIndex = CEnv.YAxis.AxisColor
  228.     ChartData(7).DataIndex = CEnv.ChartWindow.Background
  229.     ChartData(8).DataIndex = CEnv.ChartWindow.BorderColor
  230.     ChartData(9).DataIndex = CEnv.DataWindow.Background
  231.     ChartData(10).DataIndex = CEnv.DataWindow.BorderColor
  232.  
  233.     FOR i = 0 TO 10
  234.         ChartData(i).TitleNeeded = FALSE
  235.         ChartData(i).DataNeeded = TRUE
  236.     NEXT
  237.  
  238.     frmChrtAttributes.lstData.ListIndex = ChartData(0).DataIndex
  239.  
  240.     frmChrtAttributes.Tag = "Cancel"
  241.     frmChrtAttributes.SHOW 1
  242.  
  243.     'Evaluate Data
  244.     IF frmChrtAttributes.Tag <> "Cancel" THEN
  245.         CEnv.MainTitle.TitleColor = ChartData(0).DataIndex
  246.         CEnv.SubTitle.TitleColor = ChartData(1).DataIndex
  247.         CEnv.XAxis.AxisTitle.TitleColor = ChartData(2).DataIndex
  248.         CEnv.YAxis.AxisTitle.TitleColor = ChartData(3).DataIndex
  249.         CEnv.Legend.TextColor = ChartData(4).DataIndex
  250.         CEnv.XAxis.AxisColor = ChartData(5).DataIndex
  251.         CEnv.YAxis.AxisColor = ChartData(6).DataIndex
  252.         CEnv.ChartWindow.Background = ChartData(7).DataIndex
  253.         CEnv.ChartWindow.BorderColor = ChartData(8).DataIndex
  254.         CEnv.DataWindow.Background = ChartData(9).DataIndex
  255.         CEnv.DataWindow.BorderColor = ChartData(10).DataIndex
  256.     END IF
  257.  
  258.     'Unload Form
  259.     UNLOAD frmChrtAttributes
  260. END SUB
  261.  
  262. ' Sets up and shows the form frmChrtAttributes to
  263. ' display font information.
  264. SUB GetFonts ()
  265.     REDIM ChartData(16) AS ChartDataType
  266.  
  267.     'Add Title names to lstItems
  268.     frmChrtAttributes.lstItems.ADDITEM "Main Title", 0
  269.     frmChrtAttributes.lstItems.ADDITEM "Sub Title", 1
  270.     frmChrtAttributes.lstItems.ADDITEM "X Axis Title", 2
  271.     frmChrtAttributes.lstItems.ADDITEM "Y Axis Title", 3
  272.     frmChrtAttributes.lstItems.ADDITEM "Legend Text", 4
  273.     frmChrtAttributes.lstItems.ADDITEM "X Axis Labels", 5
  274.     frmChrtAttributes.lstItems.ADDITEM "Y Axis Labels", 6
  275.     
  276.     'Add Font names to lstData
  277.     FOR i = 1 TO numFonts
  278.         frmChrtAttributes.lstData.ADDITEM fonts$(i)
  279.     NEXT
  280.  
  281.     'Set up Display
  282.     frmChrtAttributes.Caption = "Chart Fonts"
  283.     frmChrtAttributes.lblitems.Visible = TRUE
  284.     frmChrtAttributes.lblitems.Caption = "&Chart Element:"
  285.     frmChrtAttributes.lstItems.ListIndex = 0
  286.     frmChrtAttributes.lstData.Visible = TRUE
  287.     frmChrtAttributes.lblData.Caption = "&Fonts:"
  288.     frmChrtAttributes.lblData.Visible = TRUE
  289.     frmChrtAttributes.txtTitle.Visible = FALSE
  290.     frmChrtAttributes.Width = 45
  291.     frmChrtAttributes.cmdOK.Left = 10
  292.     frmChrtAttributes.cmdCancel.Left = 22
  293.     frmChrtAttributes.Left = (screen.Width - frmChrtAttributes.Width) / 2 - 1
  294.  
  295.     ChartData(0).DataIndex = CEnv.MainTitle.TitleFont - 1
  296.     ChartData(1).DataIndex = CEnv.SubTitle.TitleFont - 1
  297.     ChartData(2).DataIndex = CEnv.XAxis.AxisTitle.TitleFont - 1
  298.     ChartData(3).DataIndex = CEnv.YAxis.AxisTitle.TitleFont - 1
  299.     ChartData(4).DataIndex = CEnv.Legend.TextFont - 1
  300.     ChartData(5).DataIndex = CEnv.XAxis.TicFont - 1
  301.     ChartData(6).DataIndex = CEnv.YAxis.TicFont - 1
  302.     
  303.     FOR i = 0 TO 6
  304.         ChartData(i).TitleNeeded = FALSE
  305.         ChartData(i).DataNeeded = TRUE
  306.         IF (ChartData(i).DataIndex > numFonts) OR (ChartData(i).DataIndex < 0) THEN
  307.             ChartData(i).DataIndex = numFonts - 1
  308.         END IF
  309.     NEXT
  310.     frmChrtAttributes.lstData.ListIndex = ChartData(0).DataIndex
  311.     
  312.     frmChrtAttributes.Tag = "Cancel"
  313.     frmChrtAttributes.SHOW 1
  314.  
  315.     'Evaluate Data
  316.     IF frmChrtAttributes.Tag <> "Cancel" THEN
  317.         CEnv.MainTitle.TitleFont = ChartData(0).DataIndex + 1
  318.         CEnv.SubTitle.TitleFont = ChartData(1).DataIndex + 1
  319.         CEnv.XAxis.AxisTitle.TitleFont = ChartData(2).DataIndex + 1
  320.         CEnv.YAxis.AxisTitle.TitleFont = ChartData(3).DataIndex + 1
  321.         CEnv.Legend.TextFont = ChartData(4).DataIndex + 1
  322.         CEnv.XAxis.TicFont = ChartData(5).DataIndex + 1
  323.         CEnv.YAxis.TicFont = ChartData(6).DataIndex + 1
  324.     END IF
  325.  
  326.     'Unload Form
  327.     UNLOAD frmChrtAttributes
  328.  
  329. END SUB
  330.  
  331. ' Sets up and shows the form frmChrtAttributes to
  332. ' display Title information.
  333. SUB GetTitles ()
  334.     REDIM ChartData(16) AS ChartDataType
  335.  
  336.     'Add Title names to lstItems
  337.     frmChrtAttributes.lstItems.ADDITEM "Main", 0
  338.     frmChrtAttributes.lstItems.ADDITEM "Sub", 1
  339.     frmChrtAttributes.lstItems.ADDITEM "X Axis", 2
  340.     frmChrtAttributes.lstItems.ADDITEM "Y Axis", 3
  341.  
  342.     'Set up Display
  343.     frmChrtAttributes.Caption = "Chart Titles"
  344.     frmChrtAttributes.lblitems.Visible = TRUE
  345.     frmChrtAttributes.lblitems.Caption = "&Title:"
  346.     frmChrtAttributes.lstItems.ListIndex = 0
  347.     frmChrtAttributes.lstData.Visible = FALSE
  348.     frmChrtAttributes.lblData.Visible = TRUE
  349.     frmChrtAttributes.lblData.Caption = "T&ext:"
  350.     frmChrtAttributes.txtTitle.Visible = TRUE
  351.     frmChrtAttributes.Left = (screen.Width - frmChrtAttributes.Width) / 2 - 1
  352.     
  353.     FOR i = 0 TO 3
  354.         ChartData(i).TitleNeeded = TRUE
  355.         ChartData(i).DataNeeded = FALSE
  356.     NEXT
  357.     ChartData(0).Title = CEnv.MainTitle.Title
  358.     ChartData(1).Title = CEnv.SubTitle.Title
  359.     ChartData(2).Title = CEnv.XAxis.AxisTitle.Title
  360.     ChartData(3).Title = CEnv.YAxis.AxisTitle.Title
  361.     frmChrtAttributes.txtTitle.Text = ChartData(0).Title
  362.  
  363.     frmChrtAttributes.Tag = "Cancel"
  364.     frmChrtAttributes.SHOW 1
  365.  
  366.     'Evaluate Data
  367.     IF frmChrtAttributes.Tag <> "Cancel" THEN
  368.         CEnv.MainTitle.Title = ChartData(0).Title
  369.         CEnv.SubTitle.Title = ChartData(1).Title
  370.         CEnv.XAxis.AxisTitle.Title = ChartData(2).Title
  371.         CEnv.YAxis.AxisTitle.Title = ChartData(3).Title
  372.     END IF
  373.  
  374.     'Unload Form
  375.     UNLOAD frmChrtAttributes
  376. END SUB
  377.  
  378. DEFINT A-Z
  379. ' Initializes the chart.
  380. '
  381. SUB InitChart ()
  382.     ' Dimension chart data variables.
  383.     REDIM colors$(1 TO MAXCOLORS)                     'valid colors$
  384.     REDIM fonts$(1 TO MAXFONTS)
  385.     REDIM Cat$(1 TO cMaxValues)                       'category names
  386.     REDIM setName$(1 TO cMaxSets)                     'set names
  387.     REDIM setLen(1 TO cMaxSets)   AS INTEGER          '# values per set
  388.     REDIM setVal!(1 TO cMaxValues, 1 TO cMaxSets)     'actual values
  389.     REDIM mode$(1 TO 13)                              'list of modes
  390.  
  391.     GetBestMode                             ' get best graphics screen mode
  392.  
  393.     ' Exit if no graphics mode available
  394.     IF screenMode = 0 THEN
  395.         LOCATE 10, 10
  396.         PRINT "Cannot run Quick Chart - No graphic screen modes available for charting."
  397.         END
  398.     END IF
  399.  
  400.     ' Chart support comes from the Presentation Graphics
  401.     ' Tooklit.  To run this program you must use the supplied
  402.     ' library (CHART.LIB, CHARTA.LIB) and Quick library
  403.     ' (CHART.QLB).
  404.     DefaultChart CEnv, cBar, cPlain         ' Get defaults for chart variable
  405.     ClearData                               ' Clear all chart data
  406.     frmChrtdemo.mnuGalleryOptions(0).Checked = TRUE ' Check default chart type on menu.
  407.  
  408.     InitColors                              ' Set up color list
  409.     InitFonts                               ' Set up font lists
  410.  
  411.     LoadDefaultData
  412. END SUB
  413.  
  414. ' Creates color list based on screen mode
  415. '
  416. SUB InitColors ()
  417.  
  418.     ' create list of displayable colors$ based on screen mode
  419.     SELECT CASE screenMode
  420.         CASE 1
  421.             numColors = 4
  422.             REDIM color$(numColors)
  423.             colors$(1) = "Black"
  424.             colors$(2) = "White"
  425.             colors$(3) = "Bright Cyan"
  426.             colors$(4) = "Bright Magenta"
  427.         CASE 2, 3, 4, 11
  428.             numColors = 2
  429.             REDIM color$(numColors)
  430.             colors$(1) = "Black"
  431.             colors$(2) = "White"
  432.         CASE 7, 8, 9, 12, 13
  433.             numColors = 16
  434.             REDIM color$(numColors)
  435.             colors$(1) = "Black"
  436.             colors$(2) = "High White"
  437.             colors$(3) = "Blue"
  438.             colors$(4) = "Green"
  439.             colors$(5) = "Cyan"
  440.             colors$(6) = "Red"
  441.             colors$(7) = "Magenta"
  442.             colors$(8) = "Brown"
  443.             colors$(9) = "White"
  444.             colors$(10) = "Gray"
  445.             colors$(11) = "Bright Blue"
  446.             colors$(12) = "Bright Green"
  447.             colors$(13) = "Bright Cyan"
  448.             colors$(14) = "Bright Red"
  449.             colors$(15) = "Bright Magenta"
  450.             colors$(16) = "Yellow"
  451.         CASE 10
  452.             numColors = 4
  453.             REDIM color$(numColors)
  454.             colors$(1) = "Off"
  455.             colors$(2) = "On High"
  456.             colors$(3) = "On Normal"
  457.             colors$(4) = "Blink"
  458.     END SELECT
  459.  
  460.     ' reset chart color pointers to default values
  461.     IF numColors < 16 THEN
  462.         CEnv.ChartWindow.Background = 0
  463.         CEnv.ChartWindow.BorderColor = 1
  464.         CEnv.DataWindow.Background = 0
  465.         CEnv.DataWindow.BorderColor = 1
  466.         CEnv.MainTitle.TitleColor = 1
  467.         CEnv.SubTitle.TitleColor = 1
  468.         CEnv.XAxis.AxisColor = 1
  469.         CEnv.XAxis.AxisTitle.TitleColor = 1
  470.         CEnv.YAxis.AxisColor = 1
  471.         CEnv.YAxis.AxisTitle.TitleColor = 1
  472.         CEnv.Legend.TextColor = 1
  473.         CEnv.Legend.LegendWindow.Background = 0
  474.         CEnv.Legend.LegendWindow.BorderColor = 1
  475.     END IF
  476. END SUB
  477.  
  478. ' Sets up default font and initializes font list.
  479. '
  480. SUB InitFonts ()
  481. DIM FI AS FontInfo
  482.  
  483.     ' reset
  484.     UnRegisterFonts
  485.     SetMaxFonts 1, 1
  486.  
  487.     ' get default font
  488.     DefaultFont Segment%, Offset%
  489.     reg% = RegisterMemFont%(Segment%, Offset%)
  490.  
  491.     ' load default font
  492.     numFonts = LoadFont("n1")
  493.  
  494.     IF numFonts = 0 THEN numFonts = 1
  495.  
  496.     fonts$(numFonts) = "IBM 8 Point"
  497.  
  498.     UnRegisterFonts
  499. END SUB
  500.  
  501. ' Loads chart data and settings from the given file.
  502. '
  503. SUB LoadChart (ChartName$)
  504.     ON LOCAL ERROR GOTO LoadError
  505.  
  506.     OPEN ChartName$ FOR INPUT AS #1
  507.     INPUT #1, setNum%
  508.     FOR i% = 1 TO setNum%
  509.         LINE INPUT #1, setName$(i%)
  510.     NEXT
  511.     FOR i% = 1 TO 15
  512.         LINE INPUT #1, Cat$(i%)
  513.     NEXT
  514.     LINE INPUT #1, CEnv.MainTitle.Title
  515.     LINE INPUT #1, CEnv.SubTitle.Title
  516.     LINE INPUT #1, CEnv.XAxis.AxisTitle.Title
  517.     LINE INPUT #1, CEnv.YAxis.AxisTitle.Title
  518.  
  519.     INPUT #1, CEnv.MainTitle.TitleColor
  520.     INPUT #1, CEnv.SubTitle.TitleColor
  521.     INPUT #1, CEnv.XAxis.AxisTitle.TitleColor
  522.     INPUT #1, CEnv.YAxis.AxisTitle.TitleColor
  523.     INPUT #1, CEnv.Legend.TextColor
  524.     INPUT #1, CEnv.XAxis.AxisColor
  525.     INPUT #1, CEnv.YAxis.AxisColor
  526.     INPUT #1, CEnv.ChartWindow.Background
  527.     INPUT #1, CEnv.ChartWindow.BorderColor
  528.     INPUT #1, CEnv.DataWindow.Background
  529.     INPUT #1, CEnv.DataWindow.BorderColor
  530.  
  531.     INPUT #1, CEnv.MainTitle.TitleFont
  532.     INPUT #1, CEnv.SubTitle.TitleFont
  533.     INPUT #1, CEnv.XAxis.AxisTitle.TitleFont
  534.     INPUT #1, CEnv.YAxis.AxisTitle.TitleFont
  535.     INPUT #1, CEnv.Legend.TextFont
  536.     INPUT #1, CEnv.XAxis.TicFont
  537.     INPUT #1, CEnv.YAxis.TicFont
  538.  
  539.  
  540.     FOR i% = 1 TO setNum%
  541.         FOR j% = 1 TO 15
  542.             INPUT #1, setVal!(j%, i%)
  543.         NEXT
  544.     NEXT
  545.     CLOSE
  546.     EXIT SUB
  547.  
  548. ' Handle any file format errors
  549. LoadError:
  550.     MSGBOX ERROR$ + ". loading chart.", 0, "Quick Chart"
  551.     InitChart
  552.     LoadDefaultData
  553.  
  554.     CLOSE FileNum%                              ' close and exit
  555.     EXIT SUB
  556. RESUME NEXT
  557.  
  558.  
  559. END SUB
  560.  
  561. DEFSNG A-Z
  562. ' Load Default data contained in Data statements in
  563. ' the module level code of this module.
  564. SUB LoadDefaultData ()
  565.     frmChrtdemo.Tag = ""
  566.  
  567.     RESTORE
  568.     setNum% = 3
  569.     FOR i% = 1 TO 12
  570.         READ Cat$(i%)
  571.     NEXT
  572.     FOR i% = 13 TO 15
  573.         Cat$(i%) = ""
  574.     NEXT
  575.  
  576.     FOR i% = 1 TO 15
  577.         FOR j% = 1 TO 15
  578.             setVal!(i%, j%) = cMissingValue
  579.         NEXT
  580.         setLen%(i%) = 0
  581.     NEXT
  582.  
  583.     FOR i% = 1 TO setNum%
  584.         READ setName$(i%)
  585.         setLen%(i%) = 12
  586.     NEXT
  587.     
  588.     FOR i% = 1 TO setNum%
  589.         FOR j% = 1 TO 12
  590.             READ temp$
  591.             setVal!(j%, i%) = VAL(temp$)
  592.         NEXT
  593.     NEXT
  594.  
  595.     READ CEnv.MainTitle.Title
  596.     READ CEnv.SubTitle.Title
  597.     READ CEnv.XAxis.AxisTitle.Title
  598.     READ CEnv.YAxis.AxisTitle.Title
  599.  
  600.  
  601. END SUB
  602.  
  603. DEFINT A-Z
  604. ' Exits the program after allowing the user a chance to
  605. ' save the current chart.
  606. '
  607. SUB Quit (abort%)
  608.     IF frmChrtdemo.Tag = "Changed" THEN
  609.         A$ = CHR$(13) + "Current chart has not been saved.  Save now?"
  610.         status = MSGBOX(A$, 3, "Quick Chart")
  611.  
  612.         ' save chart
  613.         IF status = 6 THEN
  614.             IF saveFile$ = "" THEN
  615.                 CALL FileSave(saveFile$, savePath$, "Sample.cht", "Save Chart As", 0, 7, 0, Canceled)
  616.             END IF
  617.             IF Canceled <> -1 THEN
  618.                 IF RIGHT$(savePath$, 1) <> "\" THEN t$ = "\"
  619.                 CALL SaveChart(savePath$ + t$ + saveFile$)
  620.             ELSE
  621.                 status = 2
  622.             END IF
  623.         END IF
  624.     ELSE
  625.         status = 6
  626.     END IF
  627.  
  628.     ' quit if operation has not been canceled.
  629.     IF status <> 2 THEN
  630.         screen.HIDE
  631.         END
  632.     ELSE
  633.         abort% = -1
  634.     END IF
  635. END SUB
  636.  
  637. ' Saves chart information.
  638. SUB SaveChart (ChartName$)
  639.     ON LOCAL ERROR GOTO saveError
  640.  
  641.     OPEN ChartName$ FOR OUTPUT AS #1
  642.     PRINT #1, setNum%
  643.     FOR i% = 1 TO setNum%
  644.         PRINT #1, setName$(i%)
  645.     NEXT
  646.     FOR i% = 1 TO 15
  647.         PRINT #1, Cat$(i%)
  648.     NEXT
  649.     PRINT #1, CEnv.MainTitle.Title
  650.     PRINT #1, CEnv.SubTitle.Title
  651.     PRINT #1, CEnv.XAxis.AxisTitle.Title
  652.     PRINT #1, CEnv.YAxis.AxisTitle.Title
  653.  
  654.     PRINT #1, CEnv.MainTitle.TitleColor
  655.     PRINT #1, CEnv.SubTitle.TitleColor
  656.     PRINT #1, CEnv.XAxis.AxisTitle.TitleColor
  657.     PRINT #1, CEnv.YAxis.AxisTitle.TitleColor
  658.     PRINT #1, CEnv.Legend.TextColor
  659.     PRINT #1, CEnv.XAxis.AxisColor
  660.     PRINT #1, CEnv.YAxis.AxisColor
  661.     PRINT #1, CEnv.ChartWindow.Background
  662.     PRINT #1, CEnv.ChartWindow.BorderColor
  663.     PRINT #1, CEnv.DataWindow.Background
  664.     PRINT #1, CEnv.DataWindow.BorderColor
  665.  
  666.     PRINT #1, CEnv.MainTitle.TitleFont
  667.     PRINT #1, CEnv.SubTitle.TitleFont
  668.     PRINT #1, CEnv.XAxis.AxisTitle.TitleFont
  669.     PRINT #1, CEnv.YAxis.AxisTitle.TitleFont
  670.     PRINT #1, CEnv.Legend.TextFont
  671.     PRINT #1, CEnv.XAxis.TicFont
  672.     PRINT #1, CEnv.YAxis.TicFont
  673.  
  674.     FOR i% = 1 TO setNum%
  675.         FOR j% = 1 TO 15
  676.             PRINT #1, setVal!(j%, i%)
  677.         NEXT
  678.     NEXT
  679.     CLOSE
  680.     frmChrtdemo.Tag = ""
  681.     EXIT SUB
  682.  
  683. ' handle any file format errors
  684. saveError:
  685.  
  686.     MSGBOX ERROR$ + ".  Cannot save " + ChartName$, 0, "Quick Chart"
  687.     CLOSE
  688.     IF DIR$(ChartName$) <> "" THEN KILL (ChartName$)
  689.     EXIT SUB
  690.  
  691. END SUB
  692.  
  693. ' Displays the chart
  694. '
  695. SUB ViewChart ()
  696.  
  697.     ' When a chart is drawn, data is moved from the 2-dimensional array
  698.     ' into arrays suitable for the charting library routines.  The
  699.     ' following arrays are used directly in calls to the charting routines:
  700.     DIM ValX1!(1 TO cMaxValues)                    ' Passed to Chart routine
  701.     DIM ValY1!(1 TO cMaxValues)
  702.     DIM ValX2!(1 TO cMaxValues, 1 TO cMaxSeries)   ' Passed to ChartMS routine
  703.     DIM ValY2!(1 TO cMaxValues, 1 TO cMaxSeries)
  704.     DIM explode(1 TO cMaxValues)  AS INTEGER       ' Explode pie chart pieces
  705.  
  706.     FOR j% = 1 TO 15
  707.         IF setName$(j%) <> "" THEN
  708.             setNum = j%
  709.         END IF
  710.         FOR i% = 1 TO 15
  711.             IF setVal!(i%, j%) = cMissingValue THEN
  712.                 setLen(j%) = i% - 1
  713.                 EXIT FOR
  714.             ELSEIF i% = 15 THEN
  715.                 setLen(j%) = i%
  716.                 EXIT FOR
  717.             END IF
  718.         NEXT
  719.     NEXT
  720.  
  721.     ' find the longest series
  722.     maxLen% = 0
  723.     FOR i% = 1 TO setNum
  724.         IF setLen(i%) > maxLen% THEN maxLen% = setLen(i%)
  725.     NEXT i%
  726.  
  727.     ' Set up the proper screen mode (exit if not valid)
  728.     screen.HIDE
  729.     ChartScreen screenMode
  730.     IF ChartErr = cBadScreen THEN
  731.         MSGBOX "Invalid screen mode. Can't display chart.", 0, "Quick Chart"
  732.         EXIT SUB
  733.     END IF
  734.  
  735.     ' Process depending on chart type
  736.     SELECT CASE CEnv.ChartType
  737.         CASE cBar, cColumn, cLine, cPie:
  738.         ' If the chart is a single series one or a pie chart:
  739.         IF setNum = 1 OR CEnv.ChartType = cPie THEN
  740.  
  741.             ' Transfer data into a single dimension array:
  742.             FOR i% = 1 TO maxLen%
  743.                 ValX1!(i%) = setVal!(i%, 1)
  744.             NEXT i%
  745.  
  746.             IF CEnv.ChartType = cPie THEN
  747.                 ' determine which pieces to explode
  748.                 FOR i% = 1 TO maxLen%
  749.                     IF setVal!(i%, 2) <> 0 THEN
  750.                         explode(i%) = 1
  751.                     ELSE
  752.                         explode(i%) = 0
  753.                     END IF
  754.                 NEXT i%
  755.  
  756.                 ' display pie chart
  757.                 ChartPie CEnv, Cat$(), ValX1!(), explode(), maxLen%
  758.             ELSE
  759.                 Chart CEnv, Cat$(), ValX1!(), maxLen%
  760.             END IF
  761.  
  762.          ' If multiple series, then data is OK so just call routine:
  763.          ELSE
  764.             ChartMS CEnv, Cat$(), setVal!(), maxLen%, 1, setNum, setName$()
  765.          END IF
  766.  
  767.       CASE cScatter:
  768.          ' Make sure there's enough data sets:
  769.          IF setNum = 1 THEN
  770.             SCREEN 0
  771.             WIDTH 80
  772.             screen.SHOW
  773.  
  774.             A$ = CHR$(13) + "Too few data sets for Scatter chart"
  775.             MSGBOX A$, 0, "Quick Chart"
  776.             EXIT SUB
  777.  
  778.          ' If it's a single series scatter, transfer data to one-
  779.          ' dimensional arrays and make chart call:
  780.          ELSEIF setNum = 2 THEN
  781.             FOR i% = 1 TO maxLen%
  782.                ValX1!(i%) = setVal!(i%, 1)
  783.                ValY1!(i%) = setVal!(i%, 2)
  784.             NEXT i%
  785.             ChartScatter CEnv, ValX1!(), ValY1!(), maxLen%
  786.  
  787.          ' If it's a multiple series scatter, transfer odd columns to
  788.          ' X-axis data array and even columns to Y-axis array and make
  789.          ' chart call:
  790.          ELSE
  791.             FOR j% = 2 TO setNum STEP 2
  792.                FOR i% = 1 TO maxLen%
  793.                   ValX2!(i%, j% \ 2) = setVal!(i%, j% - 1)
  794.                   ValY2!(i%, j% \ 2) = setVal!(i%, j%)
  795.                NEXT i%
  796.             NEXT j%
  797.  
  798.             ChartScatterMS CEnv, ValX2!(), ValY2!(), maxLen%, 1, setNum \ 2, setName$()
  799.          END IF
  800.  
  801.    END SELECT
  802.  
  803.    ' If there's been a "fatal" error, indicate what it was:
  804.    IF ChartErr <> 0 THEN
  805.        GOSUB ViewError
  806.  
  807.    ' Otherwise, just wait for a keypress:
  808.    ELSE
  809.       ' Wait for key or mousepress
  810.       DIM regs AS RegType
  811.       regs.ax = 0
  812.       'Check Status
  813.       CALL INTERRUPT(&H33, regs, regs)
  814.       MousePresent = regs.ax
  815.       IF MousePresent THEN
  816.            'Show Mouse
  817.            regs.ax = 1
  818.            CALL INTERRUPT(&H33, regs, regs)
  819.       END IF
  820.       mouseclick = 0
  821.       DO
  822.             C$ = INKEY$
  823.             'Check mouse status
  824.             IF MousePresent THEN
  825.                 regs.ax = &H5
  826.                 regs.bx = 0
  827.                 CALL INTERRUPT(&H33, regs, regs)
  828.                 IF regs.bx > 0 THEN
  829.                     mouseclick = TRUE
  830.                 END IF
  831.             END IF
  832.       LOOP UNTIL C$ <> "" OR mouseclick = TRUE
  833.       IF MousePresent THEN
  834.            'reset mouse
  835.            CALL INTERRUPT(&H33, regs, regs)
  836.       END IF
  837.  
  838.       SCREEN 0
  839.       WIDTH 80
  840.       screen.SHOW
  841.    END IF
  842.  
  843. EXIT SUB
  844.  
  845. ' handle charting errors
  846. ViewError:
  847.  
  848.     ' re-init the display
  849.     SCREEN 0
  850.     WIDTH 80
  851.     screen.SHOW
  852.  
  853.     ' display appropriate error message
  854.     SELECT CASE ChartErr
  855.         CASE cBadDataWindow:
  856.             MSGBOX "Data window cannot be displayed in available space.", 0, "Quick Chart"
  857.         CASE cBadLegendWindow:
  858.             MSGBOX "Invalid legend coordinates.", 0, "Quick Chart"
  859.         CASE cTooFewSeries:
  860.             MSGBOX "Too few series to plot.", 0, "Quick Chart"
  861.         CASE cTooSmallN:
  862.             MSGBOX "No data in series.", 0, "Quick Chart"
  863.         CASE IS > 200:                              ' basic error
  864.             MSGBOX "BASIC error #" + LTRIM$(STR$(ChartErr - 200)) + " occurred.", 0, "Quick Chart"
  865.         CASE ELSE:                                  ' extraneous error
  866.             MSGBOX "Charting error #" + LTRIM$(STR$(ChartErr)) + " occurred.", 0, "Quick Chart"
  867.     END SELECT
  868.  
  869. RETURN
  870.  
  871. END SUB
  872.  
  873. DEFSNG A-Z
  874. ' Sets up and Shows the form frmChrtEdit.
  875. '
  876. SUB ViewData ()
  877.     frmChrtData.SHOW
  878. END SUB
  879.  
  880. DEFINT A-Z
  881. ' Displays list of registered fonts and allows user to
  882. ' select one or more of these fonts to load
  883. '
  884. SUB ViewFont ()
  885. DIM FI AS FontInfo
  886. DIM rfonts$(1 TO MAXFONTS)
  887.  
  888.     SetMaxFonts MAXFONTS, MAXFONTS
  889.  
  890.     ' get default font
  891.     DefaultFont Segment%, Offset%
  892.     numReg = RegisterMemFont%(Segment%, Offset%)
  893.  
  894.     ' use font files that are best suited for current screen mode
  895.     curPath$ = CURDIR$
  896.     IF RIGHT$(curPath$, 1) <> "\" THEN t$ = "\"
  897.     SELECT CASE screenMode
  898.         CASE 11, 12
  899.             cour$ = curPath$ + t$ + "COURE.FON"
  900.             helv$ = curPath$ + t$ + "HELVE.FON"
  901.             tims$ = curPath$ + t$ + "TMSRE.FON"
  902.         CASE ELSE
  903.             cour$ = curPath$ + t$ + "COURB.FON"
  904.             helv$ = curPath$ + t$ + "HELVB.FON"
  905.             tims$ = curPath$ + t$ + "TMSRB.FON"
  906.     END SELECT
  907.     ' register courier fonts
  908.     numReg = numReg + RegisterFonts%(cour$)
  909.     fontname$ = cour$
  910.     IF FontErr > 0 THEN GOSUB FontError
  911.  
  912.     ' register helvetica fonts
  913.     numReg = numReg + RegisterFonts%(helv$)
  914.     fontname$ = helv$
  915.     IF FontErr > 0 THEN GOSUB FontError
  916.  
  917.     ' register times roman fonts
  918.     numReg = numReg + RegisterFonts%(tims$)
  919.     fontname$ = tims$
  920.     IF FontErr > 0 THEN GOSUB FontError
  921.  
  922.     ' create a list of registered fonts
  923.     FOR i = 1 TO numReg
  924.         GetRFontInfo i, FI
  925.         rfonts$(i) = RTRIM$(MID$(FI.FaceName, 1, 8)) + STR$(FI.Points) + " Point"
  926.     NEXT i
  927.  
  928.     ' set up window display
  929.     IF numReg + 2 > 9 THEN
  930.         frmFontDlg.Height = numReg + 2
  931.     ELSE
  932.         frmFontDlg.Height = 9
  933.     END IF
  934.  
  935.     ' open buttons for each font in list
  936.     FOR i% = 1 TO numReg
  937.         IF i% <> 1 THEN
  938.             LOAD frmFontDlg.chkFonts(i%)
  939.         END IF
  940.         frmFontDlg.chkFonts(i%).Caption = rfonts$(i%)
  941.         frmFontDlg.chkFonts(i%).Visible = TRUE
  942.         frmFontDlg.chkFonts(i%).Value = 0
  943.         frmFontDlg.chkFonts(i%).Top = i%
  944.         FOR j% = 1 TO numFonts
  945.             IF fonts$(j%) = rfonts$(i%) THEN
  946.                 frmFontDlg.chkFonts(i%).Value = 1
  947.             END IF
  948.         NEXT j%
  949.     NEXT i%
  950.     frmFontDlg.Tag = "Cancel"
  951.     frmFontDlg.Top = (screen.Height - frmFontDlg.Height) \ 2
  952.     frmFontDlg.Left = (screen.Width - frmFontDlg.Width) \ 2
  953.     IF numReg > 0 THEN
  954.         frmFontDlg.SHOW 1
  955.     ELSE
  956.         MSGBOX "No Fonts are available."
  957.         frmFontDlg.Tag = "Cancel"
  958.     END IF
  959.  
  960.     ' finished and not cancelled
  961.     IF frmFontDlg.Tag <> "Cancel" THEN
  962.         ' create font spec for load operation
  963.         FontSpec$ = ""
  964.         FOR i% = 1 TO numReg
  965.             IF frmFontDlg.chkFonts(i%).Value THEN
  966.                 FontSpec$ = FontSpec$ + "/n" + LTRIM$(STR$(i))
  967.             END IF
  968.         NEXT i%
  969.  
  970.         ' default if none chosen
  971.         IF FontSpec$ = "" THEN
  972.             MSGBOX "No fonts selected - using default.", 0, "Quick Chart"
  973.             numFonts = LoadFont%("N1")
  974.             REDIM fonts$(1)
  975.             fonts$(1) = rfonts$(1)
  976.         ELSE
  977.             ' load selected fonts
  978.             numLoaded = LoadFont%(RIGHT$(FontSpec$, LEN(FontSpec$) - 1))
  979.  
  980.             ' notify user of error and let them try again.
  981.             IF FontErr <> 0 THEN
  982.                 GOSUB FontError
  983.                 currButton = 1
  984.             ELSE
  985.                 REDIM fonts$(numLoaded)
  986.                 ' create a list of loaded fonts
  987.                 FOR i = 1 TO numLoaded
  988.                     SelectFont i
  989.                     GetFontInfo FI
  990.                     fonts$(i) = RTRIM$(MID$(FI.FaceName, 1, 8)) + STR$(FI.Points) + " Point"
  991.                 NEXT i
  992.                 numFonts = numLoaded
  993.                 ClearFonts
  994.             END IF
  995.         END IF
  996.     ' reload existing fonts if operation cancelled
  997.     ELSE
  998.         FontSpec$ = ""
  999.         FOR i = 1 TO numReg
  1000.             FOR j% = 1 TO numFonts
  1001.                 IF fonts$(j%) = rfonts$(i%) THEN FontSpec$ = FontSpec$ + "/n" + LTRIM$(STR$(i))
  1002.             NEXT j%
  1003.         NEXT i
  1004.         numFonts = LoadFont%(RIGHT$(FontSpec$, LEN(FontSpec$) - 1))
  1005.     END IF
  1006.  
  1007.     UnRegisterFonts
  1008.  
  1009.     UNLOAD frmFontDlg
  1010.  
  1011.     EXIT SUB
  1012.  
  1013. ' handle font loading errors
  1014. FontError:
  1015.     SELECT CASE FontErr
  1016.         CASE cNoFontMem:
  1017.             MSGBOX "Not enough memory to load selected fonts.", 0, "Quick Chart"
  1018.         CASE cFileNotFound:
  1019.             MSGBOX fontname$ + " font file not found.", 0, "Quick Chart"
  1020.         CASE cTooManyFonts:
  1021.             numReg = MAXFONTS
  1022.         CASE cBadFontFile:
  1023.             MSGBOX "Invalid font file format for " + fontname$ + ".", 0, "Quick Chart"
  1024.         CASE cNoFonts:
  1025.             MSGBOX "No fonts are loaded.", 0, "Quick Chart"
  1026.         CASE cBadFontType:
  1027.             MSGBOX "Font not a bitmap font.", 0, "Quick Chart"
  1028.         CASE IS > 200:                                  ' basic error
  1029.             MSGBOX "BASIC error #" + LTRIM$(STR$(FontErr - 200)) + " occurred.", 0, "Quick Chart"
  1030.         CASE ELSE                                       ' unplanned font error
  1031.             MSGBOX "Font error #" + LTRIM$(STR$(FontErr)) + " occurred.", 0, "Quick Chart"
  1032.     END SELECT
  1033.  
  1034. RETURN
  1035.  
  1036. END SUB
  1037.  
  1038.