So I'm doing a project for school and I have an image loop for my program with the code as follows
Dim Images(10) As Bitmap
Dim Pos As Integer = 0
Private Sub MainMenu_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'Inserting images from resources
Images(0) = GloriousGetaways.My.Resources.MM10
Images(1) = GloriousGetaways.My.Resources.MM1
Images(2) = GloriousGetaways.My.Resources.MM2
Images(3) = GloriousGetaways.My.Resources.MM3
Images(4) = GloriousGetaways.My.Resources.MM4
Images(5) = GloriousGetaways.My.Resources.MM5
Images(6) = GloriousGetaways.My.Resources.MM6
Images(7) = GloriousGetaways.My.Resources.MM7
Images(8) = GloriousGetaways.My.Resources.MM8
Images(9) = GloriousGetaways.My.Resources.MM9
'Puts the images into order
PictureBox1.Image = Images(Pos)
End Sub
Private Sub MainmenuSlideshowTimer_Tick(sender As Object, e As EventArgs) Handles MainmenuSlideshowTimer.Tick
'Starting the timer for the slideshow on main menu
MainmenuSlideshowTimer.Start()
'Setting the time between slides to 5 seconds
MainmenuSlideshowTimer.Interval = 5000
Pos = Pos + 1
If Pos < Images.Length - 1 Then
PictureBox1.Image = Images(Pos)
Else
Pos = Images.Length - 2
End If
End Sub
It works perfectly but the slideshow stops once it gets to the last image on the form. How would I make it so it continuously loops and restarts the slideshow from the first image once it gets to the last image. I'm not very advanced so I'm unsure.
Have a good day
Arrays in vb.net Are declared Images(UpperBound) As Type. So, Images(9).
GloriousGetaways.My.Resources.MM10 looks a bit strange. Are you sure you are getting the images you expect?
You want to check if Pos is greater than Images.Lenght -1 and reset to zero. Increment the Pos as the last line of the Tick event.
Dim Images(9) As Bitmap
Dim Pos As Integer
Private Sub MainMenu_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'Inserting images from resources
Images(0) = GloriousGetaways.My.Resources.MM10
Images(1) = GloriousGetaways.My.Resources.MM1
Images(2) = GloriousGetaways.My.Resources.MM2
Images(3) = GloriousGetaways.My.Resources.MM3
Images(4) = GloriousGetaways.My.Resources.MM4
Images(5) = GloriousGetaways.My.Resources.MM5
Images(6) = GloriousGetaways.My.Resources.MM6
Images(7) = GloriousGetaways.My.Resources.MM7
Images(8) = GloriousGetaways.My.Resources.MM8
Images(9) = GloriousGetaways.My.Resources.MM9
MainmenuSlideshowTimer.Interval = 5000
MainmenuSlideshowTimer.Start()
PictureBox1.Image = Images(Pos)
End Sub
Private Sub MainmenuSlideshowTimer_Tick(sender As Object, e As EventArgs) Handles MainmenuSlideshowTimer.Tick
If Pos > Images.Length - 1 Then
Pos = 0
End If
PictureBox1.Image = Images(Pos)
Pos += 1
End Sub
Related
Hi so I've created a search system with a button, textbox and rich text box to search for items displayed in the rich text box (which are imported from a text file) and to highlight them when found. For some reason when I click the search button, it does not highlight the word that is being searched for.
This is the code I used:
Private Sub btnSearch_Click(sender As Object, e As EventArgs) Handles btnSearch.Click
Dim index As Integer = 0
While index < rtxtEdit.Text.LastIndexOf(txtSearch.Text)
rtxtEdit.Find(txtSearch.Text,index ,rtxtEdit.TextLength, RichTextBoxFinds.None)
rtxtEdit.SelectionBackColor = Color.Red
index = rtxtEdit.Text.IndexOf(txtSearch.Text, index) + 1
End While
End Sub
As stated in this post:
Private Sub btnSearch_Click(sender As Object, e As EventArgs) Handles btnSearch.Click
Dim len = searchText.Length
Dim pos = rtb.Find(searchText, 0, RichTextBoxFinds.NoHighlight)
While (pos >= 0)
rtb.Select(pos, len)
rtb.SelectionBackColor = Color.Yellow
if pos + len >= rtb.Text.Length Then
Exit While
End If
pos = rtb.Find(searchText, pos + len, RichTextBoxFinds.NoHighlight)
End While
End Sub
I'd write that this way instead:
Private Sub btnSearch_Click(sender As Object, e As EventArgs) Handles btnSearch.Click
Dim searchFor As String = txtSearch.Text.Trim
If searchFor <> "" Then
Dim index As Integer = 0
Dim startAt As Integer = 0
Do
index = rtxtEdit.Find(searchFor, startAt, RichTextBoxFinds.None)
If index <> -1 Then
rtxtEdit.SelectionBackColor = Color.Red
startAt = index + 1
End If
Loop While index <> -1
End If
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim index As Integer = 0
'Clears the existing formatting
Dim t = rtxtEdit.Text
rtxtEdit.Text = t
'Incremented the loop condition by 1 so that text at the beginning gets selected as well.
While index < rtxtEdit.Text.LastIndexOf(txtSearch.Text) + 1
rtxtEdit.Find(txtSearch.Text, index, rtxtEdit.TextLength, RichTextBoxFinds.None)
rtxtEdit.SelectionBackColor = Color.Red
index = rtxtEdit.Text.IndexOf(txtSearch.Text, index) + 1
End While
End Sub
I have a program that uses countdown timers, it works but I am trying to do something new with this blender timer. It uses a NumericUpDown and is supposed to add 5 minutes for each value, 1 being 5 minutes and 2 being 10 minutes etc. I did find a way adding 5 minutes to BlenderCountDownFrom but when pressing the BlenderButton to stop it, it kept the new value. I am a complete novice and don't know what I am doing so the code is probably horrible! The actual countdown code I got from an example on the internet.
BlenderButton is both the start and stop for the countdown. It will use a "Set" button to program the amount of minutes from the NumericUpDown.
Dim BlenderCountDownFrom As New TimeSpan(0, 5, 1)
Dim BlenderStopwatch As New Stopwatch
Private Sub BlenderButton_Click(sender As Object, e As EventArgs) Handles BlenderButton.Click
If BlenderButton.Text = "Start" Then
BlenderTimer.Interval = 100
BlenderButton.Text = "Stop"
BlenderTimer.Start()
BlenderStopwatch.Reset()
BlenderStopwatch.Start()
Else
BlenderButton.Text = "Start"
My.Computer.Audio.Stop()
BlenderTimerLabel.BackColor = Color.White
BlenderTimer.Stop()
BlenderStopwatch.Stop()
BlenderTimerLabel.Text = ("00:05:00")
Me.MiscTab.Text = "Misc"
End If
End Sub
Private Sub BlenderTimer_Tick(sender As Object, e As EventArgs) Handles BlenderTimer.Tick
If BlenderStopwatch.Elapsed <= BlenderCountDownFrom Then
Dim toGo As TimeSpan = BlenderCountDownFrom - BlenderStopwatch.Elapsed
BlenderTimerLabel.Text = String.Format("{0:00}:{1:00}:{2:00}", toGo.Hours, toGo.Minutes, toGo.Seconds)
Else
BlenderTimer.Stop()
My.Computer.Audio.Play(My.Resources.Alarm.Blender, AudioPlayMode.BackgroundLoop)
Me.MiscTab.Text = "Alarm"
BlenderStopwatch.Stop()
BlenderTimerLabel.BackColor = Color.Red
End If
End Sub
Private Sub BlenderSetButton_Click(sender As Object, e As EventArgs) Handles BlenderSetButton.Click
If BlenderUpDown.Value = 1 Then
BlenderTimerLabel.Text = ("00:05:00")
End If
If BlenderUpDown.Value = 2 Then
BlenderTimerLabel.Text = ("00:10:00")
'This below doesn't work
Dim BlenderCountDownFrom As New TimeSpan(0, 10, 1)
End If
If BlenderUpDown.Value = 3 Then
BlenderTimerLabel.Text = ("00:15:00")
End If
If BlenderUpDown.Value = 4 Then
BlenderTimerLabel.Text = ("00:20:00")
End If
If BlenderUpDown.Value = 5 Then
BlenderTimerLabel.Text = ("00:25:00")
End If
End Sub
Since I have been trying to make a space invaders style game I have been having trouble with collision detection with spawned objects in arrays (and having a bit of trouble with the bullets, they keep stopping and having another generate). I am new at coding and would like some help with these issues, or at least some links to some forums that had the same thread question.
here is my code:
Public Class Form1
'global variables
Dim intAmountOfEnemys As Short = 9
Dim intRowsOfEnemys As Integer = 0 '**
Dim intAmountOfBullets As Integer = 0
Dim picEnemysWave1(intAmountOfEnemys) As PictureBox
Dim lblBullets As New Label
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Welcome_Screen.Hide()
Call EnemyWaves(picEnemysWave1)
End Sub
Sub PlayerMovement(ByVal sender As Object, ByVal e As KeyEventArgs) Handles MyBase.KeyDown
If e.KeyCode = Keys.A Then
If picShip.Right <= 0 Then
picShip.Left = 1567
Else
picShip.Left -= 10
End If
ElseIf e.KeyCode = Keys.D Then
If picShip.Left >= 1567 Then
picShip.Left = -15
Else
picShip.Left += 10
End If
ElseIf e.KeyCode = Keys.Space Then
Do
BulletGeneration(lblBullets)
Loop Until Keys.Space
lblBullets.Left = (picShip.Left + 7)
End If
End Sub
#Region "Enemy waves, Movement, and Properties"
Sub EnemyWaves(ByRef picEnemysWave1() As PictureBox)
'Enemy Generator
Const srtENEMYSPACING_Y As Short = 155
For intCounterForEnemys As Integer = 0 To intAmountOfEnemys
Dim intEnemySpacing As Integer = srtENEMYSPACING_Y * intCounterForEnemys
picEnemysWave1(intCounterForEnemys) = New PictureBox
picEnemysWave1(intCounterForEnemys).Location = New Point(42 + intEnemySpacing, 1)
picEnemysWave1(intCounterForEnemys).Image = My.Resources.enemy
picEnemysWave1(intCounterForEnemys).Width = 124
picEnemysWave1(intCounterForEnemys).Height = 84
picEnemysWave1(intCounterForEnemys).Show()
Me.Controls.Add(picEnemysWave1(intCounterForEnemys))
Next intCounterForEnemys
End Sub``
Private Sub TmrAlien1_Tick(sender As Object, e As EventArgs) Handles TmrAlien1.Tick
For intRandom As Integer = 0 To 9
picEnemysWave1(intRandom).Top += 3
Dim intRandomNum As Integer = Rnd()
If intRandomNum > 0.66 Then
picEnemysWave1(intRandom).Left += 2 'goes left randomly
ElseIf intRandomNum < 0.33 Then
picEnemysWave1(intRandom).Left -= 2 'goes right randomly
End If
If picEnemysWave1(intRandom).Top <= 0 Then
TmrAlien1.Start()
End If
If picEnemysWave1(intRandom).Top >= 952 Then
TmrAlien1.Stop()
End If
Next intRandom
End Sub
#End Region
#Region "Bullet Generation, Movement, and Properties"
Sub BulletGeneration(ByRef lblBullets As Object)
'Generation of Bullets
For intBulletCounter As Integer = 0 To intAmountOfBullets
lblBullets = New Label
lblBullets.location = New Point(760, 785)
lblBullets.image = My.Resources.blast2
lblBullets.width = 32
lblBullets.height = 64
lblBullets.show()
Me.Controls.Add(lblBullets)
Next intBulletCounter
End Sub
Private Sub tmrBullets_Tick(sender As Object, e As EventArgs) Handles tmrBullets.Tick
lblBullets.Top -= 20
End Sub
#End Region
#Region "Collision Detection"
Sub BulletCollision(ByRef lblBullets As Label, ByRef intAmontOfEnemys As Integer)
For Each picEnemy As PictureBox In picEnemysWave1
If lblBullets.Bounds.IntersectsWith(picEnemy.Bounds) Then
picEnemy.Location = New Point(3900, 8700)
Exit For
End If
Next
'what Im trying
End Sub
#End Region
This is a slot machine program. I am trying to detect how many times the user clicks a button (spins). But I can't figure out why my counter only adding 1 to my clickLabel? I'm sure it's a simple fix but I'm drawing a blank.
Public Class MainForm
Private Sub clickHereButton_Click(sender As Object, e As EventArgs) Handles clickHereButton.Click
' simulates a slot machine
Dim randGen As New Random
Dim leftIndex As Integer
Dim centerIndex As Integer
Dim rightIndex As Integer
Dim counter As Integer = 1
clickHereButton.Enabled = False
For spins As Integer = 1 To 10
leftIndex = randGen.Next(0, 6)
leftPictureBox.Image = ImageList1.Images.Item(leftIndex)
Me.Refresh()
System.Threading.Thread.Sleep(50)
centerIndex = randGen.Next(0, 6)
centerPictureBox.Image = ImageList1.Images.Item(centerIndex)
Me.Refresh()
System.Threading.Thread.Sleep(50)
rightIndex = randGen.Next(0, 6)
rightPictureBox.Image = ImageList1.Images.Item(rightIndex)
Me.Refresh()
System.Threading.Thread.Sleep(50)
Next spins
If leftIndex = centerIndex AndAlso
leftIndex = rightIndex Then
MessageBox.Show("Congratulations!", "Winner", MessageBoxButtons.OK, MessageBoxIcon.Information)
End If
counter += 1
clickLabel.Text = counter.ToString()
clickHereButton.Enabled = True
clickHereButton.Focus()
End Sub
Private Sub exitButton_Click(sender As Object, e As EventArgs) Handles exitButton.Click
Me.Close()
End Sub
End Class
What's happening is you're always setting the counter to 1 everytime you click the button because it is inside the clickHereButton_Click. So even though you are incrementing it, at the beginning of your sub you are still setting it to 1.
Dim counter As Integer = 1
Private Sub clickHereButton_Click(sender As Object, e As EventArgs) Handles clickHereButton.Click
...
End Sub
i am trying to get a automatic scroll going (goes all the way down a panel, then scrolls all the way back up). I get it to go down to the end of the panel, but cannot get it to come back up. It is set to work on a timer. Here is my code:
Private Sub tmrSCROLL_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tmrSCROLL.Tick
pnlScrollFeed.AutoScrollPosition = New Point(pnlScrollFeed.AutoScrollPosition.X, Math.Abs(pnlScrollFeed.AutoScrollPosition.Y) + 1)
Dim totalHeight As Integer = pnlScrollFeed.VerticalScroll.Maximum
Dim tempHeight As Integer = pnlScrollFeed.VerticalScroll.Value
Dim tempDiff As Integer = totalHeight - tempHeight
If tempDiff > 800 Then
pnlScrollFeed.AutoScrollPosition = New Point(pnlScrollFeed.AutoScrollPosition.X, Math.Abs(pnlScrollFeed.AutoScrollPosition.Y) + 1)
ElseIf tempDiff <= 800 Then
pnlScrollFeed.AutoScrollPosition = New Point(pnlScrollFeed.AutoScrollPosition.X, Math.Abs(pnlScrollFeed.AutoScrollPosition.Y) - 1)
tempHeight += 1
End If
End Sub
Probably works better if you have a variable to tell you which direction to go, then just calculate when the scroll thumb hits the bottom or to top:
Private scrollUp As Boolean = False
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
If scrollUp Then
Dim scrollY As Integer = -Panel1.AutoScrollPosition.Y - 1
If scrollY < 0 Then
scrollUp = False
Else
Panel1.AutoScrollPosition = New Point(Panel1.AutoScrollPosition.X, scrollY)
End If
Else
Dim scrollY As Integer = -Panel1.AutoScrollPosition.Y + 1
If scrollY > Panel1.AutoScrollMinSize.Height - Panel1.ClientSize.Height Then
scrollUp = True
Else
Panel1.AutoScrollPosition = New Point(Panel1.AutoScrollPosition.X, scrollY)
End If
End If
End Sub