copyright 1999 - 2014 by heinz prelle - hannover  - lenbachstraße 42 - www.visual-basic5.de | impressum
'Beispiel: VB .Net - Würfelspiel - Play cube - 1 - Benötigen Sie die Projektdateien? Dann schicken Sie mir eine Mail und ich werden ihnen die Projektdateien als .zip Datei zusenden.
'
'
Option Explicit On
Option Strict On

Public Partial Class MainForm
Public Sub New()
Me.InitializeComponent()
End Sub

Private Sub EndeToolStripMenuItemClick(sender As Object, e As System.EventArgs)
Application.Exit()
End Sub

Private Sub Button1Click(sender As Object, e As System.EventArgs) _
Handles Button2.Click, _
Button3.Click, _
Button4.Click, _
Button5.Click, _
Button6.Click

Dim Number As Integer = MyRandomNumbers.Next(1, 6 + 1)
Dim btn  As Button = DirectCast(sender, Button)
Dim Compare As String = ""
Static won  As Integer
Static lost As Integer
Static entirely As Integer

If btn.Name.ToString().Equals("button1") Then
SetImage(Number)
ElseIf btn.Name.ToString().Equals("button2") Then
SetImage(Number)
ElseIf btn.Name.ToString().Equals("button3") Then
SetImage(Number)
ElseIf btn.Name.ToString().Equals("button4") Then
SetImage(Number)
ElseIf btn.Name.ToString().Equals("button5") Then
SetImage(Number)
ElseIf btn.Name.ToString().Equals("button6") Then
SetImage(Number)
End If
Compare = btn.Name.ToString().Substring(6, 1)

Dim Buffer As Byte()
Dim ResourceName As String
If Number = CType(Compare, Integer) Then
label1.Text = "Sie haben gewonnen"
label1.ForeColor = System.Drawing.Color.Red
won += 1
label6.Text = CType(won, String)
'
ResourceName = "won.wav"
Buffer = CreateStream(ResourceName)
If (Buffer IsNot Nothing) Then
'PCM Format requiered
My.Computer.Audio.Play(Buffer, AudioPlayMode.Background)
End If
Else
label1.Text = "Sie haben verloren"
label1.ForeColor = System.Drawing.Color.Black
lost += 1
label5.Text = CType(lost, String)
'
ResourceName = "lost.wav"
Buffer = CreateStream(ResourceName)
If (Buffer IsNot Nothing) Then
'PCM Format requiered
My.Computer.Audio.Play(Buffer, AudioPlayMode.Background)
End If

End If
entirely += 1
label7.Text = CType(entirely, String)
End Sub

Private Sub SetImage(ByVal RndNumber As Integer)
Dim cci As CreateCubeImage = New CreateCubeImage(RndNumber, pictureBox1.Width, pictureBox1.Height)
Dim img As Image = cci.ReturnCubeImage()
If (Not pictureBox1.Image Is Nothing) Then pictureBox1.Image = Nothing
If (img IsNot Nothing) Then
Me.pictureBox1.Image = img
End If
End Sub

Private Function CreateStream(ByVal resFilename As String) As Byte()
Try
Dim Buffer As Byte()
Dim MyNameSpace As String = _
System.Reflection.Assembly.GetExecutingAssembly().GetName().Name.ToString()
If MyNameSpace <> "" Then
Dim hStream As System.IO.Stream = _
System.Reflection.Assembly.GetExecutingAssembly().GetManifestResourceStream( _
MyNameSpace + "." + resFilename)
If hStream IsNot Nothing Then
ReDim Buffer(CType(hStream.Length, Integer))
hStream.Read(Buffer, 0, Int(CType(hStream.Length, Integer)))
hStream.Close()
Return Buffer
End If
End If
Catch
Return Nothing
End Try
Return Nothing
End Function

Private Sub DrawRoundetCorner(ByVal Corner As Int32, ByVal clr As Color)
Try
With pictureBox1
.Size = New Size(300, 300)
Dim gp As New System.Drawing.Drawing2D.GraphicsPath
gp.StartFigure()
gp.AddArc(New Rectangle(0, 0, Corner, Corner), 180, 90)
gp.AddLine(Corner, 0, .Width - Corner, 0)
gp.AddArc(New Rectangle(.Width - Corner, 0, Corner, Corner), -90, 90)
gp.AddLine(.Width, Corner, .Width, .Height - Corner)
gp.AddArc(New Rectangle(.Width - Corner, .Height - Corner, Corner, Corner), 0, 90)
gp.AddLine(.Width - 200, .Height, 200, .Height)
gp.AddArc(New Rectangle(0, .Height - Corner, Corner, Corner), 90, 90)
gp.CloseFigure()
.Region = New Region(gp)
.BackColor = clr
gp.Dispose()
End With
Catch ex As Exception
MessageBox.Show(ex.Message.ToString(), "Info")
End Try
End Sub

