Add or Update data in Checkbox + Radiobutton Visual basic - vba

Okay, this is my problem; I have code like this:
Private Sub process_Click(sender As Object, e As EventArgs) Handles hitung.Click
If radiobuttonplus.Checked = True Then
Me.h1.Text = Val(txt1.Text) + Val(txt5.Text)
Me.h2.Text = Val(txt2.Text) + Val(txt6.Text)
Me.h3.Text = Val(txt3.Text) + Val(txt7.Text)
Me.h4.Text = Val(txt4.Text) + Val(txt8.Text)
result = (h1.Text * h4.Text) - (h2.Text * h3.Text)
resultdeterminan.Text = result
ElseIf checkboxadjoint.Checked = True Then
Me.a1.Text = 1 * (Val(Me.h4.Text))
Me.a2.Text = -1 * (Val(Me.h3.Text))
Me.a3.Text = -1 * (Val(Me.h2.Text))
Me.a4.Text = 1 * (Val(Me.h1.Text))
result = (a1.Text * a4.Text) - (a2.Text * a3.Text)
resultdeterminan.Text = result
resultadjoint.Text = result
End if
End Sub
As you can see, radiobuttonplus has data underneath it and checkbuttonadjoint also has data below it.
I use checkbuttonadjoint to update data from radiobuttonplus.
Initially, there were no problems regarding radiobuttonplus, because I tried to successfully display all the data in radiobuttonplus; however, the problem arose when I clicked radiobutton + ticked checkbuttonadjoint. The data in checkbuttonadjoint is not displayed and does not update the data from radiobuttonplus.

Because you have ElseIf, when the first If is executed the second block will never be executed. If you want both to execute then change ElseIf to simply If. You'll need to add an End If before that to close off the first block.
So when you're all done, it'd look like this:
Private Sub process_Click(sender As Object, e As EventArgs) Handles hitung.Click
If radiobuttonplus.Checked = True Then
Me.h1.Text = Val(txt1.Text) + Val(txt5.Text)
Me.h2.Text = Val(txt2.Text) + Val(txt6.Text)
Me.h3.Text = Val(txt3.Text) + Val(txt7.Text)
Me.h4.Text = Val(txt4.Text) + Val(txt8.Text)
result = (h1.Text * h4.Text) - (h2.Text * h3.Text)
resultdeterminan.Text = result
End If
If checkboxadjoint.Checked = True Then
Me.a1.Text = 1 * (Val(Me.h4.Text))
Me.a2.Text = -1 * (Val(Me.h3.Text))
Me.a3.Text = -1 * (Val(Me.h2.Text))
Me.a4.Text = 1 * (Val(Me.h1.Text))
result = (a1.Text * a4.Text) - (a2.Text * a3.Text)
resultdeterminan.Text = result
resultadjoint.Text = result
End If
End Sub

Related

How can you make random movement?

