How to use roscolor() but to ignore value (like empty cell) ?
I color row if value is upper than 5 but when there is nothing in the cell, i want to ignore the roscolor() apply, how?
Public Sub RosColor()
For i As Integer = 0 To QuoteDataGridView1.Rows.Count() - 1 Step +1
Dim val As Integer
val = QuoteDataGridView1.Rows(i).Cells(3).Value
If val = vbEmpty Then
QuoteDataGridView1.Rows(i).DefaultCellStyle.BackColor = Color.White
ElseIf val < 5 Then
QuoteDataGridView1.Rows(i).DefaultCellStyle.BackColor = Color.Red
ElseIf val > 5 And val < 10 Then
QuoteDataGridView1.Rows(i).DefaultCellStyle.BackColor = Color.LightYellow
End If
Next
End Sub
you can check for the empty value as following
Public Sub RosColor()
For i As Integer = 0 To QuoteDataGridView1.Rows.Count() - 1 Step +1
Dim val = QuoteDataGridView1.Rows(i).Cells(3).Value
If IsDBNull(val) or val Is Nothing Then
QuoteDataGridView1.Rows(i).DefaultCellStyle.BackColor = Color.White
ElseIf CInt(val) < 5 Then
QuoteDataGridView1.Rows(i).DefaultCellStyle.BackColor = Color.Red
ElseIf CInt(val) > 5 And CInt(val) < 10 Then
QuoteDataGridView1.Rows(i).DefaultCellStyle.BackColor = Color.LightYellow
End If
Related
I'm trying to add Items to my item list then load images in the inventory but keep ending up with this error and I'm not sure why. I'm making a game which uses visual basic and forms.
Public Class InvInterface
Public ItemMax As Integer = 9 'Number of inventory slots
Public Items As New List(Of Items)
Public Sub Add(Newitem As Items)
If Items.Count <= ItemMax Then
For Each I As Items In Items
If I.Name = Newitem.Name Then
If I.IsStackable = True And I.ItemCount < 16 Then
I.ItemCount += 1
Exit Sub
Else
Items.Add(Newitem)
Exit Sub
End If
End If
Next
Items.Add(Newitem)
End If
End Sub
Public Sub Remove(ItemID As Items)
If Items.Item(Items.IndexOf(ItemID)).ItemCount > 0 Then
Items.Item(Items.IndexOf(ItemID)).ItemCount -= 1
Else
Items.RemoveAt(Items.IndexOf(ItemID))
End If
End Sub
Public Sub UpdateInv()
For i = 1 To ItemMax
If 0 < Items.Count Then
Select Case i
Case 1
Inv11.Image = Items(i).ImageAsset
Case 2
Inv12.Image = Items(i).ImageAsset
Case 3
Inv13.Image = Items(i).ImageAsset
Case 4
Inv21.Image = Items(i).ImageAsset
Case 5
Inv22.Image = Items(i).ImageAsset
Case 6
Inv23.Image = Items(i).ImageAsset
Case 7
Inv31.Image = Items(i).ImageAsset
Case 8
Inv32.Image = Items(i).ImageAsset
Case 9
Inv33.Image = Items(i).ImageAsset
End Select
End If
Next
End Sub
Dim Cobblestone As New Items
Dim WoodPlank As New Items
Dim currancy As New Items
Dim Flower As New Items
Dim CactusPlant As New Items
Public Sub initialiseItems()
With cobblestone
.Item = ItemClass.Blocks
.Name = "Stone"
.Description = "Comes from the ground made from rock"
.IsStackable = True
.ImageAsset = My.Resources.Stone
End With
With WoodPlank
.Item = ItemClass.Blocks
.Name = "Wood"
.Description = "Wood planks can be used to create structures"
.IsStackable = True
.ImageAsset = My.Resources.Wood
End With
With Flower
.Item = ItemClass.Usable
.Name = "Flowers"
.Description = "Gives small health boost"
.IsStackable = True
.ImageAsset = My.Resources.HumanBrainIcon
End With
With currancy
.Item = ItemClass.Specials
.Name = "Gold Coin"
.Description = "These can be used at a merchant shop or casino"
.IsStackable = True
.ImageAsset = My.Resources.Coin
End With
With CactusPlant
.Item = ItemClass.Usable
.Name = "Cactus"
.Description = "Gives a substantial health boost"
.IsStackable = True
.ImageAsset = My.Resources.Florance
End With
End Sub
Lists Indexes goes from 0 to Lenght -1 so in
Public Sub UpdateInv()
you need to change the for loop to:
For i = 0 To ItemMax -1
and in the selectCase
Select Case (i-1)
or each case to 0 based index (start in 0 and go to 8)
I have a problem with my blackjack game in vb.net. This code I have will add the player's score perfectly, but when it comes to the dealer's score, it will not. It only takes the second card that the dealer has.
It is called with this:
addScore("p") 'add player's score
addScore("d") 'add dealer's score
And this is "addScore()":
Public Function card(player As String, index As Integer) As Label
Try
If player = "p" Then
Return GroupBox1.Controls.OfType(Of Label).Where(Function(l) l.Name = "YouCard" & index.ToString()).Single()
ElseIf player = "d" Then
Return GroupBox1.Controls.OfType(Of Label).Where(Function(l) l.Name = "DealerCard" & index.ToString()).Single()
End If
Catch
Return Nothing
End Try
End Function
Public Sub addScore(ByVal player As String)
Dim currScore As Integer
Dim result As Integer = 0
'Add Score
For value As Integer = 1 To 7
If card(player, value).Text = "A" AndAlso (currScore + 11) <= 21 Then
result = currScore + 11
ElseIf card(player, value).Text = "A" AndAlso (currScore + 1) <= 22 Then
result = currScore + 1
ElseIf IsNumeric(card(player, value).Text) Then
result = currScore + CInt(card(player, value).Text)
ElseIf card(player, value).Text = "" Then
result = result
Else
result = currScore + 10
End If
If player = "p" Then
YouScore.Text = result
Else
DealerScore.Text = result
End If
Next
End Sub
currScore shouldn't be there. Replace it with result
Public Sub addScore(ByVal player As String)
Dim result As Integer = 0
'Add Score
For value As Integer = 1 To 7
If card(player, value).Text = "A" AndAlso (result + 11) <= 21 Then
result = result + 11
ElseIf card(player, value).Text = "A" AndAlso (result + 1) <= 22 Then
result = result + 1
ElseIf IsNumeric(card(player, value).Text) Then
result = result + CInt(card(player, value).Text)
ElseIf card(player, value).Text = "" Then
result = result
Else
result = result + 10
End If
If player = "p" Then
YouScore.Text = result
Else
DealerScore.Text = result
End If
Next
End Sub
Please help me in shortening the following code:
If Val(TB.Text) = 0 Then
OvalShape1.BackColor = Color.Gray
ElseIf Val(TB.Text) = 1 Then
OvalShape1.BackColor = Color.Lime
ElseIf Val(TB.Text) = 2 Then
OvalShape1.BackColor = Color.Red
ElseIf Val(TB.Text) = 3 Then
OvalShape1.BackColor = Color.White
End If
This would do it:
Dim colors As System.Drawing.Color() = {Color.Gray, Color.Lime, Color.Red, Color.White}
OvalShape1.BackColor = colors(Val(TB.Text))
But it is better to add some validation to cover for invalid inputs in TB.Text that would lead to runtime errors. Here is longer, but better code:
Dim colors As System.Drawing.Color() = {Color.Gray, Color.Lime, Color.Red, Color.White}
Dim value as Integer
value = Val(TB.Text)
If value >= 0 And value <= colors.GetUpperBound(0) Then
OvalShape1.BackColor = colors(value)
End If
I have a procedure that should check the background colour of a selection of cells, and depending on the colour output a value and then colour the text to match the background.
However, every time this procedure is run, I get the following error. This also causes Excel to freeze, meaning that I have to close and reopen it (simply ending the macro doesn't stop that behavior) -
Run-time error '-2147417847 (80010108)':
Method 'ThemeColor' of object 'Font' failed
Can anyone help me find what I am doing wrong? Thanks.
Private Sub AssignBackgroundValue(ByVal Target As Range)
Dim val As Integer
Dim c As Range
For Each c In Target.Cells
With c.Interior
Select Case Target.Interior.ThemeColor
Case xlThemeColorAccent6
val = 1
Case xlThemeColorAccent5
val = 2
Case xlThemeColorAccent4
val = 3
Case xlThemeColorAccent3
val = 4
Case xlThemeColorAccent2
val = 5
Case xlThemeColorDark1
val = 6
Case xlThemeColorLight1
val = 7
End Select
c.Font.ThemeColor = IIf(VarType(.ThemeColor) = vbLong, .ThemeColor, 0)
c.Font.TintAndShade = IIf(VarType(.TintAndShade) = vbDouble, .TintAndShade, 0)
End With
c.value = val
Next
End Sub
You need to consider cases when you are using standard colors and no fill so:
Private Sub AssignBackgroundValue(ByVal Target As Range)
Dim val As Integer
Dim c As Range
For Each c In Target.Cells
With c.Interior
If IsError(Target.Interior.ThemeColor) Then
c.Font.PatternTintAndShade = 0
Else
Select Case Target.Interior.ThemeColor
Case xlThemeColorAccent6
val = 1
Case xlThemeColorAccent5
val = 2
Case xlThemeColorAccent4
val = 3
Case xlThemeColorAccent3
val = 4
Case xlThemeColorAccent2
val = 5
Case xlThemeColorDark1
val = 6
Case xlThemeColorLight1
val = 7
Case 0
val = 0
End Select
If val <> 0 Then
c.Font.ThemeColor = IIf(VarType(.ThemeColor) = vbLong, .ThemeColor, 0)
Else
c.Font.Color = IIf(VarType(.ThemeColor) = vbLong, .Color, 0)
End If
c.Font.TintAndShade = IIf(VarType(.TintAndShade) = vbDouble, .TintAndShade, 0)
End If
End With
c.Value = val
Next
End Sub
Here's basically what I have:
Public checkprogresstime_p1 As String = ""
Public checkprogresstime_p2 As String = ""
'P1 Progress bar updater
checkprogresstime_p1 = (time_total.Text - time_p1_hour.Value)
If checkprogresstime_p1 >= 60 Then
checkprogresstime_p1 = 60
time_p1_progress.ForeColor = Color.LimeGreen
ElseIf checkprogresstime_p1 <= 0 Then
checkprogresstime_p1 = 1
End If
If time_p1_progress.Value < 60 Then
time_p1_progress.ForeColor = Color.Red
End If
time_p1_progress.Value = checkprogresstime_p1
Here's basically what I need:
Dim cnt As Integer = 1
Do
'P1 Progress bar updater
checkprogresstime_p(cnt) = (time_total.Text - time_p(cnt)_hour.Value)
If checkprogresstime_p(cnt) >= 60 Then
checkprogresstime_p(cnt) = 60
time_p(cnt)_progress.ForeColor = Color.LimeGreen
ElseIf checkprogresstime_p(cnt) <= 0 Then
checkprogresstime_p(cnt) = 1
End If
If time_p(cnt)_progress.Value < 60 Then
time_p(cnt)_progress.ForeColor = Color.Red
End If
time_p(cnt)_progress.Value = checkprogresstime_p(cnt)
Loop While cnt <= 25
I have no idea how to do it... I need it to loop and add +1, 25 times. I basically have it written out 25 times at the moment...
This is the For/Loop with your current request. The cnt variable will increment itself in this type of Loop.
For cnt As Integer = 1 To 25
'P1 Progress bar updater
checkprogresstime_p(cnt) = (time_total.Text - time_p(cnt)_hour.Value)
If checkprogresstime_p(cnt) >= 60 Then
checkprogresstime_p(cnt) = 60
time_p(cnt)_progress.ForeColor = Color.LimeGreen
ElseIf checkprogresstime_p(cnt) <= 0 Then
checkprogresstime_p(cnt) = 1
End If
If time_p(cnt)_progress.Value < 60 Then
time_p(cnt)_progress.ForeColor = Color.Red
End If
time_p(cnt)_progress.Value = checkprogresstime_p(cnt)
Next
I believe what you're wanting to do has more to do with having 25 progress bars on your form where each one is named time_p#_progress where # is the number of the progress bar. That being said, there are two ways to acheive updating your progress bars without having to copy and paste your code 25 times...
1. Use Me.Controls to get a reference to the progress bar
For j = 1 To 25
Dim pbar As ProgressBar = Me.Controls("time_p" & j & "_progress")
Dim ph As NumericUpDown = Me.Controls("time_p" & j & "_hour")
Dim checkprogresstime As Long = (time_total.Text - ph.Value)
If checkprogresstime >= 60 Then
checkprogresstime = 60
pbar.ForeColor = Color.LimeGreen
ElseIf checkprogresstime <= 0 Then
checkprogresstime = 1
End If
If time_p1_progress.Value < 60 Then
pbar.Value = checkprogresstime
End If
pbar.Value = checkprogresstime
Application.DoEvents()
Next
Note: You didn't tell us what type of control time_p1_hour was. I assumed it was a NumericUpDown down control. So, if it's not, you need to replace it the type of control that time_p1_hour is.
2. Dynamically create your controls as a control array
Initizliaze your progress bars in the Form1_Load method (MyBase.Load)
Private pbars(24) As ProgressBar
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
For i = LBound(pbars) To UBound(pbars)
pbars(i) = New ProgressBar()
pbars(i).Parent = Me
pbars(i).Top = i * pbars(i).Height
pbars(i).Left = 0
pbars(i).Visible = True
Next
End Sub
Put your code inside of a loop like so
For cnt = 0 To 24
checkprogresstime_p(cnt) = (time_total.Text - time_hour(cnt).Value)
If checkprogresstime_p(cnt) >= 60 Then
checkprogresstime_p(cnt) = 60
time_p_progress(cnt).ForeColor = Color.LimeGreen
ElseIf checkprogresstime_p(cnt) <= 0 Then
checkprogresstime_p(cnt) = 1
End If
If time_p_progress(cnt).Value < 60 Then
time_p_progress(cnt).ForeColor = Color.Red
End If
time_p_progress(cnt).Value = checkprogresstime_p(cnt)
Next