Background Thread slowing Main UI Thread visual basic [duplicate] - vb.net

This question already has an answer here:
vb.net - service app & forms app both have very high CPU usage since adding socket comms
(1 answer)
Closed 2 years ago.
I would like to show a gif inside a Picture Box for 2 seconds on a separate thread from the main thread. I am running a timer that moves a Picture Box with an Image on the main thread.
To test I created a Picture Box and added same Image I start the background thread with a button click. The obvious ERROR or Issue is that the supposed Background Thread slows the Main Thread.
Creating and Implementing a Threads seems to offer two options BackgroundWorker and Task.Run.
I looked at this Code Magazine Article which offered way more options than I am grasping: Code Magazine Article
Also looked at this Article could not convert the C# code to VB YES I used a code converter: Stephen Cleary
My code is posted below for the Background Thread No need to post the Timer Tick Code.
Question what am I missing or what am I doing wrong OR is this just not possible?
Private Sub myThreadMethod()
'Await
'Async
Dim myThread As New Thread(AddressOf myThreadMethod)
myThread.IsBackground = True
myThread.Start()
If Me.InvokeRequired = True Then
Me.Invoke(Sub()
'PbT.Location = New Point(128, 132)
PbT.Left -= 1
PbT.Top += 2
End Sub)
'If PbT.Bounds.IntersectsWith(btnBot.Bounds) Then
'TextBox1.Invoke(Sub() TextBox1.Text =
End If
If PbT.Location.Y > 500 Then
PbT.Invoke(Sub() PbT.Location = New Point(350, 230))
Thread.Sleep(9000)
myThread.Abort()
End If
End Sub
Answer to Question was added to by Craig and Answered by James_Duh
Public Class frmStart
Dim running As Boolean = False
Dim stopWatch As Stopwatch = New Stopwatch
Private Sub frmStart_MouseMove(sender As Object, e As MouseEventArgs) Handles Me.MouseMove
Cursor.Clip = New Rectangle(Me.Location, Me.Size)
btnLPad.Left = e.X
btnCPad.Left = e.X + 28
btnRPad.Left = e.X + 56
End Sub
Private Sub tmrMove_Tick(sender As Object, e As EventArgs) Handles tmrMove.Tick
Static direction As New Point(0, 4)
Static endTime As DateTime = DateTime.Now.AddYears(1)
If DateTime.Now > endTime Then
PbT.Visible = False
endTime = DateTime.Now.AddYears(1)
End If
If _buttons.All(Function(x) x.Button.Visible = False) Then
pbOne.Top = 300
PbT.Visible = False
tbAns.Visible = True
stopWatch.Stop()
Dim ts = stopWatch.Elapsed
Dim elapsedTime = $"{ts.Minutes:0} Min {ts.Seconds:00} Sec"
tbAns.Text = elapsedTime
running = False
direction = New Point(0, 4)
tmrMove.Stop()
MsgBox("You Win")
stopWatch.Reset()
'================
tbAns.Visible = False
ResetButtons()
End If
If pbOne.Bounds.IntersectsWith(btnLPad.Bounds) Then
direction = New Point(-2, -3)
End If
If pbOne.Bounds.IntersectsWith(btnRight.Bounds) Then
Static spC As Integer = 1
spC += 1
direction = If(spC Mod 2 = 0, New Point(-3, 2), New Point(-5, 1))
End If
If pbOne.Bounds.IntersectsWith(btnLeft.Bounds) Then
direction = New Point(4, 2)
End If
If pbOne.Bounds.IntersectsWith(btnCPad.Bounds) Then
direction = New Point(direction.X, -4)
End If
If pbOne.Bounds.IntersectsWith(btnRPad.Bounds) Then
Static spA As Integer = 1
spA += 1
direction = If(spA Mod 2 = 0, New Point(1, -5), New Point(-3, -4))
End If
If pbOne.Bounds.IntersectsWith(btnTop.Bounds) Then
Static spE As Integer = 1
spE += 1
direction = If(spE Mod 2 = 0, New Point(-3, 2), New Point(4, 2))
End If
If pbOne.Bounds.IntersectsWith(btnBot.Bounds) Then
tmrMove.Stop()
running = False
pbOne.Top = 200
PbT.Visible = False
MsgBox("Press S to Start")
End If
pbOne.Left += direction.X
pbOne.Top += direction.Y
For Each x In _buttons
If pbOne.Bounds.IntersectsWith(x.Button.Bounds) Then
endTime = DateTime.Now.AddSeconds(2.0)
x.Button.Visible = False
x.Button.Location = New Point(350, -30)
PbT.Location = New Point(x.Location.X + 20, 31)
PbT.Visible = True
direction = New Point(3, 3)
End If
Next
End Sub
Private Sub frmStart_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
If running AndAlso e.KeyCode = Keys.P Then
tmrMove.Stop()
End If
If e.KeyCode = Keys.S Then
If Not running Then
stopWatch.Start()
running = True
End If
tmrMove.Interval = 1
tmrMove.Start()
End If
End Sub
Public Sub frmStart_KeyPress(sender As Object, e As KeyPressEventArgs) Handles Me.KeyPress
'Form Property KeyPreview needs to be set to True
'=================================================
If Asc(e.KeyChar) = 27 Then
Const message As String = "YES" & " Exit Program" + vbCrLf + vbNewLine + "NO" & " Read Directions"
Const caption As String = "Exit OR Return"
Dim result = MessageBox.Show(message, caption, MessageBoxButtons.YesNo, MessageBoxIcon.Question)
If result = DialogResult.Yes Then
Application.Exit()
ElseIf result = DialogResult.No Then
frmInfo.Show()
Close()
End If
End If
End Sub
Private _buttons As (Button As Button, Location As Point)() = Nothing
Private Sub frmStart_Load(sender As Object, e As EventArgs) Handles MyBase.Load
If _buttons Is Nothing Then
_buttons =
{
(btnB1, New Point(29, 32)),
(btnB2, New Point(110, 32)),
(btnB3, New Point(191, 32)),
(btnB4, New Point(272, 32)),
(btnB5, New Point(353, 32)),
(btnB6, New Point(434, 32)),
(btnB7, New Point(515, 32)),
(btnB8, New Point(596, 32)),
(btnB9, New Point(677, 32))
}
End If
ResetButtons()
End Sub
Private Sub ResetButtons()
For Each x In _buttons
x.Button.Visible = True
x.Button.Location = x.Location
Next
End Sub
End Class
This Code above was from Enigmativity and FIXES a number of issues. See his comments about the Stopwatch and playing the gif. As well the game plays 70% Faster with his code

