Anti-aliasing

[Mad Compie]

Hi kids, any one knows how to draw anti-aliased (smooth) lines, circles, ... in VB6?
Should I implement some specific algorithms or does there exist some DLL?

[kedaman]

Sure there are dll's for this, but i've once tried to make a antialiased circle, here's the sample:

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

Private Sub Command1_Click()
Dim dx&, dy&, X&, Y&, fade!, color1&, color2&, alpha&
Picture = Image
For Y = 1 To 200
For X = 1 To 200
dx = 100 - X
dy = 100 - Y
fade = Abs(100 - Sqr(dx * dx + dy * dy))
If fade < 1 Then
color1 = GetPixel(hdc, X, Y)
color2 = vbRed
alpha = RGB((color1 Mod 256) * fade + (color2 Mod 256) * (1 - fade), (Int(color1 / 256) Mod 256) * fade + (Int(color2 / 256) Mod 256) * (1 - fade), Int(color1 / 65536) * fade + Int(color2 / 65536) * (1 - fade))
SetPixelV hdc, X, Y, alpha
End If
Next X
Next Y
End Sub

Put a picture on the form and it will blend to the background.

[Jotaf98]

This is a blending module I made a while ago:



'To draw/extract pixels...
Private Declare Function SetPixel 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



Private Type RGBColor
Red As Integer
Green As Integer
Blue As Integer
End Type


Public Sub SmoothImage(TargetHDC As Long, Width As Long, Height As Long)

' -- These are the variables --

'Loop counters and temporary variable for colors
Dim cX As Long, cY As Long, TempColor As Long


'Temporary variables for RGB values
Dim R As Long, G As Long, B As Long

'A version of the image with all the RGBs extracted
Dim ImageRGB() As RGBColor



' -- Initializations... --

'Resize the array
ReDim ImageRGB(-1 To Width, -1 To Height)


' -- Get all the RGB values to an array --

For cX = -1 To Width
For cY = -1 To Height
'Extract this pixel
TempColor = GetPixel(TargetHDC, cX, cY)

'If it's out of the image, make it transparent
If cX = -1 Or cX = Width Or cY = -1 Or cY = Height Then TempColor = BGColor

'Extract its RGBs
ImageRGB(cX, cY).Red = TempColor And 255
ImageRGB(cX, cY).Green = (TempColor And 65280) \ 256
ImageRGB(cX, cY).Blue = (TempColor And 16711680) \ 65535
Next cY
Next cX



' -- Blend and draw them --

For cX = 0 To Width - 1
For cY = 0 To Height - 1





'Get the average between all the surrounding colors
R = (ImageRGB(cX, cY).Red + _
ImageRGB(cX + 1, cY).Red + _
ImageRGB(cX - 1, cY).Red + _
ImageRGB(cX, cY + 1).Red + _
ImageRGB(cX, cY - 1).Red + _
ImageRGB(cX - 1, cY - 1).Red + _
ImageRGB(cX + 1, cY + 1).Red + _
ImageRGB(cX + 1, cY - 1).Red + _
ImageRGB(cX - 1, cY + 1).Red) \ 9

G = (ImageRGB(cX, cY).Green + _
ImageRGB(cX + 1, cY).Green + _
ImageRGB(cX - 1, cY).Green + _
ImageRGB(cX, cY + 1).Green + _
ImageRGB(cX, cY - 1).Green + _
ImageRGB(cX - 1, cY - 1).Green + _
ImageRGB(cX + 1, cY + 1).Green + _
ImageRGB(cX + 1, cY - 1).Green + _
ImageRGB(cX - 1, cY + 1).Green) \ 9

B = (ImageRGB(cX, cY).Blue + _
ImageRGB(cX + 1, cY).Blue + _
ImageRGB(cX - 1, cY).Blue + _
ImageRGB(cX, cY + 1).Blue + _
ImageRGB(cX, cY - 1).Blue + _
ImageRGB(cX - 1, cY - 1).Blue + _
ImageRGB(cX + 1, cY + 1).Blue + _
ImageRGB(cX + 1, cY - 1).Blue + _
ImageRGB(cX - 1, cY + 1).Blue) \ 9

'Now, draw this pixel with the new color
SetPixel TargetHDC, cX, cY, RGB(R, G, B)

Next cY
Next cX

'Show the default pointer
Screen.MousePointer = vbDefault
End Sub



Not sure if it's correct, had to do some last-minute changes...