[Projekti] Kyselijä

[jjoona]

Elikkä tuli mieleen tuollainen kyselijä joka kyselisi esimerkiksi englannin sanoja, aina kun sana menee väärin tulee punaisella lukemaan oikea vastaus ja kun sana menee oikein siirtyy ohjelma seuraavaan sanaan. Ohjelma jankkaisi sanoja niin kauan, että ne menee oikein, jos sana menee oikein sitä ei kysytä uudelleen, kun kaikki sanat ovat sanottu oikein alkaa kysely uudelleen

Lisäksi: Kun avaat ohjelman tulee kaksi taulukkoa, toiseen tulee 'kysymys' ja toiseen vastaus.

Tosin ongelmana on tässä se, että itsellä ei ole taitoa moiseen, en osaa tehdä Coolbasicilla mitään ja pyytäisin jos joku haluaisi tehdä tälläisen.

[valscion]

Tällaisia ehdotuksia varten on jo oma topikkinsa: viewtopic.php?f=13&t=1416.

[kaneli2000]

Jonkinlainen kyselijäohjelma CB:llähän on tehty, mutta sitä tuskin löytää mistään enää. Tekijääkään en muista.

[MrMonday]

Code: Select all

                                                //Kyselijä//
       
    Kohta1:   
    
            Color cbwhite // Asetetaan tekstin väriksi valkoinen.
    
    Kysymys$ = "Viileä" // Heittomerkkien väliin tulee kysymys.
    OikeaVastaus$ = "Cool" // Heittomerkkien väliin tulee oikea vastaus.          
      
        // Alla olevassa silmukassa kirjoitetaan vastaus..       
      
Repeat

    ClearText
        AddText ""+Kysymys$
            Vastaus$ = Input("Vastaus: ")
        DrawScreen
    
Until KeyHit(28)

    CloseInput

ClearText

        // ..ja seuraavaksi tarkistetaan onko vastaajan vastaus sama, kuin oikea vastaus.
        // Jos on, mennään suraavaan kysymykseen, jos ei, oikea vastaus tulee punaisella, 
        // ja kysymys tulee uudelleen.

    If Vastaus$ = OikeaVastaus$ Then
    
        Goto Kohta2
        
    Else
    
        Color cbred
            AddText ""+OikeaVastaus$
                DrawScreen
            WaitKey
        Goto Kohta1
        
    EndIf
    
        // Kohta 2 on samanlainen kuin kohta yksi, paitsi kysymys ja oikea vastaus ovat uudet.
        // Näin uusia kohtia voi siis tehdä kopioimalla yhden kohdan, ja muokkaamalla vain kohdan luvun.
        
    Kohta2:
    
        Color cbwhite
    
    Kysymys$ = "Perus"
    OikeaVastaus$ = "Basic"                  
          
Repeat

    ClearText
        AddText ""+Kysymys$
            Vastaus$ = Input("Vastaus: ")
        DrawScreen
        
Until KeyHit(28)

    CloseInput

ClearText

    If Vastaus$ = OikeaVastaus$ Then
    
        Goto Kohta1
        
    Else
    
        Color cbred
            AddText ""+OikeaVastaus$
                DrawScreen
            WaitKey
        Goto Kohta2
        
    EndIf
    
    
    // Huomaathan, että viimeiseen kohtaan laitetaan "Goto Kohta1", 
    // kun vastaus menee oikein, jolloin kysymykset alkavat alusta.

Ja kirjainten koolla on myös väliä, mutta en ala sellaista tuohon kyhäämään, vaikka komennot moisiin värkkeihin taitaa aika suoraan cbstä löytyä..
Mutta onpahan nyt jonkinlainen systeemi, toivottavasti jotain iloa siitä..

EDIT:

Ja jos haluaa tuon kirjainkoko "ongelman" pois, niin vinkkiä:

Code: Select all

Lower(Vastaus$)

[/edit]

[MetalRain]

