Public Declare Function SetPixelV Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
' trace un pixel avec un anti-crénelage
Public Sub SetPixelAA( _
ByVal DeviceContext As Long, _
ByVal XX As Single, _
ByVal YY As Single, _
ByVal r As Byte, _
ByVal g As Byte, _
ByVal b As Byte)
Dim BackR As Byte
Dim BackG As Byte
Dim BackB As Byte
Dim BackCol As Long
Dim xi As Long: xi = CLng(XX)
Dim yi As Long: yi = CLng(YY)
Dim xp As Single
Dim yp As Single
Dim pa As Single
Dim pb As Single
Dim pc As Single
Dim pd As Single
If xi > XX Then xi = xi - 1
If yi > YY Then yi = yi - 1
If xi <> XX And yi <> YY Then
xp = XX - xi
yp = YY - yi
pa = (1 - xp ) * (1 - yp )
pb = xp * (1 - yp )
pc = (1 - xp ) * yp
pd = xp * yp
BackCol = GetPixel(DeviceContext, xi, yi)
BackR = BackCol And &HFF
BackG = (BackCol \ &H100) And &HFF
BackB = (BackCol \ &H10000) And &HFF
SetPixelV DeviceContext, xi, yi, RGB(r * pa + BackR * (1 - pa), g * pa + BackG * (1 - pa), b * pa + BackB * (1 - pa))
BackCol = GetPixel(DeviceContext, xi + 1, yi)
BackR = BackCol And &HFF
BackG = (BackCol \ &H100) And &HFF
BackB = (BackCol \ &H10000) And &HFF
SetPixelV DeviceContext, xi + 1, yi, RGB(r * pb + BackR * (1 - pb), g * pb + BackG * (1 - pb), b * pb + BackB * (1 - pb))
BackCol = GetPixel(DeviceContext, xi, yi + 1)
BackR = BackCol And &HFF
BackG = (BackCol \ &H100) And &HFF
BackB = (BackCol \ &H10000) And &HFF
SetPixelV DeviceContext, xi, yi + 1, RGB(r * pc + BackR * (1 - pc), g * pc + BackG * (1 - pc), b * pc + BackB * (1 - pc))
BackCol = GetPixel(DeviceContext, xi + 1, yi + 1)
BackR = BackCol And &HFF
BackG = (BackCol \ &H100) And &HFF
BackB = (BackCol \ &H10000) And &HFF
SetPixelV DeviceContext, xi + 1, yi + 1, RGB(r * pd + BackR * (1 - pd), g * pd + BackG * (1 - pd), b * pd + BackB * (1 - pd))
ElseIf xi <> XX Then
pc = XX - xi
pa = 1 - (XX - xi)
BackCol = GetPixel(DeviceContext, xi, yi)
BackR = BackCol And &HFF
BackG = (BackCol \ &H100) And &HFF
BackB = (BackCol \ &H10000) And &HFF
SetPixelV DeviceContext, xi, yi, RGB(r * pa + BackR * (1 - pa), g * pa + BackG * (1 - pa), b * pa + BackB * (1 - pa))
BackCol = GetPixel(DeviceContext, xi + 1, yi)
BackR = BackCol And &HFF
BackG = (BackCol \ &H100) And &HFF
BackB = (BackCol \ &H10000) And &HFF
SetPixelV DeviceContext, xi + 1, yi, RGB(r * pc + BackR * (1 - pc), g * pc + BackG * (1 - pc), b * pc + BackB * (1 - pc))
ElseIf yi <> YY Then
pb = YY - yi
pa = 1 - (YY - yi)
BackCol = GetPixel(DeviceContext, xi, yi)
BackR = BackCol And &HFF
BackG = (BackCol \ &H100) And &HFF
BackB = (BackCol \ &H10000) And &HFF
SetPixelV DeviceContext, xi, yi, RGB(r * pa + BackR * (1 - pa), g * pa + BackG * (1 - pa), b * pa + BackB * (1 - pa))
BackCol = GetPixel(DeviceContext, xi, yi + 1)
BackR = BackCol And &HFF
BackG = (BackCol \ &H100) And &HFF
BackB = (BackCol \ &H10000) And &HFF
SetPixelV DeviceContext, xi, yi + 1, RGB(r * pb + BackR * (1 - pb), g * pb + BackG * (1 - pb), b * pb + BackB * (1 - pb))
Else
SetPixelV DeviceContext, XX, YY, RGB(r, g, b )
End If
End Sub
' trace une ligne avec anti-crénelage
Public Sub DrawLineAA( _
ByVal DeviceContext As Long, _
ByVal x1 As Single, _
ByVal y1 As Single, _
ByVal x2 As Single, _
ByVal y2 As Single, _
ByVal Color As Long)
Dim m As Single
Dim b As Single
Dim XX As Single
Dim YY As Single
Dim rr As Byte: rr = Color And &HFF
Dim gg As Byte: gg = (Color \ &H100) And &HFF
Dim bb As Byte: bb = (Color \ &H10000) And &HFF
If x2 = x1 Then
m = (y2 - y1) / 1
Else
m = (y2 - y1) / (x2 - x1)
End If
b = y1 - (m * x1)
If Abs(m) <= 1 Then
If x1 <= x2 Then
For XX = x1 To x2 - 1
YY = m * XX + b
SetPixelAA DeviceContext, XX, YY, rr, gg, bb
Next XX
Else
For XX = x2 + 1 To x1
YY = m * XX + b
SetPixelAA DeviceContext, XX, YY, rr, gg, bb
Next XX
End If
Else
If y1 <= y2 Then
For YY = y1 To y2 - 1
XX = (YY - B ) / m
SetPixelAA DeviceContext, XX, YY, rr, gg, bb
Next YY
Else
For YY = y2 + 1 To y1
XX = (YY - B ) / m
SetPixelAA DeviceContext, XX, YY, rr, gg, bb
Next YY
End If
End If
End Sub
' trace un cercle avec anti-crénelage
Public Sub DrawCircleAA( _
ByVal DeviceContext As Long, _
ByVal X As Single, _
ByVal Y As Single, _
ByVal Rayon As Single, _
ByVal Color As Long)
Dim XX As Single
Dim YY As Single
Dim rr As Byte: rr = Color And &HFF
Dim gg As Byte: gg = (Color \ &H100) And &HFF
Dim bb As Byte: bb = (Color \ &H10000) And &HFF
If Rayon = 0 Then Exit Sub
SetPixelAA DeviceContext, X + Rayon, Y, rr, gg, bb
SetPixelAA DeviceContext, X, Y + Rayon, rr, gg, bb
SetPixelAA DeviceContext, X, Y - Rayon, rr, gg, bb
SetPixelAA DeviceContext, X - Rayon, Y, rr, gg, bb
For XX = 1 To Rayon * 0.71 ' = 1 / Sqr(2)
YY = Sqr(Rayon * Rayon - XX * XX)
SetPixelAA DeviceContext, XX + X, YY + Y, rr, gg, bb
SetPixelAA DeviceContext, -XX + X, YY + Y, rr, gg, bb
SetPixelAA DeviceContext, XX + X, -YY + Y, rr, gg, bb
SetPixelAA DeviceContext, -XX + X, -YY + Y, rr, gg, bb
SetPixelAA DeviceContext, YY + X, XX + Y, rr, gg, bb
SetPixelAA DeviceContext, -YY + X, XX + Y, rr, gg, bb
SetPixelAA DeviceContext, YY + X, -XX + Y, rr, gg, bb
SetPixelAA DeviceContext, -YY + X, -XX + Y, rr, gg, bb
Next XX
End Sub
Ce code à mettre dans un module, permet de tracer de manière très rapide des pixels, des cercles, et lignes dans des picturebox, .... avec un anti-crénélage.
Je rappel que l'anti-crénélage est le mots français pour anti-alliasing.
Technique par laquelle on diminue l'effet d'escalier (Voir aliasing) des images, en créant des dégradés de couleurs le long des contours, pour les lisser. L'anti-aliasing est utilisé par exemple en imagerie de synthèse, et coûte beaucoup de temps de calcul, car on calcule plusieurs fois chaque point avec d'infimes variations des paramètres. Voir aussi les VF anticrénelage, crénelage. Une technique cousine s'appelle le dithering.
Définition tirée de : http://www.tout-savoir.net/lexique.php?rub...nition&code=529
--Message édité par Neku le 19-02-06 à 01:59:24--
Leandre aka Neku