fb:porticula NoPaste

Info / Hilfe Liste
Übersicht / Liste Neu
Datei hochladen Suche
Quellcode suchen
Dateidownload
Geometrie für faule

Uploader:	The_Muh
Datum/Zeit:	08.09.2007 20:11:53
const pi = 4*atn(1) 'macht aus pi eine konstante

'Erstellung der variablen:

dim as string key

Dim as double r,a,b,c,g,h



'Declarierung der Subs:

declare sub kugel(r as double)

declare sub quadrat(a as double)

declare sub wuerfel(a as double)

declare sub kreis(r as double)

declare sub dreieck(h as double, g as double)

declare sub quader(a as double, c as double, b as double)

declare sub rechteck(a as double, b as double)

declare sub grafik()



'Erstellen der Subs

sub kreis(r as double)

    locate 13,31 : ? "Der Kreis:"

    locate 14,31 : Input "Gib den Radius ein: ",r

    locate 15,31 : ? CSNG(r^2*pi);" = Flaeche"

    locate 16,31 : ? CSNG((r*2)*pi);" = Umfang"

    sleep

end sub



sub quadrat(a as double)

    locate 13,31 : ? "Das Quadrat:"

    locate 14,31 : Input "Gib die Kantenlaenge ein: ", a

    locate 15,31 : ? a^2; " = Flaeche"

    locate 16,31 : ? a*4; " = Umfang"

    sleep

end sub



sub rechteck(a as double, b as double)

    locate 13,31 : ? "Das Rechteck:"

    locate 14,31 : Input "Gib seite a ein: ", a

    locate 15,31 : Input "Gib seite b ein: ", b

    locate 16,31 : ? a*b;" = Flaeche"

    locate 17,31 : ? (a*2)+(b*2);" = Umfang"

    sleep

end sub



sub wuerfel(a as double)

    locate 13,31 : ? "Der Wuerfel:"

    locate 14,31 : Input "Gib die Kantenlaenge ein: ", a

    locate 15,31 : ? a^3; " = Volumen"

    locate 16,31 : ? (a^2)*6; "= Oberflaeche"

    locate 17,31 : ? a^2; " = Einzelflaeche"

    sleep

end sub



sub quader(a as double, c as double, b as double)

    locate 13,31 :? "Der Quader:"

    locate 14,31 :Input "Gib seite a ein: ", a

    locate 15,31 :Input "Gib seite b ein: ", b

    locate 16,31 :Input "Gib Seite c ein: ", c

    locate 17,31 :? a*b*c; " = Volumen"

    locate 18,31 :? 2*(a*b+b*c+a*c) ;" = Oberflaeche"

    sleep

end sub



sub dreieck(h as double, g as double)

    locate 13,31 :? "Das Dreieck:"

    locate 14,31 :Input "Die Hoehe: ",h

    locate 15,31 :Input "Die Grundseite: ",g

    locate 16,31 :? (g*h)/2 ;" = Flaeche"

    sleep

end sub



sub kugel(r as double)

    locate 13,31 :? "Die Kugel:"

    locate 14,31 :Input "Bitte Radius eingeben: ",r

    locate 15,31 :? (4/3)*pi*r^3 ;" = Volumen"

    locate 16,31 :? 4*pi*r^2 ;" = Flaeche"

    sleep

end sub



sub grafik()

    color 15

    Screen 18,32         'ein Grafik-Fenster erstellen

    Bload "geo.bmp"

end sub



do

grafik() 'läd die hintergrund grafik

'----------------------------------------------------------'

'------------------ab hier kommt das Menü!-----------------'

'----------------------------------------------------------'

locate 13,31

    Print "F1 = Quadrat"

locate 14,31

    Print "F2 = Wuerfel"

locate 15,31

    Print "F3 = Rechteck"

locate 16,31

    Print "F4 = Quader"

locate 17,31

    Print "F5 = Kreis"

locate 18,31

    Print "F6 = Kugel"

locate 19,31

    Print "F7 = Dreieck"

    ? : ?

locate 20,31

    Print "ESC zum Beenden"

    do: sleep 1 : key = inkey$ : loop until key <> ""



    select case key

    case chr(255,59) 'F1

        CLS

        grafik()

        quadrat(a)

    case CHR(255,60) 'F2

        CLS

        grafik()

        wuerfel(a)

    case CHR(255,61) 'F3

        CLS

        grafik()

        rechteck(a,b)

    case CHR(255,62) 'F4

        cls

        grafik()

        quader(a,b,c)

    case chr(255,63) 'F5

        cls

        grafik()

        kreis(r)

    case chr(255,64) 'F6

        CLS

        grafik()

        kugel(r)

    case chr(255,65) 'F7

        cls

        grafik()

        dreieck(g,h)

    '-------------------------------------'

    'platzhalter für spätere erweiterungen'

    '-------------------------------------'

    case chr(255, 107)

        CLS

        exit do

    case chr(27)

        CLS

        exit do

    case else

        continue do

    end select

loop