在vb元件內調用excel2000實現GIF圓形圖 |
|
jackkcg
站務副站長 發表:891 回覆:1050 積分:848 註冊:2002-03-23 發送簡訊給我 |
此為轉貼資料 在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 上測試通過。
**********************************************************************
有人可以改成delphi嗎? 還是可以請各大版主討論討論
------
********************************************************** 哈哈&兵燹 最會的2大絕招 這個不會與那個也不會 哈哈哈 粉好 Delphi K.Top的K.Top分兩個字解釋Top代表尖端的意思,希望本討論區能提供Delphi的尖端新知 K.表Knowlege 知識,就是本站的標語:Open our mind |
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |