Keskustelu: Ohjelmointikysymykset: VB6: [VB 6] TextBoxissa rivien määrä

Tässä aloittelen VB 6:lla, ja tälläinen on ongelma:

Käyttäjä kirjoittaa TextBoxiin sen verran tekstiä kun haluaa, painaa nappia kun on valmis. Painaessa nappia aukeaa MsgBox, jossa on TextBoxissa olevien rivien määrä.
Miten siis saan laskettua rivien määrän?

- Pawe

Ensimmäisenä täytyisi määritellä, mitä tarkoitat rivimäärällä. Ruudulla näkyvät rivit vai käyttäjän rivivaihdolla erottamat?

Const EM_GETLINECOUNT = &HBA
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
    (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Sub LaskeSyötetytRivit()
    Dim Rivejä As Long
    Rivejä = UBound(Split(Tekstipoksi.Text, vbCrLf)) + 1
    MsgBox Rivejä
End Sub
Private Sub LaskeNäkyvätRivit()
    Dim Rivejä As Long
    Rivejä = SendMessage(Tekstipoksi.hwnd, EM_GETLINECOUNT, 0, 0)
    MsgBox Rivejä
End Sub

Homma pelaa tuolla LaskeNäkyvätRivit aliohjelmalla(?). Kiitos tästä :)

- Pawe

Jep, kyllähän tuo EM_GETLINECOUNT palauttaa ihan suoraan kaikki rivit. MSDN sanoo: "The EM_GETLINECOUNT message retrieves the total number of text lines, not just the number of lines that are currently visible."

Joo, siis tuossa nyt tuli sellainen käsite-epätarkkuus, että tarkoitin näkyvillä riveillä rivimäärää joka ruudulla näytetään tai näytettäisiin kun tekstissä on automaattirivitys. Näkyvyydellä en siis tarkoittanut sitä, onko rivi näkyvillä ruudussa vai ei. Muutenhan sen pitäisi palauttaa 0 jos on esimerkiksi toinen ikkuna päällä :D

Varmaankin parempi nimi tuolle aliohjelmalle olisi ollut LaskeRivitetytRivit

Tai sitten ihan vaan LaskeRivit ja LaskeRivinvaihdot. Pitkät funktionimet on tuskaa, sekoittavat vaan pääkoppaa enemmän kuin auttavat. Toisaalta suosisin aina englanninkielisiä funktionimiä.

Ajattelin tässä vertailun vuoksi tehdä koodinpätkän, joka tekee oikeasti vähemmän kuin tuo helppo Split-ratkaisu, vaikka koodi onkin paljon pidempi. Splithän etsii annetut merkit ja sitten luo monta uutta merkkijonoa ja kasaa ne uudeksi merkkijonotauluksi. Tämä ei ole kovinkaan kevyt temppu, ja kaiken lisäksi puhtaalla VB-koodilla (eli ilman API-kutsuja!) pystyy tekemään funktion joka tekee Splitin temput kolme kertaa nopeammin. Yhtenä lisäyksityiskohtana Text1.Text suorittaa Unicode-muunnoksen tekstilaatikossa sijaitsevalle ANSI-tekstille, VB6:n merkkijonothan on tunnetusti kaksi tavua per merkki.

Tässä siis kuitenkin esimerkkikoodi, joka laskee rivinvaihdot paljon vauhdikkaammin. Käytännössä se hakee suoraan tekstilaatikon tekstin sijainnin muistissa, kopioi sieltä uuden VB-yhteensopivan merkkijonon ja sitten hakee tavutasolla rivinvaihtoja, koska palautettu merkkijono ei ole Unicodea.

Aloita uusi projekti, lisää tekstilaatikko, aseta MultiLine = True ja ScrollBars = vbVertical. Sitten pastettele:

Option Explicit

Private Declare Function GetWindowTextLengthA Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function LocalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function LocalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Ptr As Long, ByVal Value As Long)
Private Declare Function SendMessageA Lib "user32" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SysAllocStringByteLen Lib "oleaut32" (ByVal Ptr As Long, ByVal Length As Long) As Long

Private Const EM_GETLINECOUNT = &HBA
Private Const EM_GETHANDLE = &HBD

