Sternenhimmel ala Wetten Dass

    • VB.NET

    Es gibt 5 Antworten in diesem Thema. Der letzte Beitrag () ist von Patschi.

      Sternenhimmel ala Wetten Dass

      Hallo,

      hier der Code meines - während dem Essen kochen entstandenen Game Sternenhimmel nach einer Idee von McCandy007.

      Die Klasse

      VB.NET-Quellcode

      1. Public Class ClassSternenhimmel
      3. Private _groesse As Size
      4. Private _anzahl As Integer
      5. Private _sterne As New List(Of Point)
      6. Private _fehlenderStern As Point
      8. Public Event Sterne(ByVal sender As Object, ByVal e As SterneEventArgs)
      10. ''' <summary>Neue Instanu der Klasse.</summary>
      11. ''' <param name="groesse">Größe der Darstellfläche (Beide Seiten zusammen)</param>
      12. ''' <param name="anzahl">Anzahl der Sterne, welche rzeugt werden sollen.</param>
      13. ''' <remarks></remarks>
      14. Public Sub New(ByVal groesse As Size, ByVal anzahl As Integer)
      15. _groesse = groesse
      16. _anzahl = anzahl
      17. End Sub
      19. ''' <summary>Erzeugen der Sterne anstossen.</summary>
      20. ''' <remarks></remarks>
      21. Public Sub SerneErzeugen()
      22. SterneErzeugen()
      23. End Sub
      25. ''' <summary>Alle Sterne erzeugen.</summary>
      26. ''' <remarks></remarks>
      27. Private Sub SterneErzeugen()
      28. Dim r As New Random()
      29. 'Sterne so erzeugen, dass kein Stern auf dem Anderen liegt.
      30. Do
      31. find_point_arg = New Point(r.Next(1, _groesse.Width / 2), r.Next(1, _groesse.Height))
      32. If _sterne.FindIndex(AddressOf find_point) = -1 Then
      33. _sterne.Add(find_point_arg)
      34. End If
      35. Loop While _sterne.Count < _anzahl
      36. 'Fehlenden Stern auswählen
      37. _fehlenderStern = _sterne(r.Next(1, _anzahl))
      38. 'Anzeigen, dass alle Sterne erzeugt wurden.
      39. RaiseEvent Sterne(Me, New SterneEventArgs())
      40. End Sub
      42. 'Suche - Collection
      43. Private find_point_arg As Point
      44. Private Function find_point(ByVal p As Point) As Boolean
      45. If p = find_point_arg Then
      46. Return True
      47. Else
      48. Return False
      49. End If
      50. End Function
      52. ''' <summary>Gibt alle Sterne zurück.</summary>
      53. ''' <value></value>
      54. ''' <returns></returns>
      55. ''' <remarks></remarks>
      56. Public ReadOnly Property GetSterne() As List(Of Point)
      57. Get
      58. Return _sterne
      59. End Get
      60. End Property
      62. ''' <summary>Gibt den fehlenden Stern zurück.</summary>
      63. ''' <value></value>
      64. ''' <returns></returns>
      65. ''' <remarks></remarks>
      66. Public ReadOnly Property GetFehlendenStern() As Point
      67. Get
      68. Return _fehlenderStern
      69. End Get
      70. End Property
      71. End Class
      73. Public Class SterneEventArgs
      74. Inherits EventArgs
      76. Public Sub New()
      78. End Sub
      79. End Class


      Die Form

      VB.NET-Quellcode

      1. Public Class Form1
      3. Private WithEvents _cs As ClassSternenhimmel
      5. Private Sub ButtonNeuerHimmel_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonNeuerHimmel.Click
      6. 'Prüfen ob die Eingabe der Anzahl der Sterne korrekt ist.
      7. If IsNumeric(Me.TextBoxAnzahlSterne.Text) = True AndAlso CInt(Me.TextBoxAnzahlSterne.Text) < 1001 Then
      8. 'Neue Instanz der Klasse
      9. _cs = New ClassSternenhimmel(Me.PictureBoxSternenhimmel.Size, Math.Abs(CInt(Me.TextBoxAnzahlSterne.Text)))
      10. 'Handler erzeugen
      11. AddHandler _cs.Sterne, AddressOf _cs_Sterne
      12. 'Sterne erzeugen
      13. _cs.SerneErzeugen()
      14. Else
      15. 'Zurücksetzen der Picturebox - bei falscher Eingabe
      16. Me.TextBoxAnzahlSterne.Text = "100"
      17. End If
      18. End Sub
      20. Private Sub _cs_Sterne(ByVal sender As Object, ByVal e As SterneEventArgs) ' Handles _cs.Sterne
      21. 'Sternenhimmel zeichnen
      22. Dim b As New Bitmap(Me.PictureBoxSternenhimmel.Width, Me.PictureBoxSternenhimmel.Height)
      23. Using g As Graphics = Graphics.FromImage(b)
      24. g.Clear(Color.Black)
      25. For Each p As Point In _cs.GetSterne
      26. 'Fehlenden Stern in der linken Hälfte nicht zeichnen
      27. If p <> _cs.GetFehlendenStern Then
      28. g.DrawRectangle(Pens.White, New Rectangle(p, New Size(1, 1)))
      29. End If
      30. 'Rechts alle Sterne zeichnen
      31. g.DrawRectangle(Pens.White, New Rectangle(Point.Add(p, New Size(Me.PictureBoxSternenhimmel.Width / 2, 0)), New Size(1, 1)))
      32. Next
      33. End Using
      34. Me.PictureBoxSternenhimmel.Image = b
      35. 'Trennlinie zeichnen
      36. drawline()
      37. End Sub
      39. Private Sub PictureBoxSternenhimmel_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBoxSternenhimmel.MouseDown
      40. 'Bereich in dem der Mausklick sein muss um einen Treffer zu erkennen.
      41. Dim testsize As New Size(20, 20)
      42. Dim r As New Rectangle(Point.Subtract(_cs.GetFehlendenStern, New Size(10, 10)), testsize)
      43. 'Fehlenden Stern und Markierung einzeichnen
      44. Dim b As Bitmap = Me.PictureBoxSternenhimmel.Image
      45. Using g As Graphics = Graphics.FromImage(b)
      46. g.FillRectangle(Brushes.White, New Rectangle(_cs.GetFehlendenStern, New Size(2, 2)))
      47. g.DrawEllipse(Pens.White, r)
      48. End Using
      49. Me.PictureBoxSternenhimmel.Image = b
      50. 'Messagebox ausgabe
      51. If r.Contains(e.Location) Then
      52. MessageBox.Show("Richtig")
      53. Else
      54. MessageBox.Show("Falsch")
      55. End If
      56. End Sub
      58. Private Sub CheckBox1_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CheckBoxHimmelTrennung.CheckedChanged
      59. drawline()
      60. End Sub
      62. Private Sub drawline()
      63. Dim p As Pen
      64. If Me.CheckBoxHimmelTrennung.Checked = True Then
      65. p = Pens.White
      66. Else
      67. p = Pens.Black
      68. End If
      69. Dim b As Bitmap = Me.PictureBoxSternenhimmel.Image
      70. Using g As Graphics = Graphics.FromImage(b)
      71. g.DrawLine(p, CInt(Me.PictureBoxSternenhimmel.Width / 2), 0, CInt(Me.PictureBoxSternenhimmel.Width / 2), Me.PictureBoxSternenhimmel.Height)
      72. End Using
      73. Me.PictureBoxSternenhimmel.Image = b
      74. End Sub
      76. Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
      77. 'Leeres Image erzeugen um keine Ausnahme beim Linienzeichen zu erhalten
      78. Dim b As New Bitmap(Me.PictureBoxSternenhimmel.Width, Me.PictureBoxSternenhimmel.Height)
      79. Using g As Graphics = Graphics.FromImage(b)
      80. g.Clear(Color.Black)
      81. End Using
      82. Me.PictureBoxSternenhimmel.Image = b
      83. End Sub
      84. End Class

      Gruss

      mikeb69

      Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „mikeb69“ ()

      Danke!

      Hab mich ein wenig gespielt und hab das für die, die sich nicht auskennen als Anhang angehängt.
      War nicht viel Arbeit, aber ich find immer wieder lustig den Stern zu suchen.

      Screenshot ist ebenfalls im Anhang.

      ~ Edit ~
      Hab den Kreis, womit der fehlende Stern gekennzeichnet wird, in rot gefärbt.
      Sieht man dann besser!

      Die Farbe könnt ihr hier ändern:

      VB.NET-Quellcode

      1. Private Sub PictureBoxSternenhimmel_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBoxSternenhimmel.MouseDown
      2. 'Bereich in dem der Mausklick sein muss um einen Treffer zu erkennen.
      3. Dim testsize As New Size(20, 20)
      4. Dim r As New Rectangle(Point.Subtract(_cs.GetFehlendenStern, New Size(10, 10)), testsize)
      5. 'Fehlenden Stern und Markierung einzeichnen
      6. Dim b As Bitmap = Me.PictureBoxSternenhimmel.Image
      7. Using g As Graphics = Graphics.FromImage(b)
      8. g.FillRectangle(Brushes.White, New Rectangle(_cs.GetFehlendenStern, New Size(2, 2)))
      9. g.DrawEllipse(Pens.Red, r) '<= Ändere einfach das "Red" zu "White", dann ist der Kreis wieder weiß!
      10. End Using
      11. Me.PictureBoxSternenhimmel.Image = b
      12. 'Messagebox ausgabe
      13. If r.Contains(e.Location) Then
      14. MessageBox.Show("Richtig")
      15. Else
      16. MessageBox.Show("Falsch")
      17. End If
      18. End Sub


      Weiterhin hab ich das maximum auf 10 000 gestellt. <= Fasst alles weiß xD
      Bilder

      • screenshot_sternenhimmel.jpg

        48,73 kB, 840×602, 545 mal angesehen
      Dateien

      • Sternenhimmel.zip

        (86,28 kB, 261 mal heruntergeladen, zuletzt: )
      Meine neue Homepage: pkern.at
      Wetter bei mir zu Haus:

      Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „Patschi“ ()

      Hallo Patschi,

      ich glaube mein Code hat noch einen Schönheitsfehler.
      Sterne aus der rechten Hälfte können soweit rechts sein, dass Sie aus dem Anzeigebreich fallen.

      Das fällt dann auf, wenn du nur sehr wenige Sterne anzeigen lässt.

      Gruss

      mikeb69

      Also ich habs jetzt mit 2 Sternen oft versucht.
      Die waren aber im Bild.

      Also ist die Chance eh sehr gering, dass ein Stern aus dem Bild fällt.

      Achja:

      VB.NET-Quellcode

      1. If IsNumeric(Me.TextBoxAnzahlSterne.Text) = True AndAlso CInt(Me.TextBoxAnzahlSterne.Text) < 1001 Then


      Wenn ich 1 als Sternenanzahl eingebe, stürzt das Programm ab!

      Fehler:
      ArgumentOutOfRangeException wurde nicht behandelt
      Der Index lag außerhalb des Bereichs. Er muss nicht negativ und kleiner als die Auflistung sein. Parametername: index

      Zeile:

      VB.NET-Quellcode

      1. _fehlenderStern = _sterne(r.Next(1, _anzahl))


      Deshalb hab ich das so geändert:

      VB.NET-Quellcode

      1. If IsNumeric(Me.TextBoxAnzahlSterne.Text) = True AndAlso CInt(Me.TextBoxAnzahlSterne.Text) < 1001 AndAlso CInt(Me.textBoxAnzahlSterne.Text) > 1 Then


      Kannst es ja vielleicht beheben, dass es auch mit einen Stern funktioniert.

      Ich blick selber noch nicht den Code durch xD
      Für das bin ich noch zu "doof" ^^
      Meine neue Homepage: pkern.at
      Wetter bei mir zu Haus: