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
Related
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
I'm trying to make a Pong knockoff in VB.net. However, I am having difficulty managing to get the ball object to change directions once it gets outside of the screen. This is what I have right now:
Option Explicit On
Option Infer Off
Option Strict On
Public Class Form1
'Declare variables here
Dim P1Score As Integer = 0
Dim P2Score As Integer = 0
Dim velocity As Integer = 1
Dim RandGen As New Random
Dim angle As Integer
'This function defines the X-value movement
Private Function angleCalcX(ByVal angle As Integer) As Integer
Dim xSpeed As Integer
xSpeed = Convert.ToInt16(ball.Location.X + (velocity * System.Math.Cos(angle)))
If ball.Bounds.IntersectsWith(Player1.Bounds) OrElse ball.Bounds.IntersectsWith(Player2.Bounds) Then
xSpeed = Convert.ToInt16(-(ball.Location.X + (velocity * System.Math.Cos(angle))))
End If
Return xSpeed
End Function
Private Function angleCalcY(ByRef angle As Integer) As Integer
Dim ySpeed As Integer
ySpeed = Convert.ToInt16(ball.Location.Y + (velocity * System.Math.Sin(angle)))
If (ball.Bounds.IntersectsWith(background.Bounds)) = False Then
ySpeed = Convert.ToInt16(-(ball.Location.Y + (velocity * System.Math.Sin(angle))))
End If
Return ySpeed
End Function
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
MessageBox.Show("Hello, and welcome to Pong! This is a 2-player game. Player 1 uses the W and S keys, and Player 2 uses the K and I keys. First to five goals wins. Press space to start!", "Start Screen.jpg", MessageBoxButtons.OK, MessageBoxIcon.Information)
angle = RandGen.Next(1, 360)
End Sub
Private Sub Timer2_Tick(sender As Object, e As EventArgs) Handles Timer2.Tick
ball.Location = New Point(angleCalcX(angle), angleCalcY(angle))
If ball.Location.X > 1049 Then
P1Score += 1
velocity = 1
ElseIf ball.Location.X < 12 Then
P2Score += 1
velocity = 1
End If
End Sub
Public Sub Form1_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
If e.KeyCode = Keys.S Then
Player1.Top += 25
ElseIf e.KeyCode = Keys.W Then
Player1.Top -= 25
ElseIf e.KeyCode = Keys.K Then
Player2.Top += 25
ElseIf e.KeyCode = Keys.I Then
Player2.Top -= 25
End If
End Sub
Private Sub quitButton_Click(sender As Object, e As EventArgs) Handles quitButton.Click
Me.Close()
End Sub
End Class
Can anyone help me out?
There's missing something like this in your Timer2_Tick
ElseIf ball.Location.Y < 12 OrElse ball.Location.Y > 600 Then
ySpeed = -ySpeed 'Make a bounce from top/bottom edge
But there's a lot to improve in the rest of code as well. I don't see the reason to use Int16 for speeds or hard-coding boundaries in code for example.
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
I have a very simple countdown timer that I made. I would like the color of the label (numbers) to change as the timer ticks. I want to start with Green and then fade(transition) to Red when the timer ticks 00:00.
The timer is working great, I can also get the label to change to red once the timer hits 00:00. I would like it to fade though. Here's is part of the code.
'handles the label ticking down'
Private Sub tmrCountdown_Tick(sender As Object, e As EventArgs) Handles tmrCountdown.Tick
Dim ts As TimeSpan = TargetDT.Subtract(DateTime.Now)
If ts.Milliseconds > 0 Then
lblTime.Text = ts.ToString("mm\:ss")
lblTime.ForeColor = Color.FromArgb(0, 255, 0)
Else
lblTime.ForeColor = Color.FromArgb(255, 0, 0) 'changes label color to red when it hits 00:00'
'stops the timer once the label reaches 00:00
lblTime.Text = "00:00"
'Plays sound when timer hits 00:00'
My.Computer.Audio.Play(My.Resources.alarm, AudioPlayMode.BackgroundLoop)
tmrCountdown.Stop()
End If
End Sub
I know this is an old thread, but I was looking for something like this with a label glowing red. To do this I created a timer and then set up some conditional counters to alter the RGB values of the label colour. The rate of change is set by the timer.interval value. Hope this helps someone.
Public Class AlertWindow
Dim Red As Integer = 0
Dim Green As Integer = 0
Dim Blue As Integer = 0
Dim CountUp As Boolean = True
Private Sub AlertWindow_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
Timer1.Enabled = True
End Sub
Private Sub Timer1_Tick(sender As System.Object, e As System.EventArgs) Handles Timer1.Tick
If CountUp = True Then
If Red < 253 Then
Red = Red + 1
Else
CountUp = False
End If
End If
If CountUp = False Then
If Red > 0 Then
Red = Red - 1
Else
CountUp = True
End If
End If
Label1.ForeColor = Color.FromArgb(Red, Blue, Green)
End Sub
End Class
For Fade in you can use Alpha parameter
for example:
Static Alpha As Integer
lblTime.BackColor = Color.FromArgb(Alpha , 255, 0, 0)
Alpha += 5 'amount of opacity change for each timer tick
If Alpha > 255 Then lblTime.Enabled = False 'finished fade-in
This works better when you can average the colors together.
You have to work out what value you want for the tickCount based on your timer interval:
Private tickCount As Integer = 100
Private tickValue As Integer = 0
Private Sub tmrCountdown_Tick(sender As Object, e As EventArgs) _
Handles tmrCountdown.Tick
If tickValue > tickCount Then
tmrCountdown.Stop()
tickValue = 0
Else
lblTime.ForeColor = AvgColor(Color.Green, Color.Red, tickValue, tickCount)
tickValue += 1
End If
End Sub
Private Function AvgColor(startColor As Color,
finalColor As Color,
colorValue As Integer,
colorCount As Integer) As Color
Dim r1 As Integer = startColor.R
Dim g1 As Integer = startColor.G
Dim b1 As Integer = startColor.B
Dim r2 As Integer = finalColor.R
Dim g2 As Integer = finalColor.G
Dim b2 As Integer = finalColor.B
Dim avgR As Integer = r1 + ((r2 - r1) * colorValue) / colorCount
Dim avgG As Integer = g1 + ((g2 - g1) * colorValue) / colorCount
Dim avgB As Integer = b1 + ((b2 - b1) * colorValue) / colorCount
Return Color.FromArgb(avgR, avgG, avgB)
End Function
'RGB_1 = Timer;
'RGB_2 = Timer;
'RGB_3 = Timer;
'Label1 = Label;
'RGB1 = Progressbar;
'RGB2 = Progressbar;
'RGB3 = Progressbar.
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
RGB1.Value = 255
RGB_1.Interval = 10
RGB_2.Interval = 10
RGB_3.Interval = 10
RGB_1.Start()
End Sub
Private Sub RGB_1_Tick(sender As Object, e As EventArgs) Handles RGB_1.Tick
If RGB2.Value = 255 Then
If RGB1.Value = 0 Then
If RGB3.Value = 255 Then
RGB_1.Stop()
RGB_2.Start()
Else
RGB3.Value += 1
End If
Else
RGB1.Value -= 1
End If
Else
RGB2.Value += 1
End If
SetColor()
End Sub
Private Sub RGB_2_Tick(sender As Object, e As EventArgs) Handles RGB_2.Tick
If RGB3.Value = 255 Then
If RGB2.Value = 0 Then
If RGB1.Value = 255 Then
RGB_2.Stop()
RGB_3.Start()
Else
RGB1.Value += 1
End If
Else
RGB2.Value -= 1
End If
Else
RGB3.Value += 1
End If
SetColor()
End Sub
Private Sub RGB_3_Tick(sender As Object, e As EventArgs) Handles RGB_3.Tick
If RGB3.Value = 0 Then
RGB_3.Stop()
RGB_1.Start()
Else
RGB3.Value -= 1
End If
SetColor()
End Sub
Sub SetColor()
Label1.ForeColor = Color.FromArgb(RGB1.Value, RGB2.Value, RGB3.Value)
End Sub
I manage to customize the normal list box with an image, change text and background color when item is selected in ownerdrawn, what I want to achieve now is to drawn a custom highlight color on the item when mouse is hover on the listbox item, is that possible or not..., I provided my sample code below on what I come so far..
If e.Index = -1 Then Exit Sub
Dim listBox As ListBox = CType(sender, ListBox)
e.DrawBackground()
Dim isItemSelected As Boolean = ((e.State And DrawItemState.Selected) = DrawItemState.Selected)
If e.Index >= 0 AndAlso e.Index < listBox.Items.Count Then
Dim textSize As SizeF = e.Graphics.MeasureString(listBox.Items(e.Index).ToString(), listBox.Font)
Dim itemImage As Image = My.Resources.FolderHorizontal
'set background and text color
Dim backgroundColorBrush As New SolidBrush(If((isItemSelected), Color.CornflowerBlue, Color.White))
Dim itemTextColorBrush As Color = If((isItemSelected), Color.White, Color.Black)
e.Graphics.FillRectangle(backgroundColorBrush, e.Bounds)
'draw the item image
e.Graphics.SmoothingMode = SmoothingMode.HighQuality
e.Graphics.DrawImage(itemImage, e.Bounds.X + 2, _
e.Bounds.Y + (e.Bounds.Height - textSize.Height) / 2, _
itemImage.Width, itemImage.Height)
'draw the item text
Dim x, y As Single
Dim h As Single = textSize.Height
Dim rect As Rectangle = e.Bounds
rect.X += listBox.ItemHeight
rect.Width -= listBox.ItemHeight
x = rect.X - 3
y = rect.Y + (rect.Height - h) / 2
Dim itemText As String = listBox.Items(e.Index).ToString()
TextRenderer.DrawText(e.Graphics, itemText, e.Font, _
New Rectangle(x, y, ClientRectangle.Width, ClientRectangle.Height), _
itemTextColorBrush, TextFormatFlags.Default)
'clean up
backgroundColorBrush.Dispose()
End If
e.DrawFocusRectangle()
You can use the IndexFromPoint to do something like that:
Dim mouseIndex As Integer = -1
Private Sub ListBox1_MouseMove(sender As Object, e As MouseEventArgs) _
Handles ListBox1.MouseMove
Dim index As Integer = ListBox1.IndexFromPoint(e.Location)
If index <> mouseIndex Then
If mouseIndex > -1 Then
Dim oldIndex As Integer = mouseIndex
mouseIndex = -1
If oldIndex <= ListBox1.Items.Count - 1 Then
ListBox1.Invalidate(ListBox1.GetItemRectangle(oldIndex))
End If
End If
mouseIndex = index
If mouseIndex > -1 Then
ListBox1.Invalidate(ListBox1.GetItemRectangle(mouseIndex))
End If
End If
End Sub
Then in your drawing code:
If mouseIndex > -1 AndAlso mouseIndex = e.Index Then
backgroundColorBrush = New SolidBrush(Color.DarkMagenta)
End If
I will show you how to do this. All experts say its complicated and cannot be done with a listbox... I was able to do that in 5 minutes
the name of the listbox I created is listPOSSIBILITIES
1) create a variable which is global to your form
Dim HOVERTIME As Boolean = True
2) create MouseEnter event
Private Sub listPOSSIBILITIES_MouseEnter(sender As Object, e As system.EventArgs) Handles listPOSSIBILITIES.MouseEnter
HOVERTIME = True
End Sub
3) create MouseLeave event
Private Sub listPOSSIBILITIES_MouseLeave(sender As Object, e As System.EventArgs) Handles listPOSSIBILITIES.MouseLeave
HOVERTIME = False
End Sub
4) create MouseMove event
Private Sub listPOSSIBILITIES_MouseMove(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles listPOSSIBILITIES.MouseMove
Dim mypoint As Point
mypoint = listPOSSIBILITIES.PointToClient(Cursor.Position)
Dim myindex As Integer = listPOSSIBILITIES.IndexFromPoint(mypoint)
If myindex < 0 Then Exit Sub
listPOSSIBILITIES.SelectedIndex = myindex
End Sub
5) create MouseClick event
Private Sub listPOSSIBILITIES_MouseClick(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles listPOSSIBILITIES.MouseClick
HOVERTIME = False
End Sub
6) create SelectedIndexChanged event
Private Sub listPOSSIBILITIES_SelectedIndexChanged(sender As System.Object, e As System.EventArgs) Handles listPOSSIBILITIES.SelectedIndexChanged
If HOVERTIME Then Exit Sub
'put the rest of your code after this above If statement
End Sub
This works because the MouseClick event is triggered before the SelectIndexChanged event