Public Function SmoothIconBlt(ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal hExeSrc As String, ByVal hIndex As Long, ByVal hSmallIcon As Boolean) As Long
Dim hSmIco As Long
Dim hLgIco As Long
Dim hResult As Long
Dim hImgDC As Long
Dim hMaskDC As Long
Dim hTempDC As Long
hImgDC = CreateMyDC(16, 16)
hMaskDC = CreateMyDC(16, 16)
hTempDC = CreateMyDC(16, 16)
Call ExtractIconEx(hExeSrc, hIndex, hLgIco, hSmIco, 1)
If hSmallIcon Then
hResult = DrawIconEx(hMaskDC, 0, 0, hSmIco, 16, 16, 0, 0, DI_MASK)
hResult = DrawIconEx(hImgDC, 0, 0, hSmIco, 16, 16, 0, 0, DI_IMAGE)
SmoothMaskFast hTempDC, hMaskDC, 0, 0, 16, 16, smoothval
AlphaBltFast hDestDC, X, Y, 16, 16, hImgDC, hMaskDC, 0, 0
Else
hResult = DrawIconEx(hMaskDC, 0, 0, hLgIco, 32, 32, 0, 0, DI_MASK)
hResult = DrawIconEx(hImgDC, 0, 0, hLgIco, 32, 32, 0, 0, DI_IMAGE)
SmoothMaskFast hTempDC, hMaskDC, 0, 0, 32, 32, smoothval * 2
AlphaBltFast hDestDC, X, Y, 32, 32, hImgDC, hMaskDC, 0, 0
End If
DestroyIcon hSmIco: DestroyIcon hLgIco
ReleaseDC frmMain.hwnd, hImgDC
ReleaseDC frmMain.hwnd, hMaskDC
ReleaseDC frmMain.hwnd, hTempDC
End Function
Public Function SmoothMaskFast(ByVal hDestDC As Long, ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal hWidth As Long, ByVal hHeight As Long, ByVal hSmoothWeight As Long)
Dim hInverse As Long
Dim I As Long, J As Long
Dim Base As Long
Dim Plus As Long
Dim Dot As Long
Dim Q As Long
Dim nDot As Long
Dim nPlus As Long
Dim xBitmap As Long
Dim xBMP As BITMAP
Dim xPic() As mRGB
Dim xMem As BITMAPINFO
xBitmap = GetCurrentObject(hDestDC, OBJ_BITMAP)
GetObjectAPI xBitmap, Len(xBMP), xBMP
With xMem.bmiHeader
.biBitCount = 32
.biCompression = BI_RGB
.biPlanes = 1
.biSize = Len(xMem.bmiHeader)
.biWidth = xBMP.bmWidth
.biHeight = xBMP.bmHeight
ReDim Preserve xPic(0 To (.biWidth * .biHeight) - 1) As mRGB
End With
GetDIBits hDestDC, xBitmap, 0, xBMP.bmHeight, xPic(0), xMem, DIB_RGB_COLORS
hInverse = 100 - (6 * hSmoothWeight)
'.+. This requires explaining. # will recieve hInverse rating, + will
'+#+ recieve hSmoothWeight rating, and . will recieve half of hSmoothWieght
'.+. as its rating. Thus 4 * hSmoothWeight + (4 * 0.5) * hSmoothWeight, or 6 * hSmoothweight
For J = Y To Y + (hHeight - 1)
For I = X To X + (hWidth - 1)
Dot = 0
Q = 0
Base = 0
Plus = 0
nPlus = 0
nDot = 0
Q = xPic(Morph2D(I, hHeight - J, hWidth)).R
Base = Mono(Q)
If Base = 0 Then
If I - 1 >= X Then
Plus = Plus + MonoA(xPic(Morph2D(I - 1, hHeight - J, hWidth)).R)
nPlus = nPlus + 1
If J - 1 >= Y Then
Dot = Dot + MonoA(xPic(Morph2D(I - 1, hHeight - (J - 1), hWidth)).R)
nDot = nDot + 1
End If
If J + 1 <= Y + (hHeight - 1) Then
Dot = Dot + MonoA(xPic(Morph2D(I - 1, hHeight - (J + 1), hWidth)).R)
nDot = nDot + 1
End If
End If
If I + 1 <= X + (hWidth - 1) Then
Plus = Plus + MonoA(xPic(Morph2D(I + 1, hHeight - J, hWidth)).R)
nPlus = nPlus + 1
If J - 1 >= Y Then
Dot = Dot + MonoA(xPic(Morph2D(I + 1, hHeight - (J - 1), hWidth)).R)
nDot = nDot + 1
End If
If J + 1 <= Y + (hHeight - 1) Then
Dot = Dot + MonoA(xPic(Morph2D(I + 1, hHeight - (J + 1), hWidth)).R)
nDot = nDot + 1
End If
End If
If J + 1 <= Y + (hHeight - 1) Then
Plus = Plus + MonoA(xPic(Morph2D(I, hHeight - (J + 1), hWidth)).R)
nPlus = nPlus + 1
End If
If J - 1 >= Y Then
Plus = Plus + MonoA(xPic(Morph2D(I, hHeight - (J - 1), hWidth)).R)
nPlus = nPlus + 1
End If
Plus = Plus / nPlus
Dot = Dot / nDot
Base = ((hInverse / 100) * Base) + ((hSmoothWeight * 4 / 100) * Plus) + ((hSmoothWeight * 2 / 100) * Dot)
With xPic(Morph2D(I, hHeight - J, hWidth))
.R = Base
.G = Base
.B = Base
End With
End If
Next I
Next J
SetDIBits hDestDC, xBitmap, 0, xBMP.bmHeight, xPic(0), xMem, DIB_RGB_COLORS
End Function
Public Function SmoothMask(ByVal hDestDC As Long, ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal hWidth As Long, ByVal hHeight As Long, ByVal hSmoothWeight As Long)
Dim hInverse As Long
Dim I As Long, J As Long
Dim Base As Long
Dim Plus As Long
Dim Dot As Long
Dim Q As Long
Dim nDot As Long
Dim nPlus As Long
hInverse = 100 - (6 * hSmoothWeight)
'.+. This requires explaining. # will recieve hInverse rating, + will
'+#+ recieve hSmoothWeight rating, and . will recieve half of hSmoothWieght
'.+. as its rating. Thus 4 * hSmoothWeight + (4 * 0.5) * hSmoothWeight, or 6 * hSmoothweight
For J = Y To Y + (hHeight - 1)
For I = X To X + (hWidth - 1)
Dot = 0
Q = 0
Base = 0
Plus = 0
nPlus = 0
nDot = 0
Q = GetPixel(hDestDC, I, J)
Base = Mono(Q)
If Base = 0 Then
Q = GetPixel(hdc, I - 1, J)
If Q <> -1 Then
Plus = Plus + Mono(Q)
nPlus = nPlus + 1
End If
Q = GetPixel(hdc, I + 1, J)
If Q <> -1 Then
Plus = Plus + Mono(Q)
nPlus = nPlus + 1
End If
Q = GetPixel(hdc, I, J - 1)
If Q <> -1 Then
Plus = Plus + Mono(Q)
nPlus = nPlus + 1
End If
Q = GetPixel(hdc, I, J + 1)
If Q <> -1 Then
Plus = Plus + Mono(Q)
nPlus = nPlus + 1
End If
Plus = Plus / nPlus
Q = GetPixel(hdc, I - 1, J - 1)
If Q <> -1 Then
Dot = Dot + Mono(Q)
nDot = nDot + 1
End If
Q = GetPixel(hdc, I + 1, J - 1)
If Q <> -1 Then
Dot = Dot + Mono(Q)
nDot = nDot + 1
End If
Q = GetPixel(hdc, I - 1, J + 1)
If Q <> -1 Then
Dot = Dot + Mono(Q)
nDot = nDot + 1
End If
Q = GetPixel(hdc, I + 1, J + 1)
If Q <> -1 Then
Dot = Dot + Mono(Q)
nDot = nDot + 1
End If
Dot = Dot / nDot
Base = ((hInverse / 100) * Base) + ((hSmoothWeight * 4 / 100) * Plus) + ((hSmoothWeight * 2 / 100) * Dot)
SetPixelV hDestDC, I, J, RGB(Base, Base, Base)
End If
Next I
Next J
End Function
Public Function Mono(Valu As Long) As Long
If Valu = 0 Then Mono = 0 Else Mono = 255
End Function
Public Function MonoA(Valu As Byte) As Long
If Valu = 0 Then MonoA = 0 Else MonoA = 255
End Function
Public Function CreateMyDC(Width As Long, Height As Long, Optional hCompatDC As Long) As Long
Dim iCompatDC As Long
Dim iDC As Long
If IsMissing(hCompatDC) Then
iCompatDC = GetDC(GetDesktopWindow)
Else
iCompatDC = hCompatDC
End If
iDC = CreateCompatibleDC(iCompatDC)
DeleteObject SelectObject(iDC, CreateCompatibleBitmap(iCompatDC, Width, Height))
CreateMyDC = iDC
End Function
Public Function DestroyDC(lngDC As Long) As Boolean
ReleaseDC frmMain.hwnd, lngDC
End Function
Public Function Morph2D(X As Long, Y As Long, NumRow As Long) As Long
Morph2D = (Y - 1) * NumRow + X
End Function
Reply With Quote