VB.NET 通过获取RGB值在Excel单元格填充绘图
VB.NET 通过获取RGB值在Excel单元格填充绘图
Imports System.Drawing.Imaging
Imports System.Runtime.InteropServices
Imports Microsoft.Office.Interop
Public Class Form1
Private Sub ToolStripMenuItem1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStripMenuItem1.Click
Dim path As String
ToolStripProgressBar1.Minimum = 0
ToolStripProgressBar1.Maximum = 1
ToolStripProgressBar1.Value = 0
OpenFileDialog1.ShowDialog()
path = OpenFileDialog1.FileName
pc.ImageLocation = path
ToolStripProgressBar1.Value = 1
If ToolStripProgressBar1.Value = ToolStripProgressBar1.Maximum Then ToolStripProgressBar1.ForeColor = Color.Red
ToolStripStatusLabel1.Text = "图片加载完成"
End Sub
Private Sub ToolStripMenuItem2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStripMenuItem2.Click
Dim xlapp As New Excel.Application
Dim xlbook As Excel.Workbook
Dim xlsheet As Excel.Worksheet
On Error Resume Next
'-------------------------------------------------
ToolStripProgressBar1.Minimum = 0
ToolStripProgressBar1.Maximum = pc.Image.Width - 1
ToolStripProgressBar1.Value = 0
ToolStripProgressBar1.ForeColor = Color.Blue
ToolStripStatusLabel1.Text = "正在绘图请耐心等待.."
'------------------------------------------------
xlapp.Application.Workbooks.Add(True)
xlapp.Visible = True
xlbook = xlapp.ActiveWorkbook
xlsheet = xlbook.ActiveSheet
xlsheet.Cells.ColumnWidth = 0.8
xlsheet.Cells.RowHeight = 4
xlapp.ActiveWindow.Zoom = 10
Dim str As String = ""
Dim x, y As Integer
Dim arr(pc.Image.Height - 1, 0 To 2)
Dim betmap As New Bitmap(pc.Image)
For x = 0 To pc.Image.Width - 1
For y = 0 To pc.Image.Height - 1
Dim getcolor As Color = betmap.GetPixel(x, y)
'arr(y, x) = RGB(getcolor.R.ToString, getcolor.G.ToString, getcolor.B.ToString)
xlsheet.Cells(y + 1, x + 1).Interior.Color = RGB(getcolor.R.ToString, getcolor.G.ToString, getcolor.B.ToString)
Application.DoEvents()
ToolStripProgressBar1.Value = x
Next
Next
If ToolStripProgressBar1.Value = ToolStripProgressBar1.Maximum Then ToolStripProgressBar1.ForeColor = Color.Red
ToolStripStatusLabel1.Text = "绘图完成"
xlsheet = Nothing
xlbook = Nothing
xlsheet = Nothing
MsgBox("ok")
End Sub
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
ToolStripStatusLabel1.Text = "就绪"
ToolStripProgressBar1.Value = 0
Me.TopMost = True
Application.DoEvents()
End Sub
End Class