PC Pro 1998 October

home *** CD-ROM | disk | FTP | other *** search

/ PC Pro 1998 October / DPPCPRO1098.ISO / Ocx / VCFIMP / VCIMPRES.Z / DragDrop.frm (.txt) < prev next >

Wrap

Visual Basic Form | 1995-11-01 | 45.7 KB | 1,262 lines

VERSION 4.00 Begin VB.Form Form1 Caption = "First Impression Drag 'n Drop Formatting Example" ClientHeight = 7290 ClientLeft = 1215 ClientTop = 1890 ClientWidth = 9465 Height = 8040 Icon = "DragDrop.frx":0000 Left = 1125 LinkTopic = "Form1" ScaleHeight = 7290 ScaleWidth = 9465 Top = 1230 Width = 9645 Begin Threed.SSPanel pnlControls Height = 1575 Left = 60 TabIndex = 1 Top = 60 Width = 9315 _Version = 65536 _ExtentX = 16431 _ExtentY = 2778 _StockProps = 15 BackColor = 12632256 BevelOuter = 1 Begin VB.ComboBox cboChartType Height = 300 Left = 6180 Style = 2 'Dropdown List TabIndex = 40 Top = 360 Width = 1755 End Begin VB.ComboBox cboLineSize Height = 300 Left = 8220 Style = 2 'Dropdown List TabIndex = 36 Top = 360 Width = 855 End Begin VB.ComboBox cboFontSize Height = 300 Left = 8220 Style = 2 'Dropdown List TabIndex = 35 Top = 1080 Width = 855 End Begin VB.ComboBox cboFontName Height = 300 Left = 6180 Sorted = -1 'True Style = 2 'Dropdown List TabIndex = 34 Top = 1080 Width = 1755 End Begin VB.Frame Frame2 Caption = " Draggable Objects " ForeColor = &H00C00000& Height = 1335 Left = 180 TabIndex = 8 Top = 120 Width = 2595 Begin VB.PictureBox pctColors DragMode = 1 'Automatic Height = 135 Index = 8 Left = 180 ScaleHeight = 105 ScaleWidth = 1125 TabIndex = 24 Top = 1020 Width = 1155 End Begin VB.PictureBox pctColors DragMode = 1 'Automatic Height = 255 Index = 7 Left = 1080 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 23 Top = 720 Width = 255 End Begin VB.PictureBox pctColors DragMode = 1 'Automatic Height = 255 Index = 6 Left = 780 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 22 Top = 720 Width = 255 End Begin VB.PictureBox pctColors DragMode = 1 'Automatic Height = 255 Index = 5 Left = 480 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 21 Top = 720 Width = 255 End Begin VB.PictureBox pctColors DragMode = 1 'Automatic Height = 255 Index = 4 Left = 180 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 20 Top = 720 Width = 255 End Begin VB.PictureBox pctColors DragMode = 1 'Automatic Height = 255 Index = 3 Left = 1080 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 19 Top = 420 Width = 255 End Begin VB.PictureBox pctColors DragMode = 1 'Automatic Height = 255 Index = 2 Left = 780 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 18 Top = 420 Width = 255 End Begin VB.PictureBox pctColors DragMode = 1 'Automatic Height = 255 Index = 1 Left = 480 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 17 Top = 420 Width = 255 End Begin VB.PictureBox pctColors DragMode = 1 'Automatic Height = 255 Index = 0 Left = 180 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 16 Top = 420 Width = 255 End Begin VB.PictureBox pctImage BackColor = &H00FFFFFF& DragMode = 1 'Automatic Height = 255 Index = 0 Left = 1560 Picture = "DragDrop.frx":030A ScaleHeight = 225 ScaleWidth = 225 TabIndex = 15 Tag = "Pictures" Top = 420 Width = 255 End Begin VB.PictureBox pctImage BackColor = &H00FFFFFF& DragMode = 1 'Automatic Height = 255 Index = 1 Left = 1860 Picture = "DragDrop.frx":1FD6 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 14 Tag = "Pictures" Top = 420 Width = 255 End Begin VB.PictureBox pctImage BackColor = &H00FFFFFF& DragMode = 1 'Automatic Height = 255 Index = 2 Left = 2160 Picture = "DragDrop.frx":A1B0 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 13 Tag = "Pictures" Top = 420 Width = 255 End Begin VB.PictureBox pctImage BackColor = &H00FFFFFF& DragMode = 1 'Automatic Height = 255 Index = 3 Left = 1560 Picture = "DragDrop.frx":100A8 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 12 Tag = "Pictures" Top = 720 Width = 255 End Begin VB.PictureBox pctImage BackColor = &H00FFFFFF& DragMode = 1 'Automatic Height = 255 Index = 4 Left = 1860 Picture = "DragDrop.frx":1096C ScaleHeight = 225 ScaleWidth = 225 TabIndex = 11 Tag = "Pictures" Top = 720 Width = 255 End Begin VB.PictureBox pctImage BackColor = &H00FFFFFF& DragMode = 1 'Automatic Height = 255 Index = 5 Left = 2160 Picture = "DragDrop.frx":1106E ScaleHeight = 225 ScaleWidth = 225 TabIndex = 10 Tag = "Pictures" Top = 720 Width = 255 End Begin VB.PictureBox pctImage BackColor = &H00FFFFFF& DragMode = 1 'Automatic Height = 135 Index = 6 Left = 1560 ScaleHeight = 105 ScaleWidth = 825 TabIndex = 9 Tag = "Pictures" Top = 1020 Width = 855 End End Begin VB.Frame Frame1 Caption = " Show: " ForeColor = &H00C00000& Height = 1335 Left = 4380 TabIndex = 3 Top = 120 Width = 1515 Begin Threed.SSCheck chkPointLabels Height = 255 Left = 180 TabIndex = 7 Top = 240 Width = 1215 _Version = 65536 _ExtentX = 2143 _ExtentY = 450 _StockProps = 78 Caption = "Point Labels" ForeColor = 12582912 End Begin Threed.SSCheck chkAxisTitles Height = 255 Left = 180 TabIndex = 6 Top = 720 Width = 1215 _Version = 65536 _ExtentX = 2143 _ExtentY = 450 _StockProps = 78 Caption = "Axis Titles" ForeColor = 12582912 End Begin Threed.SSCheck chkSeriesLabels Height = 255 Left = 180 TabIndex = 5 Top = 480 Width = 1215 _Version = 65536 _ExtentX = 2143 _ExtentY = 450 _StockProps = 78 Caption = "Series Labels" ForeColor = 12582912 End Begin Threed.SSCheck chkLegend Height = 255 Left = 180 TabIndex = 4 Top = 960 Width = 1215 _Version = 65536 _ExtentX = 2143 _ExtentY = 450 _StockProps = 78 Caption = "Legend" ForeColor = 12582912 Value = -1 'True End End Begin VB.Frame Frame3 Caption = " Light Source " ForeColor = &H00C00000& Height = 1335 Left = 3000 TabIndex = 2 Top = 120 Width = 1155 Begin VB.OptionButton optLight Height = 255 Index = 8 Left = 780 TabIndex = 33 Top = 900 Width = 195 End Begin VB.OptionButton optLight Height = 255 Index = 7 Left = 480 TabIndex = 32 Top = 900 Width = 195 End Begin VB.OptionButton optLight Height = 255 Index = 6 Left = 180 TabIndex = 31 Top = 900 Width = 195 End Begin VB.OptionButton optLight Height = 255 Index = 5 Left = 780 TabIndex = 30 Top = 600 Width = 195 End Begin VB.OptionButton optLight Height = 255 Index = 4 Left = 480 TabIndex = 29 Top = 600 Width = 195 End Begin VB.OptionButton optLight Height = 255 Index = 3 Left = 180 TabIndex = 28 Top = 600 Width = 195 End Begin VB.OptionButton optLight Height = 255 Index = 2 Left = 780 TabIndex = 27 Top = 300 Width = 195 End Begin VB.OptionButton optLight Height = 255 Index = 1 Left = 480 TabIndex = 26 Top = 300 Width = 195 End Begin VB.OptionButton optLight Height = 255 Index = 0 Left = 180 TabIndex = 25 Top = 300 Value = -1 'True Width = 195 End End Begin VB.Label Label1 Caption = "Chart Type" ForeColor = &H00C00000& Height = 195 Index = 0 Left = 6180 TabIndex = 41 Top = 120 Width = 840 End Begin VB.Label Label1 Caption = "Font Size" ForeColor = &H00C00000& Height = 195 Index = 3 Left = 8220 TabIndex = 39 Top = 840 Width = 840 End Begin VB.Label Label1 Caption = "Line Size" ForeColor = &H00C00000& Height = 195 Index = 2 Left = 8220 TabIndex = 38 Top = 120 Width = 840 End Begin VB.Label Label1 Caption = "Font Name" ForeColor = &H00C00000& Height = 195 Index = 1 Left = 6180 TabIndex = 37 Top = 840 Width = 840 End End Begin MSComDlg.CommonDialog CommonDialog1 Left = 8700 Top = 1800 _Version = 65536 _ExtentX = 847 _ExtentY = 847 _StockProps = 0 CancelError = -1 'True End Begin VCIFiLib.VtChart VtChart1 Height = 5475 Left = 60 TabIndex = 0 Top = 1740 Width = 9315 _version = 65536 _extentx = 16431 _extenty = 9657 _stockprops = 96 filename = "DragDrop.frx":11770 End Begin VB.Menu mnuFile Caption = "&File" Begin VB.Menu FileRead Caption = "&Read Chart" End Begin VB.Menu FileWrite Caption = "&Write Chart" End Begin VB.Menu fileSep0 Caption = "-" End Begin VB.Menu mnuWriteMeta Caption = "Write &Metafile" End Begin VB.Menu mnuWriteBitmap Caption = "Write &Bitmap" End Begin VB.Menu fileSep1 Caption = "-" End Begin VB.Menu mnuFileExit Caption = "E&xit" End End Begin VB.Menu mnuAbout Caption = "&About" End Attribute VB_Name = "Form1" Attribute VB_Creatable = False Attribute VB_Exposed = False Option Explicit Dim gfiPartSelected%, gfiAxisID%, gfiSeriesID%, gfiDataPointID% Private Sub GetFontAndSize(chartPart%) '' Puts the font name and size of the selected part in '' the respective combo boxes Dim i%, fSize!, fName$ Dim part As Object With VtChart1 Select Case chartPart Case VtChPartTypeTitle Set part = .Title.VtFont Case VtChPartTypeFootnote Set part = .Footnote.VtFont Case VtChPartTypeLegend Set part = .Legend.VtFont Case VtChPartTypeSeriesLabel Set part = .Plot.SeriesCollection.Item(gfiSeriesID).SeriesLabel.VtFont Case VtChPartTypePointLabel Set part = .Plot.SeriesCollection.Item(gfiSeriesID).DataPoints.Item(gfiDataPointID).DataPointLabel.VtFont Case VtChPartTypeAxis Set part = .Plot.Axis(gfiAxisID).Labels.Item(1).VtFont Case VtChPartTypeAxisTitle Set part = .Plot.Axis(gfiAxisID).AxisTitle.VtFont Case Else '' N/A VtChPartTypeChart, VtChPartTypePlot, VtChPartTypeSeries, VtChPartTypePoint cboFontName.ListIndex = -1 cboFontSize.ListIndex = -1 Exit Sub End Select End With Let fName = part.Name fSize = part.size For i = 0 To cboFontName.ListCount - 1 If StrComp(fName, cboFontName.List(i)) = 0 Then cboFontName.ListIndex = i Exit For End If Next i For i = 0 To cboFontSize.ListCount - 1 If fSize = Val(cboFontSize.List(i)) Then cboFontSize.ListIndex = i Exit For End If Next i End Sub Sub GetLineSize(chartPart%) Dim part As Object Dim size!, i% size = Val(cboLineSize.Text) With VtChart1 Select Case chartPart Case VtChPartTypeChart Set part = .Backdrop.Frame Case VtChPartTypeTitle Set part = .Title.Backdrop.Frame Case VtChPartTypeFootnote Set part = .Footnote.Backdrop.Frame Case VtChPartTypeLegend Set part = .Legend.Backdrop.Frame Case VtChPartTypePlot Set part = .Plot.Backdrop.Frame Case VtChPartTypeSeries Set part = .Plot.SeriesCollection.Item(gfiSeriesID).Pen Case VtChPartTypeSeriesLabel Set part = .Plot.SeriesCollection.Item(gfiSeriesID).SeriesLabel.Backdrop.Frame Case VtChPartTypePoint Set part = .Plot.SeriesCollection.Item(gfiSeriesID).DataPoints.Item(gfiDataPointID).EdgePen Case VtChPartTypePointLabel Set part = .Plot.SeriesCollection.Item(gfiSeriesID).DataPoints.Item(gfiDataPointID).DataPointLabel.Backdrop.Frame Case VtChPartTypeAxis Set part = .Plot.Axis(gfiAxisID).AxisGrid.MajorPen Case VtChPartTypeAxisLabel Set part = .Plot.Axis(gfiAxisID).Labels.Item(1).Backdrop.Frame Case VtChPartTypeAxisTitle Set part = .Plot.Axis(gfiAxisID).AxisTitle.Backdrop.Frame Case Else cboLineSize.ListIndex = -1 Exit Sub End Select End With size = part.Width For i = 0 To cboLineSize.ListCount - 1 If size = Val(cboLineSize.List(i)) Then cboLineSize.ListIndex = i Exit For End If Next i End Sub Private Sub SetDefaults() With VtChart1 .Repaint = False ' supress repaint during changes .Plot.AutoLayout = True With .Title .Text = "First Impression Demo" .VtFont.size = 12 .VtFont.VtColor.Set 0, 0, 255 End With With .Footnote .Text = "Visual Components, Inc." .VtFont.size = 8 .VtFont.VtColor.Set 0, 0, 255 End With With .Legend .Location.LocationType = VtChLocationTypeRight .Backdrop.Frame.Style = VtFrameStyleSingleLine .Backdrop.Fill.VtPicture.filename = "" End With .Left = pnlControls.Left .Top = pnlControls.Top + pnlControls.Height + 75 .Width = ScaleWidth - .Left - 150 .Height = ScaleHeight - .Top - 150 .Repaint = True ' allow the chart to update End With End Sub Sub SetLighting(Index%) '' Lights are numbered top to bottom, left to right, from '' 0 to 8. These are considered infinite light sources '' that form a vector from their location to the origin. Dim x&, y&, z& '' Set the lighting according to the chosen option '' The x, y, and z values form a ray from the origin '' You can set the angle by adjusting the z magnitude z = 20 Select Case Index Case 0 ' Top Left x = 10 y = -10 Case 1 ' Top Center x = 0 y = -10 Case 2 ' Top Right x = -10 y = -10 Case 3 ' Middle Left x = 10 y = 0 Case 4 ' Middle Center x = 0 y = 0 Case 5 ' Middle Right x = -10 y = 0 Case 6 ' Bottom Left x = 10 y = 10 Case 7 ' Bottom Middle x = 0 y = 10 Case 8 ' Bottom Right x = -10 y = 10 End Select ' Default is one light - we modify that one With VtChart1.Plot.Light.LightSources.Item(1) .x = x .y = y .z = z End With End Sub Private Sub cboFontName_Click() '' Test to see if the font is different so we don't '' lay the chart out needlessly. We use a global '' gfiPartSelected to indicate which part is selected since '' this will be called if the combo selection is changed as '' a result of a chart selected event. The selected event '' happens before the chart stores the new chart part selected '' so there is no way to get it until after the event clears Dim dataPoint As Object, chartPart As Object Dim fName$ With VtChart1 Select Case gfiPartSelected Case VtChPartTypeTitle Set chartPart = .Title.VtFont Case VtChPartTypeFootnote Set chartPart = .Footnote.VtFont Case VtChPartTypeLegend Set chartPart = .Legend.VtFont Case VtChPartTypeSeriesLabel Set chartPart = .Plot.SeriesCollection.Item(gfiSeriesID).SeriesLabel.VtFont Case VtChPartTypePointLabel Set chartPart = .Plot.SeriesCollection.Item(gfiSeriesID).DataPoints.Item(gfiDataPointID).DataPointLabel.VtFont Case VtChPartTypeAxis Set chartPart = .Plot.Axis(gfiAxisID).Labels.Item(1).VtFont Case VtChPartTypeAxisTitle Set chartPart = .Plot.Axis(gfiAxisID).AxisTitle.VtFont Case Else '' N/A VtChPartTypeChart, VtChPartTypePlot, VtChPartTypeSeries, VtChPartTypePoint cboFontName.ListIndex = -1 Exit Sub End Select Let fName = cboFontName.Text If StrComp(chartPart.Name, fName) <> 0 Then chartPart.Name = fName End If End With End Sub Private Sub cboFontSize_Click() Dim dataPoint As Object, chartPart As Object Dim fSize! With VtChart1 Select Case gfiPartSelected Case VtChPartTypeTitle Set chartPart = .Title.VtFont Case VtChPartTypeFootnote Set chartPart = .Footnote.VtFont Case VtChPartTypeLegend Set chartPart = .Legend.VtFont Case VtChPartTypeSeriesLabel Set chartPart = .Plot.SeriesCollection.Item(gfiSeriesID).SeriesLabel.VtFont Case VtChPartTypePointLabel Set chartPart = .Plot.SeriesCollection.Item(gfiSeriesID).DataPoints.Item(gfiDataPointID).DataPointLabel.VtFont Case VtChPartTypeAxis Set chartPart = .Plot.Axis(gfiAxisID).Labels.Item(1).VtFont Case VtChPartTypeAxisTitle Set chartPart = .Plot.Axis(gfiAxisID).AxisTitle.VtFont Case Else '' N/A VtChPartTypeChart, VtChPartTypePlot, VtChPartTypeSeries, VtChPartTypePoint cboFontSize.ListIndex = -1 Exit Sub End Select fSize = Val(cboFontSize.Text) If chartPart.size <> fSize Then chartPart.size = fSize End If End With End Sub Private Sub cboLineSize_Click() Dim size!, fStyle%, part As Object size = Val(cboLineSize.Text) fStyle = IIf(size = 0, VtFrameStyleNull, VtFrameStyleSingleLine) With VtChart1 Select Case gfiPartSelected Case VtChPartTypeChart Set part = .Backdrop.Frame .Backdrop.Frame.Style = fStyle Case VtChPartTypeTitle Set part = .Title.Backdrop.Frame .Title.Backdrop.Frame.Style = fStyle Case VtChPartTypeFootnote Set part = .Footnote.Backdrop.Frame .Footnote.Backdrop.Frame.Style = fStyle Case VtChPartTypeLegend Set part = .Legend.Backdrop.Frame .Legend.Backdrop.Frame.Style = fStyle Case VtChPartTypePlot Set part = .Plot.Backdrop.Frame .Plot.Backdrop.Frame.Style = fStyle Case VtChPartTypeSeries Set part = .Plot.SeriesCollection.Item(gfiSeriesID).Pen .Plot.SeriesCollection.Item(gfiSeriesID).Pen.Style = VtPenStyleSolid Case VtChPartTypeSeriesLabel Set part = .Plot.SeriesCollection.Item(gfiSeriesID).SeriesLabel.Backdrop.Frame .Plot.SeriesCollection.Item(gfiSeriesID).SeriesLabel.Backdrop.Frame.Style = fStyle Case VtChPartTypePoint Set part = .Plot.SeriesCollection.Item(gfiSeriesID).DataPoints.Item(gfiDataPointID).EdgePen .Plot.SeriesCollection.Item(gfiSeriesID).DataPoints.Item(gfiDataPointID).EdgePen.Style = VtPenStyleSolid Case VtChPartTypePointLabel Set part = .Plot.SeriesCollection.Item(gfiSeriesID).DataPoints.Item(gfiDataPointID).DataPointLabel.Backdrop.Frame .Plot.SeriesCollection.Item(gfiSeriesID).DataPoints.Item(gfiDataPointID).DataPointLabel.Backdrop.Frame.Style = fStyle Case VtChPartTypeAxis Set part = .Plot.Axis(gfiAxisID).AxisGrid.MajorPen .Plot.Axis(gfiAxisID).AxisGrid.MajorPen.Style = VtPenStyleSolid Case VtChPartTypeAxisLabel Set part = .Plot.Axis(gfiAxisID).Labels.Item(1).Backdrop.Frame .Plot.Axis(gfiAxisID).Labels.Item(1).Backdrop.Frame.Style = fStyle Case VtChPartTypeAxisTitle Set part = .Plot.Axis(gfiAxisID).AxisTitle.Backdrop.Frame .Plot.Axis(gfiAxisID).AxisTitle.Backdrop.Frame.Style = fStyle Case Else cboLineSize.ListIndex = -1 Exit Sub End Select End With If size <> part.Width Then part.Width = size End If End Sub Sub FileRead_Click() Dim TheFileName$ On Error GoTo FileReadErr With CommonDialog1 .DialogTitle = "Read First Impression Chart" .DefaultExt = "vtc" 'Set default extention to vtc .Filter = "FirstImpression Charts |*.vtc" .Flags = &H1000 .InitDir = App.Path 'Set the default dir to app dir .ShowOpen VtChart1.ReadFromFile (.filename) 'Read in the chart that is selected End With Exit Sub FileReadErr: MsgBox Error End Sub Sub FileWrite_Click() On Error GoTo FileReadErr With CommonDialog1 .DialogTitle = "Write First Impression Chart" .DefaultExt = "vtc" .Filter = "First Impression Charts (*.vtc)|*.vtc" .Flags = &H2 .InitDir = App.Path .ShowSave VtChart1.WriteToFile (.filename) End With Exit Sub FileReadErr: MsgBox Error End Sub Private Sub chkLegend_Click(Value As Integer) VtChart1.Legend.Location.LocationType = VtChLocationTypeRight VtChart1.Legend.Location.Visible = Value End Sub Private Sub chkPointLabels_Click(Value As Integer) Dim series As Object, dataPoint As Object For Each series In VtChart1.Plot.SeriesCollection For Each dataPoint In series.DataPoints With dataPoint.DataPointLabel If Not Value Then .LocationType = VtChLabelLocationTypeNone Else .VtFont.size = 8 .VtFont.VtColor.Set 0, 0, 255 .LocationType = VtChLabelLocationTypeAbovePoint End If End With Next dataPoint Next series End Sub Private Sub chkAxisTitles_Click(Value As Integer) With VtChart1.Plot .Axis(VtChAxisIdX).AxisTitle.Visible = Value 'Set the Axis Visible toggle .Axis(VtChAxisIdY).AxisTitle.Visible = Value 'According to the current .Axis(VtChAxisIdY2).AxisTitle.Visible = Value 'value in the check box .Axis(VtChAxisIdZ).AxisTitle.Visible = Value End With End Sub Private Sub chkSeriesLabels_Click(Value As Integer) ' Toggles series labels on and off Dim series As Object For Each series In VtChart1.Plot.SeriesCollection With series.SeriesLabel If Not Value Then .LocationType = VtChLabelLocationTypeNone Else .LocationType = VtChLabelLocationTypeRight .LineStyle = VtChLabelLineStyleNone .VtFont.size = 8 .VtFont.VtColor.Set 0, 0, 255 With .Backdrop .Frame.Style = VtFrameStyleSingleLine .Frame.FrameColor.Set 0, 0, 0 With .Fill .Style = VtFillStyleBrush .Brush.Style = VtBrushStyleSolid .Brush.FillColor.Set 255, 255, 255 End With End With End If End With Next series End Sub Private Sub cboChartType_Click() Dim a& '' Not all series labels can be shown a = cboChartType.ItemData(cboChartType.ListIndex) chkSeriesLabels.Enabled = ((a > 1 And a < 8) Or a = 14) VtChart1.ChartType = a End Sub Private Sub Form_Load() Dim i% ' Size and position the form Top = 0 Left = 0 Height = 7200 Width = 9615 SetDefaults With VtChart1 ' Set the chart size .RowCount = 4 .ColumnCount = 4 ' Set Column Labels .Column = 1 .ColumnLabel = "Under 3000'" .Column = 2 .ColumnLabel = "3000' - 6000'" .Column = 3 .ColumnLabel = "6000' - 9000'" .Column = 4 .ColumnLabel = "Over 9000'" 'Set the Row Labels .Row = 1 .RowLabel = "Winter" .Row = 2 .RowLabel = "Spring" .Row = 3 .RowLabel = "Summer" .Row = 4 .RowLabel = "Fall" ' Fill the Chart with random data .DataGrid.RandomDataFill .Legend.Location.Visible = True 'Set the Legend to be visible and chkLegend.Value = True 'Mark the Check Box With .Plot ' Set the width for a more pleasing view .WidthToHeightRatio = 2 .DepthToHeightRatio = 2 ' Set Axis titles .Axis(VtChAxisIdX, 1).AxisTitle.Text = "Season" .Axis(VtChAxisIdY, 1).AxisTitle.Text = "Precipitation" + Chr$(10) + "(inches)" .Axis(VtChAxisIdY2, 1).AxisTitle.Text = "Precipitation" + Chr$(10) + "(inches)" .Axis(VtChAxisIdZ, 1).AxisTitle.Text = "(thousand feet)" + Chr$(10) + "Elevation" End With End With ' Fill Combination Chart List Box With cboChartType .AddItem "2d Bar Chart" .ItemData(0) = VtChChartType2dBar .AddItem "3d Bar Chart" .ItemData(1) = VtChChartType3dBar .AddItem "2d Line Chart" .ItemData(2) = VtChChartType2dLine .AddItem "3d Line Chart" .ItemData(3) = VtChChartType3dLine .AddItem "2d Area Chart" .ItemData(4) = VtChChartType2dArea .AddItem "3d Area Chart" .ItemData(5) = VtChChartType3dArea .AddItem "2d Step Chart" .ItemData(6) = VtChChartType2dStep .AddItem "3d Step Chart" .ItemData(7) = VtChChartType3dStep .AddItem "2d Pie Chart" .ItemData(8) = VtChChartType2dPie .AddItem "3d Pie Chart" .ItemData(9) = VtChChartType3dPie .AddItem "Doughnut Chart" .ItemData(10) = VtChChartType3dDoughnut .AddItem "3d Cluster Bar Chart" .ItemData(11) = VtChChartType3dClusteredBar .AddItem "Bubble Chart" .ItemData(12) = VtChChartType2dBubble .ListIndex = 0 'Set the List index to the first item End With With cboFontSize .AddItem "6" .AddItem "7" .AddItem "8" .AddItem "9" .AddItem "10" .AddItem "11" .AddItem "12" .AddItem "14" .AddItem "16" .AddItem "18" .AddItem "20" .AddItem "24" .AddItem "28" End With With cboLineSize .AddItem "0" .AddItem "1" .AddItem "2" .AddItem "3" .AddItem "4" .AddItem "5" End With For i = 0 To Screen.FontCount - 1 cboFontName.AddItem Screen.Fonts(i) Next i 'Fill in the Drag/Drop Color Boxes pctColors(0).BackColor = RGB(255, 0, 0) ' Red pctColors(1).BackColor = RGB(0, 255, 0) ' Green pctColors(2).BackColor = RGB(0, 0, 255) ' Blue pctColors(3).BackColor = RGB(255, 255, 64) ' Yellow pctColors(4).BackColor = RGB(226, 25, 136) ' Pink pctColors(5).BackColor = RGB(50, 150, 50) ' Forest pctColors(6).BackColor = RGB(0, 160, 240) ' Light Blue pctColors(7).BackColor = RGB(255, 160, 50) ' Orange pctColors(8).BackColor = RGB(255, 255, 255) ' White Call SetLighting(0) End Sub Private Sub Form_Resize() If ScaleWidth > 1000 And ScaleHeight > 1000 Then With VtChart1 .Repaint = False 'don't refresh .Width = ScaleWidth - .Left - 60 'Resize the frame and .Height = ScaleHeight - .Top - 60 'The chart to fit in the pnlControls.Width = .Width 'Resized form .Repaint = True 'update chart End With End If End Sub Private Sub Form_Unload(Cancel As Integer) End End Sub Private Sub mnuAbout_Click() MsgBox "First Impression Demonstration Program" & Chr$(10) & Chr$(10) & _ "Click on the chart pieces to select them" & Chr$(10) & _ "or to drag pie pieces." & Chr$(10) & Chr$(10) & _ "Double Click on the chart pieces to invoke" & Chr$(10) & _ "the user interface." & Chr$(10) & Chr$(10) & _ "Hold down the control key and drag the mouse" & Chr$(10) & _ "to rotate 3D charts." & Chr$(10) & Chr$(10) & _ "Drag colors to chart parts, or change the font" & Chr$(10) & _ "size or line thickness." End Sub Private Sub mnuFileExit_Click() End End Sub Private Sub mnuWriteBitmap_Click() On Error GoTo FileReadErr With CommonDialog1 .DialogTitle = "Write Chart to Bitmap File" .DefaultExt = "bmp" .Filter = "Bitmap Files (*.bmp)|*.bmp" .Flags = &H2 .InitDir = App.Path .Action = 2 VtChart1.WritePictureToFile .filename, VtPictureTypeBMP, 0 End With Exit Sub FileReadErr: MsgBox Error End Sub Private Sub mnuWriteMeta_Click() On Error GoTo FileReadErr With CommonDialog1 .DialogTitle = "Write Chart to Windows MetaFile" .DefaultExt = "wmf" .Filter = " Metafiles (*.wmf)|*.wmf" .Flags = &H2 .InitDir = App.Path .Action = 2 VtChart1.WritePictureToFile .filename, VtPictureTypeWMF, 0 End With Exit Sub FileReadErr: MsgBox Error End Sub Private Sub optLight_Click(Index As Integer) Call SetLighting(Index) End Sub Private Sub VtChart1_AxisLabelSelected(AxisId As Integer, AxisIndex As Integer, _ labelSetIndex As Integer, LabelIndex As Integer, MouseFlags As Integer, Cancel As Integer) gfiPartSelected = VtChPartTypeAxisLabel gfiAxisID = AxisId Call GetLineSize(VtChPartTypeAxisLabel) Call GetFontAndSize(VtChPartTypeAxisLabel) End Sub Private Sub VtChart1_AxisSelected(AxisId As Integer, AxisIndex As Integer, _ MouseFlags As Integer, Cancel As Integer) gfiPartSelected = VtChPartTypeAxis gfiAxisID = AxisId Call GetLineSize(VtChPartTypeAxis) Call GetFontAndSize(VtChPartTypeAxis) End Sub Private Sub VtChart1_AxisTitleSelected(AxisId As Integer, AxisIndex As Integer, _ MouseFlags As Integer, Cancel As Integer) gfiPartSelected = VtChPartTypeAxisTitle gfiAxisID = AxisId Call GetLineSize(VtChPartTypeAxisTitle) Call GetFontAndSize(VtChPartTypeAxisTitle) End Sub Private Sub VtChart1_ChartSelected(MouseFlags As Integer, Cancel As Integer) gfiPartSelected = VtChPartTypeChart Call GetLineSize(VtChPartTypeChart) Call GetFontAndSize(VtChPartTypeChart) End Sub Private Sub VtChart1_DragDrop(Source As Control, x As Single, y As Single) '' Handles drop of a picture box containing a image or color on '' any part that supports that fill type Dim r&, b&, g&, i1%, i2%, i3%, i4% Dim chartPart%, theBrushStyle& Dim pictureType&, pictureMap&, pictureName$ Dim dataPoint As Object, imageTarget As Object With VtChart1 ' Determine which chart part was dropped on .TwipsToChartPart x, y, chartPart, i1, i2, i3, i4 ' If a color was dropped then change to that color If Source.Name = "pctColors" Then ' Null brush is special case theBrushStyle = IIf(Source.Index = 8, VtBrushStyleNull, VtBrushStyleSolid) ' Get the RGB values from the dropped color r = Source.BackColor And &HFF g = (Source.BackColor \ &H100) And &HFF b = (Source.BackColor \ &H10000) And &HFF Select Case chartPart Case VtChPartTypeChart With .Backdrop.Fill .VtPicture.filename = "" .Style = VtFillStyleBrush .Brush.Style = theBrushStyle .Brush.FillColor.Set r, g, b End With Case VtChPartTypeTitle .Title.VtFont.VtColor.Set r, g, b Case VtChPartTypeFootnote .Footnote.VtFont.VtColor.Set r, g, b Case VtChPartTypeLegend With .Legend.Backdrop.Fill .VtPicture.filename = "" .Style = VtFillStyleBrush .Brush.Style = theBrushStyle .Brush.FillColor.Set r, g, b End With Case VtChPartTypePlot With .Plot.Backdrop.Fill .VtPicture.filename = "" .Style = VtFillStyleBrush .Brush.Style = theBrushStyle .Brush.FillColor.Set r, g, b End With Case VtChPartTypeSeries For Each dataPoint In .Plot.SeriesCollection.Item(i1).DataPoints With dataPoint .VtPicture.filename = "" .Brush.Style = theBrushStyle .Brush.FillColor.Set r, g, b .EdgePen.Style = VtPenStyleSolid .EdgePen.VtColor.Set r, g, b .VtPicture.Type = VtPictureTypeNull End With Next dataPoint Case VtChPartTypeSeriesLabel .Plot.SeriesCollection.Item(i1).SeriesLabel.VtFont.VtColorSet r, g, b Case VtChPartTypePoint With .series(i1).DataPoints.Item(i2) .VtPicture.filename = "" With .Brush .Style = theBrushStyle .FillColor.Set r, g, b End With With .EdgePen .Style = VtPenStyleSolid .VtColor.Set r, g, b End With End With Case VtChPartTypePointLabel For Each dataPoint In .Plot.SeriesCollection.Item(i1).DataPoints dataPoint.DataPointLabel.VtFont.VtColor.Set r, g, b Next dataPoint Case VtChPartTypeAxis .Plot.Axis(i1).Pen.VtColor.Set r, g, b .Plot.Axis(i1).AxisGrid.MajorPen.VtColor.Set r, g, b Case VtChPartTypeAxisLabel .Plot.Axis(i1).Labels.Item(1).VtFont.VtColor.Set r, g, b Case VtChPartTypeAxisTitle .Plot.Axis(i1).AxisTitle.VtFont.VtColor.Set r, g, b End Select ' A picture has been dropped on a chart part ElseIf Source.Name = "pctImage" Then pictureType = IIf(Source.Index < 4, VtPictureTypeWMF, VtPictureTypeBMP) pictureMap = IIf(Source.Index < 4, VtPictureMapTypeFitted, VtPictureMapTypeTiled) Select Case Source.Index Case 0: pictureName = App.Path & "\APPLE.WMF" Case 1: pictureName = App.Path & "\PEACH.WMF" Case 2: pictureName = App.Path & "\bananas.wmf" Case 3: pictureName = App.Path & "\dollar.wmf" Case 4: pictureName = App.Path & "\fun.BMP" Case 5: pictureName = App.Path & "\party.BMP" Case Else: pictureName = "" End Select Select Case chartPart Case VtChPartTypeChart Set imageTarget = .Backdrop.Fill.VtPicture Case VtChPartTypeTitle Set imageTarget = .Title.Backdrop.Fill.VtPicture Case VtChPartTypeFootnote Set imageTarget = .Footnote.Backdrop.Fill.VtPicture Case VtChPartTypeLegend Set imageTarget = .Legend.Backdrop.Fill.VtPicture Case VtChPartTypePlot Set imageTarget = .Plot.Backdrop.Fill.VtPicture Case VtChPartTypeSeries Set imageTarget = .Plot.SeriesCollection.Item(i1).DataPoints.Item(-1).VtPicture Case VtChPartTypeSeriesLabel Set imageTarget = .Plot.SeriesCollection.Item(i1).SeriesLabel.Backdrop.Fill.VtPicture Case VtChPartTypePoint Set imageTarget = .Plot.SeriesCollection.Item(i1).dataPoint(i2).VtPicture Case VtChPartTypePointLabel Set imageTarget = .Plot.SeriesCollection.Item(i1).dataPoint(-1).DataPointLabel.Backdrop.Fill.VtPicture Case VtChPartTypeAxis Exit Sub Case VtChPartTypeAxisLabel Set imageTarget = .Plot.Axis(i1).Labels.Item(1).Backdrop.Fill.VtPicture Case VtChPartTypeAxisTitle Set imageTarget = .Plot.Axis(i1).AxisTitle.Backdrop.Fill.VtPicture End Select With imageTarget .filename = pictureName .Type = pictureType .Map = pictureMap End With End If End With End Sub Private Sub VtChart1_FootnoteSelected(MouseFlags As Integer, Cancel As Integer) gfiPartSelected = VtChPartTypeFootnote Call GetLineSize(VtChPartTypeFootnote) Call GetFontAndSize(VtChPartTypeFootnote) End Sub Private Sub VtChart1_LegendSelected(MouseFlags As Integer, Cancel As Integer) gfiPartSelected = VtChPartTypeLegend Call GetLineSize(VtChPartTypeLegend) Call GetFontAndSize(VtChPartTypeLegend) End Sub Private Sub VtChart1_PlotSelected(MouseFlags As Integer, Cancel As Integer) gfiPartSelected = VtChPartTypePlot Call GetLineSize(VtChPartTypePlot) Call GetFontAndSize(VtChPartTypePlot) End Sub Private Sub VtChart1_PointLabelSelected(series As Integer, dataPoint As Integer, MouseFlags As Integer, Cancel As Integer) gfiPartSelected = VtChPartTypePointLabel gfiSeriesID = series gfiDataPointID = dataPoint Call GetLineSize(VtChPartTypePointLabel) Call GetFontAndSize(VtChPartTypePointLabel) End Sub Private Sub VtChart1_SeriesLabelSelected(series As Integer, MouseFlags As Integer, Cancel As Integer) gfiPartSelected = VtChPartTypeSeriesLabel gfiSeriesID = series Call GetLineSize(VtChPartTypeSeriesLabel) Call GetFontAndSize(VtChPartTypeSeriesLabel) End Sub Private Sub VtChart1_SeriesSelected(series As Integer, MouseFlags As Integer, Cancel As Integer) gfiPartSelected = VtChPartTypeSeries gfiSeriesID = series Call GetLineSize(VtChPartTypeSeries) Call GetFontAndSize(VtChPartTypeSeries) End Sub Private Sub VtChart1_Titleselected(MouseFlags As Integer, Cancel As Integer) gfiPartSelected = VtChPartTypeTitle Call GetLineSize(VtChPartTypeTitle) Call GetFontAndSize(VtChPartTypeTitle) End Sub