Code:Option Explicit Const AC_SRC_OVER = &H0 Const SW_MINIMIZE = 6 Private Type BLENDFUNCTION BlendOp As Byte BlendFlags As Byte SourceConstantAlpha As Byte AlphaFormat As Byte End Type Private Type BITMAP bmType As Long bmWidth As Long bmHeight As Long bmWidthBytes As Long bmPlanes As Integer bmBitsPixel As Integer bmBits As Long End Type Private Type POINTAPI x As Long y As Long End Type Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long Private Declare Sub RtlMoveMemory Lib "kernel32.dll" (Destination As Any, Source As Any, ByVal Length As Long) Private Declare Function AlphaBlend Lib "msimg32.dll" (ByVal hdc As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal hdc As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal BLENDFUNCT As Long) As Long 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 DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function GetForegroundWindow Lib "user32" () As Long Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long Dim STDHdc As Long, STDSpec As Long, PicPos As POINTAPI Dim BufBit As Long, BufHdc As Long Dim bf As BLENDFUNCTION Private Sub Command1_Click() blur 3 End Sub Private Sub Form_Load() Timer1.Enabled = False Me.Caption = "Shut Me down" Me.WindowState = 0 Me.Show BufHdc = CreateCompatibleDC(0) BufBit = CreateCompatibleBitmap(GetDC(0), 401, 401) SelectObject BufHdc, BufBit STDHdc = CreateCompatibleDC(0) STDSpec = CreateCompatibleBitmap(GetDC(0), 401, 401) SelectObject STDHdc, STDSpec Timer1.Interval = 2000 Timer1.Enabled = True End Sub Private Sub Form_Unload(Cancel As Integer) DeleteDC STDHdc DeleteDC BufHdc DeleteObject BufBit DeleteObject STDSpec End End Sub Private Sub blur(intensity As Integer) Dim x As Long, y As Long, SPREAD As Single, LBF As Long SPREAD = 128 With bf .BlendOp = AC_SRC_OVER .BlendFlags = 0 .SourceConstantAlpha = SPREAD .AlphaFormat = 0 End With RtlMoveMemory LBF, bf, 4 PicPos.x = 100 PicPos.y = 100 BitBlt STDHdc, 0, 0, 401, 401, _ GetDC(0), PicPos.x - 200, PicPos.y - 200, vbSrcCopy BitBlt BufHdc, 0, 0, 401, 401, STDHdc, 0, 0, vbSrcCopy If intensity > 0 Then For x = 0 To intensity - 1 AlphaBlend BufHdc, 0, 0, 400, 401, _ STDHdc, 1, 0, 400, 401, LBF BitBlt STDHdc, 0, 0, 401, 401, _ BufHdc, 0, 0, vbSrcCopy AlphaBlend BufHdc, 1, 0, 400, 401, _ STDHdc, 0, 0, 400, 401, LBF BitBlt STDHdc, 0, 0, 401, 401, _ BufHdc, 0, 0, vbSrcCopy AlphaBlend BufHdc, 0, 0, 401, 400, _ STDHdc, 0, 1, 401, 400, LBF BitBlt STDHdc, 0, 0, 401, 401, _ BufHdc, 0, 0, vbSrcCopy AlphaBlend BufHdc, 0, 1, 401, 400, _ STDHdc, 0, 0, 401, 400, LBF BitBlt STDHdc, 0, 0, 401, 401, _ BufHdc, 0, 0, vbSrcCopy AlphaBlend BufHdc, 0, 0, 400, 400, _ STDHdc, 1, 1, 400, 400, LBF BitBlt STDHdc, 0, 0, 401, 401, _ BufHdc, 0, 0, vbSrcCopy AlphaBlend BufHdc, 1, 1, 400, 400, _ STDHdc, 0, 0, 400, 400, LBF BitBlt STDHdc, 0, 0, 401, 401, _ BufHdc, 0, 0, vbSrcCopy AlphaBlend BufHdc, 0, 1, 400, 400, _ STDHdc, 1, 0, 400, 400, LBF BitBlt STDHdc, 0, 0, 401, 401, _ BufHdc, 0, 0, vbSrcCopy AlphaBlend BufHdc, 1, 0, 400, 400, _ STDHdc, 0, 1, 400, 400, LBF BitBlt STDHdc, 0, 0, 401, 401, _ BufHdc, 0, 0, vbSrcCopy Next End If BitBlt GetDC(0), PicPos.x - 200, PicPos.y - 200, 401, 401, _ BufHdc, 0, 0, vbSrcCopy End Sub Private Sub Timer1_Timer() Timer1.Enabled = False End Sub




Reply With Quote