——-- 图片处理技术之一

用过Anfy Java程序的用户一定不会忘记其优秀的图像效果处理技术：DUMP、DEFORM、FIREWORKS、SNOW、HUEROT、LAKE、LENS、ROT、WARP、WATER等等,的确让人兴奋不已。(若读者还不曾用过Anfy,可以到其相关网页http://www.AnfyTeam.com//ln//chisimp/ajdownl.htm上去下载,约2917KB,V1.4.3)。但作为爱好编程的“程序员”,老用别人的东西,总觉得心得不舒服,因此笔者也用VB6.0设计了出图片平滑过渡、加下雪效果这两种方法,以飨读者,而且可以将其设计成ActiveX,在您的网页中也可以使用--有时候，看着自己亲手做的东西，不管是否完美，总觉得有种自豪的感觉--也许这就叫做“自我陶醉”。

为了高效处理图形,当然需要用到WIN32 API,以下为常量定义及申明(用户可以利用VB6.0中API浏览器插入),我们将其存入模块API.bas中：

Attribute VB_Name = "API模块"Const MILLICMETERCELL = 26.45836  '每一个像素点相当于多少微米Public Const BLACKNESS = &H42Public Const WHITENESS = &HFF0062Public Const DSTINVERT = &H550009

Public Const NOTSRCCOPY = &H330008

Public Const NOTSRCERASE = &H1100A6

Public Const SRCAND = &H8800C6

Public Const SRCCOPY = &HCC0020

Public Const SRCERASE = &H440328

Public Const SRCINVERT = &H660046

Public Const SRCPAINT = &HEE0086

Public Type RECT

     Left As Long

     Top As Long

     Right As Long

     Bottom As Long

End Type

Public Type LOGBRUSH

  lbStyle As Long

  lbColor As Long

  lbHatch As Long

End Type

Public Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long

Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long

Public Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long

Public Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long

Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long

Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long

Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Public Declare Function PatBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Long) As Long

Public Declare Function CreateBrushIndirect Lib "gdi32" (lpLogBrush As LOGBRUSH) As Long

Public Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal HBrush As Long) As Long

Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

Public Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long

Public Declare Function CreatePalette Lib "gdi32" (lpLogPalette As LOGPALETTE) As Long

Public Declare Function SelectPalette Lib "gdi32" (ByVal hdc As Long, ByVal hPalette As Long, ByVal bForceBackground As Long) As Long

Public Declare Function GetPaletteEntries Lib "gdi32" (ByVal hPalette As Long, ByVal wStartIndex As Long, ByVal wNumEntries As Long, lpPaletteEntries As PALETTEENTRY) As Long

Public Declare Function GetBitmapDimensionEx Lib "gdi32" (ByVal hBitmap As Long, lpDimension As Size) As Long

Public Declare Function GetBkColor Lib "gdi32" (ByVal hdc As Long) As Long

以下还将定义几个常用到的函数：

'返回两者中较小的一个

Public Function Min(ByVal a As Integer, ByVal b As Integer) As Integer

Min = IIf(a > b, b, a)

End Function

'返回两者中较大的一个

Public Function Max(ByVal a As Integer, ByVal b As Integer) As Integer

Max = IIf(a > b, a, b)

End Function

以下三个函数获取色彩中的各分量值

'取色彩中n的Red的值

Public Function GetRed(ByVal n As Long) As Integer

GetRed = n Mod 256&

End Function

'取色彩n中的Green的值

Public Function GetGreen(ByVal n As Long) As Integer

GetGreen = (n \ 256&) Mod 256&

End Function

'取色彩n中的Blue的值

Public Function GetBlue(ByVal n As Long) As Integer

GetBlue = n \ 65536

End Function

在VB6.0中,函数Len(s)将返回中字符的个数(一个汉字也是被定义为一个字符长度),而在WIN32 API TextOut()要求字符串长度将一个汉字定义为2个字符,因此需要全新的计算长度串函数

'取字符串中有多少个字符(1个汉字定义为2个字符宽度)

