PhotoShop的自动色阶功能的实现

核心提示： 好了说了这么多，下面给出代码，PhotoShop的自动色阶功能的实现(5)，'***自动色阶的模拟指针实现* '** 作者 ： laviewpbt '** 开发时间 ： 2008.7.1 '** 最后修改时间 ： 2008.8.28 '** 联系方式

好了说了这么多，下面给出代码。

'***************************自动色阶的模拟指针实现*********************************
'**　 作者　　　　　　　　　 ：　　　 laviewpbt
'**　 开发时间　　　　　 ：　　　　　 2008.7.1
'**　 最后修改时间　 ：　　　　　 2008.8.28
'**　 联系方式　　　　　 ：　　　　　 QQ:33184777
'**　 E-MAIL　　　　　 :　　　　　 laviewpbt@sina.com
'**　 Blog　　　　　　　　　 :　　　　　 http://blog.csdn.net/laviewpbt/
'**　 All Rights Resered，转载请保留以上信息

'***********************************************************************


Private Sub CmdPointer_Click()
　　　 Dim i　　　　　　　　　　　　　　　　　 As Long, j　　　　　　　　　　　　　　　　　 As Long
　　　 Dim DataArr(0 To 3)　　　 As Byte, pDataArr(0 To 0)　 As Long
　　　 Dim OldArrPtr　　　　　　　　　 As Long, OldpArrPtr　　　　　　　 As Long
　　　 Dim LineAddBytes　　　　　　　 As Long, PixelAddBytes　　　　　 As Long
　　　 Dim Bmp　　　　　　　　　　　　　　　 As Bitmap, T　　　　　　　　　　　　　　　 As Long
　　　　　　　　　　　　　　　　　　　
　　　 Dim HistRed(255)　　　　　　　 As Long, HistGreen(255)　　　　　　　 As Long
　　　 Dim HistBlue(255)　　　　　 As Long
　　　 Dim DiffRed　　　　　　　　　　　 As Long, DiffGreen　　　　　　　　　　　　　 As Long
　　　 Dim DiffBlue　　　　　　　　　　　 As Long, Diff　　　　　　　　　　　　　　　　　 As Long
　　　 Dim SpeedRed(255)　　　　　 As Byte, SpeedGreen(255)　　　　　　　 As Byte
　　　 Dim SpeedBlue(255)　　　　　 As Byte, Speed(255)　　　　　　　　　　　 As Byte
　　　 Dim Sum　　　　　　　　　　　　　　　 As Long, Integral　　　　　　　　　　　　　 As Long
　　　 Dim Min　　　　　　　　　　　　　　　 As Long, Max　　　　　　　　　　　　　　　　　　　 As Long
　　　 Dim NewMin　　　　　　　　　　　　　 As Long, NewMax　　　　　　　　　　　　　　　 As Long

