Home

Add

Edit

Without Linenumbers

Code in Textfield

Download

  1. 
    
  2. '######################################################################################################
    
  3. 'Funktion zum ermitteln der Punktezahl durch einen Zug
    
  4. Function punktzahl_zug(i As Integer, j As Integer, k As Integer, l As Integer, Spielfeld() As Byte) As Integer
    
  5. If Spielfeld(i, j) = Spielfeld(k, l) Then
    
  6.     Return 2
    
  7. Elseif ((Spielfeld(i, j) = 1 And Spielfeld(k, l) = 2) Or (Spielfeld(i, j) = 2 And Spielfeld(k, l) = 3)) Then
    
  8.     Return -2
    
  9. Else
    
  10.     Return -1
    
  11. End If
    
  12. End Function
    
  13. 
    
  14. 
    
  15. 
    
  16. '######################################################################################################
    
  17. 'Rekrusive lösugnsfunktion mit intelligenter und optimaler punktezahlermittlung
    
  18. Function MachHinne(Spielfeld() As Byte, PosX As Uinteger, PosY As Uinteger, Byval AktuellerWert As Uinteger) As Uinteger
    
  19. If PosX = 11 Then Return AktuellerWert
    
  20. Dim TVal As Uinteger
    
  21. Dim TMax As Uinteger
    
  22. Dim TPos As Uinteger
    
  23. For Y As Uinteger = 1 To 4
    
  24.     If Abs(PosY - Y) <= 1 Then
    
  25.         TVal = MachHinne(Spielfeld(), PosX + 1, Y, punktzahl_zug(PosX, PosY, PosX + 1, Y, Spielfeld()) + AktuellerWert)
    
  26.         If TVal > TMax Then
    
  27.             TMax = TVal
    
  28.             TPos = Y
    
  29.         End If
    
  30.     End If
    
  31. Next
    
  32. Return TVal
    
  33. End Function
    
  34. 
    
  35. 
    
  36. 
    
  37. '######################################################################################################
    
  38. 'Funktion um bestes ergebniss zu erhalten
    
  39. Function loese(Spielfeld() As Byte) As Integer
    
  40. Return MachHinne(Spielfeld(), 1, 1, 0)
    
  41. End Function
    
  42. 
    
  43. 
    
  44. 
    
  45. '######################################################################################################
    
  46. Sub Main()
    
  47. 'unser feld mit 4 * 11 Felder
    
  48. Dim Feld(4, 11) As Byte
    
  49. 
    
  50. 'variablen für schleifen usw.
    
  51. Dim Y As Uinteger
    
  52. Dim X As Uinteger
    
  53. 
    
  54. 'das Feld mit zufälligen Farben füllen
    
  55. For X = 1 To 11
    
  56.     For Y = 1 To 4
    
  57.         Feld(Y, X) = Int((Rnd * 3) + 1)
    
  58.     Next
    
  59. Next
    
  60. 
    
  61. 'max-punktezahl ermitteln (aufruf der loese funktion)
    
  62. Dim punktzahl As Integer = loese(Feld())
    
  63. 
    
  64. Print "Maximale punktezahl ist:"; punktzahl
    
  65. End Sub
    
  66. 
    
  67. 
    
  68. 
    
  69. '######################################################################################################
    
  70. 'sub main aufrufen
    
  71. Main()
    
  72. End 0
    
  73.