Trying to reproduce this NOT seeing your Timer tick code I wrote my own
Understanding the GAME design of Breakout will help for anyone trying to follow Vectors steps need to show the gif for X amount of Seconds
First you need to Stopwatch integrated into the Timer
Second you need to know when to set the END time in Seconds Logic would require this happens when the BALL IntersectsWith the BRICK
So we write a Function called Fire see code below
NO need to have a gif for each BRICK so now we need to move our one and only gif to the correct BRICK and let it run for X Seconds We also need to make the gif Visible WHY you might ask if Enabled and Visible they run for ever It was easier to just manage Visibility
You also need code inside the Timer Tick method to make the gif Invisible after X Seconds
Excuse my lack of declarative variables
pbOne = the BALL & btnB1 = BRICK & PbT = Picture Box with the gif
Public Function Fire() As Integer
'Set Stopwatch 5 sec in the future
nT = CDbl(DateTime.Now.AddSeconds(5).ToString("ss"))
Return CInt(nT)
End Function
Private Sub tmrMove_Tick(sender As Object, e As EventArgs) Handles tmrMove.Tick
'nS is Rolling Time
nS = CDbl(DateTime.Now.ToString("ss"))
If nS > nT Then
PbT.Visible = False
End If
If pbOne.Bounds.IntersectsWith(btnB1.Bounds) Then
btnB1.BackColor = Color.Red
btnB1.Visible = False
Fire()
Y = btnB1.Location.Y
X = btnB1.Location.X
PbT.Location = New Point(X + 20, Y)
PbT.Visible = True
btnB1.Location = New Point(350, -30)
rndNUM = 8
End If

Related

Take a photo every 5 seconds

