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
kommentteja
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 :)
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.
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.
no nyt pitäisi olla hankalaa vaihtaa arvoja tiedostosta käsin.
Ihan kiva, tee vaik ite samal viel cryptaaja :)?
en usko että tarvitaan.
ihan hyvä...
pitääks toi tallentaa .exe muotoon vai miks
Aihe on jo aika vanha, joten et voi enää vastata siihen.