Enoncé
Visual Basic - Solution 4 ( Pleins et dégradés )
Interface graphique :
Code de la feuille Form1 :
Dim P1 As XY
Dim P2 As XY
Dim P3 As XY
Const Xmax = 213
Const Ymax = 125
Dim Surface(Xmax, Ymax) As Integer
Dim epaisseur As Double
Private Sub Command1_Click()
Lire
trace P1, P2, epaisseur, True
End Sub
Private Sub Command2_Click()
Lire
trace P1, P2, epaisseur, False
End Sub
Sub Lire()
P1.X = Val(TAX.Text)
P1.Y = Val(TAY.Text)
P2.X = Val(TBX.Text)
P2.Y = Val(TBY.Text)
epaisseur = Val(TEpaisseur.Text)
End Sub
Private Sub Command3_Click()
Picture1.Cls
End Sub
Private Sub trace(P1 As XY, P2 As XY, epaisseur As Double, Plein As Boolean)
Dim P4 As XY
Dim a As Double, b As Double, c As Double
Dim i As Integer, j As Integer
a = (P2.Y - P1.Y) / (P2.X - P1.X)
If a = 0 Then a = 10 ^ (-20)
b = P1.Y - a * P1.X
Picture1.Scale (0, Ymax)-(Xmax, 0)
For i = 1 To Xmax
For j = 1 To Ymax
P3.X
= i
P3.Y
= j
c =
P3.Y + P3.X / a
P4.X
= a * (c - b) / (1 + a * a)
P4.Y
= a * P4.X + b
If
Abs((Dist(P1, P4) + Dist(P4, P2)) / Dist(P1, P2)) - 1 < 0.000001 Then
'P3 est bien perpendiculaire au segment
If Dist(P3, P4) < epaisseur / 2 Then
'On peut changer le point
If Plein Then
Surface(i, j) = 0
Else
Surface(i, j) = Int(255 * Dist(P3, P4) * 2 / epaisseur)
End If
Picture1.PSet (i, j), RGB(Surface(i, j), Surface(i, j), Surface(i, j))
End If
End
If
Next j
Next i
End Sub
Code à placer dans un module :
Public Type XY
X As Double
Y As Double
End Type
Public Function Dist(a As XY, b As XY) As Double
Dist = Sqr((a.X - b.X) ^ 2 + (a.Y - b.Y) ^ 2)
End Function