I am developing a panel, which from time to time runs a process and generates an image within it. Once the image is generated, you need to take a photo to save it for the changes that are made.
I already developed the part where the images change, but when I take the photos, they all come out blank. Add a delay on the screen thinking that it should take a while to take the photo of the panel later, but it still comes out blank and if there is something inside the panel, since I am resizing it according to the size of what is updated.
Can you help me to see where my error is? Or guide me to obtain an optimal result?, I also tried using a timer, but it gives me the same result, any ideas?
This is the code developed.
sub buldimages()
Panel1.Refresh()
System.Threading.Thread.Sleep(5000)
segondGa(varName)
'Timer1.Start()
End Sub
Function segondGa(nameLine As String)
Dim widthOldPuno = Panel1.Width
Dim heightOldPuno = Panel1.Height
Dim widthOldPdos = Panel2.Width
Dim heightOldPdos = Panel2.Height
Dim coordenada, i As Integer
For Each obj As Control In Panel1.Controls
coordenada = obj.Location.X
Next
Panel1.Width = widthOldPuno + (coordenada - Panel1.Width)
Panel2.Width = Panel1.Width + 113
Panel2.Height = heightOldPdos - 65
Dim nameLineB As String = nameLine
Using bmp = New Bitmap(Panel2.Width, Panel2.Height)
Panel2.DrawToBitmap(bmp, New Rectangle(0, 0, bmp.Width, bmp.Height))
Dim bmp2 As New Bitmap(bmp.Width * 3, bmp.Height * 3)
Dim gr As Graphics = Graphics.FromImage(bmp2)
gr.DrawImage(bmp, New Rectangle(0, 0, bmp2.Width, bmp2.Height))
bmp2.Save("C:\TEMP\" & nameLineB & ".png")
End Using
Panel2.Width = widthOldPdos
Panel2.Height = heightOldPdos
Panel1.Width = widthOldPuno
End Function
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
Dim seconds As Integer
Label1.Text = seconds + 1
If Label1.Text = "5" Then
Timer1.Stop()
End If
End Sub

Progress bar gets stuck at 100%

I've programmed a "Please wait" form in which I inserted a progress bar. I looked around how to program a progress bar and this is what I did. First of all I programmed the button - Button3_Click - I press to start. Then I programmed the timer - Timer1_Tick -and so I wrote:
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
Timer1.Enabled = True
Timer1.Interval = 50
Timer1.Start()
*[calculus code]*
If Form18.ProgressBar1.Value = 100 Then
Form18.Hide()
hrrspkexcel.Visible = True
End If
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
iProgressBarValue += 1
Select Case iProgressBarValue
Case 1, 3, 5, 7, 9
Form18.ProgressBar1.ForeColor = Color.White
Form18.Label3.Text = Form18.ProgressBar1.Value & (" %")
Form18.ProgressBar1.Value = (iProgressBarValue * 10)
Case 2, 4, 6, 8
Form18.Label3.Text = Form18.ProgressBar1.Value & (" %")
Form18.ProgressBar1.Value = (iProgressBarValue * 10)
Case 10
Form18.ProgressBar1.Value = (iProgressBarValue * 10)
Form18.Label3.Text = Form18.ProgressBar1.Value & (" %")
Timer1.Stop()
Timer1.Enabled = False
End Select
End Sub
I can't understand why the progress bar gets stuck at 100% and neither form18 gets hidden, nor hrrspkexcel becomes visible. Where am I doing wrong? Thanks for any support. Best regards.
Edit: I tried to edit my code as comments say:
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
Timer1.Enabled = True
Timer1.Interval = 50
Timer1.Start()
[calculus code]
iProgressBarValue += 1
Select Case iProgressBarValue
Case 1, 3, 5, 7, 9
Form18.ProgressBar1.ForeColor = Color.White
Form18.Label3.Text = Form18.ProgressBar1.Value & (" %")
Form18.ProgressBar1.Value = (iProgressBarValue * 10)
Case 2, 4, 6, 8
Form18.Label3.Text = Form18.ProgressBar1.Value & (" %")
Form18.ProgressBar1.Value = (iProgressBarValue * 10)
Case 10
Form18.ProgressBar1.Value = (iProgressBarValue * 10)
Form18.Label3.Text = Form18.ProgressBar1.Value & (" %")
Timer1.Stop()
Timer1.Enabled = False
End Select
If Form18.ProgressBar1.Value = 100 Then
Form18.Hide()
hrrspkexcel.Visible = True
End If
End Sub
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
If Form18.ProgressBar1.Value = 100 Then
Timer1.Stop()
Timer1.Enabled = False
End If
End Sub
In this case, progress bar gets stuck at 10%.
Edit II: Following suggestions in comment, I removed the timer and based my progress bar on the entity of the calculus code (Form18.ProgressBar1.Maximum). Anyway, what is reported under [calculus code] is an heavy Excel export so the progress bar freezes to 0% until exportation has ended and then start running (I set loading cursor to understand when exportation has ended), so maybe I'd need of a BackgroundWorker to make my bar progressing while exporting? (I'm a beginner programmer and I read somewhere something about this, but I don't know if this solution is suitable for me, so I'm asking).
At last, this is how I corrected my code:
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
Form18.ProgressBar1.Minimum = 0
Form18.ProgressBar1.Value = 0
Form18.ProgressBar1.Maximum = [if loop criteria based on my code]
Form18.ProgressBar1.Increment(1)
Form18.Show()
[calculus code - excel export]
If Form18.ProgressBar1.Value = Form18.ProgressBar1.Maximum Then
Form18.Hide()
hrrspkexcel.Visible = True
End If
End Sub
With this edit, my ProgressBar freezes at 0% even if exportation has already ended, so I'm obviously doing wrong somewhere. Thanks for all the support you're giving to me.
Edit III: I managed in making progressbar working using a for loop to increment its value, as you suggested me, with a proportional equation to percentage and to overcome the problem about the maximum value of the bar, that's always set on 100. So thanks all of you for your support. The last thing I want to ask you - if I'm not offtopic - is how to make my loading form - with the progressbar - on foreground and to "lock" interaction with all other forms.
Edit III BIS: I've tried to use Backgroundworker in order to overcome the loading-form freezing. This is the first time I'm using this command and I don't know if it's the right way to make it comunicating to a ShowDialog Form. This is what I wrote:
Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click
Form18.ProgressBar1.Minimum = 0
Form18.ProgressBar1.Value = 0
BackgroundWorker1.RunWorkerAsync()
End Sub
Private Sub BackgroundWorker1_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
Form18.ShowDialog()
[excel calculus export]
If Form18.ProgressBar1.Value = Form18.ProgressBar1.Maximum Then
Form18.Hide()
hrrnativexcel.Visible = True
End If
End Sub
I'm always getting the same trouble: when Form18 appears, remains on 0% loading.
Edit IV: I'm having an issue about progressbar increment for the following situation: I have two for loops for exporting values in excel and the upper bound of this loops are different. So I've created a third for loop, whose upper bound is the sum of the upper bounds of the two abovementioned for loops, in order to increment the progressbar progress. When it reaches 100%, it starts again going in loop. How could I solve this issue? Here is the code I'm using:
For i = 1 To CInt(Form6.ListBox1.Items.Count)
For j = 1 To CInt(Form10.ListBox1.Items.Count)
For k = 0 To CInt(CInt(Form6.ListBox1.Items.Count) + CInt(Form10.ListBox1.Items.Count))
hrrspkexcel.Cells(j + 1, 1).value = Form10.ListBox2.Items(CInt(j + 1) - 2)
hrrspkexcel.Cells(i + 1, 2).value = Form6.ListBox1.Items(CInt(i + 1) - 2)
Form18.ProgressBar1.Value = CInt(100 * k / (CInt(Form6.Label9.Text) + CInt(Form10.ListBox1.Items.Count)))
Form18.Label3.Text = Form18.ProgressBar1.Value & (" %")
Next
Next
Next
Thanks in advance.
Edit V: I've updated my code following comments in order to solve the issue described in Edit IV. This is what I wrote:
Dim pbloop As Integer
pbloop = CInt(Form10.ListBox1.Items.Count) * CInt(Form6.ListBox1.Items.Count)
For p = 1 To pbloop
For i = 1 To CInt(Form6.ListBox1.Items.Count)
For j = 1 To CInt(Form10.ListBox1.Items.Count)
hrrspkexcel.Cells(i + 1, 4).value = Form6.ListBox1.Items(CInt(i + 1) - 2)
hrrspkexcel.Cells(i + 1, 3).value = Form6.ListBox2.Items(CInt(i + 1) - 2)
hrrspkexcel.Cells(j + 1, 1).value = Form10.ListBox1.Items(CInt(j + 1) - 2)
hrrspkexcel.Cells(j + 1, 2).value = Form10.ListBox2.Items(CInt(j + 1) - 2)
Form18.ProgressBar1.Value = CInt(100 * p / pbloop)
Form18.Label3.Text = Form18.ProgressBar1.Value & (" %")
Next
Next
I'm getting stuck always at 0% and progress bar that doesn't increase.
This is not the true answer of the problem but a sample to show you how to use a progress bar.
This code is not beautiful, I know, it's for the example. Please be careful when you use a textbox text as a number without check what is written.
Imports System.Threading
Public Class Form1
Private Sub btnGo_Click(sender As Object, e As EventArgs) Handles btnGo.Click
' Initialisation of the progressbar
myProgressbar.Value = 0
myProgressbar.Maximum = tbxTo.Text
lbxInfos.Items.Clear() ' Clear the content in the listbox1 if it's not the first run
' This simulate your [calculus code], I just add an information in the listbox
For i As Integer = tbxFrom.Text To tbxTo.Text
myProgressbar.Value = i ' Set the progressbar avancement
lbxInfos.Items.Add("This is the loop n° " & i & " !")
lbxInfos.Refresh() ' Just because the listbox will not be refresh until the end of the sub
Thread.Sleep(200) ' The code is too fast, I add this to see the progress (= wait 200 ms)
Next
MsgBox("This is the end ! Now the form will be closed")
Me.Close()
End Sub
End Class
Try something more like this out:
Private Async Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
Button3.Enabled = False
hrrspkexcel.Visible = False ' changed this to a Label next to the button just for demonstration
Dim f18 As New Form18
f18.ProgressBar1.Minimum = 0
f18.ProgressBar1.Value = 0
f18.ProgressBar1.Maximum = 100 ' <-- leave the maximum at 100!
f18.Show(Me)
Dim pct As Integer
Dim maximum As Integer = 319 ' <-- figure out the max value based on your "calculus code"
Await Task.Run(Sub()
' [calculus code - excel export]
For i As Integer = 0 To maximum
System.Threading.Thread.Sleep(50) ' <- some kind of processing going on
' calculate the percentage based on your loop value "i" and the "maximum":
pct = CDbl(i) / CDbl(maximum) * 100 ' <-- scale your loop value to 100
Try
f18.ProgressBar1.Invoke(Sub()
f18.ProgressBar1.Value = pct
End Sub)
Catch ex As Exception
' User closed the progressform, create another one
Me.Invoke(Sub()
f18 = New Form18
f18.ProgressBar1.Minimum = 0
f18.ProgressBar1.Value = 0
f18.ProgressBar1.Maximum = 100 ' <-- leave it at 100
f18.Show(Me)
' make progressbar immediately jump to the right spot
f18.ProgressBar1.Value = f18.ProgressBar1.Maximum
f18.ProgressBar1.Value = pct
End Sub)
End Try
Next
End Sub)
' when we hit here, the "calculus code" above completed
f18.Close()
hrrspkexcel.Visible = True ' changed this to a Label next to the button just for demonstration
Button3.Enabled = True
End Sub
Here's what it looks like in action:
You current code reads as if you want the Progress Bar to update on a button click a maximum of 10 times before hiding the form. Is that your intention? I would have expected that you want the "Please wait ..." form to stay visible with the progress bar updating every, say, second, then disappear?
Using a timer for the latter is fine but for the former, you can simply update the progress bar directly - as you are doing - without a timer.
Also, you don't need to multiply your progress bar value by 10; you can simply set the progress bar Maximum value to 10.
Also, since you change the ForeColor value on the first click, you can probably dispense with the Case Select {even|odd} test because the code is otherwise identical.
So without the timer or the color change and with Progress Bar Maximum = 10, all you need to do is:
Form18.ProgressBar1.Value = iProgressBarValue
Form18.Label3.Text = $"{iProgressBarValue} %")
No need for the Case Select.
Another option for the PB is to use the PerformStep() method to increment it. Just set the Step property to 1 for this approach.

How to stop controls from flickering during MouseMove Event

I know this is a pretty popular question, but none of the solutions I have found have worked for me.
Background: I have a windows forms project in VS2015 that reads data from text files and plots the data as multiple series on a line chart. The Chart.MouseMove event finds the point nearest the mouse and draws a circle around it. The circle is drawn in the Chart_Paint event
Private Sub crtLogView(sender As Object,e As PaintEventArgs) Handles crtLogView.Paint
Dim whitePen as New Pne(Color.White,2)
e.Graphics.DrawEllipse(whitePen,cir) '//cir is a Public Rectangle
End Sub
When moving the mouse across the chart, random controls flicker off then back on which is very annoying. I have posted the MouseMove event code below.
Potential solutions I have tried:
Turning on the DoubleBuffered property of the form, which does nothing
Using the Me.Invalidate() and Me.Update() method, which does not move the circle
Using the Chart.Invalidate() and Chart.Update() method, which works, but is very slow
Adding the following code to my Form_Load routine, which appears to do nothing
Any help with this would be greatly appreciated
Me.SetStyle(ControlStyles.AllPaintingInWmPaint, True)
Me.SetStyle(ControlStyles.DoubleBuffer, True)
Me.SetStyle(ControlStyles.UserPaint, True)
MouseMove Event Code:
Private Sub crtLogView_MouseMove(sender As Object, e As MouseEventArgs) Handles crtLogView.MouseMove
'//Show data for closest point to cursor & draw circle around point
Dim hResult As HitTestResult = crtLogView.HitTest(e.X, e.Y)
Dim srsNam As String = ""
Dim mouseY As Single
Dim pntDist As Double = 0
Dim pntX As Single
Dim pntY As Single
Dim mouseX As Single
On Error GoTo ErrTrap
'//Get X-Axis Position as integer
mouseX = Int(hResult.ChartArea.AxisX.PixelPositionToValue(e.X))
'// Set time value
lblTime.Text = String.Format("{0:n2}", hResult.ChartArea.AxisX.PixelPositionToValue(e.X) / 160)
'//Get Y-Axis Position
mouseY = hResult.ChartArea.AxisY.PixelPositionToValue(e.Y)
'//Get distance from mouse to point on Series(0)
pntDist = Math.Abs(crtLogView.Series(0).Points(mouseX).YValues(0) - mouseY)
srsNam = crtLogView.Series(0).Name '//1st series name
'//Find closest series
For i As Integer = 1 To crtLogView.Series.Count - 1
If Math.Abs(crtLogView.Series(i).Points(mouseX).YValues(0) - mouseY) < pntDist Then
pntDist = Math.Abs(crtLogView.Series(i).Points(mouseX).YValues(0) - mouseY)
srsNam = crtLogView.Series(i).Name
End If
Next
'//Set Top/Left values for circle
pntY = crtLogView.ChartAreas(0).AxisY.ValueToPixelPosition(crtLogView.Series(srsNam).Points(mouseX).YValues(0)) - 4
pntX = crtLogView.ChartAreas(0).AxisX.ValueToPixelPosition(Val(mouseX)) - 4
'//Move circle to closest point
cir.Location = New Point(pntX, pntY)
'//Refresh the form to move the circle
'//This works, but takes 2+ seconds to take effect
'crtLogView.Invalidate()
'crtLogView.Update()
'//This does not work
'Me.Invalidate()
'Me.Update()
'//This works, but randomly makes other controls flash/flicker
Me.Refresh()
ErrTrap:
End Sub
In the comments, I offered to provide an example of using a Chart Annotation or a DataPoint Label as an alternative to custom painting a circle around the point under the mouse-cursor and have included that in the code below. However, I realized that a DataPoint Marker should provide the function the OP is seeking and is likely the proper solution. Therefore, that option is also included.
Annotations are chart level graphics where-as the DataPoint Label and DataPoint Marker are as the name implies tied to the individual DataPoints. Proper sizing of annotations can be involved as their size is specified as a percentage of the Chart Area dimensions. This example does not attempt to resize the annotation based on the current chart size.
The following code sample is for a WinForm. In VS, add a new Class to a WinForm project and replace the auto-generated code with this. The set this Form as the startup Form.
Imports System
Imports System.Drawing
Imports System.Windows.Forms
Imports Charting = System.Windows.Forms.DataVisualization.Charting
Public Class ChartDemo : Inherits Form
Const yMultiplyer As Double = 100.0
Private rnd As Random
Friend WithEvents chart As System.Windows.Forms.DataVisualization.Charting.Chart
Friend WithEvents rbAnnotation As System.Windows.Forms.RadioButton
Friend WithEvents rbDataLabel As System.Windows.Forms.RadioButton
Friend WithEvents rbMarker As System.Windows.Forms.RadioButton
Private lastPoint As Charting.DataPoint
Private ellispeAnnotation As Charting.EllipseAnnotation
Public Sub New()
InitializeComponent()
rnd = New Random(0) ' use same basis for each run
SetupChart()
End Sub
Private Sub InitializeComponent()
Me.chart = New System.Windows.Forms.DataVisualization.Charting.Chart()
Me.rbAnnotation = New System.Windows.Forms.RadioButton()
Me.rbDataLabel = New System.Windows.Forms.RadioButton()
Me.rbMarker = New System.Windows.Forms.RadioButton()
CType(Me.chart, System.ComponentModel.ISupportInitialize).BeginInit()
Me.SuspendLayout()
Me.chart.Anchor = AnchorStyles.Top Or
AnchorStyles.Bottom Or
AnchorStyles.Left Or
AnchorStyles.Right
Me.chart.Location = New Point(4, 50)
Me.chart.Size = New Size(600, 500)
Me.rbAnnotation.AutoSize = True
Me.rbAnnotation.Location = New Point(50, 10)
Me.rbAnnotation.TabIndex = 1
Me.rbAnnotation.Text = "Use Annotation"
Me.rbAnnotation.UseVisualStyleBackColor = True
Me.rbDataLabel.AutoSize = True
Me.rbDataLabel.Location = New Point(200, 10)
Me.rbDataLabel.TabIndex = 2
Me.rbDataLabel.Text = "Use Data Label"
Me.rbDataLabel.UseVisualStyleBackColor = True
Me.rbMarker.AutoSize = True
Me.rbMarker.Location = New Point(400, 10)
Me.rbMarker.TabIndex = 3
Me.rbMarker.Text = "Use Data Marker"
Me.rbMarker.UseVisualStyleBackColor = True
Me.rbMarker.Checked = True
Me.AutoScaleDimensions = New SizeF(96.0!, 96.0!)
Me.AutoScaleMode = AutoScaleMode.Dpi
Me.ClientSize = New Size(610, 555)
Me.Controls.AddRange({Me.rbDataLabel, Me.rbAnnotation, Me.rbMarker, Me.chart})
Me.Text = "Charting Demo"
CType(Me.chart, System.ComponentModel.ISupportInitialize).EndInit()
Me.ResumeLayout(False)
Me.PerformLayout()
End Sub
Private Sub SetupChart()
chart.ChartAreas.Clear()
chart.Legends.Clear()
chart.Series.Clear()
chart.Annotations.Clear()
Dim area1 As New Charting.ChartArea("Area1")
chart.ChartAreas.Add(area1)
Dim ser As Charting.Series = chart.Series.Add("Series1")
ser.ChartArea = area1.Name
ser.ChartType = Charting.SeriesChartType.Line
' define defaults for point DataLabels
ser.LabelBorderColor = Color.Red
ser.LabelBorderWidth = 1
ser.LabelBackColor = Color.WhiteSmoke
ser.LabelForeColor = Color.Black
' define defaults for point DataMarkers
ser.MarkerSize = 10
ser.MarkerBorderWidth = 3
ser.MarkerBorderColor = Color.Red
ser.MarkerColor = Color.Transparent
' points for demo chart
For x As Double = -5.0 To 5.0
ser.Points.AddXY(x, rnd.NextDouble * yMultiplyer)
Next
ellispeAnnotation = CreateEllipseAnnotation()
ellispeAnnotation.Visible = False
chart.Annotations.Add(ellispeAnnotation)
End Sub
Private Sub chart_MouseLeave(sender As Object, e As EventArgs) Handles chart.MouseLeave
ellispeAnnotation.Visible = False
ClearLastPointDataLabel()
ClearLastPointMarker()
End Sub
Private Function CreateEllipseAnnotation() As Charting.EllipseAnnotation
Dim ret As New Charting.EllipseAnnotation()
ret.ForeColor = Color.Black
ret.Font = New Font("Arial", 10)
ret.LineWidth = 2
ret.Height = 7.5 ' % ChartArea height
ret.Width = 15 ' % ChartArea width
ret.BackColor = Color.PaleGoldenrod
ret.LineDashStyle = Charting.ChartDashStyle.Solid
Return ret
End Function
Private Sub chart_MouseMove(sender As Object, e As MouseEventArgs) Handles chart.MouseMove
Dim htr As Charting.HitTestResult = chart.HitTest(e.X, e.Y)
If htr.ChartElementType = Charting.ChartElementType.DataPoint Then
Dim pt As Charting.DataPoint = DirectCast(htr.Object, Charting.DataPoint)
If pt IsNot lastPoint Then
SetDataPointLabel(pt)
SetDataPointAnnotation(pt)
SetDataPointMarker(pt)
lastPoint = pt
End If
End If
End Sub
Private Sub SetDataPointAnnotation(pt As Charting.DataPoint)
If rbAnnotation.Checked Then
ellispeAnnotation.AnchorDataPoint = pt
ellispeAnnotation.Text = String.Format("{0:N2}, {1:N2}", pt.XValue, pt.YValues(0))
ellispeAnnotation.Visible = True
End If
End Sub
Private Sub SetDataPointLabel(pt As Charting.DataPoint)
ClearLastPointDataLabel()
If rbDataLabel.Checked Then
pt.Label = "#VALX{N2}, #VALY{N2}" ' case sensative, use uppercase for #VALX, #VALY
pt.IsValueShownAsLabel = True
End If
End Sub
Private Sub ClearLastPointDataLabel()
If lastPoint IsNot Nothing Then
lastPoint.Label = String.Empty
lastPoint.IsValueShownAsLabel = False
End If
End Sub
Private Sub SetDataPointMarker(pt As Charting.DataPoint)
ClearLastPointMarker()
If rbMarker.Checked Then pt.MarkerStyle = Charting.MarkerStyle.Circle
End Sub
Private Sub ClearLastPointMarker()
If lastPoint IsNot Nothing Then
lastPoint.MarkerStyle = Charting.MarkerStyle.None
End If
End Sub
Private Sub rbAnnotation_CheckedChanged(sender As Object, e As EventArgs) Handles rbAnnotation.CheckedChanged
If Not rbAnnotation.Checked Then
ellispeAnnotation.Visible = False
End If
End Sub
Private Sub rbDataLabel_CheckedChanged(sender As Object, e As EventArgs) Handles rbDataLabel.CheckedChanged
ClearLastPointDataLabel()
End Sub
Private Sub rbMarker_CheckedChanged(sender As Object, e As EventArgs) Handles rbMarker.CheckedChanged
ClearLastPointMarker()
End Sub
End Class