Public Function Strlen(ByVal s As String) As Integer Dim i As Integer  n = Len(s)  For i = 1 To n    If Asc(Mid$(s, i, 1)) < 0 Then n = n + 1 ‘若为汉字,字符个数加1

Next i

Strlen = n

End Function

以下两个函数返回用户用LoadPicture(PictureFileName)函数装入的图片的高、宽度(以像素为单位),原始的用MILLICMETER为单位。

'获取位图的宽度(以像素为单位)

Public Function GetPictureWidth(ByVal p As Picture) As Integer

GetPictureWidth = Int(p.Width / MILLICMETERCELL + 0.5)

End Function

'获取位图的高度(以像素为单位)

Public Function GetPictureHeight(ByVal p As Picture) As Integer

GetPictureHeight = Int(p.Height / MILLICMETERCELL + 0.5)

End Function

用过Photoshop 5.0的用户,一定不会忘记Trient工具,它可将一种色彩平滑过渡到另一种色彩。以下这个函数可以帮我们完成这个任务。

'获取渐变色彩值'入口参数：SrcColor 原色彩'          Steps 步骤数'          CurStep 当前的步子'          DstColor 目标色彩'返回值：当前的色彩值Public Function GetTrienColor(ByVal scrColor As Long, ByVal dstColor As Long, ByVal Steps As Integer, ByVal curStep As Integer) As Long

Dim sR, sG, sB, dR, dG, dB As Integer

sR = GetRed(scrColor)

sG = GetGreen(scrColor)

sB = GetBlue(scrColor)

dR = GetRed(dstColor)

dG = GetGreen(dstColor)

dB = GetBlue(dstColor)

sR = sR + curStep * (dR - sR) / Steps

sG = sG + curStep * (dG - sG) / Steps

sB = sB + curStep * (dB - sB) / Steps

GetTrienColor = RGB(sR, sG, sB)

End Function

例如：若用户想在Name为Pic的Picture控件中,从Blue色彩平滑过渡到Black,我们可以这样加进处理代码：

Pic.ScaleMode=3 ‘设置模式为像素

w=pic.ScaleWidth ‘取图片的高度和宽渡

h=pic.ScaleHeight

for i=0 to w

CurColor=GetTrientColor(Blue,Black,w,i)

pic.line (i,0)-(i,h),CurColor

next i

以上的常见函数,用户也应该将其添加到API.bas中。

一、实现方法

为了从一个图片P1平滑向另一个图片P2过渡,如下图(从右到左将一红花的图片过渡到雪景的图片)：

若用户仔细观察,您会发现,其实可以将过渡的画面分为三个部分：原始图片P1部分、过渡效果部分和目标图片P2部分。对于原始部分和目标部分,我们可以利用Bitblt()直接SRCCOPY过去即可,因此重要的即是得处理过渡部分。

在上述的API.bas文件中，我们知道GetTrientColor，可以帮我们完成从一种色彩渐进到另一种色彩。我们设过渡部分的宽度为tw, 当前显示区域的高为h,显示的横坐标为x,那么从右到左过渡,即是从目标色彩渐进到原始的色彩,换句话说：在色彩成分中,目标色由100%逐减到0%,而原始色彩则有0%逐增到100%,其处理方法如下：

for i=0 to tw

    xx=x+i ’当前显示的横坐标X

    for j=0 to h-1

p1Color=GetPixel(p1,xx,j) ‘取图片1的原始色彩

p2=Color=GetPixel(p2,xx,j)’取图片2的原始色彩

CurColor=GetTreintColor(p1color,p2Color,tw,i) ‘取当前从p1Color平滑过渡到p2Color当前的渐进色

SetPixel(目标DC,xx,j,CurColor)

    Next j

Next i

以上只是处理一个片断部分,若需要处理整个平滑过渡效果,还需要加入一个外循环。另外,为了能高效处理从p1到p2的过渡过程,需要将图片加入到内容兼容的DC中

dim p1 ,p2 as Picture

p1=LoadPicture(P1FileName) ‘装入图片1

p2=LoadPicture(p2)’装入图片2

p1Dc=CreateCompatibleDC(目标DC) ‘建立一个如目标dc兼容的dc

