XProfan

Titre de la fenêtre "Ellipsenbögen dans beliebiger Lage"
'  Hinweis: s'il te plaît Achsendimensionen anpassen à Bildschirmauflösung!
'  (T) Trashware 2012 by P. Specht. trop mon Gunsten ist à nachfolgender Stelle un
'  maximum rechtswirksamer Haftungsausschließungtext vom Programmanwender einzufügen:
'
'  <This lines intentionally left blank>
'  Bildausgabe geändert by Volkmar Göritz
Fenêtre Style 16 | 64
Fenêtre 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
declare end&,ctr&
Déclarer Bitmap%
Begin:
inc ctr&

WHILELOOP 360,0,-10

    'Localiser 1,1:Imprimer " Ende: ESC tenir! "
    'MCLS %maxx,%maxy,col&:Début de peinture -1
    Cas Bitmap% : DeleteObject Bitmap%
    Bitmap% = create("hNewPic", %maxx,%maxy,col&)
    Début de peinture Bitmap%
    Couleur du texte 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!*&Boucle+pi(),f!*(&Boucle+30); \'Start- et Endwinkel aus Sicht qui Ellipse_
    rgb(220,0,0),6;0' la couleur,Stärke,Segmentierschalter 0/1
    Ellipsenbogen 400,170,-f!*50; \'Halbachsen a,b, gewünschte Drehung (f!*grd=rad)
    -f!*&Boucle,-f!*(&Boucle+40); \'Start- et Endwinkel aus Sicht qui Ellipse_
    rgb(0,0,220),9;1' la couleur,Stärke,Segmentierschalter 0/1
    Ellipsenbogen 400,170,-f!*80; \'Halbachsen a,b, gewünschte Drehung (f!*grd=rad)
    f!*&Boucle,f!*(&Boucle+60); \'Start- et Endwinkel aus Sicht qui Ellipse_
    rgb(0,220,0),5;0' la couleur,Stärke,Segmentierschalter 0/1
    'EndPaint:MCopyBMP 0,0 - %maxx,%maxy >0,0;0
    EndPaint
    DrawPic Bitmap%, 0, 0; 0
    waitinput 5:si %clé=27:end&=1:pause :endif

ENDWHILE

si end&:Sound 2200,40: DeleteObject Bitmap% :FIN :Endif

    Goto "Begin"
    FIN

    proc Ellipsenbogen

        parameters a!,b!,alpha!,beta!,gamma!,col&,thk&,sw&
        declare x!,y!,g!,tmp!,nenr!,wrz!,inkr!

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

            var de!=beta!:var jusqu'à!=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!
            cas g!=de! : moveto xm!+x!,ym!-y!
            usepen 0,thk&,col&:lineto xm!+x!,ym!-y!:usepen 0,1,0
            cas sw&:line  xm!,ym! - (xm!+x!),ym!-y!
            g!=g!+inkr!:until g!>=jusqu'à!

        endproc

        proc Achsen :parameters x!,y!

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

        endproc