此為轉貼資料 在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