I'm doing a simple pacman project on vb.net, and I've come across a great difficulty: how can I make a ghost move randomly, without seeming it is trying to move everywhere at once, which looks like it's spasming?
What I wanted was:
To move the ghost in a random direction (up, left, right or down) and keep that direction until it hits a wall;
When it did hit a wall, determin where it could move, and from the possibilities, choose one and keep that movement until it would hit another wall;
So basically, a loop of that. I'm guessing I definitely need a timer and a loop structure.
This is a picture of the "map":
For example, I've tried this and it doesn't work:
Dim direction As movementdirection
Dim ghostlocation As Point
Dim currentLocation As Point
Dim random As New Random
Public Enum Movementdirection
Up = 1
Down = 2
Left = 3
Right = 4
End Enum
Private Sub redtimer_Tick(sender As Object, e As EventArgs) Handles redtimer.Tick
direction = DirectCast(random.Next(1, 5), Movementdirection)
Select Case direction
Case Movementdirection.Down
red.Top += 2
Case Movementdirection.Up
red.Top -= 2
Case Movementdirection.Left
red.Left -= 2
Case Movementdirection.Right
red.Left += 2
End Select
direction = DirectCast(random.Next(1, 5), Movementdirection
End Sub
Public Function DetectCollection(ByVal red As PictureBox) As Boolean
For Each wall As PictureBox In WallList
If red.Bounds.IntersectsWith(wall.Bounds) Then
direction = DirectCast(random.Next(1, 5), Movementdirection)
End If
Next
ghostlocation = red.Location
Return False
End Function
I've also tried this and didn't work that well, he also spasms.
Private Sub redtimer_Tick(sender As Object, e As EventArgs) Handles redtimer.Tick
Select Case direction
Case Movementdirection.Down
red.Top += 2
Case Movementdirection.Up
red.Top -= 2
Case Movementdirection.Left
red.Left -= 2
Case Movementdirection.Right
red.Left += 2
End Select
num = Int((4 * Rnd()) + 1)
If num = 1 Then
direction = Movementdirection.Down
End If
If num = 2 Then
direction = Movementdirection.Left
End If
If num = 3 Then
direction = Movementdirection.Right
End If
If num = 4 Then
direction = Movementdirection.Up
End If
If Not WallList.Any(Function(wall) wall.Bounds.IntersectsWith(New Rectangle(location:=New Point(red.Location.X, (red.Location.Y + 2)), size:=red.Size))) Then
red.Location = New Point(red.Location.X, (red.Location.Y + 2))
Else
End If
If Not WallList.Any(Function(wall) wall.Bounds.IntersectsWith(New Rectangle(location:=New Point(red.Location.X, (red.Location.Y - 2)), size:=red.Size))) Then
red.Location = New Point(red.Location.X, (red.Location.Y - 2))
End If
If Not WallList.Any(Function(wall) wall.Bounds.IntersectsWith(New Rectangle(location:=New Point((red.Location.X + 2), red.Location.Y), size:=red.Size))) Then
red.Location = New Point(red.Location.X + 2, red.Location.Y)
End If
If Not WallList.Any(Function(wall) wall.Bounds.IntersectsWith(New Rectangle(location:=New Point(red.Location.X - 2, red.Location.Y), size:=red.Size))) Then
red.Location = New Point((red.Location.X - 2), red.Location.Y)
End If
End Sub

Exception Thrown - Receive data from Arduino to Visual Basic

I'm trying to send serial data from Arduino and read it on Visual Basic. When I execute the code sometimes works and sometimes doesn't: throwing exception, System.ArgumentOutOfRangeException: 'Index and length must refer to a location within the string. Can you help me?
I'm new to Visual Basic, thanks.
Imports System.IO
Imports System.IO.Ports
Imports System.Threading
Public Class Form1
Dim TWSL, TWAL, THL, AoAL, WAL, PeL, RoilL, RyL, RydL As Integer
Dim TWS, TWA, TH, AoA, WA, Pe, Roil, Ry, Ryd, TWSResult, TWAResult, THResult, AoAResult, WAResult, PeResult, RoilResult, RyResult, RydResult As String
Dim StrSerialIn, StrSerialInRam As String
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Me.CenterToParent()
SerialPort1.PortName = "COM4"
SerialPort1.BaudRate = 9600
SerialPort1.Open()
Timer1.Start()
SerialPort1.Write(TrackBarAWA.Value & Chr(10))
End Sub
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
Try
StrSerialIn = SerialPort1.ReadExisting
Dim TB As New TextBox
TB.Multiline = True
TB.Text = StrSerialIn
If TB.Lines.Count > 0 Then
If TB.Lines(0) = "Failed to read" Then
Timer1.Stop()
SerialPort1.Close()
Return
End If
StrSerialInRam = TB.Lines(0).Substring(0, 2)
If StrSerialInRam = "A" Then
TWS = TB.Lines(0)
TWSL = TWS.Length
Else
TWS = TWS
End If
StrSerialInRam = TB.Lines(1).Substring(0, 3)
If StrSerialInRam = "B" Then
TWA = TB.Lines(1)
TWAL = TWA.Length
Else
TWA = TWA
End If
StrSerialInRam = TB.Lines(2).Substring(0, 3)
If StrSerialInRam = "C" Then
TH = TB.Lines(2)
THL = TH.Length
Else
TH = TH
End If
StrSerialInRam = TB.Lines(3).Substring(0, 2)
If StrSerialInRam = "D" Then
AoA = TB.Lines(3)
AoAL = AoA.Length
Else
AoA = AoA
End If
StrSerialInRam = TB.Lines(4).Substring(0, 1)
If StrSerialInRam = "E" Then
WA = TB.Lines(4)
WAL = WA.Length
Else
WA = WA
End If
StrSerialInRam = TB.Lines(5).Substring(0, 3)
If StrSerialInRam = "F" Then
Pe = TB.Lines(5)
PeL = Pe.Length
Else
Pe = Pe
End If
StrSerialInRam = TB.Lines(6).Substring(0, 3)
If StrSerialInRam = "G" Then
Roil = TB.Lines(6)
RoilL = Roil.Length
Else
Roil = Roil
End If
StrSerialInRam = TB.Lines(7).Substring(0, 3)
If StrSerialInRam = "H" Then
Ry = TB.Lines(7)
RyL = Ry.Length
Else
Ry = Ry
End If
StrSerialInRam = TB.Lines(8).Substring(0, 3)
If StrSerialInRam = "I" Then
Ryd = TB.Lines(8)
RydL = Ryd.Length
Else
Ryd = Ryd
End If
TWSResult = Mid(TWS, 2, TWSL)
TWAResult = Mid(TWA, 2, TWAL)
THResult = Mid(TH, 2, THL)
AoAResult = Mid(AoA, 2, AoAL)
WAResult = Mid(WA, 2, WAL)
PeResult = Mid(Pe, 2, PeL)
RoilResult = Mid(Roil, 2, RoilL)
RyResult = Mid(Ry, 2, RyL)
RydResult = Mid(Ryd, 2, RydL)
TWSvalue.Text = TWSResult
TWAvalue.Text = TWAResult
THvalue.Text = THResult
AoAvalue.Text = AoAResult
WAvalue.Text = WAResult
PeValue.Text = PeResult
RoilValue.Text = RoilResult
RyValue.Text = RyResult
RydValue.Text = RydResult
From what I gather, you are trying to get characters from specific places in specific lines on a text box. Based on the error message you included in your question, I assume the error occurs on a line of code containing the "String. Substring" method. If the string where you are getting the substring from is too short to cover the range you have specified in the substring method, you will get this error. For instance, if you are getting a substring that's 3 characters long from line 2 starting at character 0 and it has less than 3 characters, you will get this error.
See the documentation on the String.Substring method here

'System.ArgumentOutOfRangeException'"Tried the other solution but never gotten to the point of resolving" [duplicate]

This question already has answers here:
What is an IndexOutOfRangeException / ArgumentOutOfRangeException and how do I fix it?
(5 answers)
Closed 2 years ago.
i've tried the other solution(like changing item that should be shown on data) but i think i've never gotten the point to resolving. Thank you in advance whoever can answer my problem...
Private Sub dgEmp_Click(sender As Object, e As EventArgs) Handles dgEmp.Click
LoadEmployeeInfo(dgEmp.SelectedRows.Item(0).Index)
End Sub
Private Sub LoadEmployee(Optional q As String = "")
list.Query = "Select id,lastname,firstname,middlename,sss,philh,pag,rate,cola,mStatus,free_insurance,mp,mpvalue from tblemployee where (lastname like'%" & q & "%' or firstname like'%" & q & "%' or middlename like'%" & q & "%') and deactive='No' order by lastname,firstname,middlename"
list.datagrid = dgEmp
list.LoadRecords()
If list.RecordCount = Nothing Then Exit Sub
LoadEmployeeInfo(dgEmp.SelectedRows.Item(0).Index)
End Sub
Public Sub LoadEmployeeInfo(index As Integer)
With dgEmp.Rows(index)
id = .Cells(0).Value
lblName.Text = .Cells(1).Value & ", " & .Cells(2).Value & " " & .Cells(3).Value
rpd = .Cells(7).Value
lblRate.Text = Format(rpd, "#,##0.000000000")
cola = .Cells(8).Value
lblAllo.Text = Format(cola, "#,##0.000000000")
otrate = (rpd / 8) * 1.25
lblOTRate.Text = Format(otrate, "#,##0.000000000")
IsSSS = ConvertToBoolean(.Cells(4).Value)
IsPH = ConvertToBoolean(.Cells(5).Value) 'add
IsPAG = ConvertToBoolean(.Cells(6).Value) 'pos
IsMP = ConvertToBoolean(.Cells(11).Value)
IsFI = ConvertToBoolean(.Cells(10).Value)
CStatus = .Cells(9).Value
MPV = .Cells(12).Value
End With
ThisPayroll.Query = "Select * from tblpayroll where payrollperiod=? and empid=?"
ThisPayroll.AddParam("#payrollperiod", GetPeriod)
ThisPayroll.AddParam("#empid", id)
ThisPayroll.ExecQuery()
If ThisPayroll.RecordCount = Nothing Then
isUpdate = False
txtReg_Days.Text = 0
txtReg_OT.Text = 0
txtSP_Days.Text = 0
txtSP_OT.Text = 0
txtHoliday.Text = 0
txtHolidayOT.Text = 0
txtLate.Text = 0
txtAdjustment.Text = 0
txtSSSL.Text = 0
txtHDMFL.Text = 0
txtCA.Text = 0
txtDMA.Text = 0
txtRice.Text = 0
txtCloth.Text = 0
txtEmpMed.Text = 0
txtLaundry.Text = 0
txtMeal.Text = 0
Else
With ThisPayroll.DataSource
isUpdate = True
txtReg_Days.Text = .Rows(0)("regday")
txtReg_OT.Text = .Rows(0)("ot")
txtSP_Days.Text = .Rows(0)("spday")
txtSP_OT.Text = .Rows(0)("spdayot")
txtHoliday.Text = .Rows(0)("lholiday")
txtHolidayOT.Text = .Rows(0)("lhot")
txtLate.Text = .Rows(0)("hlate")
txtAdjustment.Text = .Rows(0)("salary_adj")
txtSSSL.Text = .Rows(0)("sss_loan")
txtHDMFL.Text = .Rows(0)("pag_loan")
txtCA.Text = .Rows(0)("cash_advance")
txtDMA.Text = .Rows(0)("depmed")
txtRice.Text = .Rows(0)("ricesub")
txtCloth.Text = .Rows(0)("clothing")
txtEmpMed.Text = .Rows(0)("empmed")
txtLaundry.Text = .Rows(0)("laundry")
txtMeal.Text = .Rows(0)("meal")
End With
End If
Compute()
End Sub
If you cannot make sure that something is selected elsewhere, you can last-minute check it like this:
Private Sub DataGridView1_SelectionChanged(sender As Object, e As EventArgs) Handles DataGridView1.SelectionChanged
If dgEmp.SelectedRows.Count > 0 Then
LoadEmployeeInfo(dgEmp.SelectedRows.Item(0).Index)
End If
End Sub
It works only because you're using index zero, or else you would have to be careful for your index, too. Of course, this is assuming that dgEmp is not Nothing...
Also, notice that I attached this to the SelectionChanged event, as I don't think that the Click event will give you what you want, but I'll let that part for you to deal with. Have fun!

VB.Net War Game

I have been working on a "WAR" card game in class. I seem to have most of it setup correctly, however, I am having some issues dealing 2 new cards to the image boxes when clicking the deal button.
The exact things I need the draw button to accomplish is
When the draw button is pressed, the first two cards from the shuffled deck
should show up, one on the left and one on the right side. The middle card will be the
“Left win”, “Right Win”, or “Tie” image and is correctly indicate who won (with the higher
card). Furthermore, the winner’s score should increase by 1 point.
I will include a screenshot of my form to give you an idea of what I am working with and where I should go with the deal button. My guess is when I click the deal button a second time it is resetting the values back to 0 and 26 respectively.
enter image description here
Public Class Form1
'WAR
Dim cardarray(52) As Image
Dim valuearray(52) As Integer
Dim cardval1, cardval2 As Integer
Dim card1, card2 As Integer
Dim P1, P2 As Integer
Private Sub btnExit_Click(sender As Object, e As EventArgs) Handles btnExit.Click
Close()
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
pct1.Image = My.Resources.back
pct2.Image = My.Resources.back
pct3.Image = My.Resources.back
'Needed to generate a random number/card
Randomize()
'create 52 card element array
CardArray(0) = My.Resources.twoc
CardArray(1) = My.Resources.twod
CardArray(2) = My.Resources.twoh
CardArray(3) = My.Resources.twos
CardArray(4) = My.Resources.threec
CardArray(5) = My.Resources.threed
CardArray(6) = My.Resources.threeh
CardArray(7) = My.Resources.threes
CardArray(8) = My.Resources.fourc
CardArray(9) = My.Resources.fourd
CardArray(10) = My.Resources.fourh
CardArray(11) = My.Resources.fours
CardArray(12) = My.Resources.fivec
CardArray(13) = My.Resources.fived
CardArray(14) = My.Resources.fiveh
CardArray(15) = My.Resources.fives
CardArray(16) = My.Resources.sixc
CardArray(17) = My.Resources.sixd
CardArray(18) = My.Resources.sixh
CardArray(19) = My.Resources.sixs
CardArray(20) = My.Resources.sevenc
CardArray(21) = My.Resources.sevend
CardArray(22) = My.Resources.sevenh
CardArray(23) = My.Resources.sevens
CardArray(24) = My.Resources.eightc
CardArray(25) = My.Resources.eightd
CardArray(26) = My.Resources.eighth
CardArray(27) = My.Resources.eights
CardArray(28) = My.Resources.ninec
CardArray(29) = My.Resources.nined
CardArray(30) = My.Resources.nineh
CardArray(31) = My.Resources.nines
CardArray(32) = My.Resources.tenc
CardArray(33) = My.Resources.tend
CardArray(34) = My.Resources.tenh
CardArray(35) = My.Resources.tens
CardArray(36) = My.Resources.jackc
CardArray(37) = My.Resources.jackd
CardArray(38) = My.Resources.jackh
CardArray(39) = My.Resources.jacks
CardArray(40) = My.Resources.queenc
CardArray(41) = My.Resources.queend
CardArray(42) = My.Resources.queenh
CardArray(43) = My.Resources.queens
CardArray(44) = My.Resources.kingc
CardArray(45) = My.Resources.kingd
CardArray(46) = My.Resources.kingh
CardArray(47) = My.Resources.kings
CardArray(48) = My.Resources.acec
CardArray(49) = My.Resources.aced
CardArray(50) = My.Resources.aceh
CardArray(51) = My.Resources.aces
'52 integer value array
valueArray(0) = 1
valueArray(1) = 1
valueArray(2) = 1
valueArray(3) = 1
valueArray(4) = 2
valueArray(5) = 2
valueArray(6) = 2
valueArray(7) = 2
valueArray(8) = 3
valueArray(9) = 3
valueArray(10) = 3
valueArray(11) = 3
valueArray(12) = 4
valueArray(13) = 4
valueArray(14) = 4
valueArray(15) = 4
valueArray(16) = 5
valueArray(17) = 5
valueArray(18) = 5
valueArray(19) = 5
valueArray(20) = 6
valueArray(21) = 6
valueArray(22) = 6
valueArray(23) = 6
valueArray(24) = 7
valueArray(25) = 7
valueArray(26) = 7
valueArray(27) = 7
valueArray(28) = 8
valueArray(29) = 8
valueArray(30) = 8
valueArray(31) = 8
valueArray(32) = 9
valueArray(33) = 9
valueArray(34) = 9
valueArray(35) = 9
valueArray(36) = 10
valueArray(37) = 10
valueArray(38) = 10
valueArray(39) = 10
valueArray(40) = 11
valueArray(41) = 11
valueArray(42) = 11
valueArray(43) = 11
valueArray(44) = 12
valueArray(45) = 12
valueArray(46) = 12
valueArray(47) = 12
valueArray(48) = 13
valueArray(49) = 13
valueArray(50) = 13
valueArray(51) = 13
End Sub
Public Sub shuffel()
Dim switch As Integer
Dim tempcard As Image
Dim number_of_cards, tempval As Integer
number_of_cards = 52
'Go through the deck one card at a time:
For i = 0 To number_of_cards - 1
'Get a random card number from the deck
switch = Int(Rnd() * number_of_cards)
'Switch the current card’s value with the random card’s value
tempval = valuearray(i)
valuearray(i) = valuearray(switch)
valuearray(switch) = tempval
'Switch the current card’s image with the random card’s image
tempcard = cardarray(i)
cardarray(i) = cardarray(switch)
cardarray(switch) = tempcard
Next
End Sub
Private Sub BtnClear_Click(sender As Object, e As EventArgs) Handles BtnClear.Click
'shuffle deck and set scores to 0
Call shuffel()
txtP1.Text = 0
txtP2.Text = 0
End Sub
Private Sub TextBox2_TextChanged(sender As Object, e As EventArgs) Handles txtP2.TextChanged
End Sub
Private Sub btnShuffle_Click(sender As Object, e As EventArgs) Handles btnShuffle.Click
'shuffle deck and change card backs
Call shuffel()
pct1.Image = My.Resources.back
pct2.Image = My.Resources.back
pct3.Image = My.Resources.back
End Sub
Private Sub btnDraw_Click(sender As Object, e As EventArgs) Handles btnDraw.Click
'set interger values for starting points
cardval1 = 0
cardval2 = 26
'load those starting points into image boxes
pct1.Image = cardarray(cardval1)
pct3.Image = cardarray(cardval2)
'increase card values by 1
cardval1 = (cardval1 + 1)
cardval2 = (cardval2 + 1)
End Sub
End Class
I would think that you should move the part in btnDraw_Click where you are setting the starting points to btnShuffle_CLick and this would get what you are after?

vb6 to vb.net for OracleInProcServer.OraDynaset

I am converting a project which is coded in old vb6 way. I am replacing the instances of OracleInProcServer.OraDynaset to Datatable for getting the data from database. But a form is generated in a dynamic way has the below code. i don't know how be there a alternate code for there in vb.net. Is there any way I can replace the below code without using dsAnswer As OracleInProcServer.OraDynaset. I don't know what is ! here also and how it is working.
Dim dsAnswer As OracleInProcServer.OraDynaset
Select Case dsAnswer!Shape.Value
Case 0 To 5
iShapes = iShapes + 1
'Load(f!shpCtrl(iShapes))
frmDynaForm.shpCtrl.Load(iShapes)
frmDynaForm.shpCtrl(iShapes).FillColor = System.Drawing.Color.FromArgb(DecodeColorDesc(Format$(dsAnswer!Color.Value)))
'frmDynaForm.shpCtrl(iShapes).Shape = dsAnswer!Shape.Value
frmDynaForm.shpCtrl(iShapes).Top = dsAnswer!Top.Value
frmDynaForm.shpCtrl(iShapes).Left = dsAnswer!Left.Value
frmDynaForm.shpCtrl(iShapes).Height = dsAnswer!Height.Value
frmDynaForm.shpCtrl(iShapes).Width = dsAnswer!Width.Value
frmDynaForm.shpCtrl(iShapes).BorderWidth = dsAnswer!BorderWidth.Value
frmDynaForm.shpCtrl(iShapes).Visible = True
Case -1
iLines = iLines + 1
'Load(f!lineCtrl(iLines))
frmDynaForm.lineCtrl.Load(iShapes)
frmDynaForm.lineCtrl(iLines).BorderColor = System.Drawing.Color.FromArgb(DecodeColorDesc(Format$(dsAnswer!Color.Value)))
frmDynaForm.lineCtrl(iLines).Y1 = dsAnswer!Top.Value
frmDynaForm.lineCtrl(iLines).X1 = dsAnswer!Left.Value
frmDynaForm.lineCtrl(iLines).Y2 = dsAnswer!Height.Value
frmDynaForm.lineCtrl(iLines).X2 = dsAnswer!Width.Value
frmDynaForm.lineCtrl(iLines).BorderWidth = dsAnswer!BorderWidth.Value
frmDynaForm.lineCtrl(iLines).Visible = True
End Select