Trying to figure algorithm to draw and paint polygons
#2
Hi Charlie, 

Here is something I saved from our fearless leader (Steve), it might be of help or at least of interest:
Code: (Select All)
Screen _NewImage(800, 600, 32)
For i = 1 To 50
    Line (Rnd * 800, Rnd * 600)-(Rnd * 800, Rnd * 600), _RGB(Rnd * 256, Rnd * 256, Rnd * 256), BF
Next
Sleep

Fill_It "(100,100)-(200,200)-(300,500)-(200,150)-(100,100)", "(115,110)", -1
Fill_It "(400,400)-(600,400)-(400,550)-(600,550)-(400,400)", "(425,405),(425,545)", &HFFFFFF00




Sub Fill_It (DrawPoint$, FillPoint$, Kolor As _Unsigned Long)
    Dim x As Long, y As Long
    Dim temp As Long: temp = _NewImage(_Width, _Height, 32)
    d = _Dest
    _Dest temp
    temp$ = DrawPoint$: temp2$ = FillPoint$
    GetPoint temp$, x, y
    PSet (x, y), Kolor
    Do Until temp$ = ""
        GetPoint temp$, x, y
        Line -(x, y), Kolor
    Loop
    GetPoint temp2$, x, y
    Paint (x, y), Kolor
    Do Until Left$(temp2$, 1) <> ","
        temp2$ = Mid$(temp2$, 2)
        GetPoint temp2$, x, y
        Paint (x, y), Kolor
    Loop
    _PutImage (0, 0), temp, d
    _Dest d
    _FreeImage temp
End Sub

Sub GetPoint (s$, x As Long, y As Long)
    l = InStr(s$, ")")
    l$ = LTrim$(Left$(s$, l - 1))
    s$ = Mid$(s$, l + 1)
    If Left$(l$, 1) = "-" Then l$ = Mid$(l$, 2)
    If Left$(l$, 1) = "(" Then l$ = Mid$(l$, 2)
    x = Val(l$)
    y = Val(Mid$(l$, InStr(l$, ",") + 1))
End Sub

It doesn't run too long so your time is not wasted ;-))
b = b + ...
Reply


Messages In This Thread
RE: Trying to figure algorithm to draw and paint polygons - by bplus - 08-13-2023, 07:06 PM



Users browsing this thread: 5 Guest(s)