VB Code:
Public Function TextBlt(ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal Text As String, ByVal TextColour As Long, ByVal TextPoint As Integer, ByVal TextFace As String, ByVal dwFlags As TEXTDRAWPARAM)
Dim tRect As RECT
Dim Q As SIZE
GetTextExtentPoint32 hDestDC, Text, Len(Text), Q
With tRect
If dwFlags And TDP_RIGHT Then
.Left = x - (Q.cx + 5)
.Right = x
ElseIf dwFlags And TDP_HCENTRE Then
.Left = x - (Q.cx / 2)
.Right = x + (Q.cx / 2)
Else
.Left = x
.Right = x + (Q.cx - 1)
End If
If dwFlags And TDP_BOTTOM Then
.Top = y - (Q.cy + 5)
.Bottom = y
ElseIf dwFlags And TDP_VCENTRE Then
.Top = y - (Q.cy / 2)
.Bottom = y + (Q.cy / 2)
Else
.Top = y
.Bottom = y + (Q.cy - 1)
End If
End With
SelectObject hDestDC, CreateMyFont(TextPoint, TextFace)
SetTextColor hDestDC, TextColour
DrawText hDestDC, Text, Len(Text), tRect, 0
End Function
Public Function CreateMyFont(nSize As Integer, sFace As String) As Long 'FROM ALL-API.NET, MODIFIED
'Create a specified font
CreateMyFont = CreateFont(-MulDiv(nSize, GetDeviceCaps(GetDC(0), LOGPIXELSY), 72), 0, 0, 0, FW_NORMAL, False, False, False, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, PROOF_QUALITY, DEFAULT_PITCH, sFace)
End Function
Public Function CropTextBlt(ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal Width As Long, ByVal Text As String, ByVal TextColour As Long, ByVal TextPoint As Integer, ByVal TextFace As String, ByVal dwFlags As TEXTDRAWPARAM)
Dim CropText As String
Dim Q As SIZE
SelectObject hDestDC, CreateMyFont(TextPoint, TextFace)
GetTextExtentPoint32 hDestDC, Text, Len(Text), Q
CropText = Text
Do While Q.cx > Width
Q.cx = 0: Q.cy = 0
CropText = Left$(CropText, Len(CropText) - 1)
GetTextExtentPoint32 hDestDC, CropText, Len(CropText), Q
Loop
If CropText <> Text Then
If Len(CropText) > 3 Then
CropText = Left$(CropText, Len(CropText) - 3) & "..."
Else
If Len(CropText) = 3 Then CropText = "..."
If Len(CropText) = 2 Then CropText = ".."
If Len(CropText) = 1 Then CropText = "."
End If
End If
TextBlt hDestDC, x, y, CropText, TextColour, TextPoint, TextFace, dwFlags
End Function
Public Function AlphaBlt(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 hAlphaDC As Long, ByVal xSrc As Long, ByVal ySrc As Long)
Dim I As Long
Dim J As Long
Dim dColour As mLong
Dim dRGB As mRGB
Dim sColour As mLong
Dim sRGB As mRGB
Dim aColour As mLong
Dim aRGB As mRGB
Dim TempR As Long
Dim TempG As Long
Dim TempB As Long
For J = y To y + (nHeight - 1)
For I = x To x + (nWidth - 1)
dColour.L = GetPixel(hDestDC, I, J)
sColour.L = GetPixel(hSrcDC, I - x + xSrc, J - y + ySrc)
aColour.L = GetPixel(hAlphaDC, I - x + xSrc, J - y + ySrc)
LSet dRGB = dColour
LSet sRGB = sColour
LSet aRGB = aColour
aRGB.R = 255 - aRGB.R
aRGB.G = 255 - aRGB.G
aRGB.B = 255 - aRGB.B
TempR = (aRGB.R * CLng(sRGB.R + 256 - dRGB.R)) / 256 + dRGB.R - aRGB.R
TempG = (aRGB.G * CLng(sRGB.G + 256 - dRGB.G)) / 256 + dRGB.G - aRGB.G
TempB = (aRGB.B * CLng(sRGB.B + 256 - dRGB.B)) / 256 + dRGB.B - aRGB.B
SetPixelV hDestDC, I, J, RGB(TempR, TempG, TempB)
Next I
Next J
End Function
Public Function TileBlt(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 srcWidth As Long, ByVal srcHeight As Long, ByVal dwRop As Long)
Dim I As Long
Dim J As Long
Dim ICut As Long
Dim JCut As Long
For J = y To y + (nHeight - 1) Step srcHeight
If J + srcHeight > y + (nHeight - 1) Then
JCut = (y + nHeight) - J
Else
JCut = srcHeight
End If
For I = x To x + (nWidth - 1) Step srcWidth
If I + srcWidth > x + (nWidth - 1) Then
ICut = (x + nWidth) - I
Else
ICut = srcWidth
End If
BitBlt hDestDC, I, J, ICut, JCut, hSrcDC, xSrc, ySrc, dwRop
Next I
Next J
End Function
Public Function IconBlt(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
Call ExtractIconEx(hExeSrc, hIndex, hLgIco, hSmIco, 1)
If hSmallIcon Then
IconBlt = DrawIconEx(hDestDC, x, y, hSmIco, 16, 16, 0, 0, DI_NORMAL)
Else
IconBlt = DrawIconEx(hDestDC, x, y, hLgIco, 32, 32, 0, 0, DI_NORMAL)
End If
DestroyIcon hSmIco: DestroyIcon hLgIco
End Function
Public Function SmoothIconBlt(ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal hImgDC As Long, ByVal hMaskDC As Long, ByVal hTempDC 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
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)
SmoothMask hTempDC, hMaskDC, 0, 0, 16, 16, smoothval
AlphaBlt hDestDC, x, y, 16, 16, hImgDC, frmMain.Src(8).hdc, 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)
SmoothMask hTempDC, hMaskDC, 0, 0, 32, 32, smoothval * 2
AlphaBlt hDestDC, x, y, 32, 32, hImgDC, hMaskDC, 0, 0
End If
DestroyIcon hSmIco: DestroyIcon hLgIco
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(hdc, 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