delay or stop execution for some time in vb.net

hi i want to delay the execution of code for some time on buton click i cal a func named chance() ..
which gets called after a picture box.image change .. bt the image does not change nd func chance() starts ... i want delay in chance() after the picture is changed ... thus help me ..
code
Private Sub p11_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles p11.Click
row = 1
col = 1
chck() 'function which returns hit var value
p11.Enabled = False
If hit = 1 Then
p11.Image = Image.FromFile("G:\visual progs\BATTLESHIP\hit.png")
ElseIf hit = 0 Then
p11.Image = Image.FromFile("G:\visual progs\BATTLESHIP\miss.png")
lblstatus.Text = "COMPUTER's TURN ... PLEASE WAIT ... "
chance() ' func begins
End If
End Sub
Function chance()
***'here i want a pause for 2 sec***
Dim z As Int16 = 1
While z = 1
row = mnw.Next(9) + 1
col = mnw.Next(9) + 1
If c(row, col) = False Then
c(row, col) = True
z = 0
End If
End While
chck1() ' checks for hit or miss for computer
changepic() 'changes pic hit or miss for computer
Return 0
End Function
To get a pause of 2 seconds, you simply need to suspend the thread by doing this:
Thread.Sleep(2000)
Although you can use Thread.Sleep to introduce a delay, it has generally undesirable side-effects, in particular the form and its controls become unresponsive. A better way is to use a timer - that way the form is still responsive (e.g. you can move it around).
Also, you seem to be a little unsure of where to use a Sub and where to use a Function. A Sub does something, and a Function is used to return a value, ideally with no side-effects.
You could try this with a new Windows Forms project and just a PictureBox named p11 and a Label named lblStatus:
Imports System.IO
Public Class Form1
Dim tim As Windows.Forms.Timer
Const GAMEPATH As String = "G:\visual progs\BATTLESHIP\"
Dim HitImgFile As String = Path.Combine(GAMEPATH, "hit.png")
Dim MissImgFile As String = Path.Combine(GAMEPATH, "miss.png")
Private Sub SetUpTimer()
tim = New Timer
tim.Interval = 2000 ' milliseconds
tim.Enabled = False
AddHandler tim.Tick, AddressOf Chance
End Sub
Private Sub Chance(sender As Object, e As EventArgs)
tim.Enabled = False
' your code for the computer's turn goes here
lblStatus.Text = "Your turn"
p11.Enabled = True
End Sub
Private Function IsHitByUser() As Boolean
' placeholder code for the actual check
If Rnd() < 0.5 Then
Return True
End If
Return False
End Function
Private Sub DoComputerTurn()
lblStatus.Text = "COMPUTER's TURN ... PLEASE WAIT ... "
p11.Enabled = False
tim.Enabled = True
End Sub
Private Sub p11_Click(sender As Object, e As EventArgs) Handles p11.Click
If IsHitByUser() Then
p11.Image = Image.FromFile(HitImgFile)
lblStatus.Text = "HIT"
Else
p11.Image = Image.FromFile(MissImgFile)
DoComputerTurn()
End If
End Sub
Private Sub StartGame()
lblStatus.Text = "Your turn"
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
SetUpTimer()
StartGame()
End Sub
End Class

