Kirjautuminen

Haku

Tehtävät

Kilpailu

Putka Open 2025
4. kierros:
7.11. klo 18 – 9.11. klo 23

Keskustelu: Ohjelmointikysymykset: VB.NET: Vb.Net Listbox sarakejako "uudelleen lämmitys."

Sivun loppuun

Happy [26.02.2011 13:30:06]

#

Terve.

Lämmitellään vähän uudestaan tätä kun toi edellinen keskustelu oli jo niin vanha
että ei pystyny lisäämään viestejä...

Siispä... Tässä ois toi Nea:n tekemä sarakejako koodi.

Mutta jos tossa teksti tiedostossa on tyhjä rivi jossain välissä tai lopussa,
se heittää virhe ilmoituksen:

Index was outside the bounds of the array.

Mitenköhän tosta pääsis eroon?

Private Structure ScoreStruct
   Dim name As String
   Dim value As Integer
End Structure

Dim Scores() As ScoreStruct

Sub Button1_Click(sender As Object, e As EventArgs)

   FileOpen(1, "C:\Scores.txt", OpenMode.Input)
   Dim strLines() As string = _
   Split(InputString(1, _
   CType(LOF(1), Integer)), Environment.NewLine)
   FileClose(1)

   Redim Scores(strLines.length - 1)
   Dim temp(strLines.length - 1) As integer
   Dim slen As Integer

   For i As integer = 0 To strLines.Length - 1

      Dim helpArray() As string = Split(strLines(i), " ")
      Scores(i).name = helpArray(0)

      If slen < (helpArray(0).Length + _
      helpArray(1).ToString.Length) Then
         slen = helpArray(0).Length + _
         helpArray(1).ToString.Length
      End If

      Scores(i).value = CType(helpArray(1), Integer)
      temp(i) = CType(helpArray(1), Integer)
      helpArray = Nothing

   Next

   strLines = Nothing

   Dim lstInt As New List(Of Integer)
   lstInt.AddRange(temp)
   temp = Nothing: lstInt.Sort
   listBox1.Font = New Font("Courier New", 8.25!, _
   FontStyle.Regular, GraphicsUnit.Point, CType(0,Byte))
   listBox1.Items.Clear
   listBox1.Sorted = False

   For i As integer = lstInt.count -1 To 0 Step -1

      For j As Integer = 0 To Scores.Length - 1

         If lstInt.Item(i) = Scores(j).value Then
              Dim thespace As String = "  "
              If slen > (Scores(j).name.Length _
                 + Scores(j).value.ToString.Length) Then
               Dim thelen As Integer = _
               slen - (Scores(j).name.Length _
               + Scores(j).value.ToString.Length)
               thespace += New String(CType(" ", Char), thelen)
              End If
              listBox1.Items.Add(Scores(j).name _
              & thespace & Ctype(Scores(j).value, String))
         End If

      Next j

   Next i

   lstInt = Nothing

End Sub

-Happy-

groovyb [26.02.2011 16:33:59]

#

Yrität laittaa johonkin taulukkoon enemmän tavaraa kuin mahtuu.

jtha [27.02.2011 10:25:51]

#

Olen hoitanut tuon asian omissa ohjelmissa seuraavasti(pätkä koodia josta selvinnee idea):

For I = LBound(TuoteRivi) To UBound(TuoteRivi)
  List1(0).AddItem TuoteRivi(I).Koodi & TuoteRivi(I).Nimike
Next

Fontti on "Courier New", jotta merkit ottavat saman leveyden. Tämä on mielestäni yksinkertaisin ja tehokkain tapa varmistaa että sarakejako täsmää.

groovyb [27.02.2011 11:02:56]

#

Joo ei mitään, jtha vastasikin ekaan postaukseen

neau33 [27.02.2011 13:24:31]

#

Moikka Happy!

kokeile seuraavin muutoksin...

Sub Button1_Click(sender As Object, e As EventArgs)

   'muuta tätä...
   FileOpen(1, "C:\Scores2.txt", OpenMode.Input)
   Dim fileStr As String = CorrectString( _
   InputString(1, CType(LOF(1), Integer)))
   Dim strLines() As string = Split(fileStr, Environment.NewLine)
   FileClose(1)
   If strLines.Length < 1 Then
      MsgBox("Nothing to do!"): Exit Sub
   End If

   '...
   '...

End Sub