SelectObject(p1Dc,p1) ‘将图片1选入其中

P2Dc=CreateCompatibleDC(目标DC)

SelectObject(p2Dc,p2)

以下程序PictureTranstion.bas可完成①整个图片平滑过渡到另一个图片②从左到右③从右到左④从上到下⑤从下到上等五种处理过程,用户还可以根据以上原理加入其它处理方式,如由小圆逐渐扩展到大圆,从左右同时到中央等等。由于本程序采用取点画点处理方法,处理的速度会因为平滑过渡图片部分的宽度或高度(若是整个图片的过渡,此时表示过渡的帧数)的增加而变得非常慢,但此时的处理效果最好,当然若设置成非常小,即是一般的从左到右或其它类型的转换处理方法。因此在实际的处理中,还应该充许用户中断,最好的办法是的在处理的循环中加入DoEvents,而在函数传递入口处加入一个用地址传送(VB默认的一种方式)的变量IsExit(表示是否中断),用户调用时,可以用一个变量传递,需要中断时,可以将其变量设置成真。(当然,应该在编程中防止二次调用)

Attribute VB_Name = "Module2"

'定义效果类型

'整个图片从1幅到另一幅

Public Const FromP1toP2 = 0

Public Const FromLeftToRight = 1     '从左到右

Public Const FromRightToLeft = 2     '从右到左

Public Const FromUpToDwon = 3     '从上到下

Public Const FromDownToUp = 4     '从下到上

'效果返回定义

Public Const TransOK = 0    '正常

Public Const TransP1NotFound = -1 '图片1没有找到或者不是图片文件

Public Const TransP2NotFound = -2 '图片1没有找到或者不是图片文件

Public Const TransUserBreak = -3 '用户中断

'下列程序完成从一幅图片转化到另一幅图片的过程

'入口参数: srcPictureFileName 原图片文件名

'dstPictureFileName 转换后的目标文件名

'w,h 目标设备的高,宽(以像素为单位)

'dstDc 目标设备DC

'Speed  转化速度(值越大效果越好,但速度最慢)

'IsExit 表示是否中断,请用变量传递

'例：Call P1ToP2(,....IsExit)

' 若要求中断,可以在另外的动作中要求IsExit=true

'ShowType 效果类型(见TransEnum说明)

'返回值：见TransError说明

Public Function P1ToP2(ByVal srcPictureFileName As String, ByVal dstPictureFileName As String, ByVal dstDc As Long, w As Long, h As Long, ByVal Speed As Integer, ByVal ShowType As Integer, IsExit As Boolean) As Integer

Dim  h1Dc, h2Dc, hMemDC, hMemPic As Long

Dim p1, p2 As Picture

Dim Result As integer

IsExit = False '进入时,不中断

On Error Resume Next

Set p1 = LoadPicture(srcPictureFileName) '装入图片1

If Err Then

P1ToP2 = TransP1NotFound

Exit Function '若出错,则退出

End If

Set p2 = LoadPicture(dstPictureFileName)

If Err Then '装入图片2,若出错,则删除装入的图片1,然后退出

Set p1 = Nothing

P1ToP2 = TransP2NotFound

Exit Function

End If

h1Dc = CreateCompatibleDC(dstDc) '建立一个和目标上下文环境兼容的DC

Call SelectObject(h1Dc, p1) '将图片1选入中

h2Dc = CreateCompatibleDC(dstDc) '建立一个和目标上下文环境兼容的DC

Call SelectObject(h2Dc, p2) '将图片2选入中

hMemDC = CreateCompatibleDC(dstDc) '建立一个兼容的内存位图

hMemPic = CreateCompatibleBitmap(dstDc, w, h)

Call SelectObject(hMemDC, hMemPic) '选入设备中

Result = PictureTransition(h1Dc, h2Dc, hMemDC, dstDc, w, h, Speed, ShowType, IsExit)

Set p1 = Nothing

Set p2 = Nothing

Call DeleteDC(h1Dc)

Call DeleteDC(h2Dc)

Call DeleteDC(hMemDC)

Call DeleteObject(hMemPic)

P1ToP2 = Result

End Function