XProfan

Título de la ventana "Ellipsenbögen en beliebiger Lage"
'  Referencia: Bitte Achsendimensionen adaptar a Bildschirmauflösung!
'  (T) Trashware 2012 by P. Pájaro carpintero. Zu mi Gunsten es a nachfolgender Punto una
'  máximo rechtswirksamer Haftungsausschließungtext vom Programmanwender einzufügen:
'
'  <This lines intentionally left blank>
'  Bildausgabe geändert by Volkmar Göritz
Ventana de Estilo 16 | 64
Ventana 0,0 - %maxx,%maxy
Font 2:randomize
var col&=rgb(200,200,200)+rgb(rnd(56),rnd(56),rnd(56))
var f!=pi()/180:var xm!=%maxx/2:var ym!=%maxy/2
declarar end&,ctr&
Declarar Mapa de bits%
Begin:
inc ctr&

WHILELOOP 360,0,-10

    'Localizar 1,1:Imprimir " Ende: ESC halten! "
    'MCLS %maxx,%maxy,col&:StartPaint -1
    Case Mapa de bits% : DeleteObject Mapa de bits%
    Mapa de bits% = create("hNewPic", %maxx,%maxy,col&)
    StartPaint Mapa de bits%
    Color del texto 20200,-1'col&
    DrawText 1,1,"Ende ESC"
    Achsen xm!,ym!
    Ellipsenbogen 400,170,f!*0; \'Halbachsen a,b, gewünschte Drehung (f!*grd=rad)
    f!*&Loop+pi(),f!*(&Loop+30); \'Start- y Endwinkel de Sicht el Ellipse_
    rgb(220,0,0),6;0' Farbe,Stärke,Segmentierschalter 0/1
    Ellipsenbogen 400,170,-f!*50; \'Halbachsen a,b, gewünschte Drehung (f!*grd=rad)
    -f!*&Loop,-f!*(&Loop+40); \'Start- y Endwinkel de Sicht el Ellipse_
    rgb(0,0,220),9;1' Farbe,Stärke,Segmentierschalter 0/1
    Ellipsenbogen 400,170,-f!*80; \'Halbachsen a,b, gewünschte Drehung (f!*grd=rad)
    f!*&Loop,f!*(&Loop+60); \'Start- y Endwinkel de Sicht el Ellipse_
    rgb(0,220,0),5;0' Farbe,Stärke,Segmentierschalter 0/1
    'EndPaint:MCopyBMP 0,0 - %maxx,%maxy >0,0;0
    Endpaint
    DrawPic Mapa de bits%, 0, 0; 0
    waitinput 5:if %key=27:end&=1:romper :endif

ENDWHILE

if end&:Sound 2200,40: DeleteObject Mapa de bits% :FIN :Endif

    Goto "Begin"
    FIN

    proc Ellipsenbogen

        parámetros a!,b!,alpha!,beta!,gamma!,col&,thk&,sw&
        declarar x!,y!,g!,tmp!,nenr!,wrz!,inkr!

        if beta!>gamma!:tmp!=gamma!:gamma!=beta!:beta!=tmp!:endif

            var de!=beta!:var a!=gamma!:g!=de!
            Repeat :x!=a!*cos(-g!):y!=b!*sin(-g!)
            inkr!=1/(13.2+sqrt(abs(x!*y!/(a!*b!))))
            tmp!=x!*cos(alpha!)+y!*sin(alpha!)
            y!=x!*sin(alpha!)-y!*cos(alpha!):x!=tmp!
            caso g!=de! : moveto xm!+x!,ym!-y!
            usepen 0,thk&,col&:lineto xm!+x!,ym!-y!:usepen 0,1,0
            caso sw&:line  xm!,ym! - (xm!+x!),ym!-y!
            g!=g!+inkr!:until g!>=a!

        ENDPROC

        proc Achsen :parámetros x!,y!

            line xm!,0 - xm!,2*ym!
            line 0,ym! - 2*xm!,ym!

        ENDPROC