VB.NET: Image as checkbox state box

Is it possible to use an image as the checkbox "checked" indicator square?
I know I can use a background image, but that goes behind the label aswell and also it is not possible (as far as I know) to align it.
How can I use an image instead of the square and leave the label and all other customization as they are?
Thanks in advance!
You look like this?
Dim frm As New Form
frm.Size = New Size(320, 200)
Dim iList As New ImageList
iList.Images.Add(Image.FromFile("check.png"), Color.White)
iList.Images.Add(Image.FromFile("uncheck.png"), Color.White)
Dim chk As New CheckBox
chk.Text = "Check Box With Image"
chk.AutoSize = False
chk.Size = New Size(350, 20)
chk.ImageList = iList
chk.ImageIndex = 1
chk.CheckAlign = ContentAlignment.MiddleRight
chk.ImageAlign = ContentAlignment.MiddleLeft
chk.TextImageRelation = TextImageRelation.ImageBeforeText
chk.Location = New Point(32, 32)
frm.Controls.Add(chk)
AddHandler chk.CheckStateChanged,
Sub(sender1 As Object, e1 As EventArgs)
chk.ImageIndex = IIf(chk.Checked, 0, 1)
End Sub
frm.ShowDialog()
UPDATE #1: Actually, #brahm solution's below is much better than mine!
UPDATE #2: Actually, it's not. Now I see how he did it: he's moving the checkbox out of sight by placing it way off the visible Form's area. Not a great solution...
The ideal solution would be to subclass the CheckBox control and do your own rendering by overriding the OnPaint method.
An easier, although probably messier solution, would be to place a PictureBox over the check box and control the image in the PictureBox through the CheckBox's CheckedChange event.
Another option:
You could still use the CheckBox in button mode (Appearance = Button), as you suggested, but then add a label right next to it.
Then, handle the Click event on the Label to toggle the Checked state of the CheckBox. Then end result should provide you exactly what you are looking for.
Imports System.Drawing
Imports System.Windows.Forms
Imports System.Windows.Forms.VisualStyles
Public Class ImageCheckBox
Public State As CheckBoxState = CheckBoxState.UncheckedNormal
Public Hot As Boolean = False
Public Pressed As Boolean = False
Public ImageDictionary As Dictionary(Of CheckBoxState, Image) = New Dictionary(Of CheckBoxState, Image)
Private Const PaddingModifier As Integer = 2
Sub New()
Me.New(New Dictionary(Of CheckBoxState, Image) From {
{CheckBoxState.CheckedDisabled, My.Resources.form_checkbox_checked},
{CheckBoxState.CheckedHot, My.Resources.form_checkbox_checked},
{CheckBoxState.CheckedNormal, My.Resources.form_checkbox_checked},
{CheckBoxState.CheckedPressed, My.Resources.form_checkbox_checked},
{CheckBoxState.UncheckedDisabled, My.Resources.form_checkbox_unchecked},
{CheckBoxState.UncheckedHot, My.Resources.form_checkbox_unchecked},
{CheckBoxState.UncheckedNormal, My.Resources.form_checkbox_unchecked},
{CheckBoxState.UncheckedPressed, My.Resources.form_checkbox_unchecked}})
End Sub
Sub New(imageDictionary As Dictionary(Of CheckBoxState, Image))
' This call is required by the designer.
InitializeComponent()
' Add any initialization after the InitializeComponent() call.
Me.ImageDictionary = imageDictionary
End Sub
Sub CheckBox_Paint(sender As Object, e As PaintEventArgs) Handles Me.Paint
'Return if the specific Image is not found
If Not ImageDictionary.ContainsKey(State) Then Return
'Get the Size of the CheckBox
Dim glyphSize As Size = CheckBoxRenderer.GetGlyphSize(e.Graphics, State)
'Get the Location of the CheckBox in relation to the Alignment of it
Dim glyphLocation As Point
Select Case Me.CheckAlign
Case Drawing.ContentAlignment.TopLeft
glyphLocation = New Point(Me.Padding.Left, Me.Padding.Top)
Exit Select
Case Drawing.ContentAlignment.TopCenter
glyphLocation = New Point(Me.Padding.Left + (Me.Width - glyphSize.Width) / 2, Me.Padding.Top)
Exit Select
Case Drawing.ContentAlignment.TopRight
glyphLocation = New Point(Me.Padding.Left + Me.Width - glyphSize.Width, Me.Padding.Top)
Exit Select
Case Drawing.ContentAlignment.MiddleLeft
glyphLocation = New Point(Me.Padding.Left, Me.Padding.Top + (Me.Height - glyphSize.Height) / 2)
Exit Select
Case Drawing.ContentAlignment.MiddleCenter
glyphLocation = New Point(Me.Padding.Left + (Me.Width - glyphSize.Width) / 2, Me.Padding.Top + (Me.Height - glyphSize.Height) / 2)
Exit Select
Case Drawing.ContentAlignment.MiddleRight
glyphLocation = New Point(Me.Padding.Left + Me.Width - glyphSize.Width, Me.Padding.Top + (Me.Height - glyphSize.Height) / 2)
Exit Select
Case Drawing.ContentAlignment.BottomLeft
glyphLocation = New Point(Me.Padding.Left, Me.Padding.Top + Me.Height - glyphSize.Height)
Exit Select
Case Drawing.ContentAlignment.BottomCenter
glyphLocation = New Point(Me.Padding.Left + (Me.Width - glyphSize.Width) / 2, Me.Padding.Top + Me.Height - glyphSize.Height)
Exit Select
Case Drawing.ContentAlignment.BottomRight
glyphLocation = New Point(Me.Padding.Left + Me.Width - glyphSize.Width, Me.Padding.Top + Me.Height - glyphSize.Height)
Exit Select
End Select
'Set the drawing Area
Dim glyphRectangle As Rectangle = New Rectangle(glyphLocation, glyphSize)
'Enlarge the Rectangle to completely hide default symbol
Dim clearRectangle As Rectangle = New Rectangle(glyphLocation.X - PaddingModifier,
glyphLocation.Y - PaddingModifier,
glyphSize.Width + 2 * PaddingModifier,
glyphSize.Height + 2 * PaddingModifier)
'Draw the Parent Background over the default CheckBox to clear it
CheckBoxRenderer.DrawParentBackground(e.Graphics, clearRectangle, Me)
Debug.WriteLine(State)
'Finally draw the custom CheckBox image on the position of the default one
e.Graphics.DrawImage(ImageDictionary(State), glyphRectangle)
End Sub
Sub CheckBox_MouseClick(sender As Object, e As EventArgs) Handles Me.MouseClick
Me.Checked = Not Me.Checked
End Sub
Sub CheckBox_MouseDown(sender As Object, e As MouseEventArgs) Handles Me.MouseDown
Me.Pressed = True
End Sub
Sub CheckBox_MouseUp(sender As Object, e As MouseEventArgs) Handles Me.MouseUp
Me.Pressed = False
End Sub
Sub CheckBox_MouseEnter(sender As Object, e As EventArgs) Handles Me.MouseEnter
Me.Hot = True
End Sub
Sub CheckBox_MouseLeave(sender As Object, e As EventArgs) Handles Me.MouseLeave
Me.Hot = False
End Sub
Public Sub updateState() Handles Me.MouseClick, Me.MouseDown, Me.MouseUp, Me.MouseEnter, Me.MouseLeave, Me.EnabledChanged
Debug.WriteLine(Me.Checked & " " & Me.Enabled & " " & Me.Hot & " " & Me.Pressed)
Me.State = CurrentState()
Me.Refresh()
Debug.WriteLine(State)
End Sub
Public Function CurrentState() As CheckBoxState
If (Me.Checked) Then
If (Not Me.Enabled) Then Return CheckBoxState.CheckedDisabled
If (Me.Pressed) Then Return CheckBoxState.CheckedPressed
If (Me.Hot) Then Return CheckBoxState.CheckedHot
Return CheckBoxState.CheckedNormal
Else
If (Not Me.Enabled) Then Return CheckBoxState.UncheckedDisabled
If (Me.Pressed) Then Return CheckBoxState.UncheckedPressed
If (Me.Hot) Then Return CheckBoxState.UncheckedHot
Return CheckBoxState.UncheckedNormal
End If
End Function
End Class
I also had this problem with a mute/unmute audiotrack i first went for the CheckBox but deceided to just use the PictureBox click event and used .location to get the New Point overlay the other PictureBox and enable the visibility of the one or the other box, works fine for a complete newb that i am :-)
Picture of the PictureBox in the Designer
Private Sub PictureBoxMute_Click(sender As Object, e As EventArgs) Handles PictureBoxMute.Click
PictureBoxMute.Visible = False
PictureBoxUnmute.Location = New Point(590, 433)
PictureBoxUnmute.Visible = True
Volume = 0
myplayer.Volume = Volume
End Sub
Private Sub PictureBoxUnmute_Click(sender As Object, e As EventArgs) Handles PictureBoxUnmute.Click
PictureBoxUnmute.Visible = False
PictureBoxMute.Visible = True
Volume = 1
myplayer.Volume = Volume
End Sub