-- 图片处理技术之二

每每看到一幅心中中意的图片，心里总想为它来点“别样”，而有了Anfy Java，这种心愿总算如愿了，您可以为其加下雪、加礼炮、加湖水倒影等等。下面我们也来赶一回潮流：新年来了，我们也为图片加上下雪效果，而且可以加上流动的广告词。为了使用方便，我们将其设计成ActiveX控件（*.OCX），以便网页中也能使用它。

一、实现方法

为了能达到仿真的下雪效果，我们需要在图片中加入近距离、中距离、远距离雪花的个数（分别用3、2、1个像素点表示）。在飞落的过程中，可以将定义如下：近距离向左、中距离左右、而远距离向右飘落或者返回之。这样看起来，有点打团的效果，非常不错。

因此，用下列方法产生下雪效果。

1、随机在画图的区域生成雪花的位置

2、下落的过程中，Y=y+1,而X的增量可以用随机数产生产生。

3、若y大于了区域的高度，需要从顶部重新产生一个雪花。

二、OCX设计方法

可以在我们的AddSnowCtrol.OCX中加入如下属性：

TextString:流动显示的广告词。

TextOffsetY:流动字符中显示的坐标，若为负数，表示底部显示。

NearSnowNum:近距离的雪花个数，设置在（0-500）之间。

MidSnowNum:中近距离的雪花个数，设置在（0-500）之间。

FarSnowNum:远距离的雪花个数，设置在（0-500）之间。

TextColor:文本色彩

BackColor:背景色彩

BackPictureName：背景图片文件名

Speed：运行的速度（0表示停止）

FontName：显示的字体名

FontSize：字体大小

以下为设计过程：

1、启动VB6.0，在新建工程文件中选中ActiveX控件。用户控件控件中加入Picture（Name定义为“picImd”）和Timer（Name定义为”Timer”两个控件。然后再添加一个模块Api.bas(第一篇介绍的WIN32 API)。

2、点击“外接程序”中的”ActiveX控件接口向导.....”(若没有需要加载)

(1)在可用名中选中”BackColor”,”FontName”,”BorderStyle”,”Timer”FontSize”，按下一步。

(2)在自定义成员中加入“AboutBox方法”、“TextColor”,”TextString”,”TextOffsetY”,”Speed”,”MidSnowNum”,”NearSnowNum”,”FarSnowNum”,”BackPictureName”属性，按下“下一步”

(3)将TextColor映射到“picImd”的“ForeColor”,FontName映射到picImd的 “FontName”,FontSize映射到PicImd的“FontSize”,”BackColor”映射到picImd的 “BackColor”,Speed映射到Timer的 Interval属性， Timer映射到Timer的Timer，其它选择（无）。按下一步。

(4)设置相关履属性：

TextString,BackPictureName As String

MidSnowNum,FarSnowNum,MidSnowNum,TextOffsetY As integer

按下一步。

(5)按下完成。

双击用户控件区域，出现代码部分，将其修改如下：

Const MAXNUM = 500

Const MINNUM = 0

Const SNOWCOLOR = &HFFFFFF

Const STEP = 3

Private r As RECT

Private hPic, HBrush As Long

Private hOldPic As Picture

Private w, h, TextLen As Integer '控件的高度

Private pW, pH As Integer '图片的高宽

Private IsFirst, IsCreate, IsChangeSize, IsCreateBrush As Boolean

Private x(2, MAXNUM), y(2, MAXNUM) As Integer

Private OffsetX, maxOffsetX As Integer

'缺省属性值:

Const m_def_BackPictureName = "AddSnowBack.jpg"

Const m_def_TextOffsetY = -1

Const m_def_NearSnowNum = 50

Const m_def_TextString = "为你的图片加下雪效果的AddSnowCtrol 设计：江龙 2000年1月29日"

Const m_def_FarSnowNum = 200

Const m_def_MidSnowNum = 100

Const m_def_Speed = 20

'事件声明:

Event Timer() 'MappingInfo=Timer,Timer,-1,Timer

'属性变量:

Dim m_BackPictureName, m_TextString As String

Dim m_TextOffsetY As Integer

Dim m_NearSnowNum As Integer

Dim m_FarSnowNum As Integer

Dim m_MidSnowNum As Integer

Private Sub CreateBrush() '建立一个刷子

Dim Brush As LOGBRUSH

Brush.lbColor = picImd.BackColor '用当前的背景色

Brush.lbStyle = 0

Brush.lbHatch = 0

HBrush = CreateBrushIndirect(Brush)  '建立一个刷子

IsCreateBrush = False '不再新建立

End Sub

Private Sub PaintBitmap() '将MEM位图信息写入控件

Dim i, j, m As Integer

Dim sw, sh, SnowNum As Integer

Dim hdc, hOldDc As Long

hdc = CreateCompatibleDC(picImd.hdc)

Call SelectObject(hdc, hPic)

Call FillRect(hdc, r, HBrush) '用当前用户选择的背景色清图形区域

If Not (hOldPic Is Nothing) Then

hOldDc = CreateCompatibleDC(picImd.hdc)

Call SelectObject(hOldDc, hOldPic)

sw = Min(w, pW)

sh = Min(h, pH)

Call BitBlt(hdc, 0, 0, sw, sh, hOldDc, 0, 0, SRCCOPY)

End If

For j = 0 To 2

SnowNum = Choose(j + 1, m_FarSnowNum, m_MidSnowNum, m_NearSnowNum)

