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,b1) '画出浮雕处理后的(x0,y0) DoEvents Next Next Screen.MousePointer = 0 '恢复mouse正常情况
End Sub
Private Sub Form_Load() Picture1.Picture = LoadPicture(App.Path + "/鸟.bmp")End Sub (编辑:李大同)
【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容!
|