Tässä eräänlainen kyselijä jonka tein tietokilpailua varten, huomattavasti helpommin muunnettavissa nuo kysymykset kuin MrMondayn versiossa. Pitää lukua että mihin on vastattu oikein ja kuinka monta kertaa on kutakin kysymystä yritetty. Koodi on suurimmaksi osaksi kommentoitu, mutta saa kysyä jos ei ymmärrä toimintaperiaatetta.

Code: Select all

//isommalle ruudulle mahtuu enemmän tekstiä
SCREEN 1024,768


//käytetään muuttujaa tiedostopolulle
//helpottaa sen muuttamista jos sitä on käytetty useassa paikassa
//eikä aiheuta virheitä kun johonkin on jäänyt väärä polku
tiedostonnimi$ = "Kisa.txt"


//Luodaan tekstitiedosto - Vain testimielessä tässä, luo oma tekstitiedostosi ja poista tämä
f = OpenToWrite(tiedostonnimi$)
    WriteLine f,"Mikä on Suomen pääkaupunki?Helsinki"
    WriteLine f,"Kuinka monta senttimetriä on yksi metri?100|sata|100 senttimetriä|sata senttimetriä"
    WriteLine f,"Kuinka monta bittiä on tavussa?8|kahdeksan"
CloseFile f



//Tyyppikokoelma kysymysten säilyttämiseen
Type kysymykset

    // tähän merkkijonoon tallennetaan kysymys
    Field kysymys$
    
    // tähän merkkijonoon tallennetaan vastaukset
    Field vastaukset$
    
    // tämä kertoo onko kysymykseen vastattu jo oikein
    Field vastattuoikein
    
    // tämä kertoo kuinka monta kertaa kysymykseen on vastattu
    Field vastattu
    
    //tämä kertoo ollaanko kysymykseen juuri vastaamassa
    Field valittu
EndType 

//avataan tiedosto lukemista varten
f = OpenToRead(tiedostonnimi$)

    //luetaan tiedostoa ..
    Repeat 
    
        //luetaan rivi ja tallennetaan se muuttujaan
        //näin ei vahingossa lueta kahta riviä kerralla
        rivi$ = ReadLine (f)
        
        //tarkistetaan vielä ettei rivi ole tyhjä
        If rivi$<>"" Then 
            //luodaan uusi kysymys
            k.kysymykset = New(kysymykset)
            //haetaan riviltä kaikki ennen ? merkkiä ja lisätään vielä ? merkki jotta kysymys säilyy kysymyksenä
            k\kysymys$ = GetWord(rivi$,1,"?")+"?"
            //haetaan riviltä kaikki ? merkin jälkeen
            k\vastaukset$ = GetWord(rivi$,2,"?")
        EndIf
        
    //..kunnes se loppuu
    Until EOF(f)

//suljetaan tiedosto käytön jälkeen
CloseFile f

//annetaan tilaviesti joka näkyy kysymyksen edellä
tila$ = "Tervetuloa kyselyyn! "


//tästä kohdasta alkaa kysymyksen arvonta
arvokysymys:

//nollataan arvot ettei vanhat arvot ole tallella
kysymysvalittu = 0
kysymyksiäkäytyläpi = 0
kysymyksiäoikein = 0

//käydään niin kauan että joku kysymys on arvottu
Repeat 
    //käydään kaikki kysymykset läpi
    For k.kysymykset=Each kysymykset
    
        //lasketaan kaikki kysymykset
        kysymyksiäkäytyläpi = kysymyksiäkäytyläpi + 1
        
        //arvotaan väärinvastatuista tai vastaamattomista kysymyksistä 
        If k\vastattuoikein = 0 Then 
            If Rand(1) Then 
                
                
                //valitaan kysymys
                k\valittu=1
                
                //tämä lopettaa arvonnan
                kysymysvalittu=1
                
                // jos kysymykseen on jo vastattu, lisätään tilaviestiin tieto vastausyritysten määrästä
                If k\vastattu Then tila$ = tila$+" Olet vastannut tähän kysymykseen jo "+k\vastattu+" kertaa."
                
                //poistutaan for each silmukasta
                Exit
            EndIf
        Else   
            //lasketaan oikein vastatut
            kysymyksiäoikein = kysymyksiäoikein +1
        EndIf
        
    Next k
    
    // jos kaikkiin kysymyksiin vastattu oikein lopetetaan arvonta ja lopetetaan ohjelma ilmoitukseen
    If kysymyksiäoikein=kysymyksiäkäytyläpi Then MakeError "Vastasit oikein kaikkiin kysymyksiin."
    