For i = 0 To Min(SnowNum, MAXNUM)

y(j, i) = y(j, i) + STEP

t = Choose(j + 1, Rnd * 2, Rnd * -2, Rnd * -2 + 1)

x(j, i) = x(j, i) + Int(t)

If y(j, i) > h Then

x(j, i) = Int(Rnd() * (w + 1))

y(j, i) = Int(Rnd() * STEP)

End If

Call SetPixel(hdc, x(j, i), y(j, i), SNOWCOLOR)

If j = 2 Then Call SetPixel(hdc, x(j, i) - 1, y(j, i) + 1, SNOWCOLOR)

If j <> 0 Then Call SetPixel(hdc, x(j, i) + 1, y(j, i), SNOWCOLOR)

Next i

Next j

Call BitBlt(picImd.hdc, 0, 0, w, h, hdc, 0, 0, SRCCOPY) '将内存中的信息COPY到用户控件里

OffsetX = OffsetX - STEP

If OffsetX < maxOffsetX - w Then OffsetX = w

If m_TextOffsetY < 0 Then

m = picImd.ScaleHeight - picImd.FontSize - 4

Else

m = m_TextOffsetY

End If

Call TextOut(picImd.hdc, OffsetX, m, m_TextString, TextLen)

DeleteDC hdc

If Not (hOldPic Is Nothing) Then DeleteDC hOldDc

End Sub

Public Property Get BackColor() As OLE_COLOR

BackColor = picImd.BackColor

End Property

Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)

picImd.BackColor() = New_BackColor

IsCreateBrush = True

PropertyChanged "BackColor"

End Property

Public Property Get Speed() As Long

Speed = Timer.Interval

End Property

Public Property Let Speed(ByVal New_Speed As Long)

If Not (New_Speed < 0 And New_Speed > 300) Then

     Timer.Interval() = New_Speed

End If

PropertyChanged "Speed"

End Property

Private Sub CreateMemBitmap()

On Error Resume Next

If IsCreate Then  '需要重新装入图片

Set hOldPic = LoadPicture(m_BackPictureName) '若装入图片出错，则将文件名清空

If Err Or m_BackPictureName = "" Then '若错误

Set hOldPic = Nothing

pW = 0

pH = 0

Else

pW = hOldPic.Width

pH = hOldPic.Height

End If

IsCreate = False

End If

If IsChangeSize Then '图片改变了大小

If hPic Then Call DeleteObject(hPic)

hPic = CreateCompatibleBitmap(picImd.hdc, w, h)

IsChangeSize = False

End If

For j = 0 To 2 '随机生成雪片位置

For i = 0 To MAXNUM

x(j, i) = Int(Rnd() * (w + 1))

y(j, i) = Int(Rnd() * (h + 1))

Next i

Next j

End Sub

Private Sub Timer_Timer()

If IsCreateBrush Then '需要建立刷子

CreateBrush

End If

If IsCreate Or IsChangeSize Then '图片改变了或者区域大小改变

Call CreateMemBitmap '需要重新建立MEM位图

End If

Call PaintBitmap '重画控件

RaiseEvent Timer

End Sub

Private Sub UserControl_Initialize()

  hPic = 0 :  HBrush = 0

  IsFirst = True:  IsCreate = True

  IsChangeSize = True

  IsCreateBrush = True

End Sub

'为用户控件初始化属性

Private Sub UserControl_InitProperties()

m_TextString = m_def_TextString

Timer.Interval = m_def_Speed

picImd.FontSize = 9

picImd.FontName = "宋体"

m_BackPictureName = m_def_BackPictureName

m_TextOffsetY = m_def_TextOffsetY

m_NearSnowNum = m_def_NearSnowNum

m_FarSnowNum = m_def_FarSnowNum

m_MidSnowNum = m_def_MidSnowNum

End Sub

'从存贮器中加载属性值

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

picImd.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)

picImd.ForeColor = PropBag.ReadProperty("TextColor", &H80000012)

picImd.FontSize = PropBag.ReadProperty("FontSize", 9)

picImd.FontName = PropBag.ReadProperty("FontName", "宋体")

m_TextString = PropBag.ReadProperty("TextString", m_def_TextString)

Timer.Interval = PropBag.ReadProperty("Speed", m_def_Speed)

m_BackPictureName = PropBag.ReadProperty("BackPictureName", m_def_BackPictureName)

m_TextOffsetY = PropBag.ReadProperty("TextOffsetY", m_def_TextOffsetY)

m_NearSnowNum = PropBag.ReadProperty("NearSnowNum", m_def_NearSnowNum)

m_FarSnowNum = PropBag.ReadProperty("FarSnowNum", m_def_FarSnowNum)

m_MidSnowNum = PropBag.ReadProperty("MidSnowNum", m_def_MidSnowNum)

End Sub

Private Sub UserControl_Resize()

picImd.Width = Width

picImd.Height = Height

w = picImd.ScaleWidth + 3

h = picImd.ScaleHeight + 3

r.Top = 0  :r.Left = 0

r.Bottom = h :r.Right = w

IsChangeSize = True '控件改变了大小

If IsFirst Then '第一次运行

maxOffsetX = -picImd.TextWidth(m_TextString) '计算串长度

OffsetX = w :IsCreate = True

TextLen = Strlen(m_TextString)

End If

IsFirst = False

End Sub

Private Sub UserControl_Terminate()

If Not (hOldPic Is Nothing) Then Set hOldPic = Nothing

If hPic Then DeleteObject hPic