Attribute VB_Name = "AAPixel"
Option Explicit

' Anti-aliased pixel drawing module 1.5
'   Written by Mike D Sutton of EDais
'     Microsoft Visual Basic MVP
'
' E-Mail: EDais@mvps.org
' WWW: Http://www.mvps.org/EDais/
'
'  Written: 9/10/2000
'  Last edited: 17/07/2003
'
' About:
' Just the core routines for drawing an anti-aliased or
'  semi-transparent pixel as easily as a call to SetPixelV()
'
' You use this code at your own risk, I don't accept any
'  responsibility for anything nasty it may do to your machine!
' Feel free to re-use this code in your own applications (Yeah,
'  like I could stop you anyway ;) However, please don't attempt
'  to sell or re-distribute it without my written consent.
' Visit my site for any updates to this an more strange graphics
'  related VB code, comments and suggestions always welcome!

Private Declare Function SetPixelV Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long

Public Sub DrawAAPixel(ByVal inDC As Long, ByVal inX As Single, _
    ByVal inY As Single, ByVal inCol As Long, Optional ByVal inAmt As Byte = &HFF)
    Dim SubX As Single, SubY As Single ' Plots and anti-alised pixel
    Dim XPos As Long, YPos As Long
    Dim UseAmt As Single
    Dim DestCol As Pixel
    
    If (inAmt = 0) Then Exit Sub ' Invisible!
    
    ' Convert the colour to a pixel
    DestCol = LongToPix(inCol)
    
    ' Get the sub-pixel distance traveled in the X and Y axis
    XPos = Int(inX)
    YPos = Int(inY)
    SubX = inX - XPos
    SubY = inY - YPos
    
    If (UseAmt = &HFF) Then ' Plot at original opacity
        Call SetTransPix(inDC, XPos, YPos, DestCol, (1 - SubX) * (1 - SubY))
        Call SetTransPix(inDC, XPos + 1, YPos, DestCol, SubX * (1 - SubY))
        Call SetTransPix(inDC, XPos, YPos + 1, DestCol, (1 - SubX) * SubY)
        Call SetTransPix(inDC, XPos + 1, YPos + 1, DestCol, SubX * SubY)
    Else ' Plot at semi-opacity
        UseAmt = inAmt / &HFF
        
        Call SetTransPix(inDC, XPos, YPos, DestCol, ((1 - SubX) * (1 - SubY)) * UseAmt)
        Call SetTransPix(inDC, XPos + 1, YPos, DestCol, (SubX * (1 - SubY)) * UseAmt)
        Call SetTransPix(inDC, XPos, YPos + 1, DestCol, ((1 - SubX) * SubY) * UseAmt)
        Call SetTransPix(inDC, XPos + 1, YPos + 1, DestCol, (SubX * SubY) * UseAmt)
    End If
End Sub

Public Sub SetTransPix(ByVal inDC As Long, ByVal inX As Long, _
    ByVal inY As Long, ByRef inCol As Pixel, ByVal inAmt As Single) ' Plots a transparent pixel
    Select Case inAmt
        Case Is < 0 ' Nothing - Invisible!
        Case Is >= 1: Call SetPixelV(inDC, inX, inY, PixToLong(inCol))
        Case Else:    Call SetPixelV(inDC, inX, inY, PixToLong(TransPix( _
            LongToPix(GetPixel(inDC, inX, inY)), inCol, inAmt)))
    End Select
End Sub