[轉貼]在vb元件內調用excel2000實現GIF圓形圖

VB相關技術
回覆文章
頭像
tim
文章: 1379
註冊時間: 2008年 11月 26日, 00:49

[轉貼]在vb元件內調用excel2000實現GIF圓形圖

文章 tim »

此為轉貼資料

在vb元件內調用excel2000實現GIF圓形圖
當我第一次使用excel的時候,就?excel的圖表功能所傾倒,實在強大,並且那些圖也挺漂亮了。後來我嘗試著在vb裏面調用excel所支援的vba 功能,發現功能的確強大,就是十分繁瑣。後來就考慮用vb在excel外麵包一層,寫成物件,去掉我們不需要的特性。這樣掉用起來就方便多了,所謂一勞永逸 :P
  在這裏,我將像大家介紹一個用vb編寫的圓形圖元件,你只需要給它幾個簡單的參數,就可以生成一副GIF格式的圖片給你。調用例子如下:

Dim obj
Set obj = CreateObject("ChinaaspChart.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 , 請選擇activex dll,在project explorer面板上選擇project1,然後在屬性面板上修改其name?ChinaASPChart。同樣把裏面的class modules修改?pie

   2.保存該project,將project存?chinaaspchart.vbp,將class1.cls存?pie.cls。

   3.功能表project,選擇功能表項References,然後請把Microsoft Active Server Pages Ojbect Library、Microsoft Excel 9.0 Object Library、COM+ Services Type Library選上。
注意:在NT4/win98上沒有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.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
'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)圖片必須生成在web目錄下。
   (2)asp程式運行在多用戶環境下,必須加鎖處理
  可以通過application實現。其邏輯如下:

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


總結:
  COM裏面調用office元件是一個十分有用的技巧,它的優點是開發相對簡單,使用方便,適合企業級低訪問量,高業務要求的應用,缺點是佔用系統資源高。
  程式在Windows 2000 Server + Office 2000 + VB6.0 上測試通過。
多多留言, 整理文章, 把經驗累積下來.....
回覆文章