Keskustelu: Koodit: QB: 3DPallo

DIM SHARED SMode, SColors, SGWidth, SGHeight, STWidth, STHeight
'3DPALLO: 3D Pallo
'Tekijä: Tatu Peltola (tatu@mbnet.fi)
'JOS TÄMÄ OHJELMA EI TOIMI NIIN ILMOITA SIITÄ TEKIJÄLLE!
'JOS TÄMÄ OHJELMA TEKEE JOTAIN PAHAA (ESIM. RIKKOO KONEEN TAI JOTAIN) NIIN
'ILMOITA SIITÄ TEKIJÄLLE!
'OK?
alku:
SMode = 13
SColors = 256
SGWidth = 320
SGHeight = 200
STWidth = 40
STHeight = 25
MColor = SColors - 1
SCREEN SMode
WIDTH STWidth, STHeight
PALETTE
COLOR NColor
CLS
COLOR 12: INPUT "Punainen (0-1)", Rv
COLOR 10: INPUT "Vihreä (0-1)", Gv
COLOR 9: INPUT "Sininen (0-1)", Bv
GOSUB mkpal
COLOR MColor
CLS
beggi:
PRINT "3D Pallo tai tunelli, näyttää vähän molemmilta! ;-)"
PRINT "Tekijä: Tatu Peltola"
PRINT "Väli pysäyttää piirtämisen."
INPUT "Tarkkuus (0 lopettaa ohjelman):", nRn!
IF nRn! <= 0 THEN GOTO EndP
Rn! = 1 / nRn!
Rn2! = 0 - Rn!
INPUT "Koko (0-1):", CCS!
IF CCS! < 0 THEN GOTO beggi
STF = TIMER
CLS
ST1 = TIMER
FOR cn! = 0 TO 1 STEP Rn!
        k$ = INKEY$
        IF k$ = " " THEN GOTO piirras1
        CX! = cn! * (SGWidth - 2)
        CC& = cn! * MColor
        LINE (CX!, 0)-(CX!, SGHeight - 1), CC&
        PAINT (CX! + 1, 0), CC&, CC&
NEXT
ET1 = TIMER
piirras1:
ST2 = TIMER
FOR cn! = 1 TO 0 STEP Rn2!
        k$ = INKEY$
        IF k$ = " " THEN GOTO piirras2
        '********Laske********
        nCX! = cn! * -.2
        nCY! = cn! * .2
        nCS = cn! * CCS!
        CX! = SGWidth / 2 + nCX * SGWidth / 2
        CY! = SGHeight / 2 + nCY * SGHeight / 2
        CS! = nCS! * SGHeight
        CC& = cn! * -MColor + MColor
        '****************
        CIRCLE (CX!, CY!), CS!, CC&     'Piirrä ympyrä
        PAINT (CX!, CY!), CC&, CC&      'Täytä ympyrä
NEXT
ET2 = TIMER
ETF = TIMER
piirras2:
PRINT "Piirretty!"
WT1 = ET1 - ST1
WT2 = ET2 - ST2
WTF = ETF - STF
PRINT "Taustan piirtoon kului"; WT1; "sekuntia aikaa. Kuvan piirtoon kului"; WT2; "sekuntia. Yhteensä kului"; WTF; "sekuntia."
GOTO beggi
EndP:
FEndP:
FFEndP:
END
mkpal:
' Tee "paletti".
FOR N% = 0 TO MColor
        N2% = INT(N% / 4)
        R2% = Rv * N2%
        G2% = Gv * N2%
        B2% = Bv * N2%
        C& = 0
        '****************
        'C& = C& OR (B2% * &H10000)     'Sininen
        C& = C& OR (G2% * &H100)        'Vihreä
        C& = C& OR R2%                  'Punainen
        '****************
        PALETTE N%, C&
NEXT
RETURN