Private Sub MainFormLoad(sender As Object, e As System.EventArgs)
Call DrawRoundetCorner(115, Color.Yellow)
End Sub
End Class

Public Class MyRandomNumbers

Private Shared [rnd] As New Random

Public Shared Function [Next]() As Integer
Return [rnd].Next()
End Function

Public Shared Function [Next](ByVal Min As Integer, ByVal Max As Integer) As Integer
Try
Return [rnd].Next(Min, Max)
Catch ex As Exception
MessageBox.Show(ex.Message.ToString(), "Info")
End Try
End Function

Public Shared Function [Next](ByVal Max As Integer) As Integer
Try
Return [rnd].Next(Max)
Catch ex As Exception
MessageBox.Show(ex.Message.ToString(), "Info")
End Try
End Function

End Class

Public Class CreateCubeImage

Private _rndNumber As Integer = -1
Private _width As Integer = -1
Private _height As Integer = -1

Public Sub New(ByVal RndNumber As Integer, ByVal Width As Integer, ByVal Height As Integer)
_rndNumber = RndNumber
_width = Width
_height = Height
End Sub

Public ReadOnly Property ReturnCubeImage() As Image
Get
Return CreateImage()
End Get
End Property

Private Function CreateImage() As Image
Try
Dim hBitmap As System.Drawing.Bitmap = _
New System.Drawing.Bitmap(_width, _height, System.Drawing.Imaging.PixelFormat.Format24bppRgb)
Dim g As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(hBitmap)
g.Clear(System.Drawing.Color.Yellow)
g.InterpolationMode = _
System.Drawing.Drawing2D.InterpolationMode.HighQualityBicubic

