XProfan

Français

Bresenham-Algorithmus [...]

ligne number marque

Frabbing, URL=www.paules-pc-forum.de/forum/dlls-includes-units-prozeduren/118552-bresenham-algorhythmus.html, Zeitpunkt=23.08.2009

Linien selber berechnen, Pixel pour Pixel.
Kompilieren Marque Séparation

Bresenham-Algorhythmus in XProfan
(c) Frank Abbing für http://www.paules-pc-forum.de/forum/xprofan/
Declare grid&
SYNTAX:
Bresenham(Farbe (RGB), Startpunkt links (in Pixel), Startpunkt oben, Endpunkt rechts, Endpunkt unten)
________________________________________________________________________________________________________________

Proc Bresenham

    ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
    Parameters col&,x1&,y1&,x2&,y2&
    Declare x&,y&,z&,a&,b&,d&,dx&,dy&,dp&,dq&
    dx&=@abs(x2&-x1&)
    dy&=@abs(y2&-y1&)

    If ((dx&<>0) AND (dy&<>0))

        If ((dy&<dx&) OR (dy&=dx&))

            x&=x1&
            y&=y1&
            z&=x2&

            If (x1&<x2&) OR (x1&=x2&)

                a&=1

            Else

                a&=-1

            EndIf

            If (y1&<y2&) OR (y1&=y2&)

                b&=1

            Else

                b&=-1

            EndIf

            dp&=dy&+dy&
            d&=dp&-dx&
            dq&=dp&-(dx&+dx&)
            SetPixel x&,y&,col&
            AddString(grid&,Str$(x&)+"|"+Str$(y&))

            While (x&<>z&)

                x&=x&+a&

                If d&<0

                    d&=d&+dp&

                Else

                    y&=y&+b&
                    d&=d&+dq&

                EndIf

                SetPixel x&,y&,col&
                AddString(grid&,Str$(x&)+"|"+Str$(y&))

            EndWhile

        Else

            y&=y1&
            x&=x1&
            z&=y2&

            If (y1&<y2&) OR (y1&=y2&)

                a&=1

            Else

                a&=-1

            EndIf

            If (x1&<x2&) OR (x1&=x2&)

                b&=1

            Else

                b&=-1

            EndIf

            dp&=dx&+dx&
            d&=dp&-dy&
            dq&=dp&-(dy&+dy&)
            SetPixel x&,y&,col&
            AddString(grid&,Str$(x&)+"|"+Str$(y&))

            While y&<>z&

                y&=y&+a&

                If d&<0

                    d&=d&+dp&

                Else

                    x&=x&+b&
                    d&=d&+dq&

                EndIf

                SetPixel x&,y&,col&
                AddString(grid&,Str$(x&)+"|"+Str$(y&))

            EndWhile

        EndIf

    EndIf

    If ((dx&=0) OR (dy&=0))

        If ((dx&=0) AND (dy&<>0))                   achsenparallel x

            x&=x1&
            y&=y1&
            z&=y2&

            If (y1&<y2&) OR (y1&=y2&)

                b&=1

            Else

                b&=-1

            EndIf

            SetPixel x&,y&,col&
            AddString(grid&,Str$(x&)+"|"+Str$(y&))

            While y&<>z&

                y&=y&+b&
                SetPixel x&,y&,col&
                AddString(grid&,Str$(x&)+"|"+Str$(y&))

            EndWhile

        Else

            If ((dx&<>0) AND (dy&=0))                  achsenparallel y

                x&=x1&
                y&=y1&
                z&=x2&

                If (x1&<x2&) OR (x1&=x2&)

                    a&=1

                Else

                    a&=-1

                EndIf

                SetPixel x&,y&,col&
                AddString(grid&,Str$(x&)+"|"+Str$(y&))

                While x&<>z&

                    x&=x&+a&
                    SetPixel x&,y&,col&
                    AddString(grid&,Str$(x&)+"|"+Str$(y&))

                EndWhile

            EndIf

        EndIf

    EndIf

    x1&=x&
    y1&=y&

Endproc

Cls
Randomize
grid&=Create("GridBox", %hwnd, "X-Achse;1;56;Y-Achse;1;56", 2, 8, 8, 136, 408)

Whileloop 20

    Bresenham(RGB(Rnd(255),Rnd(255),Rnd(255)), Rnd(490)+150,Rnd(400), Rnd(490)+150,Rnd(400))

EndWhile

While 1

    WaitInput
    Case %key=2:ef='./../../references-fonction/XProfan/pause/'>Pause

Endwhile

Fin

qui pas selbst LinienPunkte berechnen voudrais, mais toutefois Pixel pour Pixel selbst zeichnen voudrais, peux sich qui LineDDA-Api [...]

servir.
Kompilieren Marque Séparation

def lineDDA(6) !"gdi32.dll","LineDDA"
cls
lineDDA(10,10,200,150,procAddr(myLineDDAProc,3),rgb(255,0,0))
waitInput
end

proc myLineDDAProc

    parameters x&,y&,c&
    setpixel x&,y&,c&
    return 1

endProc