Graphics Module

Printable View

Graphics Module

Here's a general-purpose graphics module with many APIs that 'sister' existing ones (such as AlphaBlt and TileBlt). Part 1, Declarations:

VB Code:

Option Explicit
 
Public Type mLong
    L As Long
End Type
 
Public Type mRGB
    R As Byte
    G As Byte
    B As Byte
    A As Byte
End Type
 
Public Enum TEXTDRAWPARAM
    TDP_LEFT = 0
    TDP_RIGHT = 1
    TDP_HCENTRE = 2
    TDP_TOP = 4
    TDP_BOTTOM = 8
    TDP_VCENTRE = 16
End Enum
 
Public Const FW_DONTCARE = 0
Public Const FW_THIN = 100
Public Const FW_EXTRALIGHT = 200
Public Const FW_LIGHT = 300
Public Const FW_NORMAL = 400
Public Const FW_MEDIUM = 500
Public Const FW_SEMIBOLD = 600
Public Const FW_BOLD = 700
Public Const FW_EXTRABOLD = 800
Public Const FW_HEAVY = 900
Public Const FW_BLACK = FW_HEAVY
Public Const FW_DEMIBOLD = FW_SEMIBOLD
Public Const FW_REGULAR = FW_NORMAL
Public Const FW_ULTRABOLD = FW_EXTRABOLD
Public Const FW_ULTRALIGHT = FW_EXTRALIGHT
Public Const ANSI_CHARSET = 0
Public Const DEFAULT_CHARSET = 1
Public Const SYMBOL_CHARSET = 2
Public Const SHIFTJIS_CHARSET = 128
Public Const HANGEUL_CHARSET = 129
Public Const CHINESEBIG5_CHARSET = 136
Public Const OEM_CHARSET = 255
Public Const OUT_CHARACTER_PRECIS = 2
Public Const OUT_DEFAULT_PRECIS = 0
Public Const OUT_DEVICE_PRECIS = 5
Public Const CLIP_DEFAULT_PRECIS = 0
Public Const CLIP_CHARACTER_PRECIS = 1
Public Const CLIP_STROKE_PRECIS = 2
Public Const DEFAULT_QUALITY = 0
Public Const DRAFT_QUALITY = 1
Public Const PROOF_QUALITY = 2
Public Const DEFAULT_PITCH = 0
Public Const FIXED_PITCH = 1
Public Const VARIABLE_PITCH = 2
Public Const OPAQUE = 2
Public Const TRANSPARENT = 1
Public Const LOGPIXELSY = 90
Public Const OBJ_BITMAP = 7
Public Const DT_RIGHT = &H2
 