'Dim hBrush As New System.Drawing.SolidBrush(System.Drawing.Color.Navy)
Dim hBrush As New System.Drawing.Drawing2D.LinearGradientBrush( _
New Rectangle(0, 0, 60, 60), _
System.Drawing.Color.Red, _
System.Drawing.Color.Yellow, _
System.Drawing.Drawing2D.LinearGradientMode.ForwardDiagonal)
'
Dim x As Single = CType(_width, Single)
Dim y As Single = CType(_height, Single)
'
Dim hPen As New System.Drawing.Pen(System.Drawing.Color.Blue, 2)
'
Select Case _rndNumber
Case 1
'Mitte
g.FillEllipse(hBrush, (x / 2) - 30, (y / 2) - 30, 60, 60)
'Kreis aussen
Dim rc As New Rectangle(CInt(x / 2) - 30, CInt(y / 2) - 30, 60, 60)
g.DrawArc(hPen, rc, 0, 360)
Case 2
'Oben rechts
g.FillEllipse(hBrush, x - 70, 10, 60, 60)
'Kreis aussen
Dim rc As New Rectangle(CInt(x - 70), 10, 60, 60)
g.DrawArc(hPen, rc, 0, 360)
'Unten links
g.FillEllipse(hBrush, 10, y - 70, 60, 60)
'Kreis aussen
Dim rc1 As New Rectangle(10, CInt(y - 70), 60, 60)
g.DrawArc(hPen, rc1, 0, 360)
Case 3
'Oben rechts
g.FillEllipse(hBrush, x - 70, 10, 60, 60)
'Kreis aussen
Dim rc As New Rectangle(CInt(x - 70), 10, 60, 60)
g.DrawArc(hPen, rc, 0, 360)
'Unten links
g.FillEllipse(hBrush, 10, y - 70, 60, 60)
'Kreis aussen
Dim rc1 As New Rectangle(10, CInt(y - 70), 60, 60)
g.DrawArc(hPen, rc1, 0, 360)
'Mitte
g.FillEllipse(hBrush, (x / 2) - 30, (y / 2) - 30, 60, 60)
'Kreis aussen
Dim rc2 As New Rectangle(CInt(x / 2) - 30, CInt(y / 2) - 30, 60, 60)
g.DrawArc(hPen, rc2, 0, 360)
Case 4
'Oben links
g.FillEllipse(hBrush, 10, 10, 60, 60)
'Kreis aussen
Dim rc As New Rectangle(10, 10, 60, 60)
g.DrawArc(hPen, rc, 0, 360)
'Oben rechts
g.FillEllipse(hBrush, x - 70, 10, 60, 60)
'Kreis aussen
Dim rc1 As New Rectangle(CInt(x - 70), 10, 60, 60)
g.DrawArc(hPen, rc1, 0, 360)
'Unten links
g.FillEllipse(hBrush, 10, y - 70, 60, 60)
'Kreis aussen
Dim rc2 As New Rectangle(10, CInt(y - 70), 60, 60)
g.DrawArc(hPen, rc2, 0, 360)
'Unten rechts
g.FillEllipse(hBrush, x - 70, y - 70, 60, 60)
'Kreis aussen
Dim rc3 As New Rectangle(CInt(x - 70), CInt(y - 70), 60, 60)
g.DrawArc(hPen, rc3, 0, 360)
Case 5
'Oben links
g.FillEllipse(hBrush, 10, 10, 60, 60)
'Kreis aussen
Dim rc As New Rectangle(10, 10, 60, 60)
g.DrawArc(hPen, rc, 0, 360)
'Oben rechts
g.FillEllipse(hBrush, x - 70, 10, 60, 60)
'Kreis aussen
Dim rc1 As New Rectangle(CInt(x - 70), 10, 60, 60)
g.DrawArc(hPen, rc1, 0, 360)
'Unten links
g.FillEllipse(hBrush, 10, y - 70, 60, 60)
'Kreis aussen
Dim rc2 As New Rectangle(10, CInt(y - 70), 60, 60)
g.DrawArc(hPen, rc2, 0, 360)
'Unten rechts
g.FillEllipse(hBrush, x - 70, y - 70, 60, 60)
'Kreis aussen
Dim rc3 As New Rectangle(CInt(x - 70), CInt(y - 70), 60, 60)
g.DrawArc(hPen, rc3, 0, 360)
'Mitte
g.FillEllipse(hBrush, (x / 2) - 30, (y / 2) - 30, 60, 60)
'Kreis aussen
Dim rc4 As New Rectangle(CInt(x / 2) - 30, CInt(y / 2) - 30, 60, 60)
g.DrawArc(hPen, rc4, 0, 360)
Case 6
'Oben links
g.FillEllipse(hBrush, 10, 10, 60, 60)
'Kreis aussen
Dim rc As New Rectangle(10, 10, 60, 60)
g.DrawArc(hPen, rc, 0, 360)
'Oben rechts
g.FillEllipse(hBrush, x - 70, 10, 60, 60)
'Kreis aussen
Dim rc1 As New Rectangle(CInt(x - 70), 10, 60, 60)
g.DrawArc(hPen, rc1, 0, 360)
'Unten links
g.FillEllipse(hBrush, 10, y - 70, 60, 60)
'Kreis aussen
Dim rc2 As New Rectangle(10, CInt(y - 70), 60, 60)
g.DrawArc(hPen, rc2, 0, 360)
'Unten rechts
g.FillEllipse(hBrush, x - 70, y - 70, 60, 60)
'Kreis aussen
Dim rc3 As New Rectangle(CInt(x - 70), CInt(y - 70), 60, 60)
g.DrawArc(hPen, rc3, 0, 360)
'Mitte links
g.FillEllipse(hBrush, 10, (y / 2) - 30, 60, 60)
'Kreis aussen
Dim rc4 As New Rectangle(10, CInt(y / 2) - 30, 60, 60)
g.DrawArc(hPen, rc4, 0, 360)
'Mitte rechts
g.FillEllipse(hBrush, x - 70, (y / 2) - 30, 60, 60)
'Kreis aussen
Dim rc5 As New Rectangle(CInt(x - 70), CInt(y / 2) - 30, 60, 60)
g.DrawArc(hPen, rc5, 0, 360)
End Select

hPen.Dispose()
hBrush.Dispose()
g.Dispose()
Return hBitmap
Catch
Return Nothing
End Try
Return Nothing
End Function


End Class
Sourcecode Visual Basic