XProfan

'In XProfan 11.2a free geschrieben a Lernzwecken
Windowstyle 31
Windowtitle "Bresenham-Circles"
Ventana %maxx*.81,%maxy*.81
Cls @Rgb(231,231,221)
'  Kreise en Abstand de%
var r%= sqrt((@width(%hWnd)/2)^2 + (@height(%hWnd)/2)^2 )
var de%=14

mientras que r%>0

    brCircle( @width(%hWnd)/2, @height(%hWnd)/2 , r% , \
    @rgb(rnd(100)+155,rnd(155)+100,r% and 255) )
    r% = r% - de%
    caso %MousePressed : romper

endwhile

WaitInput
End

proc brCircle

    ' Bresenham-Algorithmus para una (Achtel-)Kreis
    parámetros xmittel%,ymittel%,r%,c%
    var x% = r%
    var y% = 0
    var fehler% = r%
    declarar dy%,dx%
    Gosub "DrawPixels"' JAWOLL, EIN GOSUB! DA STAUNSTE, WAS?

    WHILE y% < x%

        dy% = y%*2+1 : REM en Ensamblador-Implementierung *2 por Shift
        inc y%
        fehler% = fehler% - dy%

        IF fehler%<0

            dx% = 1 - x%*2
            x% = x% - 1
            fehler% = fehler% - dx%

        ENDIF

        ' Como lo en el Bildschirm y no ums Plotten va,
        ' puede ser el otro Oktanten hier con abdecken:
        Gosub "DrawPixels"

    ENDWHILE

    RETORNO
    DrawPixels:
    SETPIXEL xmittel%+x%, ymittel%+y%,c%
    SETPIXEL xmittel%-x%, ymittel%+y%,c%
    SETPIXEL xmittel%-x%, ymittel%-y%,c%
    SETPIXEL xmittel%+x%, ymittel%-y%,c%
    SETPIXEL xmittel%+y%, ymittel%+x%,c%
    SETPIXEL xmittel%-y%, ymittel%+x%,c%
    SETPIXEL xmittel%-y%, ymittel%-x%,c%
    SETPIXEL xmittel%+y%, ymittel%-x%,c%
    Volver

ENDPROC