Muchas gracias czar9, quería usar esta matriz para crear una sombra difuminada de una imagen, (esto ya se hizo en vbAccelerator y también por Lavolpe) usando DIB, lo único que no me gusta mucho como difuminan la sombra es un método rápido pero hay algo que no me convence, entonces quería emplear esa matriz que en realidad cada valor de esta matriz seria un porcentaje Alpha de cada pixel de la imagen, osea algo así como un circulo que se desvanece.
pero bueno es muy lento ya que por cada pixel recore toda esa matriz.
Option Explicit
Private Declare Function GdipBitmapUnlockBits Lib "GdiPlus.dll" (ByVal mBitmap As Long, ByRef mLockedBitmapData As BitmapData) As Long
Private Declare Function GdipBitmapLockBits Lib "GdiPlus.dll" (ByVal mBitmap As Long, ByRef mRect As RECTL, ByVal mFlags As ImageLockMode, ByVal mPixelFormat As Long, ByRef mLockedBitmapData As BitmapData) As Long
Private Declare Function ExtCreateRegion Lib "gdi32" (lpXform As Any, ByVal nCount As Long, lpRgnData As Any) As Long
Private Declare Function GdipGetImageHeight Lib "GdiPlus.dll" (ByVal mImage As Long, ByRef mHeight As Long) As Long
Private Declare Function GdipGetImageWidth Lib "GdiPlus.dll" (ByVal mImage As Long, ByRef mWidth As Long) As Long
Private Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal Hdc As Long, ByRef graphics As Long) As Long
Private Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal graphics As Long) As Long
Private Declare Function GdipLoadImageFromFile Lib "gdiplus" (ByVal FileName As Long, ByRef image As Long) As Long
Private Declare Function GdiplusStartup Lib "gdiplus" (ByRef token As Long, ByRef lpInput As GDIPlusStartupInput, Optional ByRef lpOutput As Any) As Long
Private Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As Long) As Long
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As Long
Private Declare Function GdipGetImageGraphicsContext Lib "GdiPlus.dll" (ByVal mImage As Long, ByRef mGraphics As Long) As Long
Private Declare Function GdipDrawImageRectRect Lib "GdiPlus.dll" (ByVal mGraphics As Long, ByVal mImage As Long, ByVal mDstx As Single, ByVal mDsty As Single, ByVal mDstwidth As Single, ByVal mDstheight As Single, ByVal mSrcx As Single, ByVal mSrcy As Single, ByVal mSrcwidth As Single, ByVal mSrcheight As Single, ByVal mSrcUnit As Long, ByVal mImageAttributes As Long, ByVal mcallback As Long, ByVal mcallbackData As Long) As Long
Private Declare Function GdipCreateBitmapFromScan0 Lib "gdiplus" (ByVal Width As Long, ByVal Height As Long, ByVal stride As Long, ByVal PixelFormat As Long, scan0 As Any, BITMAP As Long) As Long
Private Declare Function GdipGetImageDimension Lib "GdiPlus.dll" (ByVal mImage As Long, ByRef mWidth As Single, ByRef mHeight As Single) As Long
Private Declare Function SetRect Lib "user32" (lpRect As Any, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Type GDIPlusStartupInput
GdiPlusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
Private Type BitmapData
Width As Long
Height As Long
stride As Long
PixelFormat As Long
Scan0Ptr As Long
ReservedPtr As Long
End Type
Private Type RECTL
Left As Long
Top As Long
Width As Long
Height As Long
End Type
Private Type RGBQUAD
Blue As Byte
Green As Byte
Red As Byte
Alpha As Byte
End Type
Private Enum ImageLockMode
ImageLockModeRead = &H1
ImageLockModeWrite = &H2
ImageLockModeUserInputBuf = &H4
End Enum
Private Type COLORMATRIX
m(0 To 4, 0 To 4) As Single
End Type
Private Const GdiPlusVersion As Long = 1&
Private Const PixelFormat32bppPARGB As Long = &HE200B
Dim GdipToken As Long
Dim m_hImage As Long
Private Function CreateMatrix(ByVal MatSize As Long) As Byte()
Dim bvMat() As Byte
Dim i As Long, j As Long, k As Long
ReDim bvMat(MatSize * 2 - 2, MatSize * 2 - 2)
For k = 0 To MatSize - 2
For j = k To MatSize - 1
bvMat(j, k) = k + 1
bvMat(MatSize * 2 - 3 - j, k) = k + 1
Next
For i = k To MatSize - 1
bvMat(k, i) = k + 1
bvMat(MatSize * 2 - 2 - k, i) = k + 1
Next
bvMat(k, k) = k
bvMat(MatSize * 2 - 2 - k, k) = k
Next
bvMat(MatSize - 1, MatSize - 1) = MatSize
For k = MatSize To MatSize * 2 - 2
For i = 0 To MatSize * 2 - 2
bvMat(i, k) = bvMat(i, MatSize * 2 - 2 - k)
Next
Next
CreateMatrix = bvMat
End Function
Private Sub InitGDI()
Dim GdipStartupInput As GDIPlusStartupInput
GdipStartupInput.GdiPlusVersion = GdiPlusVersion
Call GdiplusStartup(GdipToken, GdipStartupInput, ByVal 0)
End Sub
Private Sub TerminateGDI()
Call GdiplusShutdown(GdipToken)
End Sub
Private Sub Command1_Click()
Dim hImgShadow As Long
Dim hGraphic As Long
Dim lWidth As Single, lHeight As Single
Dim Blur As Long
Blur = 6
Me.Cls
GdipGetImageDimension m_hImage, lWidth, lHeight
hImgShadow = CreateBlurShadowImage(m_hImage, vbRed, Blur, 0, 0, lWidth, lHeight)
GdipCreateFromHDC Me.Hdc, hGraphic
GdipDrawImageRectRect hGraphic, hImgShadow, 0, 0, lWidth, lHeight, 0, 0, lWidth, lHeight, &H2, 0&, 0&, 0&
GdipDrawImageRectRect hGraphic, m_hImage, Blur, Blur, lWidth, lHeight, 0, 0, lWidth, lHeight, &H2, 0&, 0&, 0&
GdipDeleteGraphics hGraphic
GdipDisposeImage hImgShadow
Me.Refresh
End Sub
Private Sub Form_Load()
Call InitGDI
Call GdipLoadImageFromFile(StrPtr("C:\Documents and Settings\Administrador\Escritorio\Image6.png"), m_hImage)
Me.AutoRedraw = True
End Sub
Private Sub Form_Terminate()
Call GdipDisposeImage(m_hImage)
Call TerminateGDI
End Sub
Private Function CreateBlurShadowImage(ByVal hImage As Long, ByVal Color As Long, blurDepth As Long, _
Optional ByVal Left As Long, Optional ByVal Top As Long, _
Optional ByVal Width As Long, Optional ByVal Height As Long) As Long
Dim Rec As RECTL
Dim X As Long, Y As Long
Dim hImgShadow As Long
Dim bmpData1 As BitmapData
Dim bmpData2 As BitmapData
Dim Data1() As RGBQUAD
Dim Data2() As RGBQUAD
Dim bMatrix() As Byte
Dim t2xBlur As Long
Dim R As Long, G As Long, B As Long, A As Long
Dim Alpha As Byte
Dim lSrcAlpha As Long, lDestAlpha As Long
Dim XX As Long, YY As Long
If hImage = 0& Then Exit Function
If Width = 0& Then Call GdipGetImageWidth(hImage, Width)
If Height = 0& Then Call GdipGetImageHeight(hImage, Height)
bMatrix = CreateMatrix(blurDepth + 1)
t2xBlur = blurDepth * 2
R = Color And &HFF
G = (Color \ &H100&) And &HFF
B = (Color \ &H10000) And &HFF
'-----------------------------------------------
SetRect Rec, Left, Top, Width, Height
ReDim Data1(Rec.Width - 1&, Rec.Height - 1&)
With bmpData1
.Scan0Ptr = VarPtr(Data1(0&, 0&))
.stride = 4& * Rec.Width
End With
Call GdipBitmapLockBits(hImage, Rec, ImageLockModeUserInputBuf Or ImageLockModeRead, PixelFormat32bppPARGB, bmpData1)
'-----------------------------------------------
SetRect Rec, Left, Top, Width + t2xBlur, Height + t2xBlur
Call GdipCreateBitmapFromScan0(Rec.Width, Rec.Height, 0&, PixelFormat32bppPARGB, ByVal 0&, hImgShadow)
ReDim Data2(Rec.Width - 1&, Rec.Height - 1&)
With bmpData2
.Scan0Ptr = VarPtr(Data2(0&, 0&))
.stride = 4& * Rec.Width
End With
Call GdipBitmapLockBits(hImgShadow, Rec, ImageLockModeUserInputBuf Or ImageLockModeRead Or ImageLockModeWrite, PixelFormat32bppPARGB, bmpData2)
'-----------------------------------------------
For Y = 0 To Height - 1
For X = 0 To Width - 1
lSrcAlpha = Data1(X, Y).Alpha
If lSrcAlpha > 0 Then
For XX = X To X + t2xBlur
For YY = Y To Y + t2xBlur
lDestAlpha = Data2(XX, YY).Alpha
A = lDestAlpha + (lSrcAlpha * bMatrix(XX - X, YY - Y) / 255)
If A > 255 Then A = 255
With Data2(XX, YY)
.Alpha = A
.Red = R * A / 255
.Green = G * A / 255
.Blue = B * A / 255
End With
Next YY
Next XX
End If
Next X
Next Y
Call GdipBitmapUnlockBits(hImage, bmpData1)
Call GdipBitmapUnlockBits(hImgShadow, bmpData2)
CreateBlurShadowImage = hImgShadow
End Function
