在form1的代码编辑窗口中添加如下代码 Option Explicit Const pi = 3.1415926 'api函数声明------------------------------------------------------------ Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _ (Destination As Any, Source As Any, ByVal Length As Long) '拷贝内存
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, _ ByVal X As Long, ByVal Y As Long) As Long '取像素值
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, _ ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long '设置像素值
Private Sub cmd1_Click() cmd1.Enabled = False MakeSpark txtA, txtW, txtS, 0, txtE, 65, 10 cmd1.Enabled = True End Sub
Private Sub MakeSpark(Angle As Long, WidthOfArea As Long, _ Speed As Long, MaskColor As Long, _ EnhanceRatio As Single, OffsetX As Long, OffsetY As Long) '熠熠生辉效果 '参数表----------------------------------------------------- 'Angle 光照倾角 'WidthOfArea 光照区宽度 'Speed 光照区运动速度 'MaskColor 主体图的屏蔽色 'EnhanceRatio 光照强度参数 'OffsetX 主体图叠加到目标图时的 X 偏移 'OffsetY 主体图叠加到目标图时的 Y 偏移
Dim i&, X&, Y&, L&, Color&, EnhanceValue& Dim R As Byte, G As Byte, B As Byte
With picSource
For i = 0 To .Width + .Height * Tan(Angle * pi / 180) + WidthOfArea _ Step Speed '扫描主体图 For X = 0 To .Width - 1 For Y = 0 To .Height - 1 Color = GetPixel(.hdc, X, Y) '遍历主体图的像素 If Color = MaskColor Then 'skip跳过 Else L = Abs(X - (i - Y * Tan(Angle * pi / 180))) '计算当前像素于扫描线的 X 方向距离 If L <= WidthOfArea Then '如果当前像素在光照范围内 R = ExtractR(Color) '取 R,G,B 值 G = ExtractG(Color) B = ExtractB(Color) EnhanceValue = EnhanceRatio * (WidthOfArea - L) '算出要增强的亮度值 '加强亮度，但不能超过最大值 255 R = IIf(R + EnhanceValue > 255, 255, R + EnhanceValue) G = IIf(G + EnhanceValue > 255, 255, G + EnhanceValue) B = IIf(B + EnhanceValue > 255, 255, B + EnhanceValue) Color = RGB(R, G, B) '算出加强亮度后的颜色值 End If SetPixel picDest.hdc, X + OffsetX, Y + OffsetY, Color '拷贝像素到目标图 End If Next Y Next X picDest.Refresh '一帧已处理完，显示 DoEvents Next i End With End Sub Private Function ExtractR(Col As Long) As Byte '提取一个颜色值的红色分量值，红色分量位于这个颜色值的最低字节 Dim tmp As Byte CopyMemory tmp, ByVal VarPtr(Col), 1 ExtractR = tmp End Function Private Function ExtractG(Col As Long) As Byte '提取一个颜色值的绿色分量值，绿色分量的位置比红色分量高一字节 Dim tmp As Byte CopyMemory tmp, ByVal VarPtr(Col) + 1, 1 ExtractG = tmp End Function Private Function ExtractB(Col As Long) As Byte '提取一个颜色值的蓝色分量值，蓝色分量的位置比绿色分量高一字节 Dim tmp As Byte CopyMemory tmp, ByVal VarPtr(Col) + 2, 1 ExtractB = tmp End Function
本程序在Win2000+VB6.0下调试通过。
2/2 首页 上一页 1 2 |
