Sorry it took so long to post......I got a little busy.
1) Start a new VB6 application.
2) Right-click the toolbox and add a reference to "Microsoft Office XP Web
Components".
3) Add a Picturebox control to Form1.
4) Add a ChartSpace control to Form1.
5) Paste the following code (at end of instructions) behind Form1.
6) Run the example.
Please read the notes in the example for explanations regarding sizing of
the input/output images.
Have fun!
Jim Hubbard
Hubbard Software
'Begin Code Snippet ----------
Option Explicit
'+++ Functions needed for creating a temporary file to save our output to
while printing it.......
Private Declare Function ShellExecute Lib "shell32.dll" Alias _
"ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal _
lpDirectory As String, ByVal nShowCmd As Long) As Long
'Used to come up with the temp file directory
Private Declare Function GetTempPath Lib "kernel32" _
Alias "GetTempPathA" (ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
'used to come up with the temp file name
Private Declare Function GetTempFileName Lib "kernel32" _
Alias "GetTempFileNameA" (ByVal lpszPath As String, _
ByVal lpPrefixString As String, ByVal wUnique As Long, _
ByVal lpTempFileName As String) As Long
'+++ Functions needed for creating a temporary file to save our output to
while printing it.......
'variant arrays required to place data into chart
Private marrRowHeaders()
Private mstrHeaders()
'used in printing chart
Private Enum enuChartSize
Small = 1
MedIum = 2
Large = 3
End Enum
Private Sub Form_Load()
'call to sub to populate the chart
CreateAChart
End Sub
Private Sub CreateAChart()
Dim varCategories As Variant
Dim varCloseValues As Variant
Dim varLoValues As Variant
Dim varHiValues As Variant
Dim chtStock
varCategories = Array("1/3", "1/4", "1/5", "1/6", "1/7")
varCloseValues = Array(116.5625, 112.625, 113.8125, 110, 111.4375)
varLoValues = Array(112, 112.25, 109.375, 108.375, 107.4375)
varHiValues = Array(118.625, 117.125, 116.375, 113.875, 112.25)
' Adds a chart title.
With ChartSpace1
.HasChartSpaceTitle = True
.ChartSpaceTitle.Caption = "Microsoft Stock 1/3 - 1/7"
End With
' Adds a chart to the ChartSpace object.
Set chtStock = ChartSpace1.Charts.Add
chtStock.Type = chChartTypeStockHLC
' Specifies which fields in the recordset are values and labels.
chtStock.SetData chDimCategories, chDataLiteral, varCategories
With chtStock.SeriesCollection(0)
.SetData chDimCloseValues, chDataLiteral, varCloseValues
.SetData chDimHighValues, chDataLiteral, varLoValues
.SetData chDimLowValues, chDataLiteral, varHiValues
End With
' Specifies scaling for axis.
With chtStock.Axes(chAxisPositionLeft).Scaling
.Maximum = 120
.Minimum = 105
End With
' Specifies gridlines.
chtStock.Axes(chAxisPositionLeft).HasMinorGridlines = True
'Show the legend
ChartSpace1.HasChartSpaceLegend = True
End Sub
Private Sub Form_Resize()
With Form1
.Width = 6570
.Height = 5565
.ChartSpace1.Left = 210
.ChartSpace1.Height = 4305
.ChartSpace1.Top = 210
.ChartSpace1.Width = 6045
End With
End Sub
Private Sub mnuPrintChart_Click(Index As Integer)
Dim strTempFile As String
Dim lngAxes1FontSize As Long
Dim lngAxes2FontSize As Long
Dim lngLegendFontSize As Long
Dim lngTitleFontSize As Long
Dim lngNewAxes1FontSize As Long
Dim lngNewAxes2FontSize As Long
Dim lngNewLegendFontSize As Long
Dim lngNewTitleFontSize As Long
'get a name for the temporary GIF to be saved to
strTempFile = CreateTempFile("jTmp", "gif")
Dim chLeg As ChLegend
Set chLeg = ChartSpace1.ChartSpaceLegend
'save the current font sizes.....
With ChartSpace1.Charts(0)
lngAxes1FontSize = .Axes.Item(0).Font.Size
lngAxes2FontSize = .Axes.Item(1).Font.Size
lngLegendFontSize = chLeg.Font.Size
lngTitleFontSize = ChartSpace1.ChartSpaceTitle.Font.Size
End With
Select Case Index
Case 1
lngNewAxes1FontSize = 14
lngNewAxes2FontSize = 14
lngNewLegendFontSize = 14
lngNewTitleFontSize = 18
Case 2
lngNewAxes1FontSize = 12
lngNewAxes2FontSize = 12
lngNewLegendFontSize = 12
lngNewTitleFontSize = 14
Case 3
lngNewAxes1FontSize = 14
lngNewAxes2FontSize = 14
lngNewLegendFontSize = 14
lngNewTitleFontSize = 18
End Select
' 'create a temp file with a GIF of the chart
With ChartSpace1.Charts(0)
'X-axis text
.Axes.Item(0).Font.Size = lngNewAxes1FontSize
'Y-axis text
.Axes.Item(1).Font.Size = lngNewAxes2FontSize
'legend text
chLeg.Font.Size = lngNewLegendFontSize
'title text
ChartSpace1.ChartSpaceTitle.Font.Size = lngNewTitleFontSize
End With
'**Normally image export examples shown are as follows...
' ChartSpace1.ExportPicture strTempFile, "gif", 600, 400
' ...but we want a higher resolution image to improve image quality, so
this line is changed as follows in the code....
ChartSpace1.ExportPicture strTempFile, "gif", 1200, 800
'in my original post the code recommended was.....
' ChartSpace1.ExportPicture strTempFile, "gif", ChartSpace1.Width /
Index, ChartSpace1.Height / Index
'This line worked in my actual application because of the size of the
chart being displayed,
' If you use this line in this example, you will get a black rectangle.
You will need to experiment with the
' dimensions needed by your application to get the best results.
'There is probably a relationship between these parameters, the size of
the object being printed and the printer resolution
' that could be coded to auto-adjust these parameters for the best
looking printout. This is not a priority for me at this time,
' but if you find this before I do, please post it to the group.
'Be careful when increasing the chart resolution in this way.
' Increasing the resolution too much can result in printing a darker
(or even solid black) image
'load the temp image of the chart to print it using the picturebox
Picture1.Picture = LoadPicture(strTempFile)
PrintChart Picture1, CLng(Index)
'get rid of the temp file
Kill strTempFile
'reset the current font sizes.....
With ChartSpace1.Charts(0)
'X-axis text
.Axes.Item(0).Font.Size = lngAxes1FontSize
'Y-axis text
.Axes.Item(1).Font.Size = lngAxes2FontSize
'legend text
chLeg.Font.Size = lngLegendFontSize
'title text
ChartSpace1.ChartSpaceTitle.Font.Size = lngTitleFontSize
End With
End Sub
Private Sub PrintChart(pic As Picture, ChartSize As enuChartSize)
'ASSUMPTION!!!!!! This code assumes the user has a default printer!
' If no printer is installed this sub will error!
' To keep this sample short, the printer check code was removed.
Const intHiMetric As Integer = 8
Dim dblPicRatio As Double
Dim dblPrnWidth As Double
Dim dblPrnHeight As Double
Dim dblPrnRatio As Double
Dim dblPrnPicWidth As Double
Dim dblPrnPicHeight As Double
Dim blnResetToolbar As Boolean
Dim Prn As Printer
Set Prn = Printer
'Determine if picture should be printed in landscape or portrait and set
the orientation
If ChartSize = Large Then
If pic.Height >= pic.Width Then
' Taller than wide
Prn.Orientation = vbPRORPortrait
Else
' Wider than tall
Prn.Orientation = vbPRORLandscape
End If
End If
'Calculate device independent Width to Height ratio for picture
dblPicRatio = pic.Width / pic.Height
Dim x
'Calculate the dimentions of the printable area in HiMetric
dblPrnWidth = Prn.ScaleX(Prn.ScaleWidth, Prn.ScaleMode, intHiMetric)
dblPrnHeight = Prn.ScaleY(Prn.ScaleHeight, Prn.ScaleMode, intHiMetric)
'Calculate device independent Width to Height ratio for printer
dblPrnRatio = dblPrnWidth / dblPrnHeight
'Scale the output to the printable area
If dblPicRatio >= dblPrnRatio Then
'Scale picture to fit full width of printable area
dblPrnPicWidth = Prn.ScaleX(dblPrnWidth, intHiMetric, _
Prn.ScaleMode)
dblPrnPicHeight = Prn.ScaleY(dblPrnWidth / dblPicRatio, _
intHiMetric, Prn.ScaleMode)
Else
'Scale picture to fit full height of printable area
dblPrnPicHeight = Prn.ScaleY(dblPrnHeight, intHiMetric, _
Prn.ScaleMode)
dblPrnPicWidth = Prn.ScaleX(dblPrnHeight * dblPicRatio, _
intHiMetric, Prn.ScaleMode)
End If
'set high print quality
Prn.PrintQuality = vbPRPQHigh
'Print the picture using the PaintPicture method
Select Case ChartSize
Case 1
Prn.PaintPicture pic, (dblPrnPicWidth - 6000) / 2,
(dblPrnPicHeight - 4000) / 3, 6000, 4000
Case 2
Prn.PaintPicture pic, (dblPrnPicWidth - 10000) / 2,
(dblPrnPicHeight - 6667) / 3, 10000, 6667
Case 3
Prn.PaintPicture pic, 0, 0, dblPrnPicWidth, dblPrnPicHeight
End Select
'force the printing of the document
Prn.EndDoc
End Sub
Private Function CreateTempFile(sPrefix As String, sSuffix As String) As
String
Dim strTempPath As String * 512
Dim strTempName As String * 576
Dim lngRet As Long
lngRet = GetTempPath(512, strTempPath)
If (lngRet > 0 And lngRet < 512) Then
lngRet = GetTempFileName(strTempPath, sPrefix, 0, strTempName)
If lngRet <> 0 Then
strTempName = Left$(strTempName, _
InStr(strTempName, vbNullChar) - 1)
CreateTempFile = Left(Trim(strTempName),
Len(Trim(strTempName)) - 3) & sSuffix
End If
End If
End Function
'End Code Snippet ----------
