QB64 Phoenix Edition
Triangles with line thickness - Printable Version

+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://staging.qb64phoenix.com/forumdisplay.php?fid=3)
+---- Forum: Utilities (https://staging.qb64phoenix.com/forumdisplay.php?fid=8)
+---- Thread: Triangles with line thickness (/showthread.php?tid=569)

Triangles with line thickness - James D Jarvis - 06-24-2022

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