Photoshop自动色阶调整原理

关于自动色阶，用过PS的人应该都对他有所了解，在调整图像的视觉效果上这个调整滤镜的运用频率也是相当高的。关于其实现原理，网络上亦已经有不少人对其执行 了探讨和研究，这里只是再基本的给有兴趣的人复习一下。 
　　 首先计算出一副图像的直方图，也就是每个色阶（0~255）所对应的像素点的个数，然后沿0阶->255阶方向找到最小色阶点Min（所谓最小色阶点即第一个在某一阶上有点数出现的阶数，如在0阶时为0点，1阶时为0点，2阶也为0点，3阶为10点，4阶为5点,...,那么最小点应为3阶),　 同样最大值则是反方向从255阶开始第一个在某一阶上有点数出现的阶数Max.一般来讲，对以多彩图像最小色阶点=0，而最大色阶点为255。然后从最小色阶点开始选择整个图像总点数的0.5％的那一点做为新的最小点NewMin，再沿相反方向（即255阶->0阶方向）选择整个图像总点数的0.5％的那一点做为新的最大点NewMax，计两者之差为Differ,则每以原始像素点对应的新值可以按如下算法计算： 
If Color <= NewMin Then 
　　　 Color = 0 
ElseIf Color >= NewMax Then 
　　　 Color = 255 
Else 
　　　 Color = (Color - NewMin) * 255 / Differ 
End If　
　　 这里我们假设你已经加载了一副24位真多彩图像到一个叫做Pic的图像容器中，并且为了方便我们配置其AutoRedraw为True，现在我们要对这副图像执行 自动色阶的调整，除此之外，我们还希望处理的速度越快越好，首先我们请VB自带的Point和Pset函数站到一边去，他们处于图像处理的最低层（留心，不是最底层哦），接着，我们还要放弃对SetPixel和GetPixel的钟爱，因为他们和Point之流是一丘之貉。下一步，将目光瞄准GetBitmapBits和SetBitmapBits，哇，好名字，确实，这两个函数功能强大，但是我们不须要他们，因为他们是设备有关的，我不希望在我机器上能正常运行的程序在别人计算机上出现莫名其妙的效果。OK,还是请设备无关的函数GetDIBits，SetDIBits出山吧。关于这两个函数的运用要领，我不想详谈，但是你们可以记得，我们调用他们只是想高速的获得图像的点阵数据而已。　 

　　 为了大家理解方便，这里我们配置图像的数据为一二维的RGBQUAD结构体，该结构体由四个分量组成，分别表示了颜色空间的Red,Green,Blue,Alpha分量（有的地点最后一个变量名为Reserved,但这不妨碍我们）。其中的Alpha因为VB的StdPicture对象不支持，我们不予以关心。

'***************************自动色阶的模拟指针实现********************************* 
'**　 作者　　　　　　　　　 ：　　　 laviewpbt 
'**　 开发时间　　　　　 ：　　　　　 2008.7.1 
'**　 最后修改时间　 ：　　　　　 2008.8.28 
'**　 联系方式　　　　　 ：　　　　　 QQ:33184777 
'**　 E-MAIL　　　　　 :　　　　　 [e-mail] 
'**　 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的话也就在这个时间范围内。