Kirjautuminen

Haku

Tehtävät

Keskustelu: Koodit: QB: TOP-lista

Sivun loppuun

snakari [02.04.2003 17:53:33]

#

Samantapainen vinkki oli jo vblle, mutta se taitaa olla aika hankala kääntää qblle, joten tein yksinkertaisemman top-listan.
komennot:
tallennalista "tiedoston nimi" / tallentaa top-listan
lataalista "tiedoston nimi" / lataa top-listan
lisaauusi "uusi nimi", 666 / lisää uuden nimen listaan (jos pisteet riittävät)
tulostalista x, y / tulostaa top-listan
jarjestys-muuttujalla voi vaihtaa onko listassa korkeimmat pisteet (0) vai pienimmät pisteet (1). listan koon voi vaihtaa muuttamalla
DIM SHARED lista(1 TO 10) AS top
rivin arvoja. esim.
DIM SHARED lista(1 TO 5) AS top
koodia saa vapaasti käyttää.

muokkaus:
nyt listan oikeus tarkastetaan lisäämällä tallennusvaiheessa tiedoston loppuun jokaisen listan arvon ascii-koodin summa ja katsomalla sen jakojäännös, näin pienikin muutos tiedostossa huomataan. ja latauksessa tarkistetaan onko numero alhaalla kohdallaan.

DECLARE FUNCTION yht! (sana$)
DECLARE SUB tulostalista (y!, x!)
DECLARE SUB tallennalista (nimi$)
DECLARE SUB lataalista (nimi$)
DECLARE SUB lisaauusi (nimi$, pisteet!)

TYPE top
  pisteet AS INTEGER
  nimi AS STRING * 11
END TYPE

' numeroiden määrä
DIM SHARED lista(1 TO 10) AS top
DIM SHARED jarjestys, jaannos AS INTEGER

jarjestys = 0 ' 0 = isoin ylemmäksi | 1 = pienin ylemmäksi
jaannos = 69  ' tällä katsotaan jakojäännös, voi ja kannattaakin vaihtaa

CLS ' tyhjentää ruudun

lataalista "top.sav" ' ladataan lista

' tekee listan
FOR i = 1 TO UBOUND(lista)
  lista(i).pisteet = 100 - 10 * (i - 1)
  lista(i).nimi = "nimetön"
NEXT

lisaauusi "snakari", 110   ' lisätään uusi arvo listaan
lisaauusi "hallitsee", 65  ' lisätään uusi arvo listaan

COLOR 10
LOCATE 9, 10: PRINT "TOP 10"
COLOR 2
tulostalista 10, 10' tulostetaan lista

tallennalista "top.sav" ' tallennetaan lista

SUB lataalista (nimi$)
a = FREEFILE
OPEN nimi$ FOR BINARY AS a
FOR i = 1 TO UBOUND(lista)
  GET a, , lista(i)
  tarkistus = tarkistus + yht(lista(i).nimi) + yht(STR$(lista(i).pisteet))
NEXT
GET a, , tarkista
IF NOT tarkista = tarkistus MOD jaannos THEN
  PRINT "top-listaa on muunneltu!"
  SLEEP
  END
END IF
CLOSE a
END SUB

SUB lisaauusi (nimi$, pisteet)
IF jarjestys = 0 THEN
  FOR kohta = 1 TO UBOUND(lista)
    IF pisteet > lista(kohta).pisteet THEN
      FOR i = 0 TO UBOUND(lista) - kohta - 1
        lista(UBOUND(lista) - i).pisteet = lista(UBOUND(lista) - i - 1).pisteet
        lista(UBOUND(lista) - i).nimi = lista(UBOUND(lista) - i - 1).nimi
      NEXT
      lista(kohta).pisteet = pisteet
      lista(kohta).nimi = nimi$
      EXIT FOR
    END IF
  NEXT
  ELSEIF jarjestys = 1 THEN
  FOR kohta = 1 TO UBOUND(lista)
    IF pisteet < lista(kohta).pisteet THEN
      FOR i = 0 TO UBOUND(lista) - kohta - 1
        lista(UBOUND(lista) - i).pisteet = lista(UBOUND(lista) - i - 1).pisteet
        lista(UBOUND(lista) - i).nimi = lista(UBOUND(lista) - i - 1).nimi
      NEXT
      lista(kohta).pisteet = pisteet
      lista(kohta).nimi = nimi$
      EXIT FOR
    END IF
  NEXT
END IF
END SUB

SUB tallennalista (nimi$)
a = FREEFILE
OPEN nimi$ FOR BINARY AS a
FOR i = 1 TO UBOUND(lista)
  PUT a, , lista(i)
  tarkistus = tarkistus + yht(lista(i).nimi) + yht(STR$(lista(i).pisteet))
NEXT
tarkista = tarkistus MOD jaannos
PUT a, , tarkista
CLOSE a
END SUB

SUB tulostalista (y, x)
FOR i = 1 TO UBOUND(lista)
  LOCATE y + i - 1, x: PRINT lista(i).nimi; ":"; lista(i).pisteet
NEXT
END SUB

FUNCTION yht (sana$)
' tarvitaan vain jakojäännöksen laskemiseen
FOR i = 1 TO LEN(sana$)
  arvo = arvo + ASC(MID$(sana$, i, 1))
NEXT
yht = arvo
END FUNCTION

snakari [02.04.2003 17:56:54]

#

kommentteja

Sami [02.04.2003 19:10:33]

#

Vaikuttaa kuvaukseltaan hyvältä, ajattelin joskus itsekin vääntää tuontapaista, mutta kun en ainakaan vielä ole tarvinnut sitä mihinkään niin en sitten ole edes alkanut tekemään semmoista :)

Antti Laaksonen [02.04.2003 19:20:21]

#

Näyttää ihan toimivalta ja helppokäyttöiseltä systeemiltä. Huono puoli on kuitenkin se, että nimiä ja tuloksia ei salakirjoiteta - listaa pystyy muokkaamaan kuka vain.

snakari [03.04.2003 09:00:51]

#

no olishan ne tietenkin kryptata voinut, mutta fawkzin top-listan kryptaajaa saa käyttää ja se löytyy osoitteesta https://www.ohjelmointiputka.net/koodit_nayta.php?id=18

snakari [03.04.2003 22:49:46]

#

no nyt pitäisi olla hankalaa vaihtaa arvoja tiedostosta käsin.

N [05.04.2003 17:16:29]

#

Ihan kiva, tee vaik ite samal viel cryptaaja :)?

snakari [06.04.2003 00:39:35]

#

en usko että tarvitaan.

Jakezu91 [15.06.2003 15:11:40]

#

ihan hyvä...

Suominen90v [30.09.2003 20:36:28]

#

pitääks toi tallentaa .exe muotoon vai miks


Sivun alkuun

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Tietoa sivustosta