Until kysymysvalittu

//nollataan vastaus ettei vanha jää ruudulle
vastaus$ = ""

//putsataan näppäimistö jottei vanha enterinpainallus jumiuta ohjelmaa ikuiseen arvontojen sarjaan
ClearKeys


//Siirrytään itse kyselyyn
Repeat

    //valitaan paikka inputille
    Locate 20,40
    
    //otetaan inputista merkkijono muuttujaan
    vastaus$ = Input("") 
    
    //kirjoitetaan tilaviesti
    Text 20,0,tila$
    
    //käydään kaikki kysymykset läpi
    For k.kysymykset=Each kysymykset
        
        //jos kysymys on valittu 
        If k\valittu=1 Then 
            
            //kirjoitetaan kysymys ruudulle
            Text 20,20,k\kysymys
            
            //kun enteriä painetaan
            If KeyHit(cbkeyreturn) Then 
            
                //lasketaan kysymykseen vastaamiskertoja
                k\vastattu = k\vastattu + 1
            
                //käydään kaikki oikeat vastaukset läpi
                // vastauksia oletetaan olevan ainakin yksi
                // ja korkeintaan niin monta kuinka moneen osaan | merkillä oli vastaukset jaettu
                For i=1 To CountWords(k\vastaukset,"|")
                
                    // muutetaan molemmat kirjaimet pieniksi ja verrataan ovatko samat
                    // getword siis lukee i:nen vastauksen vastausten listasta
                    If Lower(vastaus$) = Lower(GetWord(k\vastaukset,i,"|")) Then 
                        //mikäli täsmäävät merkitään vastaus oikeaksi
                        k\vastattuoikein = 1 
                        //poistetaan valinta 
                        k\valittu = 0
                        //suljetetaan input jotta se tyhjenee
                        CloseInput 
                        // annetaan palautetta 
                        
                        tila$ = "Vastasit oikein."
                        //hypätään takaisin arvontaan
                        Goto arvokysymys
                    EndIf
                    
                    
                Next i
                
                // jos tänne tullaan on vastaus mennyt väärin
                
                //annetaan palautetta
                tila$ = "Vastasit väärin."
                
                //poistetaan valinta
                k\valittu = 0 
                
                 //suljetetaan input jotta se tyhjenee
                CloseInput 
                
                //hypätään takaisin arvontaan
                Goto arvokysymys
                
            EndIf
        EndIf
    
    Next k

    //muista piirtää ruutu
    DrawScreen

Forever

Edit: Olipahan muuten kamalaa koodia, mutta ehkä helpompaa ymmärtää jos tyyppikokoelmat ei ole kovin tuttuja.

[KilledWhale]

Itse tein joskus opettelumielessä cbllä VirtuaaliKyselijä nimisen ohjelman, mutta se on (onneksi) kadonnut

[MrMonday]

Tässä eräänlainen kyselijä jonka tein tietokilpailua varten, huomattavasti helpommin muunnettavissa nuo kysymykset kuin MrMondayn versiossa. Pitää lukua että mihin on vastattu oikein ja kuinka monta kertaa on kutakin kysymystä yritetty. Koodi on suurimmaksi osaksi kommentoitu, mutta saa kysyä jos ei ymmärrä toimintaperiaatetta.

Code: Select all

Koodia..

Edit: Olipahan muuten kamalaa koodia, mutta ehkä helpompaa ymmärtää jos tyyppikokoelmat ei ole kovin tuttuja.

Hyvä että saatiin parempaakin tuotosta tänne, sillä tuo omani oli kyllä aika nopea viritys, kun en jaksanut mitään monimutkaisempaa alkaa pykäämään.. (ihan kuin olisin vielä osannutkin )
Helpoin reitti ei aina ole se paras, ei välttämättä loppupelissä edes helpoin..

[jjoona]

Kiitoksia paljon : )