Keskustelu: Ohjelmointikysymykset: VB6 For-loop ongelma

Private Sub Form_Load()
    Randomize

    Dim i As Integer

    cn.Open "DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & App.Path & _
        "\races.mdb;DefaultDir=;UID=;PWD=;"

    Dim rs As New ADODB.Recordset

    rs.Open "SELECT * FROM races", cn, adOpenStatic, adLockReadOnly

    If Not rs.EOF Then rs.MoveFirst
            Do While Not rs.EOF
                maara = rs!ID

                lstRace.AddItem rs!RaceName

                ReDim Races(maara) As Integer
                ReDim RaceStr(maara) As Integer
                ReDim RaceDex(maara) As Integer
                ReDim RaceCon(maara) As Integer
                ReDim RaceWis(maara) As Integer
                ReDim RaceCha(maara) As Integer

                For i = 0 To maara
                    Races(i) = rs!ID
                    RaceStr(i) = rs!RaceStr
                    RaceDex(i) = rs!RaceDex
                    RaceCon(i) = rs!RaceCon
                    RaceWis(i) = rs!RaceWis
                    RaceCha(i) = rs!RaceCha
                Next i
                rs.MoveNext
            Loop
    rs.Close

Mistä johtuu että toi ylläoleva koodipätkä tallentaa races.mdb-tiedostosta ainoastaan tietokannassa viimeisenä olevan racen tiedot noihin RaceStr, RaceDex jne taulukoihin?

Koittanu järkätä semmosta systeemiä että toi hakis sieltä tietokannasta ne racen tiedot ja sitte listais ne listboxiin ja vois vaan klikkailla siitä listboxista eri racevaihtoehtoja ja se sitte sitä mukaa muuttais playerin str dex jne statteja. Eli miten sais sen for-loopin tallentamaan RaceNamen mukaan noi RaceStr jne tiedot ja niin vielä että ku valitsee listboxista jonkun racen niin se osaa hakee oikeat RaceStr sun muut tiedot sieltä taulukosta?

