06-24-2022, 12:22 AM
A couple subs for drawing triangles with a line thickness over 1 pixel.
Code: (Select All)
Screen _NewImage(800, 500, 32)
'Filled triangles with lines with a defined thickness
'you can make an empty circle by assigning a value of 0 to the fill color
Locate 16, 8: Print "FatTriangle x1,y1,x2,y2,x3,y3,thickness,linecolor,fillcolor"
Locate 14, 25: Print "TrimTriangle x1,y1,x2,y2,x3,y3,thickness,linecolor,fillcolor"
Locate 11, 33: Print "BlendTriangle x1,y1,x2,y2,x3,y3,thickness,linecolor,fill1,fill2"
Locate 27, 8: Print "FatTriangle x1,y1,x2,y2,x3,y3,thickness,linecolor,fillcolor"
Locate 28, 8: Print " the fill color can be set to 0 so you can draw an unfilled rectangle"
fattriangle 101, 101, 130, 130, 130, 200, 4, _RGB32(150, 100, 50), _RGB32(200, 150, 100)
trimtriangle 201, 101, 230, 10, 230, 200, 2, _RGB32(150, 100, 50), _RGB32(200, 150, 100)
blendtriangle 301, 101, 330, 10, 430, 150, 3, _RGB32(150, 100, 50), _RGB32(200, 150, 50), _RGB32(190, 190, 50)
trimtriangle 11, 301, 30, 360, 100, 400, 2, _RGB32(150, 100, 50), 0 'yeah it's empty use fill color 0 to just draw a triangle
trimtriangle 31, 301, 50, 360, 110, 400, 2, _RGB32(150, 100, 50), 0
Sub blendtriangle (x1, y1, x2, y2, x3, y3, TT, lc&, f1&, f2&)
'draw a filled triangle with a border with a defined thickness
fx = x1
If x2 < fx Then fx = x2
If x3 < fx Then fx = x3
XX = x1
If x2 > XX Then XX = x2
If x3 > XX Then XX = x3
YY = y1
If y2 > YY Then YY = y2
If y3 > YY Then YY = y3
sr = _Red(f1&)
er = _Red(f2&)
sg = _Green(f1&)
eg = _Green(f2&)
sb = _Blue(f1&)
eb = _Blue(f2&)
rr = (er - sr) / (XX - fx)
gg = (eg - sg) / (XX - fx)
bb = (eb - sb) / (XX - fx)
rc = sr: gc = sg: bc = sb
tri& = _NewImage(XX + 1, YY + 1, 32)
_Dest tri&
For lx = fx To XX
Line (lx, 0)-(lx, YY), _RGB32(rc, gc, bc)
rc = rc + rr
gc = gc + gg
bc = bc + bb
Next lx
fatLine x1, y1, x2, y2, TT, lc&
fatLine x2, y2, x3, y3, TT, lc&
fatLine x3, y3, x1, y1, TT, lc&
_Dest 0
_MapTriangle _Seamless(x1, y1)-(x2, y2)-(x3, y3), tri& To(x1, y1)-(x2, y2)-(x3, y3)
_FreeImage tri& '<<< this is important!
End Sub
Sub trimtriangle (x1, y1, x2, y2, x3, y3, TT, lc&, fc&)
'draw a filled triangle with a border with a defined thickness
XX = x1
If x2 > XX Then XX = x2
If x3 > XX Then XX = x3
YY = y1
If y2 > YY Then YY = y2
If y3 > YY Then YY = y3
tri& = _NewImage(XX + 1, YY + 1, 32)
_Dest tri&
fatLine x1, y1, x2, y2, TT, lc&
fatLine x2, y2, x3, y3, TT, lc&
fatLine x3, y3, x1, y1, TT, lc&
px = (x1 + x2 + x3) / 3
py = (y1 + y2 + y3) / 3
If fc& <> 0 Then Paint (px, py), fc&, lc&
_Dest 0
_MapTriangle _Seamless(x1, y1)-(x2, y2)-(x3, y3), tri& To(x1, y1)-(x2, y2)-(x3, y3)
_FreeImage tri& '<<< this is important!
End Sub
Sub fattriangle (x1, y1, x2, y2, x3, y3, TT, lc&, fc&)
'draw a triangle with points on lines built by circles to make a line thicker then 1 pixel.
fatLine x1, y1, x2, y2, TT, lc&
fatLine x2, y2, x3, y3, TT, lc&
fatLine x3, y3, x1, y1, TT, lc&
px = (x1 + x2 + x3) / 3
py = (y1 + y2 + y3) / 3
If fc& <> 0 Then Paint (px, py), fc&, lc&
End Sub
Sub fatLine (x0, y0, x1, y1, TT, kk As _Unsigned Long)
If Abs(y1 - y0) < Abs(x1 - x0) Then
If x0 > x1 Then
fatLineLow x1, y1, x0, y0, TT, kk
Else
fatLineLow x0, y0, x1, y1, TT, kk
End If
Else
If y0 > y1 Then
fatLineHigh x1, y1, x0, y0, TT, kk
Else
fatLineHigh x0, y0, x1, y1, TT, kk
End If
End If
End Sub
Sub fatLineLow (x0, y0, x1, y1, tt, kk As _Unsigned Long)
dx = x1 - x0
dy = y1 - y0
yi = 1
If dy < 0 Then
yi = -1
dy = -dy
End If
'D = (2 * dy) - dx
d = (dy + dy) - dx
y = y0
For x = x0 To x1
CircleFill x, y, tt, kk
If d > 0 Then
y = y + yi
' D = D + (2 * (dy - dx))
d = d + ((dy - dx) + (dy - dx))
Else
' D = D + 2 * dy
d = d + dy + dy
End If
Next x
End Sub
Sub fatLineHigh (x0, y0, x1, y1, tt, kk As _Unsigned Long)
dx = x1 - x0
dy = y1 - y0
xi = 1
If dx < 0 Then
xi = -1
dx = -dx
End If
' D = (2 * dx) - dy
D = (dx + dx) - dy
x = x0
For y = y0 To y1
CircleFill x, y, tt, kk
If D > 0 Then
x = x + xi
' D = D + (2 * (dx - dy))
D = D + ((dx - dy) + (dx - dy))
Else
' D = D + 2 * dx
D = D + dx + dx
End If
Next y
End Sub
Sub CircleFill (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
'sub by SMcNeill makes a filled circle without worrying about using the paint comamnd to fill an empty circle
Dim Radius As Long, RadiusError As Long
Dim X As Long, Y As Long
Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
Line (CX - X, CY)-(CX + X, CY), C, BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
Wend
End Sub