　　　 T = GetTickCount
　　　
　　　 GetGDIObject Pic.Picture.Handle, Len(Bmp), Bmp
　　　 If Bmp.bmBits <> 0 Then　　　　　　　　　　　　　　　　　　　　　　　　　　　 '是个有效的图片
　　　　　　　 If Bmp.bmBitsPixel < 24 Then Exit Sub　　　　　　　　　　　 '不处理费真彩色图像，实际上，VB的picture属性也支持8位索引色的Bmp，如果你为了节省内存，采用改格式的图片，可以自行修改代码。
　　　　　　　 MakePoint VarPtrArray(DataArr), VarPtrArray(pDataArr), OldArrPtr, OldpArrPtr
　　　　　　　 PixelAddBytes = Bmp.bmBitsPixel / 8　　　　　　　　　　　　　　　 '可为3，可为4
　　　　　　　 pDataArr(0) = Bmp.bmBits　　　　　　　　　　　　　　　　　　　　　　　 '首地址
　　　　　　　 LineAddBytes = Bmp.bmWidthBytes - (Bmp.bmBitsPixel 8) * Bmp.bmWidth　 '每个扫描行额外多出的字节
　　　
　　　　　　　 For j = 1 To m_Height
　　　　　　　　　　　 For i = 1 To m_Width
　　　　　　　　　　　　　　　 HistRed(DataArr(2)) = HistRed(DataArr(2)) + 1
　　　　　　　　　　　　　　　 HistGreen(DataArr(1)) = HistGreen(DataArr(1)) + 1
　　　　　　　　　　　　　　　 HistBlue(DataArr(0)) = HistBlue(DataArr(0)) + 1
　　　　　　　　　　　　　　　 pDataArr(0) = pDataArr(0) + PixelAddBytes
　　　　　　　　　　　 Next
　　　　　　　　　　　 pDataArr(0) = pDataArr(0) + LineAddBytes
　　　　　　　 Next
　　　　　
　　　　　　　 For i = 0 To 255
　　　　　　　　　　　 If HistRed(i) <> 0 Then
　　　　　　　　　　　　　　　 Min = i
　　　　　　　　　　　　　　　 Exit For
　　　　　　　　　　　 End If
　　　　　　　 Next
　　　　　　　 For i = 255 To 0 Step -1
　　　　　　　　　　　 If HistRed(i) <> 0 Then
　　　　　　　　　　　　　　　 Max = i
　　　　　　　　　　　　　　　 Exit For
　　　　　　　　　　　 End If
　　　　　　　 Next
　　　　　　　
　　　　　　　 Sum = 0
　　　　　　　 For i = Min To Max
　　　　　　　　　　　 Sum = Sum + HistRed(i)
　　　　　　　 Next
　　　　　　　
　　　　　　　 Integral = 0
　　　　　　　 For i = Min To Max
　　　　　　　　　　　 Integral = Integral + HistRed(i)
　　　　　　　　　　　 If Integral >= Sum * 0.005 Then
　　　　　　　　　　　　　　　 NewMin = i
　　　　　　　　　　　　　　　 Exit For
　　　　　　　　　　　 End If
　　　　　　　 Next
　　　　　　　 For i = NewMin + 1 To Max
　　　　　　　　　　　 Integral = Integral + HistRed(i)
　　　　　　　　　　　 If Integral > Sum * 0.995 Then
　　　　　　　　　　　　　　　 NewMax = i
　　　　　　　　　　　　　　　 Exit For
　　　　　　　　　　　 End If
　　　　　　　 Next
　　　　　　　
　　　　　　　 For i = 0 To 255
　　　　　　　　　　　 If i <= NewMin Then
　　　　　　　　　　　　　　　 SpeedRed(i) = 0
　　　　　　　　　　　 ElseIf i >= NewMax Then
　　　　　　　　　　　　　　　 SpeedRed(i) = 255
　　　　　　　　　　　 Else
　　　　　　　　　　　　　　　 SpeedRed(i) = (i - NewMin) / (NewMax - NewMin) * 255
　　　　　　　　　　　 End If
　　　　　　　 Next
　　　
　　　
　　　 ''''''''''''''''''''''''''''
　　　　　 For i = 0 To 255
　　　　　　　　　　　 If HistGreen(i) <> 0 Then
　　　　　　　　　　　　　　　 Min = i
　　　　　　　　　　　　　　　 Exit For
　　　　　　　　　　　 End If
　　　　　　　 Next
　　　　　　　 For i = 255 To 0 Step -1
　　　　　　　　　　　 If HistGreen(i) <> 0 Then
　　　　　　　　　　　　　　　 Max = i
　　　　　　　　　　　　　　　 Exit For
　　　　　　　　　　　 End If
　　　　　　　 Next
　　　　　　　
　　　　　　　 Sum = 0
　　　　　　　 For i = Min To Max
　　　　　　　　　　　 Sum = Sum + HistGreen(i)
　　　　　　　 Next
　　　　　　　
　　　　　　　 Integral = 0
　　　　　　　 For i = Min To Max
　　　　　　　　　　　 Integral = Integral + HistGreen(i)
　　　　　　　　　　　 If Integral >= Sum * 0.005 Then
　　　　　　　　　　　　　　　 NewMin = i
　　　　　　　　　　　　　　　 Exit For
　　　　　　　　　　　 End If
　　　　　　　 Next
　　　　　　　
　　　　　　　 For i = NewMin + 1 To Max
　　　　　　　　　　　 Integral = Integral + HistGreen(i)
　　　　　　　　　　　 If Integral > Sum * 0.995 Then
　　　　　　　　　　　　　　　 NewMax = i
　　　　　　　　　　　　　　　 Exit For
　　　　　　　　　　　 End If
　　　　　　　 Next
　　　
　　　　　　　 For i = 0 To 255
　　　　　　　　　　　 If i <= NewMin Then
　　　　　　　　　　　　　　　 SpeedGreen(i) = 0
　　　　　　　　　　　 ElseIf i > NewMax Then
　　　　　　　　　　　　　　　 SpeedGreen(i) = 255
　　　　　　　　　　　 Else
　　　　　　　　　　　　　　　 SpeedGreen(i) = (i - NewMin) / (NewMax - NewMin) * 255
　　　　　　　　　　　 End If
　　　　　　　 Next


'''''''''''''''''''''''''

　　　　　　　 For i = 0 To 255
　　　　　　　　　　　 If HistBlue(i) <> 0 Then
　　　　　　　　　　　　　　　 Min = i
　　　　　　　　　　　　　　　 Exit For
　　　　　　　　　　　 End If
　　　　　　　 Next
　　　　　　　 For i = 255 To 0 Step -1
　　　　　　　　　　　 If HistBlue(i) <> 0 Then
　　　　　　　　　　　　　　　 Max = i
　　　　　　　　　　　　　　　 Exit For
　　　　　　　　　　　 End If
　　　　　　　 Next
　　　　　　　
　　　　　　　 Sum = 0
　　　　　　　 For i = Min To Max
　　　　　　　　　　　 Sum = Sum + HistBlue(i)
　　　　　　　 Next
　　　　　　　
　　　　　　　 Integral = 0
　　　　　　　 For i = Min To Max
　　　　　　　　　　　 Integral = Integral + HistBlue(i)
　　　　　　　　　　　 If Integral >= Sum * 0.005 Then
　　　　　　　　　　　　　　　 NewMin = i
　　　　　　　　　　　　　　　 Exit For
　　　　　　　　　　　 End If
　　　　　　　 Next
　　　　　　　
　　　　　　　 For i = NewMin + 1 To Max
　　　　　　　　　　　 Integral = Integral + HistBlue(i)
　　　　　　　　　　　 If Integral > Sum * 0.995 Then
　　　　　　　　　　　　　　　 NewMax = i
　　　　　　　　　　　　　　　 Exit For
　　　　　　　　　　　 End If
　　　　　　　 Next
　　　
　　　　　　　 For i = 0 To 255
　　　　　　　　　　　 If i <= NewMin Then
　　　　　　　　　　　　　　　 SpeedBlue(i) = 0
　　　　　　　　　　　 ElseIf i > NewMax Then
　　　　　　　　　　　　　　　 SpeedBlue(i) = 255
　　　　　　　　　　　 Else
　　　　　　　　　　　　　　　 SpeedBlue(i) = (i - NewMin) / (NewMax - NewMin) * 255
　　　　　　　　　　　 End If
　　　　　　　 Next
　　　　　　　 pDataArr(0) = Bmp.bmBits
　　　　　　　 For j = 1 To m_Height
　　　　　　　　　　　 For i = 1 To m_Width
　　　　　　　　　　　　　　　 DataArr(2) = SpeedRed(DataArr(2))
　　　　　　　　　　　　　　　 DataArr(1) = SpeedGreen(DataArr(1))
　　　　　　　　　　　　　　　 DataArr(0) = SpeedBlue(DataArr(0))
　　　　　　　　　　　　　　　 pDataArr(0) = pDataArr(0) + PixelAddBytes
　　　　　　　　　　　 Next
　　　　　　　　　　　 pDataArr(0) = pDataArr(0) + LineAddBytes
　　　　　　　 Next
　　　　　　　 FreePoint VarPtrArray(DataArr), VarPtrArray(pDataArr), OldArrPtr, OldpArrPtr
　　　　　　　 Pic.Refresh
　　　 End If
　　　　　　　　　　　
　　　 Me.Caption = "模拟指针用时" & GetTickCount - T & "毫秒"

End Sub

Private Sub MakePoint(ByVal DataArrPtr As Long, ByVal pDataArrPtr As Long, ByRef OldArrPtr As Long, ByRef OldpArrPtr As Long)
　　　 Dim Temp As Long, TempPtr As Long
　　　 CopyMemory Temp, ByVal DataArrPtr, 4　　　　　　　 '得到DataArrPtr的SAFEARRAY结构的地址
　　　 Temp = Temp + 12　　　　　　　　　　　　　　　　　　　　　　　　　　　 '这个指针偏移12个字节后就是pvData指针
　　　 CopyMemory TempPtr, ByVal pDataArrPtr, 4　　　 '得到pDataArrPtr的SAFEARRAY结构的地址
　　　 TempPtr = TempPtr + 12　　　　　　　　　　　　　　　　　　　　　 '这个指针偏移12个字节后就是pvData指针
　　　 CopyMemory OldpArrPtr, ByVal TempPtr, 4　　　 '保存旧地址
　　　 CopyMemory ByVal TempPtr, Temp, 4　　　　　　　　　 '使pDataArrPtr指向DataArrPtr的SAFEARRAY结构的pvData指针
　　　 CopyMemory OldArrPtr, ByVal Temp, 4　　　　　　　 '保存旧地址
End Sub


Private Sub FreePoint(ByVal DataArrPtr As Long, ByVal pDataArrPtr As Long, ByVal OldArrPtr As Long, ByVal OldpArrPtr As Long)
　　　 Dim TempPtr As Long
　　　 CopyMemory TempPtr, ByVal DataArrPtr, 4　　　　　　　 '得到DataArrPtr的SAFEARRAY结构的地址
　　　 CopyMemory ByVal (TempPtr + 12), OldArrPtr, 4　 '恢复旧地址
　　　 CopyMemory TempPtr, ByVal pDataArrPtr, 4　　　　　　　 '得到pDataArrPtr的SAFEARRAY结构的地址
　　　 CopyMemory ByVal (TempPtr + 12), OldpArrPtr, 4　 '恢复旧地址
End Sub

编译后测试，同样1024*768大小的图片，用模拟指针方法只需32ms左右，这个时间人是基本看不到延迟的。用VC的话也就在这个时间范围内。

怎么样，对VB的信心是不是又增加了不少，是的，VB一直是很优秀的。以前是，现在是，将来也是。

示例工程中有部分代码和本文中给出的不一致，但这不影响大局。