Public Const BI_RGB = 0&
Public Const DIB_RGB_COLORS = 0
 
 
Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public 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
Public Declare Function GetCurrentObject Lib "gdi32" (ByVal hdc As Long, ByVal uObjectType As Long) As Long
Public Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Public Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Public Declare Function DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long
Public Declare Function ExtractIconEx Lib "shell32.dll" Alias "ExtractIconExA" (ByVal lpszFile As String, ByVal nIconIndex As Long, phiconLarge As Long, phiconSmall As Long, ByVal nIcons As Long) As Long
Public Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
Public Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Public Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Public Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As SIZE) As Long
Public Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal H As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, ByVal W As Long, ByVal I As Long, ByVal u As Long, ByVal S As Long, ByVal C As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal F As String) As Long
Public Declare Function MulDiv Lib "kernel32" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Public Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Public Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Ptr() As Any) As Long
Public Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Public Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Public Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Public Declare Function SetDIBits Lib "gdi32" (ByVal hdc As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
 
Public Const DI_MASK = &H1
Public Const DI_IMAGE = &H2
Public Const DI_NORMAL = DI_MASK Or DI_IMAGE
 
Public Type SAFEARRAYBOUND
    cElements As Long
    lLbound As Long
End Type
Public Type SAFEARRAY2D
    cDims As Integer
    fFeatures As Integer
    cbElements As Long
    cLocks As Long
    pvData As Long
    Bounds(0 To 1) As SAFEARRAYBOUND
End Type
Public 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 BITMAPINFOHEADER '40 bytes
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
End Type
Public Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
    bmiColors As mRGB
End Type
Public Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Public Type SIZE
        cx As Long
        cy As Long
End Type

Part II, Code Part One:

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 AlphaBltFast(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 TempR As Long
Dim TempG As Long
Dim TempB As Long
 
Dim AlphaVal As mRGB
Dim SrcVal As mRGB
Dim DestVal As mRGB
 
Dim dBitmap As Long
Dim dBMP As BITMAP
Dim dPic() As mRGB
Dim dMem As BITMAPINFO
 
Dim sBitmap As Long
Dim sBMP As BITMAP
Dim sPic() As mRGB
Dim sMem As BITMAPINFO
 
Dim aBitmap As Long
Dim aBMP As BITMAP
Dim aPic() As mRGB
Dim aMem As BITMAPINFO
 
    dBitmap = GetCurrentObject(hDestDC, OBJ_BITMAP)
    sBitmap = GetCurrentObject(hSrcDC, OBJ_BITMAP)
    aBitmap = GetCurrentObject(hAlphaDC, OBJ_BITMAP)
 
    GetObjectAPI dBitmap, Len(dBMP), dBMP
    GetObjectAPI sBitmap, Len(sBMP), sBMP
    GetObjectAPI aBitmap, Len(aBMP), aBMP
    
    With dMem.bmiHeader
        .biBitCount = 32
        .biCompression = BI_RGB
        .biPlanes = 1
        .biSize = Len(dMem.bmiHeader)
        .biWidth = dBMP.bmWidth
        .biHeight = dBMP.bmHeight
        ReDim Preserve dPic(0 To (.biWidth * .biHeight) - 1) As mRGB
    End With
     
    GetDIBits hDestDC, dBitmap, 0, dBMP.bmHeight, dPic(0), dMem, DIB_RGB_COLORS
    
    With sMem.bmiHeader
        .biBitCount = 32
        .biCompression = BI_RGB
        .biPlanes = 1
        .biSize = Len(sMem.bmiHeader)
        .biWidth = sBMP.bmWidth
        .biHeight = sBMP.bmHeight
        ReDim Preserve sPic(0 To (.biWidth * .biHeight) - 1) As mRGB
    End With
    
    GetDIBits hSrcDC, sBitmap, 0, sBMP.bmHeight, sPic(0), sMem, DIB_RGB_COLORS
    
    With aMem.bmiHeader
        .biBitCount = 32
        .biCompression = BI_RGB
        .biPlanes = 1
        .biSize = Len(aMem.bmiHeader)
        .biWidth = aBMP.bmWidth
        .biHeight = aBMP.bmHeight
        ReDim Preserve aPic(0 To (.biWidth * .biHeight) - 1) As mRGB
    End With
    
    GetDIBits hAlphaDC, aBitmap, 0, aBMP.bmHeight, aPic(0), aMem, DIB_RGB_COLORS
    
    For J = Y To Y + (nHeight - 1)
        For I = X To X + (nWidth - 1)
            
            DestVal = dPic(Morph2D(I, dBMP.bmHeight - J, dBMP.bmWidth)) 'dColour.L = GetPixel(hDestDC, I, J)
            SrcVal = sPic(Morph2D(I - X + xSrc, sBMP.bmHeight - (J - Y + ySrc), sBMP.bmWidth)) 'sColour.L = GetPixel(hSrcDC, I - x + xSrc, J - y + ySrc)
            AlphaVal = aPic(Morph2D(I - X + xSrc, aBMP.bmHeight - (J - Y + ySrc), aBMP.bmWidth)) 'aColour.L = GetPixel(hAlphaDC, I - x + xSrc, J - y + ySrc)
            
            AlphaVal.R = 255 - AlphaVal.R
            AlphaVal.G = 255 - AlphaVal.G
            AlphaVal.B = 255 - AlphaVal.B
            
            TempR = (AlphaVal.R * CLng(SrcVal.R + 256 - DestVal.R)) / 256 + DestVal.R - AlphaVal.R
            TempG = (AlphaVal.G * CLng(SrcVal.G + 256 - DestVal.G)) / 256 + DestVal.G - AlphaVal.G
            TempB = (AlphaVal.B * CLng(SrcVal.B + 256 - DestVal.B)) / 256 + DestVal.B - AlphaVal.B
            
            With dPic(Morph2D(I, dBMP.bmHeight - J, dBMP.bmWidth))
                .R = TempR
                .G = TempG
                .B = TempB
            End With
            
        Next I
    Next J
    
    SetDIBits hDestDC, dBitmap, 0, dBMP.bmHeight, dPic(0), dMem, DIB_RGB_COLORS
    
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

Part III, Code Part II:

VB Code:

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