Public Function CorrectString(ByVal MyStr as String) As String
   'lisää tämä...
   Dim retStr As String = MyStr
   Dim sngLine As String = Environment.Newline
   Dim dblLine As String = Environment.Newline + Environment.Newline

   Do While retStr.indexOf("  ") > -1 _
      Or retStr.indexOf(dblLine) > -1
      retStr = retStr.Replace("  ", " ")
      retStr = retStr.Replace(dblLine, sngLine)
   Loop

   If retStr.Substring(0, 2) = sngLine Then
      Try
      retStr = retStr.Substring(2, retStr.Length - 2)
      Catch ex As Exception
      End Try
   End If

   If retStr.Substring(retStr.Length - 2, 2) = sngLine Then
      Try
      retStr = retStr.Substring(0, retStr.Length - 2)
      Catch ex As Exception
      End Try
   End If

   Return retStr

End Function

Happy [27.02.2011 14:10:08]

#

Moi.

Kiitti Nea nyt toimii... ;D

-Happy-

Happy [05.03.2011 19:44:43]

#

Moi taas...!

Nyt rupee lähtee järki tän Listboxin kanssa...

Nyt on siis saatu sarakejaot toimimaan ja vaikka ois tyhjiä rivejäkin
tiedostossa homma toimii, mutta....

Jos listalla sattuu olemaan useampi sama "tulos" ni sitte tää menee sekasin..

Esimerkki.... ;)

(teksti tiedostossa on siis tulos lista...)

Sami 400
Kalle 355
Jussi 355
Ville 355
Teemu 300
Jari 200

Nytpä listaus Listboxissa on sitte vastaava...

Sami 400
Kalle 355
Jussi 355
Ville 355
Kalle 355
Jussi 355
Ville 355
Kalle 355
Jussi 355
Ville 355
Teemu 300
Jari 200

Eli se "tuplaa" ton listan niin monta kertaa ku sama tulos löytyy listalta...


Apuva!!!!!!!!!!

-Happy-

Happy [10.03.2011 17:00:32]

#

Terve.

Nyt mä sain ne "tuplat" pois sieltä listalta...

Public Class Form1
    Private Structure ScoreStruct
        Dim name As String
        Dim value As Integer
    End Structure
    Dim Scores() As ScoreStruct



    Public Function CorrectString(ByVal MyStr As String) As String

        Dim retStr As String = MyStr
        Dim sngLine As String = Environment.Newline
        Dim dblLine As String = Environment.Newline + Environment.Newline

        Do While retStr.indexOf("  ") > -1 _
           Or retStr.indexOf(dblLine) > -1
            retStr = retStr.Replace("  ", " ")
            retStr = retStr.Replace(dblLine, sngLine)
        Loop

        If retStr.Substring(0, 2) = sngLine Then
            Try
                retStr = retStr.Substring(2, retStr.Length - 2)
            Catch ex As Exception
            End Try
        End If

        If retStr.Substring(retStr.Length - 2, 2) = sngLine Then
            Try
                retStr = retStr.Substring(0, retStr.Length - 2)
            Catch ex As Exception
            End Try
        End If

        Return retStr

    End Function

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        FileOpen(1, "E:\W1L1.txt", OpenMode.Input)
        Dim fileStr As String = CorrectString( _
        InputString(1, CType(LOF(1), Integer)))
        Dim strLines() As String = Split(fileStr, Environment.NewLine)
        FileClose(1)
        If strLines.Length < 1 Then
            MsgBox("Nothing to do!") : Exit Sub
        End If



        ReDim Scores(strLines.Length - 1)
        Dim temp(strLines.Length - 1) As Integer
        Dim slen As Integer

        For i As Integer = 0 To strLines.Length - 1

            Dim helpArray() As String = Split(strLines(i), " ")
            Scores(i).name = helpArray(0)

            If slen < (helpArray(0).Length + _
            helpArray(1).ToString.Length) Then
                slen = helpArray(0).Length + _
                helpArray(1).ToString.Length
            End If

            Scores(i).value = CType(helpArray(1), Integer)
            temp(i) = CType(helpArray(1), Integer)
            helpArray = Nothing

        Next

        strLines = Nothing

        Dim lstInt As New List(Of Integer)
        lstInt.AddRange(temp)
        temp = Nothing : lstInt.Sort()
        ListBox1.Font = New Font("Courier New", 8.25!, _
        FontStyle.Regular, GraphicsUnit.Point, CType(0, Byte))
        ListBox1.Items.Clear()
        ListBox1.Sorted = False

        For i As Integer = lstInt.Count - 1 To 0 Step -1

            For j As Integer = 0 To Scores.Length - 1

                If lstInt.Item(i) = Scores(j).value Then
                    Dim thespace As String = "  "
                    If slen > (Scores(j).name.Length _
                       + Scores(j).value.ToString.Length) Then
                        Dim thelen As Integer = _
                        slen - (Scores(j).name.Length _
                        + Scores(j).value.ToString.Length)
                        thespace += New String(CType(" ", Char), thelen)
                    End If
                    ListBox1.Items.Add(Scores(j).name _
                    & thespace & CType(Scores(j).value, String))
                End If

            Next j

        Next i

        lstInt = Nothing
        ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' Tämä hoitaa tuplat pois listalta
        ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Dim tuplat As New ListBox.ObjectCollection(New ListBox)
        For i As Int32 = 0 To ListBox1.Items.Count - 1
            If tuplat.IndexOf(ListBox1.Items(i)) = -1 Then tuplat.Add(ListBox1.Items(i))
        Next
        ListBox1.Items.Clear()
        For i As Int32 = 0 To tuplat.Count - 1
            ListBox1.Items.Add(tuplat(i))
        Next

    End Sub

