I am creating a program that prints the element of array one at a time (from top left to bottom right) using the timer control, however, it's not printing the elements one at a time, it prints all of them at the same time. I need help, below is a sample screenshot and my code so far.
Public Class SymbolDrawFRM
Private symbol(10, 10) As String
Sub Drawing()
Dim s As String = ""
For i = 1 To rowNUD.Value
For j = 1 To columnNUD.Value
s = s & symbol(i, j) & # & " "
Next
s = s & vbCrLf
Next
outputTBX.Text = s
End Sub
Private Sub startStopBTN_Click(sender As Object, e As EventArgs) Handles startStopBTN.Click
Timer.Start()
End Sub
Private Sub Timer_Tick(sender As Object, e As EventArgs) Handles Timer.Tick
Drawing()
End Sub
End Class
Ignoring the Array, and only using the NumericUpDown controls:
Private Sub startStop_Click(sender As Object, e As EventArgs) Handles startStop.Click
Timer1.Interval = 500
Timer1.Enabled = Not Timer1.Enabled
End Sub
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
Static x As Integer
Static y As Integer
If x = 0 And y = 0 Then
outputTBX.Clear()
End If
outputTBX.AppendText("# ")
x = x + 1
If x = columnNUD.Value Then
x = 0
outputTBX.AppendText(vbCrLf)
y = y + 1
If y = rowNUD.Value Then
x = 0
y = 0
Timer1.Stop()
MessageBox.Show("Done!")
End If
End If
End Sub
Related
I have THREE buttons on a form and would like to control the order in which they can be CLICKED based on an ever changing random number made up of 3 digits
I can control the click order as long as the random number does not change
As the code is now the random number is not being generated
I just change the random number to test
I understand what is needed is a valid test when clicking the buttons looked at using an Array not much luck
How to dynamically associate the position of the number in the String to control the buttons click order?
Private Sub btnAdd_Click()
ck = 0
GetPos
tbOne.Text = S1
End Sub
Private Sub GetPos()
Dim Y As Integer
S1 = "132" 'Random Number
For Y = 1 To Len(S1)
pos = Mid(S1, Y, 1) 'Position of Value in S1 the Random Number
lbOne.AddItem pos & vbNewLine
Next
End Sub
Private Sub btnOne_Click()
ck = ck + 1
If Mid(S1, 1, 1) = "1" And ck = 3 Then
btnOne.BackColor = vbYellow
Else
ck = 4
If btnOne.BackColor = vbYellow Then
Exit Sub
End If
btnOne.BackColor = vbRed
If btnOne.BackColor <> vbYellow Then
btnOne.Enabled = False
End If
End If
End Sub
Private Sub btnTwo_Click()
ck = ck + 1
If Mid(S1, 2, 1) = "3" And ck = 1 Then
btnTwo.BackColor = vbYellow
Else
ck = 4 ' Prevents other buttons from being Yellow
If btnTwo.BackColor = vbYellow Then
Exit Sub
End If
btnTwo.BackColor = vbRed
If btnTwo.BackColor <> vbYellow Then
btnTwo.Enabled = False
End If
End If
End Sub
Private Sub btnThree_Click()
ck = ck + 1
If Mid(S1, 3, 1) = "2" And ck = 2 Then
btnThree.BackColor = vbYellow
Else
ck = 4
If btnThree.BackColor = vbYellow Then
Exit Sub
End If
btnThree.BackColor = vbRed
If btnThree.BackColor <> vbYellow Then
btnThree.Enabled = False
End If
End If
End Sub
This seems to do what you need:
Private Sub btnOne_Click()
ck = ck + 1
If ck = Mid(S1, 1, 1) Then
btnOne.BackColor = vbYellow
Else
btnOne.BackColor = vbRed
btnOne.Enabled = False
End If
End Sub
Private Sub btnTwo_Click()
ck = ck + 1
If ck = Mid(S1, 2, 1) Then
btnTwo.BackColor = vbYellow
Else
btnTwo.BackColor = vbRed
btnTwo.Enabled = False
End If
End Sub
Private Sub btnThree_Click()
ck = ck + 1
If ck = Mid(S1, 3, 1) Then
btnThree.BackColor = vbYellow
Else
btnThree.BackColor = vbRed
btnThree.Enabled = False
End If
End Sub
This code finds all the information you need
I am still trying to implement the values in the respective button clicks events
Private Sub btnAdd_Click()
S1 = "132"
S2 = "321"
FindPlace
tbOne.Text = S1
End Sub
Private Sub FindPlace()
Dim Y As Integer
Dim i As Integer
tbOne.Text = S1
lbOne.Clear
For Y = 1 To Len(S2)
pos = Mid(S1, 4 - Y, 1)
S3 = Mid(S2, Y, 1)
For i = 1 To Len(S1)
If Mid(S1, i, 1) = S3 Then
lbOne.AddItem "Press " & i & " the value " & pos & " is in Position " & Mid(S1, i, 1)
End If
Next
Next
End Sub
I tried to make a quick-sort in VB2015, however when I run it, the values don't sort fully (however it does almost sort). I'm fairly sure that the problem has something to do with the two recurring lines.
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
numbers = TextBox1.Text.Split()
Dim tempstring As String
Form2.Show()
tempstring = ""
quicksort(numbers, numbers.Length() - 1, 0)
For Each a As String In numbers
tempstring = tempstring + a + " "
Next
TextBox2.Text = tempstring
Form2.Show()
Form2.Chart1.Series(0).Points.DataBindY(numbers)
End Sub
Public Sub quicksort(list As Array, high As Integer, low As Integer)
MessageBox.Show(Str(high) + " " + Str(low))
ListView1.Items.Add(Str(high) + " " + Str(low))
Dim i As Integer
Dim pivot As Integer
'pivot = (high + low) / 2
pivot = high
If high > low + 1 And low >= 0 Then
i = low
For c = low + 1 To high
If Int(list(c)) <= Int(list(pivot)) Then
swap(list, c, i)
i = i + 1
End If
Next
quicksort(numbers, i - 2, low)
quicksort(numbers, high, i)
End If
End Sub
Public Sub swap(list As Array, x As Integer, y As Integer)
Dim temp As Integer
temp = list(x)
list(x) = list(y)
list(y) = temp
Form2.Chart1.Series(0).Points.DataBindY(numbers)
'pause()
End Sub
I know this is old, but somebody may come across this. Your SWAP sub needs to pass the parameters ByRef, or the swap is only taking place inside the sub's variables and not within your QuickSort routine.
I have to write a program which calculate quadratic equation and find its roots. The roots must be displayed via MsgBox-es, and the variables A, B and C must be entered via InputBox-es. For now I have written this, but it somehow doesn't work and I can't figure out why.
**I'm new to Visual Basic ..
Public Class Form1
Dim A As Integer
Dim B As Integer
Dim C As Integer
Dim Det As Double
Dim x1 As Double
Dim x2 As Double
Private Sub txtA_Click(sender As Object, e As EventArgs) Handles txtA.Click
txtA.Text = InputBox("Please, enter value of the variable A.", "Enter A")
End Sub
Private Sub txtB_Click(sender As Object, e As EventArgs) Handles txtB.Click
txtB.Text = InputBox("Please, enter value of the variable B.", "Enter B")
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
End Sub
Private Sub cmdCalculate_Click(sender As Object, e As EventArgs) Handles cmdCalculate.Click
A = Val(txtA.Text)
B = Val(txtB.Text)
C = Val(txtC.Text)
Det = B ^ 2 + 4 * A * C
If Det > 0 Then
x1 = (-B + Math.Sqrt(Det)) / (2 * A)
x2 = (-B - Math.Sqrt(Det)) / (2 * A)
MsgBox("The roots are " + x1 + " and " + x2 + " ! ", 64, "2 Roots")
ElseIf Det = 0 Then
x1 = -B / (2 * A)
MsgBox("The roots are " + x1 + " ! ", 64, "1 Double Root")
ElseIf Det < 0 Then
MsgBox("No roots ! ", 64, "No Roots")
End If
End Sub
Private Sub txtC_Click(sender As Object, e As EventArgs) Handles txtC.Click
txtC.Text = InputBox("Please, enter value of the variable C.", "Enter C")
End Sub
Private Sub cmdExit_Click(sender As Object, e As EventArgs) Handles cmdExit.Click
End
End Sub
Private Sub cmdClear_Click(sender As Object, e As EventArgs) Handles cmdClear.Click
txtA.Text = ""
txtB.Text = ""
txtC.Text = ""
End Sub
End Class
http://imgur.com/hIcDxFv <-- Screen view
Oh, the problem was just because the x1 and x2 must be in Str()..
If Det > 0 Then
x1 = (-B + Math.Sqrt(Det)) / (2 * A)
x2 = (-B - Math.Sqrt(Det)) / (2 * A)
MsgBox("The roots are " + Str(x1) + " and " + Str(x2) + " ! ", 64, "2 Roots")
ElseIf Det = 0 Then
x = -B / (2 * A)
MsgBox("The roots are " + Str(x) + " ! ", 64, "1 Double Root")
Quick question that I've been struggling with. I have 2 arrays of different lengths that contain strings.
I want to output a new array which removes BOTH the elements if a duplicate is detected. At the moment it only removes duplicates but leaves the original which is incorrect for what I am trying to accomplish.
E.g.
input = array ("cat","dog","mouse","cat")
expected output = array ("dog","mouse")
actual output = array ("cat","dog","mouse")
Code is below:
Sub removeDuplicates(CombinedArray)
Dim myCol As Collection
Dim idx As Long
Set myCol = New Collection
On Error Resume Next
For idx = LBound(CombinedArray) To UBound(CombinedArray)
myCol.Add 0, CStr(CombinedArray(idx))
If Err Then
CombinedArray(idx) = Empty
dups = dups + 1
Err.Clear
ElseIf dups Then
CombinedArray(idx - dups) = CombinedArray(idx)
CombinedArray(idx) = Empty
End If
Next
For idx = LBound(CombinedArray) To UBound(CombinedArray)
Debug.Print CombinedArray(idx)
Next
removeBlanks (CombinedArray)
End Sub
Thanks for all help and support in advance.
What about using Scripting.Dictionary? Like this:
Function RemoveDuplicates(ia() As Variant)
Dim c As Object
Set c = CreateObject("Scripting.Dictionary")
Dim v As Variant
For Each v In ia
If c.Exists(v) Then
c(v) = c(v) + 1
Else
c.Add v, 1
End If
Next
Dim out() As Variant
Dim nOut As Integer
nOut = 0
For Each v In ia
If c(v) = 1 Then
ReDim Preserve out(nOut) 'you will have to increment nOut first, if you have 1-based arrays
out(nOut) = v
nOut = nOut + 1
End If
Next
RemoveDuplicates = out
End Function
Here is a quick example. Let me know if you get any errors.
Sub Sample()
Dim inputAr(5) As String, outputAr() As String, temp As String
Dim n As Long, i As Long
inputAr(0) = "cat": inputAr(1) = "Hen": inputAr(2) = "mouse"
inputAr(3) = "cat": inputAr(4) = "dog": inputAr(5) = "Hen"
BubbleSort inputAr
For i = 1 To UBound(inputAr)
If inputAr(i) = inputAr(i - 1) Or inputAr(i) = temp Then
inputAr(i - 1) = "": temp = inputAr(i): inputAr(i) = ""
End If
Next i
n = 0
For i = 1 To UBound(inputAr)
If inputAr(i) <> "" Then
n = n + 1
ReDim Preserve outputAr(n)
outputAr(n) = inputAr(i)
End If
Next i
For i = 1 To UBound(outputAr)
Debug.Print outputAr(i)
Next i
End Sub
Sub BubbleSort(arr)
Dim value As Variant
Dim i As Long, a As Long, b As Long, c As Long
a = LBound(arr): b = UBound(arr)
Do
c = b - 1
b = 0
For i = a To c
value = arr(i)
If (value > arr(i + 1)) Xor False Then
arr(i) = arr(i + 1)
arr(i + 1) = value
b = i
End If
Next
Loop While b
End Sub
EDIT
Another way without sorting
Sub Sample()
Dim inputAr(5) As String, outputAr() As String
Dim n As Long, i As Long, j As Long
Dim RemOrg As Boolean
inputAr(0) = "cat": inputAr(1) = "Hen": inputAr(2) = "mouse"
inputAr(3) = "cat": inputAr(4) = "dog": inputAr(5) = "Hen"
For i = 0 To UBound(inputAr)
For j = 1 To UBound(inputAr)
If inputAr(i) = inputAr(j) Then
If i <> j Then
inputAr(j) = "": RemOrg = True
End If
End If
Next
If RemOrg = True Then
inputAr(i) = ""
RemOrg = False
End If
Next i
n = 0
For i = 0 To UBound(inputAr)
If inputAr(i) <> "" Then
n = n + 1
ReDim Preserve outputAr(n)
outputAr(n) = inputAr(i)
End If
Next i
For i = 1 To UBound(outputAr)
Debug.Print outputAr(i)
Next i
End Sub
I have an application in which i'm drawing a line/square on a picturebox. I also need the user to click on a particular point on the picturebox(after drawing the square/line) so as to get the location of the second point. But the mouse down event does not work for the second click. My code is as shown:
Dim m_Drawing As Boolean
'm_Drawing = False
Dim m_Startx As Single
Dim m_Starty As Single
Dim m_endx As Single
Dim m_endy As Single
Dim square_click As Boolean
'square_click = False
Dim line_click As Boolean
'line_click = False
Dim bclick As Boolean
'blick = True
Dim startx As Single
Dim starty As Single
Dim endx As Single
Dim endy As Single
Dim laserx_mm As Single
Dim lasery_mm As Single
Dim rectx_mm As Single
Dim recty_mm As Single
Dim xpos As Single
Dim ypos As Single
Dim uxpos As Single
Dim uypos As Single
Dim dist As Single
Dim dist1 As Single
Private Sub Command1_Click()
square_click = True
End Sub
Private Sub Command2_Click()
line_click = True
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim diffx As Single
Dim diffy As Single
Picture1.Cls
If m_Startx = 0 And m_Starty = 0 Then
m_Startx = X
m_Starty = Y
'End If
startx = X
starty = Y
rectx_mm = X
recty_mm = Y
'move to start position
ElseIf m_Startx <> 0 And m_Starty <> 0 Then
laserx_mm = X
lasery_mm = Y
diffx = rectx_mm - laserx_mm
diffy = recty_mm - lasery_mm
dist = xpos + (diffx / 4.74 / 1000)
dist1 = ypos - (diffy / 4.68 / 1000)
End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
endx = X
endy = Y
m_endx = X
m_endy = Y
If square_click = True Then
Picture1.Line (m_Startx, m_Starty)-(endx, endy), vbWhite, B
ElseIf line_click = True Then
Picture1.Line (m_Startx, m_Starty)-(endx, endy), vbWhite
End If
End Sub
The Code: ElseIf m_Startx <> 0 And m_Starty <> 0
does not get executed unless and until i put a breakpoint there. I'm not sure why this is happening. Please help me out! Hope i was clear enough! Thanks.
I threw a Debug.Print "Here I am" call inside your ElseIf m_Startx <> 0 And m_Starty <> 0...Works like a charm on the 2nd click. Perhaps you may want to go with a darker color or a thicker line? The white line is fairly hard to see.