How do I blur the content of a picture box?

[rino_2]

Hi,

I have got a picture box containing a picture and I would like to blur this picture. I'm sure you have all seen it done in Paint Shop Pro etc... Please Help.

Thanks

[The Matrix]

' put this in the forms declarationsOption Explicit

Private 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
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Const SRCAND = &H8800C6
Private Const SRCCOPY = &HCC0020

' put this wherever whenever you want to fade the picture box

Dim lDC As Long
Dim lBMP As Long
Dim W As Integer
Dim H As Integer
Dim lColor As Long

Screen.MousePointer = vbHourglass


'
' Create Memory Compatible Bitmap to that in Picture1
'
lBMP = CreateCompatibleBitmap(Picture1.hdc, W, H)
'
' Create Compatible DC in memory
'
lDC = CreateCompatibleDC(Picture1.hdc)
'
' Select the Bitmap into the memory DC
'
Call SelectObject(lDC, lBMP)
BitBlt lDC, 0, 0, W, H, Picture1.hdc, 0, 0, SRCCOPY
'
' Quickly clear the Picture in Picture1
'
Picture1 = LoadPicture("")

For lColor = 255 To 0 Step -3
'
' Set the backcolor to a gray scale -> black
'
Picture1.BackColor = RGB(lColor, lColor, lColor)
'
' Copy the bitmap into the picturebox 'AND' with the backcolor
'
BitBlt Picture1.hdc, 0, 0, W, H, lDC, 0, 0, SRCAND
'
' Pause for a bit
'
Sleep 15
Next
'
' Clear up our DC's and Bitmaps
'
Call DeleteDC(lDC)
Call DeleteObject(lBMP)
Screen.MousePointer = vbDefault

[AndyK]

He said BLUR not fade...

[AndyK]

here is how to blur
1) make a picturebox (picture1)
2) make a commandbutton (command1)
3) place a image into it (try to place a photo, that way you can see the blur effect better)
4) paste this code into form

private Sub Command1_Click()
Dim X(10)
Dim XX(10)
Dim RedA(10) as Integer
Dim GreenA(10) as Integer
Dim BlueA(10) as Integer
X1 = 1: Y1 = 1
X2 = Picture1.ScaleWidth - 1: Y2 = Picture1.ScaleHeight - 1
Y = 0
L = 0
for I = Y1 to Y2
for J = X1 to X2
RedB = 0: GreenB = 0: BlueB = 0
X(0) = Picture1.Point(J, I)
X(1) = Picture1.Point(J - 1, I - 1)
X(2) = Picture1.Point(J - 1, I)
X(3) = Picture1.Point(J - 1, I + 1)
X(4) = Picture1.Point(J, I - 1)
X(5) = Picture1.Point(J, I + 1)
X(6) = Picture1.Point(J + 1, I - 1)
X(7) = Picture1.Point(J + 1, I)
X(8) = Picture1.Point(J + 1, I + 1)
for D = 0 to 8
MHB = X(D) + 1
RedTemp = MHB Mod 256
AX = Int(MHB / 256)
GreenTemp = AX Mod 256
BlueTemp = Int(AX / 256)
RedA(D) = RedTemp - 1
If RedTemp = 0 then RedA(D) = 0
GreenA(D) = GreenTemp
BlueA(D) = BlueTemp
next D
for D = 0 to 8
RedB = RedB + RedA(D)
GreenB = GreenB + GreenA(D)
BlueB = BlueB + BlueA(D)
next D
RedC = Int(RedB / 9)
GreenC = Int(GreenB / 9)
BlueC = Int(BlueB / 9)
If RedC < 0 then RedC = 0
If GreenC < 0 then GreenC = 0
If BlueC < 0 then BlueC = 0
If RedC > 255 then RedC = 255
If GreenC > 255 then GreenC = 255
If BlueC > 255 then BlueC = 255
Picture1.PSet (J, I), RGB(RedC, GreenC, BlueC)
next J
next I
End Sub

private Sub Form_Load()
Picture1.ScaleMode = 3
End Sub