End Class

Nyt on sitten niin ikävä tilanne ku jengi on käynny lisäämässä pisteitään ohjelmaan ni nyt on 240 teksti tiedostoa joissa noita "tuplia" saattaa olla ;)

Oisko mitään ideaa kuinka sais ohjelman luuppaamaan läpi noi kaikki tiedostot.

Tiedostot on tyyliin...

W1L1.txt
W1L2.txt
W1L3.txt
jne.. (Angry Birdsin kenttiä ;D )

-Happy-

neau33 [11.03.2011 18:52:36]

#

Moikka taas Happy!

try this...

Private Sub Button1_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles Button1.Click

   'lisää nämä...
   Dim MyFolder As New System.IO.DirectoryInfo("E:\") 'tai esim. "E:\TXTFILES\"
   Dim MyFiles() As System.IO.FileInfo = MyFolder.GetFiles("W1L*.txt")

   Dim filelist As String = String.Empty

   For i As Integer = 0 To MyFiles.GetUpperBound(0)
      filelist += MyFolder.ToString + MyFiles(i).ToString
      If i < MyFiles.GetUpperBound(0) Then
         filelist += " + "
      End If
   Next

   Dim fullPath As String = MyFolder.ToString + "w1ALL.txt"
   Try
      Kill(fullPath)
   Catch ex As Exception
   End Try

   Dim CmdStr As String = "cmd /C copy /B "
   CmdStr += filelist + " " + fullPath


   KillProcess("cmd")
   Shell(CmdStr, AppWinStyle.Hide)
   CheckProcess("cmd")

   'vaihda tämä...
   FileOpen(1, fullPath, OpenMode.Input)

   '...

   '...

End Sub

'ja lisää vielä nämä
Sub KillProcess (ByVal AppName As String)

   For Each MyProcess As Process In Process.GetProcesses
      If MyProcess.ProcessName = AppName Then
         MyProcess.Kill
      End If
   Next

End Sub

Sub CheckProcess(ByVal AppName As String)

   JumpBack:

   For Each MyProcess As Process In Process.GetProcessesByName(AppName)
      With MyProcess
         If .ProcessName = AppName Then
            GoTo JumpBack
         End If
      End With
   Next

End Sub

Happy [12.03.2011 00:05:47]

#

Moi.

No joo. kiitti Nea, mut keksin jo kuinka poistaa "tuplat" noista tiedostoista....

Tollanen epätoivonen yritys, mutta toimiva...

Imports System.IO
Public Class Form1
    Private Structure ScoreStruct
        Dim name As String
        Dim value As Integer
    End Structure

    Dim HighScore() As ScoreStruct

    Public Function CorrectString(ByVal MyStr As String) As String
        Dim retStr As String = MyStr
        Dim sngLine As String = Environment.NewLine
        Dim dblLine As String = Environment.NewLine + Environment.NewLine

        Do While retStr.IndexOf("  ") > -1 _
           Or retStr.IndexOf(dblLine) > -1
            retStr = retStr.Replace("  ", " ")
            retStr = retStr.Replace(dblLine, sngLine)
        Loop

        If retStr.Substring(0, 2) = sngLine Then
            Try
                retStr = retStr.Substring(2, retStr.Length - 2)
            Catch ex As Exception
            End Try
        End If

        If retStr.Substring(retStr.Length - 2, 2) = sngLine Then
            Try
                retStr = retStr.Substring(0, retStr.Length - 2)
            Catch ex As Exception
            End Try
        End If

        Return retStr

    End Function


    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click


        Dim OpenFileDialog1 As New OpenFileDialog

      With OpenFileDialog1
            .Multiselect = True
            .CheckFileExists = True
            .ShowReadOnly = False
            .Filter = "Txt|*.txt"
            .FilterIndex = 0
        End With
        If (OpenFileDialog1.ShowDialog() = Windows.Forms.DialogResult.OK) Then
            If (OpenFileDialog1.FileNames.Length > 0) Then
                For Each strFileName As String In OpenFileDialog1.FileNames
                    List1.Items.Add(strFileName)
                Next
            End If
        End If

       End Sub

    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click

        For n As Integer = 0 To List1.Items.Count - 1 Step 1
            List1.SetSelected(n, True)
            TextBox1.Text = List1.SelectedItem
            FileOpen(1, TextBox1.Text, OpenMode.Input)
            Dim fileStr As String = CorrectString( _
            InputString(1, CType(LOF(1), Integer)))
            Dim strLines() As String = Split(fileStr, Environment.NewLine)
            FileClose(1)
            If strLines.Length < 1 Then
                MsgBox("Nothing to do!") : Exit Sub
            End If



            ReDim Preserve HighScore(strLines.Length - 1)
            Dim temp(strLines.Length - 1) As Integer

            For i As Integer = 0 To strLines.Length - 1
                Dim helpArray() As String = Split(strLines(i), " ")
                HighScore(i).name = helpArray(0)
                HighScore(i).value = CType(helpArray(1), Integer)
                temp(i) = CType(helpArray(1), Integer)
                helpArray = Nothing
            Next

            strLines = Nothing

            Dim lstInt As New List(Of Integer)
            lstInt.AddRange(temp)
            temp = Nothing : lstInt.Sort()
            ListBox1.Items.Clear()
            ListBox1.Sorted = False

            For i As Integer = lstInt.Count - 1 To 0 Step -1
                For j As Integer = 0 To HighScore.Length - 1
                    If lstInt.Item(i) = HighScore(j).value Then
                        ListBox1.Items.Add(HighScore(j).name _
                        & " " & CType(HighScore(j).value, String))

                    End If
                Next j
            Next i

            lstInt = Nothing

            ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            ' Tämä hoitaa tuplat pois listalta
            ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            Dim tuplat As New ListBox.ObjectCollection(New ListBox)
            For i As Int32 = 0 To ListBox1.Items.Count - 1
                If tuplat.IndexOf(ListBox1.Items(i)) = -1 Then tuplat.Add(ListBox1.Items(i))
            Next
            ListBox1.Items.Clear()
            For i As Int32 = 0 To tuplat.Count - 1
                ListBox1.Items.Add(tuplat(i))
            Next

            Using sw As StreamWriter = New StreamWriter(TextBox1.Text)
                Dim linew As String
                For Each linew In ListBox1.Items
                    sw.Write(linew & vbNewLine)
                Next
                sw.Close()
                sw.Dispose()
            End Using

            ListBox1.Items.Clear()
        Next n
        End
    End Sub
End Class

vähän Textboxii ja Openfiledialogiii.

Mutta sitte taitaa mennä vähän ohi topikin :)

Mulla on .lua tiedosto jokseenkin näin...

Level27 = {
    completed = true,
    birds = 3,
    score = 1,
    lowScore = 33390,

}
LevelP2_104 = {
    completed = true,
    birds = 4,
    score = 2,
    lowScore = 68650,

}
Level9 = {
    completed = true,
    birds = 1,
    score = 3,
    lowScore = 56130,

}
LevelP2_65 = {
    completed = true,
    birds = 2,
    score = 4,
    lowScore = 42490,

jne...

ja hakusanana on siis toi Level****.
mutta mä haluan siis saada ton score = "******" tiedon ittelleni johonkin, esim listboxii tai richtextboxii.

siis kun mä löydän tosta richtextboxit haluamani Levelin ni kuinka mä pystyn siirtyy 3 riviä alaspäin tossa richtextboxissa....
vai onko tähän olemassa joku helpompi konsti olemassa ettei tarttis loikkii noita rivejä(en oo kyllä keksiny mitää muutakaa konstia.)

Ok. vähän huono esimerkki, koska tää sitte pitäs käydä looppina läpi n. 240 levelin läpi...

No näillä mennää.... ;)

-Happy-

Sivun alkuun

Vastaus

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

Tietoa sivustosta