Kirjautuminen

Haku

Tehtävät

Keskustelu: Koodit: QB: STRING taulukkona 2

xatir [02.01.2003 12:38:17]

#

Kirjoitin yleiskäyttööm funktioryhmän, jonka avulla $-muuttujan voi jakaa "alkioiksi" haluamaansa välierotinta käyttäen. Huom! jokainen alkio päättyy EROTIN-merkkiin.

Funktiot

'palauttaa lista$:n poislukien mainitun rivin ts, poistaa mainitun rivin.
DECLARE FUNCTION poista$ (lista$, rivi%)
'Muuttaa lista$:n mainitun rivin uudeksi
DECLARE FUNCTION muuta$ (lista$, rivi%, uusi$)
'pari funktiota listojen käsittelyyn
DECLARE FUNCTION rivinalku% (lista$, rivi%)'Mistä alkaa n:s rivi (1...
DECLARE FUNCTION rivinpituus% (lista$, rivi%)'Miten pitkä on n. rivi (0..
'lisää uuden rivin (sama kuin lista$+uusi$, mutta tekee tarkistuksen)
DECLARE FUNCTION lisaa$ (lista$, uusi$)
'palauttaa lista$:n tietyn rivin (1...riveja%)
DECLARE FUNCTION mikarivi$ (lista$, rivi%)
'palauttaa lista$:n rivimäärän
DECLARE FUNCTION riveja% (lista$)

'Rivien välinen erotin, jolla erotat alkiot toisistaan
CONST erotin = "#" 'Yksi merkki, kaksi ei kelpaa!

FUNCTION lisaa$ (lista$, uusi$)
IF RIGHT$(uusi$, 1) = erotin THEN
  lisaa$ = lista$ + uusi$
ELSE
  lisaa$ = lista$ + uusi$ + erotin
END IF
END FUNCTION

FUNCTION mikarivi$ (lista$, rivi%)
start% = 0: pit% = 0: r$ = ""
IF rivi% <= riveja(lista$) AND rivi% > 0 THEN
  alku% = rivinalku(lista$, rivi%)
  pit% = rivinpituus(lista$, rivi%)
  r$ = MID$(lista$, alku%, pit%)
END IF
mikarivi$ = r$
END FUNCTION

FUNCTION muuta$ (lista$, rivi%, uusi$)
a$ = "": uusil$ = ""'uusi lista

IF riveja(lista$) > 0 AND rivi% <= riveja(lista$) THEN 'muutettava rivi löytyy
  FOR a% = 1 TO riveja(lista$)
    IF a% <> rivi% THEN
      a$ = mikarivi(lista$, a%) + erotin
    ELSE
      IF RIGHT$(uusi$, 1) = erotin THEN a$ = uusi$ ELSE a$ = uusi$ + erotin
    END IF
    uusil$ = uusil$ + a$
  NEXT a%
END IF

muuta$ = uusil$

END FUNCTION

FUNCTION poista$ (lista$, rivi%)
a$ = "": uusil$ = ""'uusi lista

IF riveja(lista$) > 0 AND rivi% <= riveja(lista$) THEN 'on poistettavien joukossa...
  FOR a% = 1 TO riveja(lista$)
    IF a% <> rivi% THEN a$ = mikarivi(lista$, a%) + erotin ELSE a$ = ""
    uusil$ = uusil$ + a$
  NEXT a%
END IF

poista$ = uusil$

END FUNCTION

FUNCTION riveja% (lista$)
r = 0
FOR a% = 1 TO LEN(lista$)
  IF MID$(lista$, a%, 1) = erotin THEN r = r + 1
NEXT a%
riveja% = r
END FUNCTION

FUNCTION rivinalku% (lista$, rivi%)
al% = 1
IF rivi% = 1 THEN
  rivinalku% = 1
ELSEIF rivi% <= riveja(lista$) THEN
  FOR a% = 1 TO LEN(lista$)
    IF MID$(lista$, a%, 1) = erotin THEN al% = al% + 1
    IF al% = rivi% THEN al% = a% + 1: EXIT FOR
  NEXT a%
  rivinalku = al%
END IF
END FUNCTION

FUNCTION rivinpituus% (lista$, rivi%)
llen% = 0
FOR a% = rivinalku(lista$, rivi%) TO LEN(lista$)
  IF MID$(lista$, a%, 1) = erotin THEN llen% = a%: EXIT FOR
NEXT a%
rivinpituus% = llen% - rivinalku(lista$, rivi%)
END FUNCTION

Esim 1- Rivin palautus, muokkaus & poisto

a$ = "Rivi1#Rivi2Rivi3#" '<- erotin päättää jokaisen alkion, myös viimeisen. Jos unohdat lisätä viimeisen erottimen, funktiot jättävät viimeisen alkion lukematta!
'funktio mikarivi$
PRINT mikarivi$(a$,2) 'Tulostetaan 2. rivi
'funktio muuta$
PRINT mikarivi$(a$,1)+", ennen muokkausta"
a$=muuta$(a$,1,"Muutettu rivi 1")
PRINT mikarivi$(a$,1)+", muokkauksen jälkeen"
'funktio poista$
PRINT "Ennen poistoa:"
FOR e%=1 TO riveja(a$)
  PRINT mikarivi$(a$,e%),
NEXT e%
a$=poista$(a$,1) 'poistetaan 1. rivi
PRINT "Poiston jälkeen:"
FOR e%=1 TO riveja(a$)
  PRINT mikarivi$(a$,e%),
NEXT e%

Esim 2- käyttö

'Esimerkkinä valikko, jossa käytetään funktioita
'Voitte itse jatkokehittää!
valikko$="Valinta1#Valinta2#Valinta3#" 'valikon valinnat
DIM cols(riveja(valikko$)) 'Värit
selec%=0
cols(selec%)=1 'Valittu kohta
DO
  'Tulostetaan valikko.
  FOR a% = 1 TO riveja(valikko$)
    COLOR cols(a%)+1 'Valitun kohdan väri on eri kuin muilla
    PRINT mikarivi$(valikko$,a%)
  NEXT a%
  DO:a$=INKEY$:LOOP UNTIL a$ <> ""'odottaa näppäimen painallusta
  cols(selec%)=0 'Poistetaan nyk. valinnan arvo; selec SAATTAA muuttua.
  SELECT CASE UCASE$(a$) 'Nopea valintarakenne
    CASE "Q": selec% = selec% - 1
    CASE "A": selec% = selec% + 1
    CASE CHR$(13): EXIT DO 'Lopettaa valikon, valittu kohta on selec.
  END SELECT
  IF selec% < 1 THEN selec%=riveja(valikko$) 'Tarkistukset, ettei mene cols yli.
  IF selec% > riveja(valikko$) THEN selec%=1
  cols(selec%)=1 'Valittu kohta
LOOP
PRINT "VALITSIT: ";mikarivi$(valikko$,selec%)

Antti Laaksonen [03.01.2003 21:46:26]

#

Hyviltä ja käyttökelpoisilta vaikuttavia funktioita.

KimmoKM [04.01.2003 12:31:25]

#

Hyviä funktioita

progo [05.01.2003 12:57:57]

#

Mojovia funktioita

xatir [05.01.2003 15:44:49]

#

Kiitoksia. Jatkan kehittelyä!

Vastaus

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

Tietoa sivustosta