Prkl ku on vaikeeta :(
(Enpä kyllä koskaan oo ymmärtäny noita for-looppeja, että miten niitä käytetään hyväksi tekemään sitä mitä haluat :( )

-Feltsu

NO MORJENS TAAS feltsu!

jos ylipäätään noin, niin sitten vaikka näinpäin...

'Module1 (globaali moduuli)
Public Type RaceDataType
   RaceName As String
   Races As Integer
   RaceStr As Integer 'vaiko As String ???
   RaceDex As Integer
   RaceCon As Integer
   RaceWis As Integer
   RaceCha As Integer
End Type

Global RaceData() As RaceDataType

'Form1
Private Sub Form_Load()

   'Randomize '???

   Dim cn As ADODB.Connection
   Set cn = New ADODB.Connection

   cn.Open "DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & App.Path & _
   "\races.mdb;DefaultDir=;UID=;PWD=;"

   Dim rs As ADODB.Recordset
   Set rs = New ADODB.Recordset
   rs.Open "SELECT * FROM races", cn, adOpenStatic, adLockReadOnly

   If rs.RecordCount > 0 Then
      rs.MoveFirst
   Else
      MsgBox "Taulussa ei ole tietueita"
      Goto Jump
   End If

   ReDim RaceData(0)

   Do While Not rs.EOF

      RaceData(UBound(RaceData)).RaceName = rs!RaceName
      RaceData(UBound(RaceData)).Races = rs!ID  '???
      RaceData(UBound(RaceData)).RaceStr = rs!RaceStr
      RaceData(UBound(RaceData)).RaceDex = rs!RaceDex
      RaceData(UBound(RaceData)).RaceCon = rs!RaceWis
      RaceData(UBound(RaceData)).RaceWis = rs!RaceWis
      RaceData(UBound(RaceData)).RaceCha = rs!RaceCha

      rs.MoveNext

      ReDim Preserve RaceData(UBound(RaceData) + 1)

   Loop

   ReDim Preserve RaceData(UBound(RaceData) - 1)

   Dim i As Integer

   For i = LBound(RaceData) To UBound(RaceData)
      lstRace.AddItem RaceData(i).RaceName
   Next i
   'Testi:
   'MsgBox "eka: " & RaceData(LBound(RaceData)).RaceName & _
   'vbCrLf & "vika: "  & _
   'RaceData(UBound(RaceData)).RaceName

Jump:
   rs.Close: Set Rs = Nothing
   cn.Close: Set cn = Nothing

    '...
    '...

End Sub

MORJENS TAAS feltsu!

pari pikku muutosta...

vaihda adOpenStatic -> adOpenKeyset tuossa kohdassa

rs.Open "SELECT * FROM races", cn, adOpenStatic, adLockReadOnly

' ...

      rs.MoveNext

      If  UBound(RaceData) < Rs.RecordCount Then 'lisää tämä rivi

         ReDim Preserve RaceData(UBound(RaceData) + 1)

      End If 'ja tämä rivi

   Loop

   ReDim Preserve RaceData(UBound(RaceData) - 1) ' poista tämä rivi

   '...

Jee!! Kiitos paljon nyt toimii ainakin toi rotujen listaus ihan niinku pitääkin! Ja periaatteessa kaikki muukin paitsi sellain pikku juttu et onko tätä alla olevaa koodia edes mahdollista toteuttaa ilman että laitan 50 kertaa ton If lstRace.Selected(1) then RaceData(1).RaceStr blaablaablaa If lstRace.Selected(2) then RaceData(2).RaceStr blaablaablaa..
Elikkä voiko ton jotenkin automatisoida että if lstRaceSelected(numero) then RaceData(sama numero ku toi selected).Raceblaablaablaa

Private Sub lstRace_Click()

    player.race = lstRace.Text
    lblRace.Caption = player.race
        If lstRace.Selected(1) Then
            player.str = player.str + RaceData(1).RaceStr
            player.dex = player.dex + RaceData(1).RaceDex
            player.con = player.con + RaceData(1).RaceCon
            player.wis = player.wis + RaceData(1).RaceWis
            player.cha = player.cha + RaceData(1).RaceCha
        End If
    PUpdate
End Sub

Mut tosiaan kiitoksia miljoonasti tosta rotujen listauksesta! kokeilin tuolla MsgBox tekeleellä niin ihan oikein on eka tietue se mikä pitääki ja vikakin oli oikein :D En ois ikimaailmassa ite onnistunu keksimään!

-Feltsu

No siis ihan

Private Sub lstRace_Click()

    Dim Luku as Long

    player.race = lstRace.Text
    lblRace.Caption = player.race
    For Luku = 1 To 50
        If lstRace.Selected(Luku) Then
            player.str = player.str + RaceData(Luku).RaceStr
            player.dex = player.dex + RaceData(Luku).RaceDex
            player.con = player.con + RaceData(Luku).RaceCon
            player.wis = player.wis + RaceData(Luku).RaceWis
            player.cha = player.cha + RaceData(Luku).RaceCha
        End If
    Next
    PUpdate
End Sub

Kiitoksia Grez, mut en kyllä ymmärrä mitä pirua nyt tein väärin, laitoin sun koodin tuohon ja ajoin ohjelman ja klikkasin listalta rotua ja oikein mukava pikku errori: "Invalid property array index"

EDIT: Joo sain toimimaan melkein mutten kuitenkaan ihan, ois kiva että se laskis sieltä tietokannasta ne rotujen määrät eikä tarviis joka kerta ku lisää accessilla rodun niin alkaa tuota sorsaa muuttelemaan ku se on nyt sitte For 0 to 6 (joka on tämän hetkinen rotujen määrä) jos koitan tota lisäillä niin alkaa herjaamaan ylläolevaa erroria..

Ja nyt satuin törmäämään oikein mielenkiintoiseen bugiin, meinaa sellainen että ihan kaikki muu toimii ku rasvattu mutta jostain syystä RaceCon on täysin mielivaltainen numero jonka visual basic luultavasti keksii ihan omasta päästä ja sillä ei siis oo mitään tekemistä sen tietokannan kanssa. (Tai jos on niin en tiedä mitä)

EDIT2: HAHA, siellä oli painovirhepaholainen :D:D Ei mitään hätää, sori turhasta whinestä! (paitsi edelleen toi et miten tohon for looppiin sais haettua sieltä tietokannasta sen rotujen määrän automaagisesti)

-Feltsu

Tuosta varmaankin valitaan vain yksi rotu, joten ota silmukka pois ja korvaa Luku arvolla lstRace.ListIndex (eli korvaa vain aiemmasta koodistasi ykkönen lstRace.ListIndex:lla).

Tämä tieto perustui lyhyeen Googletukseen. Itse en ole koskaan ohjelmoinut VB6:lla.

Hei kiitti! Se meinaa toimi :D Googlea käyttäisin mielelläni jos osaisin käyttää sitä tälläisissä tilanteissa :( Mut koska on itse "koodaus" vielä vähän hakusessa niin en kaikkeen pysty yksikseni löytämään vastausta, jonka takia tietenkin täällä aina itken kaikista asioista ku ei toimi :/ Mutta nyt oon saanu jo paljon aikaan ihan itse (täällä saadun avun seuraksena siis tietenkin), meinaa oon vähän oppinu jo soveltamaan noita juttuja mitä täällä kerrotaan, esim osasin soveltaa tuon neau33:n koodin niin että se hakee myös monsterit erillisestä tietokannasta ja tallentaa niiden arvot muuttujiin :) Nyt oon tässä väsäilemässä sellasta systeemiä että vertaa pelaajan leveliä monsterin leveliin ja hakee vaan oikean tasoisia vihuja sieltä :)

KIITOKSIA SIIS IHAN KAIKILLE!

-Feltsu