Login Register
Frontpage Code library Pastebin

GetWord2 & CountWords2

Author: KilledWhale
Added: 9.4.2011 21:34
Edited: 15.4.2011 22:19
Category: Merkkijonot

Description

CB:n omissa GetWord ja CountWords -funktioissa tuntuu olevan häikkää monikirjaimisten erottimien kanssa. Lisäksi GetWord tykkää kusta ääkkösetkin joskus. Tässä olisi saman asian hoitavat funktiot jotka eivät sekoile. Koodia olen yrittänyt optimoida niin paljon kuin mahdollista ja lisäksi kommentoin sitä hieman aloittelijoille lueskeltavaksi. Koodissa on mukana pieni esimerkki, joka demonstroi valmiiden GetWordin Ja CountWordsin ongelmia. GetWord2:lle annetaan samat parametrit kuin normaalille GetWordille ja CountWords2 ottaa samat parametrit kuin CountWords.

Code

Select all
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
    txt$ = "ääk - b-c - ö"

    Print CountWords(txt, " - ") + "::" + CountWords2(txt, " - ")
    Print ""
    For i = 1 To 3
       Print GetWord(txt, i, " - ") + "::" + GetWord2(txt, i, " - ")
    Next i

    WaitKey

    Function GetWord2(a As String, b As Integer, c As String)
       l = Len(c) // Otetaan pituus muuttujaan optimoinniksi
        For i As Integer = 2 To b // Käydään läpi kaikki ei-halutut sanat
          q = InStr(a, c) // Katsotaan löytyykö erotinta
            If q Then // Löytyi
                a = Mid(a, q + l) // Otetaan alkuosa pois erottimeen asti
          EndIf
        Next i

       q = InStr(a, c) // Katsotaan vielä löytyykö erotinta
        If q Then // Jos löytyi
            Return Mid(a, 1, q - 1) // Palautetaan tekstiä seuraavaan erottimeen asti
        Else // Ei löytynyt
            Return Mid(a, 1) // Palautetaan loppuosa
        EndIf
    EndFunction

    Function CountWords2(a As String, c As String)
       Repeat
          n + 1 // Kasvatetaan arvoa, että montako ON löydetty
          aa = InStr(a, c, aa + 1) // Katsotaan löytyykö erotinta
          If Not aa Then // Jos ei löydy
             Exit // Poistutaan
          EndIf
       Forever
       Return n // Palautetaan esiintymien määrä
    EndFunction

Comments

#2 Sent by: Jare, 9.4.2011 22:57

Näitä funktioita olen aina silloin tällöin etsiskellyt! Hienoa että ne ovat nyt täällä. :)

Leave a comment

You must be logged in to comment.