VB6浮雕效果源代码
Private Sub Command1_Click() Dim r2, g2, b2 As Integer Dim r1, g1, b1 As Integer Dim c1 As Long Dim c2 As Long Dim x0 As Integer Dim y0 As Integer Screen.MousePointer = 11 m
Private Sub Command1_Click()
Dim r2, g2, b2 As Integer
Dim r1, g1, b1 As Integer
Dim c1 As Long
Dim c2 As Long
Dim x0 As Integer
Dim y0 As Integer
Screen.MousePointer = 11 'mouse呈沙漏形状
For x0 = 1 To Picture1.Width - 2
For y0 = 1 To Picture2.Height - 2
c1 = Picture1.Point(x0, y0)
r1 = (c1 And &HFF)
g1 = (c1 And 62580) / 256
b1 = (c1 And &HFF0000) / 65536
'获得Picture1中指定点(x0,y0)的R、G、B分量值
c2 = Picture1.Point(x0 + 1, y0 + 1)
r2 = (c2 And &HFF)
g2 = (c2 And 62580) / 256
b2 = (c2 And &HFF0000) / 65536
'获得Picture1中与(x0,y0)点相邻的点的R、G、B分量值
r1 = Abs(r1 - r2 + 128)
g1 = Abs(g1 - g2 + 128)
b1 = Abs(b1 - b2 + 128)
If r1 > 255 Then r1 = 255
If r1 < 0 Then r1 = 0
If b1 > 255 Then b1 = 255
If b1 < 0 Then b1 = 0
If g1 > 255 Then g1 = 255
If g1 < 0 Then g1 = 0
'计算浮雕处理后的R、G、B分量值
Picture2.PSet (x0, y0), RGB(r1, g1, b1)
'画出浮雕处理后的(x0,y0)
DoEvents
Next
Next
Screen.MousePointer = 0 '恢复mouse正常情况
End Sub
Private Sub Form_Load()
Picture1.Picture = LoadPicture(App.Path + "/鸟.bmp")
End Sub
开放原子开发者工作坊旨在鼓励更多人参与开源活动,与志同道合的开发者们相互交流开发经验、分享开发心得、获取前沿技术趋势。工作坊有多种形式的开发者活动,如meetup、训练营等,主打技术交流,干货满满,真诚地邀请各位开发者共同参与!
更多推荐
所有评论(0)