在vb元件內呼叫excel2000實現GIF餅圖 (轉)

在vb元件內呼叫excel2000實現GIF餅圖 (轉)[@more@]在vb內2000實現GIF餅圖

---

點選:405 

在vb元件內呼叫excel2000實現GIF餅圖
　　當我第一次使用excel的時候，就為excel的圖表功能所傾倒，實在強大，並且那些圖也挺漂亮了。後來我嘗試著在vb裡面呼叫excel所支援的vba功能，發現功能的確強大，就是十分繁瑣。後來就考慮用vb在excel外面包一層，寫成，去掉我們不需要的特性。這樣掉用起來就方便多了，所謂一勞永逸 :P。
　　在這裡，我將像大家介紹一個用vb編寫的餅圖元件，你只需要給它幾個簡單的引數，就可以生成一副GIF格式的圖片給你。呼叫例子如下：
 
 Dim obj
 Set obj = Create("ChinaChart.pie")
 obj.AddValue "男", 150
 obj.AddValue "女", 45
 obj.AddValue "不知道", 15
 obj.ChartName = "性別比例圖"
 obj.FileName = "d:123.gif"
 obj.SaveChart
　　除了在vb裡面可以呼叫，這段程式碼同樣也可以在asp裡面呼叫。
 
　　下面請follow me 編寫我們的元件。
　　 1.New project , 請選擇 dll，在project explorer皮膚上選擇project1,然後在屬性皮膚上修改其name為ChinaASPChart。同樣把裡面的class modules修改為pie

　　 2.儲存該project,將project存為chinaaspchart.vbp,將class1.cls存為pie.cls。

　　 3.選單project,選擇選單項References,然後請把 Active Server Pages Ojbect Library、Microsoft Excel 9.0 Object Library、COM+ Services Type Library選上。
注意：在NT4/上沒有COM+ Service Type Library這個東東，應該選Microsoft Transaction Server Type Library

　　 4.編輯pie.cls,程式碼如下：


 '------------------------------------------------------------------------------- 
 Dim xl
 Dim m_chartName
 Dim m_chartData()
 Dim m_chartType
 Dim m_fileName
 Public ErrMsg
 Public foundErr
 Dim iCount
 Type m_Value
 label As String
 value As Double
 End Type
 Dim tValue 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.SetData 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.ion.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
 '54 '柱狀圖
 End Sub
 '------------------------------------------------------------------------------- 

　　5. 如果實現柱狀圖？
 實際上前面的程式碼已經實現了柱狀圖的功能，只是預設是餅圖功能。呼叫程式碼改成如下：

 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

　　 6. 在asp裡面呼叫該元件畫圖並顯示它需要注意的地方。
　　 （1）圖片必須生成在目錄下。
　　 （2）asp執行在多環境下，必須加鎖處理
 　　可以透過application實現。其邏輯如下：

　if application("標誌")=0 then
 顯示圖片
 else
 application.lock
 生成圖片
 顯示圖片
 application("標誌")=0
 application.unlock
 end if
 當然何時需要生成圖片置標誌位，就需要您自己根據程式的要求來確定了。
 

總結：
　　COM裡面呼叫元件是一個十分有用的技巧，它的優點是開發相對簡單，使用方便，適合企業級低訪問量，高業務要求的應用，缺點是佔用資源高。
　　程式在 2000 Server + Office 2000 + .0 上測試透過。