Dim Color As Long, newcolor As Long
Dim Width As Long, Height As Long
Width = UBound(SrcData, 2) + 1
Height = UBound(SrcData, 3) + 1
If Left = -1 Then Left = 0
If Top = -1 Then Top = 0
If Right = -1 Then Right = Width - 1
If Bottom = -1 Then Bottom = Height - 1
For j = Left To Right
For k = Height - Bottom - 1 To Height - Top - 1
blue = SrcData(0, j, k)
green = SrcData(1, j, k)
red = SrcData(2, j, k)
newcolor = CLng(0.299 * CDbl(red) + 0.585 * CDbl(green) + 0.114 * CDbl(blue)) '
newcolor = newcolor * 65793
red = newcolor Mod 256
green = newcolor / 256 Mod 256 '(9798 * RValue + 19235 * GValue + 3735 * BValue) / 32768
blue = newcolor / 256 / 256
DestData(0, j, k) = blue
DestData(1, j, k) = green
DestData(2, j, k) = red
Next
Next
End Sub
'黑白处理DestData(0 to 2, 0 to 宽度-1, 0 to 高度-1)
'图片最下面两行总是无法参与变换????只好将采集的图片区域向下多延伸2个像素
Public Sub ColorToBlackAndWhite(ByRef SrcData() As Byte, ByRef DestData() As Byte)
Dim i As Long, j As Long, k As Long
Dim red As Byte, green As Byte, blue As Byte
Dim Color As Long, newcolor As Long
Dim Width As Long, Height As Long
Width = UBound(SrcData, 2) + 1
Height = UBound(SrcData, 3) + 1
For j = 0 To Width - 1
For k = 0 To Height - 1
blue = SrcData(0, j, k)
green = SrcData(1, j, k)
red = SrcData(2, j, k)
newcolor = CLng(0.3 * CDbl(red) + 0.59 * CDbl(green) + 0.11 * CDbl(blue))
'newcolor = CLng(0.39 * CDbl(red) + 0.5 * CDbl(green) + 0.11 * CDbl(blue))
If newcolor127 Then newcolor = 255 Else newcolor = 0
red = newcolor
green = newcolor
blue = newcolor
DestData(0, j, k) = blue
DestData(1, j, k) = green
DestData(2, j, k) = red
Next
Next
End Sub
'黑白处理DestData(0 to 2, 0 to 宽度-1, 0 to 高度-1)
'图片最下面两行总是无法参与变换????只好将采集的图片区域向下多延伸2个像素
'OSTU算法可以说是自适应计算单阈值(用来转换灰度图像为二值图像)的简单高效方法 。
'1978 OTSU年提出的最大类间方差法以其计算简单、稳定有效,一直广为使用 。
Public Sub OtsuColorToBlackAndWhite(ByRef SrcData() As Byte, ByRef DestData() As Byte)
On Error Resume Next
Dim i As Long, j As Long, k As Long
Dim red As Byte, green As Byte, blue As Byte
Dim Color As Long, newcolor As Long
Dim Width As Long, Height As Long
Dim AllSum As Long, SumSmall As Long, SumBig As Long, PartSum As Long
Dim AllPixelNumber As Integer, PixelNumberSmall As Long, PixelNumberBig As Long
Dim ProbabilitySmall As Double, ProbabilityBig As Double, Probability As Double, MaxValue As Double
Dim BmpData() As Byte, Threshold As Byte
Dim Histgram(255) As Integer '图像直方图,256个点
Dim PixelNumber As Integer
Width = UBound(SrcData, 2) + 1
Height = UBound(SrcData, 3) + 1
PixelNumber = Width * Height
For i = 0 To Width - 1
For j = 0 To Height - 1
Histgram(SrcData(0, i, j)) = Histgram(SrcData(0, i, j)) + 1 '统计图像的直方图
Next
Next
For i = 0 To 255
AllSum = AllSum + i * Histgram(i)'质量矩
AllPixelNumber = AllPixelNumber + Histgram(i) '质量
Next
MaxValue = https://www.04ip.com/post/-1#
For i = 0 To 255
PixelNumberSmall = PixelNumberSmall + Histgram(i)
PixelNumberBig = AllPixelNumber - PixelNumberSmall
If PixelNumberBig = 0 Then Exit For
SumSmall = SumSmall + i * Histgram(i)
SumBig = AllSum - SumSmall
ProbabilitySmall = CDbl(SumSmall) / PixelNumberSmall
ProbabilityBig = CDbl(SumBig) / PixelNumberBig
'Probability = PixelNumberSmall * PixelNumberBig * (ProbabilityBig - ProbabilitySmall) * (ProbabilityBig - ProbabilitySmall)
推荐阅读
- 对峙2单机中文版下载安卓,对峙二下载中文版
- 怎么查看显卡gddr,怎么查看显卡驱动版本号
- pg用rpm包默认安装路径,rpm包指定安装目录
- 虚拟主机数据导入,虚拟主机备份的文件怎么导入
- linux系统命令目录 linux 命令目录
- sap命名,sap命名规则
- 拍摄书画注意什么,如何拍摄书画类文物
- mysql中怎么修改表格 mysql怎么修改表内容
- 学习c语言最好的课件的简单介绍