Bresenham-Algorhythmus

'
' 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:Break


Endwhile


End