vb生成饼图

在做数据统计时往往要实现这一功能,在网上找了好几个例子,
选定了两个,可是在VB6.0上运行都有些小错误,以下是修改后的代码,运行完全正确

方法一:用画圆的方法

Option Explicit

  Const PI As Double = 3.14159265359
  Const CircleEnd As Double = (-2 * PI)
 
Public Sub DrawPiePiece(lColor As Long, fStart As Double, fEnd As Double)

  Dim dStart As Double
  Dim dEnd As Double
  Picture1.FillColor = lColor
  Picture1.FillStyle = 0
  dStart = fStart * (CircleEnd / 100)
  dEnd = fEnd * (CircleEnd / 100)
  Picture1.Circle (100, 100), 60, , dStart, dEnd
End Sub

Private Sub Command1_Click()
  Picture1.ScaleMode = vbPixels
  Call DrawPiePiece(QBColor(10), 0.001, 48)
  Call DrawPiePiece(QBColor(11), 48, 55)
  Call DrawPiePiece(QBColor(15), 55, 85)
  Call DrawPiePiece(QBColor(14), 85, 99.999)
End Sub

不知道怎么的图象都不通知帖上,呵呵,本人刚开通这个博客,还有地方可能不会操作,

方法二:调用Excel 实现GIF饼图(这个方法也是经过修改在VB6.0上运行成功)

步骤:

1.打开VB,新建一个工程,然后在属性面板上修改首窗体的name为ChinaASPChart。添加一个类模块,把其名修改为pie

2.保存该工程,将工程存为chinaaspchart.vbp,将class1.cls存为pie.cls。

3.选择"菜单栏"的"工程"-->"引用…",然后请把Microsoft Active Server Pages Ojbect Library、Microsoft Excel 11.0 Object Library、COM+ Services Type Library选上。
4.编辑pie.cls,代码如下：
 Dim xl
  Dim m_chartName
  Dim m_chartType
  Dim m_fileName
  Public ErrMsg
  Public foundErr
  Dim iCount
  Private Type m_Value
      label As String
      value As Double
  End Type
  Dim tValue As m_Value
  Dim m_chartData() As m_Value
 
  Public Property Let ChartType(ChartType)
      m_chartType = ChartType
  End Property
  Public Property Get ChartType()
      ChartType = m_chartType
  End Property

  Public Property Let ChartName(ChartName)
      m_chartName = ChartName
  End Property
  Public Property Get ChartName()
      ChartName = m_chartName
  End Property
  Public Property Let FileName(fname)
      m_fileName = fname
  End Property
  Public Property Get FileName()
      FileName = m_fileName
  End Property
   
  Public Sub AddValue(label, value)
      iCount = iCount + 1
      ReDim Preserve m_chartData(iCount)
      tValue.label = label
      tValue.value = value
      m_chartData(iCount) = tValue
  End Sub
  Public Sub SaveChart()
      On Error Resume Next
      Dim iSheet
      Dim i
      Set xl = New Excel.Application
      xl.Application.Workbooks.Add
      xl.Workbooks(1).Worksheets("sheet1").Activate
      If Err.Number <> 0 Then
          foundErr = True
          ErrMsg = Err.Description
          Err.Clear
      Else
          xl.Workbooks(1).Worksheets("sheet1").Cells("2,1").value = m_chartName
          For i = 1 To iCount
              xl.Worksheets("Sheet1").Cells(1, i + 1).value = m_chartData(i).label
              xl.Worksheets("Sheet1").Cells(2, i + 1).value = m_chartData(i).value
          Next
          xl.Charts.Add
          xl.ActiveChart.ChartType = m_chartType
          xl.ActiveChart.SetSourceData xl.Sheets("Sheet1").Range("A1:" & Chr((iCount Mod 26) + Asc("A")) & "2"), 1
          xl.ActiveChart.Location 2, "Sheet1"
          With xl.ActiveChart
              .HasTitle = True
              .ChartTitle.Characters.Text = m_chartName
          End With
          xl.ActiveChart.ApplyDataLabels 2, False, _
              True, False
          With xl.Selection.Border
              .Weight = 2
              .LineStyle = 0
          End With
             
          xl.ActiveChart.PlotArea.Select
          With xl.Selection.Border
              .Weight = xlHairline
              .LineStyle = xlNone
          End With
          xl.Selection.Interior.ColorIndex = xlNone
         
          xl.ActiveWindow.Visible = False
         
          xl.DisplayAlerts = False
     
          xl.ActiveChart.Export m_fileName, FilterName:="GIF"
          xl.Workbooks.Close
          If Err.Number <> 0 Then
              foundErr = True
              ErrMsg = ErrMsg
              Err.Clear
          End If
      End If
      Set xl = Nothing
  End Sub
  Private Sub Class_Initialize()
      iCount = 0
      foundErr = False
      ErrMsg = ""
      m_chartType = -4102 'xl3DPie ''''''''''''''''''这里是实现的图形的形状   缺省是饼图功能(-4102)
                    '54 '柱状图
  End Sub
注释：-------------------------------------------------------------------------------
饼图的实现代码如下:

Private Sub Command1_Click()
  Dim obj
  Set obj = New pie
  obj.AddValue "男", 150
  obj.AddValue "女", 45
  obj.AddValue "不知道", 15
  obj.ChartName = "性别比例图"
  obj.FileName = "d:/123.gif"
  obj.SaveChart
End Sub

如果实现柱状图？
实际上前面的代码已经实现了柱状图的功能，只是缺省是饼图功能。调用代码改成如下：

Dim obj
Set obj = CreateObject("ChinaaspChart.pie")
obj.AddValue "男", 150
obj.AddValue "女", 45
obj.AddValue "不知道", 15
obj.ChartName = "性别比例图"
obj.FileName = "d:/123.gif"
obj.ChartType=54  '柱状图
obj.SaveChart


在asp里面调用该组件画图并显示它需要注意的地方。

（1）图片必须生成在web目录下。
（2）asp程序运行在多用户环境下，必须加锁处理

可以通过application实现。其逻辑如下：

if application("标志")=0 then
    显示图片
else
    application.lock
    生成图片
    显示图片
    application("标志")=0
    application.unlock
end if