Private Function Rivinvaihdot(ByVal hWnd As Long) As Long
    Dim lngPos As Long, lngPtr As Long, lngStrHandle As Long, lngStrPtr As Long
    Dim CRLF As String, strText As String
    ' luodaan tavutason CRLF - lopputulos on sama kuin tekisi kutsun StrConv(vbCrLf, vbFromUnicode)
    CRLF = ChrW$(&HA0D)
    ' hae tekstin kahva
    lngStrHandle = SendMessageA(hWnd, EM_GETHANDLE, 0, ByVal 0&)
    ' varmista että saimme kahvan
    If lngStrHandle Then
        ' hae tekstin pointteri ja varaa muisti vain tämän ohjelman käyttöön
        lngStrPtr = LocalLock(lngStrHandle)
        ' varmista että saimme pointterin ja myös että varasimme kahvan
        If lngStrPtr Then
            ' kopioi siitä uusi BSTR: joudumme tekemään näin, koska saamamme tekstibufferi ei ole BSTR
            lngPtr = SysAllocStringByteLen(lngStrPtr, GetWindowTextLengthA(hWnd))
            ' vapauta kahva
            LocalUnlock lngStrHandle
            ' sijoita uusi BSTR tekstimuuttujaan
            PutMem4 VarPtr(strText), lngPtr
            ' etsi seuraava rivinvaihto (huomioi: käytössä tavuhaku, ei merkkihaku!)
            lngPos = InStrB(strText, CRLF)
            ' jatka niin kauan kuin rivinvaihtoja löytyy
            Do While lngPos
                ' kasvata löydettyjen rivinvaihtojen määrää
                Rivinvaihdot = Rivinvaihdot + 1
                ' etsi seuraava rivinvaihto
                lngPos = InStrB(lngPos + 2, strText, CRLF)
            Loop
            ' vapauta luotu BSTR
            strText = vbNullString
        End If
    End If
End Function

Private Function Rivit(ByVal hWnd As Long) As Long
    ' suoraviivainen kutsu
    Rivit = SendMessageA(hWnd, EM_GETLINECOUNT, 0, ByVal 0&)
End Function

Private Sub Form_Load()
    ' vaihda teksti yhdeksi rivinvaihdoksi
    Text1.Text = vbNewLine
End Sub

Private Sub Text1_Change()
    Form1.Caption = "Rivinvaihdot: " & Rivinvaihdot(Text1.hWnd) & " | Rivit: " & Rivit(Text1.hWnd)
End Sub

Eron Splitiin huomaa vaikka Ctrl + Alt + Del > Suorituskyky-välillehdeltä: tee ensin yllä olevalla koodilla testi ja pasteta vaikka tuota koodia jatkuvalla syötöllä tekstilaatikkoon Ctrl + V pohjassa. Huomaat miten prosessorin käyttö lopulta alkaa muutaman tuhannan rivin kohdalla nousta, mutta ei mene huippuunsa. Sen jälkeen vaihda käyttöön tämä koodi:

Private Sub Text1_Change()
    Form1.Caption = "Rivinvaihdot: " & UBound(Split(Text1.Text, vbNewLine)) & " | Rivit: " & Rivit(Text1.hWnd)
End Sub

Pitäisi jo ihan muutaman tuhannen rivinvaihdon tienoilla huomata miten kone alkaa huutaa armoa :)

Merri kirjoitti:

Pitäisi jo ihan muutaman tuhannen rivinvaihdon tienoilla huomata miten kone alkaa huutaa armoa :)

Vähän päälle 6000 rivillä meni pahimmillaan 10% CPU-tehoa (kun hakkasi jatkuvasti näppistä)

Kieltämättä split on epätehokas tapa, mutta mielestäni esittämäsi tapa on ylioptimointia, koska suunnilleen samaan (vain 15% hitaampaan) pääsee ihan muutamalla rivillä peruskoodia (ilman API-kutsuja)

Private Function CountCrLf(tb As TextBox) As Long
    Dim i As Long, sz As String
    sz = tb.Text
    For CountCrLf = 1 To &H7FFFFFFF
        i = InStr(i + 1, sz, vbCrLf, vbBinaryCompare)
        If i = 0 Then Exit For
    Next
End Function

6000 rivillä, aika ms / ajokerta

EM_GETLINECOUNT: 0,035
Rivivaihdot -funktiosi: 1,7
Vastaava ilman API-kutsuja: 2,0
Splitillä: 6,6

Toki, tiedän sen tässä tapauksessa ylioptimoinniksi, toisaalta en nähnyt siihen kovinkaan paljoa vaivaa. Kommentoimiseen meni enemmän aikaa kuin koodin kirjoittamiseen, kun piti miettiä sanottavansa suomeksi :D

Sen verran toki pitää kysyä, että ajoitko testin IDE:ssä vai käännettynä?

Logiikastasi tuossa koodissa sen verran, että sen pitäisi aloittaa nollasta, koska sen pitäisi laskea sitä määrää mitä CRLF:ää löytyy, nyt se laittaa tarjolle ykköstä jo ennen kuin ainuttakaan on löydetty.

Jos siellä on aaaa<RIVINVAIHTO>bbbb, niin silloin siellä on 2 riviä. Samoin splitillä pelkkä vbCrLf palauttaa kaksi tyhjää merkkijonoa, eli logiikka vaan pyritään säilyttämään. Toki jälleen tässä tapauksessa funktion nimeäminen on mennyt täysin päin pyllyä. :D