I read the data from mysql database with command
vrijeme = myData.Item(2) ' translation vrijeme = time
ime = "Dobrodosli " & myData.Item(0) & "" ' translation ime = name
GameForma.Show()
After that i store the vrijeme to the textbox with
txtvrijeme.text = vrijeme
Then i add timer control on form and want to countdown from the time in textbox to 0 ..
The time in textbox is in format 00:00:00
Anyway's ill set the entire project in .rar with connection strings and all needed stuffs if anyone want to help
Dropbox :https://www.dropbox.com/s/maxmxeak0cr353q/PocetnaVerzija.rar
The solution would be . Read the data from value
hours = txtTimefromDB.Text.Substring(0, 2)
minutes = txtTimefromDB.Text.Substring(3, 2)
sec = txtTimefromDB.Text.Substring(6, 2)
Start decrementing
Private Sub tmrCountdown_Tick(sender As Object, e As EventArgs) Handles tmrCountdown.Tick
sec = sec - 1
If sec = 0 Then
minutes = minutes - 1
sec = 60
ElseIf minutes = 0 Then
hours = hours - 1
minutes = 60
End If
txtTimefromDB.Text = "" & hours & ":" & minutes & ":" & sec
End Sub
Related
I am currently attempting optimise a set of 4 variables which can have any value between 0.01 and 0.97, the total of these 4 variables must equal 1. Eventually these 4 variables will need to be entered into the spreadsheet in order to return an output (this is a cell in the spreadsheet), ideally I would like to store this output against the 4 inputted variables.
My first step was to attempt to find all the combinations possible; I did this in a very basic form which took over an hour and returned around 150,000 rows.
Next I attempted to store the variables in a class before adding them to a collection but this was still quite slow.
My next step was to add them into a multi dimensional array but this was just as slow as the collection method.
I have already added Application.ScreenUpdating = False and found that Application.Calculation = xlManual made no difference in this case.
Does anyone have any advice on how to make this quicker?
This would need to be repeated a fair amount so ideally wouldn't take an hour to produce all the combinations. I haven't included the part about getting an output as the first step is way too slow and storing those results will use the same process as getting the combinations. I added the secondselapsed after the 3rd next as this takes about 32 seconds and is easier to test with.
My code example using arrays is here:
Sub WDLPerfA()
StartTime = Timer
Application.ScreenUpdating = False
NoRows = 0
Dim combos()
ReDim combos(NoRows, 1)
'Looping through variables
For a = 1 To 97
For b = 1 To 97
For c = 1 To 97
For d = 1 To 97
Application.ScreenUpdating = False
Total = a + b + c + d
If Total = 100 Then
If NoRows = 0 Then GoTo Line1
ElseIf NoRows > 0 Then
NoRows = NoRows + 1
ReDim combos(NoRows, 1)
Line1:
combo = a & "," & b & "," & c & "," & d
combos(NoRows, 0) = combo
Else: GoTo Line2
End If
Line2:
Next
Next
Next
SecondsElapsed = Round(Timer - StartTime, 2)
Debug.Print SecondsElapsed
Next
End Sub
As an test, I used a Collection to capture all of the combinations to add up to your target value and then stored all those combinations on a worksheet. It didn't take anywhere near an hour.
You don't need GoTo and you don't need to disable ScreenUpdating. But you should always use Option Explicit (read this explanation for why).
The combination loop test is simple:
Option Explicit
Sub FourCombos()
Const MAX_COUNT As Long = 97
Const TARGET_VALUE As Long = 100
Dim combos As Collection
Set combos = New Collection
Dim a As Long
Dim b As Long
Dim c As Long
Dim d As Long
StartCounter
For a = 1 To MAX_COUNT
For b = 1 To MAX_COUNT
For c = 1 To MAX_COUNT
For d = 1 To MAX_COUNT
If (a + b + c + d = TARGET_VALUE) Then
combos.Add a & "," & b & "," & c & "," & d
End If
Next d
Next c
Next b
Next a
Debug.Print "calc time elapsed = " & FormattedTimeElapsed()
Debug.Print "number of combos = " & combos.Count
Dim results As Variant
ReDim results(1 To combos.Count, 1 To 4)
StartCounter
For a = 1 To combos.Count
Dim combo As Variant
combo = Split(combos.Item(a), ",")
results(a, 1) = combo(0)
results(a, 2) = combo(1)
results(a, 3) = combo(2)
results(a, 4) = combo(3)
Next a
Sheet1.Range("A1").Resize(combos.Count, 4).Value = results
Debug.Print "results to sheet1 time elapsed = " & FormattedTimeElapsed()
End Sub
I used a high-performance timer in a separate module to measure the timing. On my system the results were
calc time elapsed = 1.774 seconds
number of combos = 156849
results to sheet1 time elapsed = 3.394 minutes
The timer code module is
Option Explicit
'------------------------------------------------------------------------------
' For Precision Counter methods
'
Private Type LargeInteger
lowpart As Long
highpart As Long
End Type
Private Declare Function QueryPerformanceCounter Lib _
"kernel32" (lpPerformanceCount As LargeInteger) As Long
Private Declare Function QueryPerformanceFrequency Lib _
"kernel32" (lpFrequency As LargeInteger) As Long
Private counterStart As LargeInteger
Private counterEnd As LargeInteger
Private crFrequency As Double
Private Const TWO_32 = 4294967296# ' = 256# * 256# * 256# * 256#
'==============================================================================
' Precision Timer Controls
' from: https://stackoverflow.com/a/198702/4717755
'
Private Function LI2Double(lgInt As LargeInteger) As Double
'--- converts LARGE_INTEGER to Double
Dim low As Double
low = lgInt.lowpart
If low < 0 Then
low = low + TWO_32
End If
LI2Double = lgInt.highpart * TWO_32 + low
End Function
Public Sub StartCounter()
'--- Captures the high precision counter value to use as a starting
' reference time.
Dim perfFrequency As LargeInteger
QueryPerformanceFrequency perfFrequency
crFrequency = LI2Double(perfFrequency)
QueryPerformanceCounter counterStart
End Sub
Public Function TimeElapsed() As Double
'--- Returns the time elapsed since the call to StartCounter in microseconds
If crFrequency = 0# Then
Err.Raise Number:=11, _
Description:="Must call 'StartCounter' in order to avoid " & _
"divide by zero errors."
End If
Dim crStart As Double
Dim crStop As Double
QueryPerformanceCounter counterEnd
crStart = LI2Double(counterStart)
crStop = LI2Double(counterEnd)
TimeElapsed = 1000# * (crStop - crStart) / crFrequency
End Function
Public Function FormattedTimeElapsed() As String
'--- returns the elapsed time value as above, but in a nicely formatted
' string in seconds, minutes, or hours
Dim result As String
Dim elapsed As Double
elapsed = TimeElapsed()
If elapsed <= 1000 Then
result = Format(elapsed, "0.000") & " microseconds"
ElseIf (elapsed > 1000) And (elapsed <= 60000) Then
result = Format(elapsed / 1000, "0.000") & " seconds"
ElseIf (elapsed > 60000) And (elapsed < 3600000) Then
result = Format(elapsed / 60000, "0.000") & " minutes"
Else
result = Format(elapsed / 3600000, "0.000") & " hours"
End If
FormattedTimeElapsed = result
End Function
I'm trying to create a program that will alarm every 2 hours and a message box will be display
Another option would be to set a module-level variable to the current time + two hours (Now + (2.0 / 24.0)), then have the Timer interrupt check to see if the current time is greater than this stored value.
You could use a Timer control to do this but you will not be able to directly set the Interval to 7200000. You could set your Interval to 60000 (and set Enabled property to True) and have a variable that counts the minutes that have gone by:
Dim iMinutesElapsed As Integer
Private Sub Timer1_Timer()
iMinutesElapsed = iMinutesElapsed + 1
If iMinutesElapsed = 120 Then
DoAlarm
iMinutesElapsed = 0
End If
End Sub
Private Sub DoAlarm()
MsgBox "2 hours have gone by."
End Sub
A better approach is to store a variable with the value of the Timer function and check how long it's been since you called Start. In this approach, set Timer1's Interval to 1000 and Enabled to False, the Start method will enable Timer1 for you:
Dim sngStart As Single
Public Sub Start()
sngStart = Timer
Timer1.Enabled = True
End Sub
Private Sub Timer1_Timer()
Dim sngElapsedTime As Single
sngElapsedTime = Timer - sngStart
If sngElapsedTime < 0 Then
' Clock passed midnight
sngElapsedTime = (86400 - sngStart) + Timer
End If
If sngElapsedTime > 7200 Then ' counting seconds with this code
sngStart = Timer ' Restart
DoAlarm
End If
End Sub
Finally, a solution that will be triggered every odd hour on minute 30 as described in the comments:
Private Sub Timer1_Timer()
If Hour(Now) Mod 2 = 1 And Minute(Now) = 30 Then
DoAlarm
End If
End Sub
You could also use the Task Scheduler to run a VBScript that displays your message box. You simply have to create a Task with a Trigger that repeats every 2 hours, indefinitely.
The VBScript can display the time:
MsgBox "It's now " & FormatDateTime(Now, vbShortTime)
I am programming a function in which I can populate my array with some values. I want to populate them because the array is way to big to fill it myself.
The array is a set of time values from which a person can choose in a dropdown (selection). The default should be 7:30 (european time) and the dates to choose from should have steps of 15 minutes. The lowest time to choose from is 5.00 and the highest is 23:00, which is a total of 18 hours. so with steps of 15 minutes that means: 18 hours x 60 minutes = 1080 minutes / 15 minutes = 72 steps of 15 minutes. So that is a total of 71 array values (counting the 0 as well).
Now the function i figured out is as follows:
Dim myArray
ReDim myArray(5)
Dim counter
For counter = 0 To UBound(myArray)
if counter = 0 then
myArray(counter) = Hour("05:00")
else
myArray(counter) = DateAdd("n",15,myArray(counter))
end if
Next
For Each item In myArray
Response.Write(item & "<br />")
Next
This bit was just for the testing:
For Each item In myArray
Response.Write(item & "<br />")
Next
Though the looping doesn't add the 15 minutes, instead it starts with the 5.00 but then keeps printing the 00:15 after the first counter, so it doesnt add the 15 minutes to its last count value.
Any clue how to fix it?
The output is as follows while testing the array with a count of 5:
5
00:15:00
00:15:00
00:15:00
00:15:00
00:15:00
Alright I figured it out myself.
I did it now by adding the value to a variable which changes in every loop to a new (the added 15 minute) value. This way it adds the 15 minutes to the latest value.
The code:
Dim myArray
ReDim myArray(5)
Dim counter
Dim BeginTijdArray
BeginTijdArray = Hour("05:00") & ":" & Minute("05:00")
For counter = 0 To UBound(myArray)
if counter = 0 then
myArray(counter) = BeginTijdArray
else
myArray(counter) = DateAdd("n",15,BeginTijdArray)
myArray(counter) = Hour(myArray(counter)) & ":" & Minute(myArray(counter))
BeginTijdArray = myArray(counter)
end if
Next
For Each item In myArray
Response.Write(item & "<br />")
Next
I believe there is a simple bug in your loop.
This line
myArray(counter) = DateAdd("n",15,myArray(counter))
should be
myArray(counter) = DateAdd("n",15,myArray(counter - 1))
I think that is all.
I had to write a function that takes a value (qty) and then determines the range it falls in, and determines the price based off of that range.
So if 1-10 is passed in, the price is $2, if 11-20, the price is $4. Etc etc etc. And this had to be fairly unlimited, because this is being used on an eCommerce site to determine checkout shipping cost.
My question is if there is a more efficient way to do this, rather than having a loop to 10,000 that builds an array by 10's, and then loop through the array that I have made to determine the range of the value passed in.
function getPrice(qty)
tempArray = array()
for i = 0 to 10000 step 10
addArrayItem tempArray,i
next
if qty > 9 then
for i = 0 to ubound(tempArray)
if cInt(qty) > tempArray(i) AND cInt(qty) <= tempArray(i+1) then
response.write("falls in range " & tempArray(i) + 1 & " through " & tempArray(i+1) & "<br>")
temp = left(tempArray(i+1),len(tempArray(i+1)) - 1)
rate = formatcurrency(cInt(temp * 2),2)
exit for
end if
next
elseif qty > 0 then
rate = "$2.00"
else
rate = "error"
end if
getPrice = rate
end function
sub addArrayItem(ByRef ar,ByVal count)
ub = uBound(ar)
reDim preserve ar(ub + 1)
ar(ub+1) = count
end sub
i keep running in this issue where it will jump out of the for statements that generate the table, I've been pouring over the code for a better part of three hours and i cannot find what is going wrong so i think i need another pair of eyes.
Shared Function DrawGrid() As TableLayoutPanel
Dim dayNames As New ArrayList
dayNames.Add("Monday")
dayNames.Add("Tuesday")
dayNames.Add("Wednesday")
dayNames.Add("Thursday")
dayNames.Add("Friday")
dayNames.Add("Saturday")
dayNames.Add("Sunday")
Dim hour As Integer = 8
Dim minute As Integer = 0
Dim timeType As String = "AM"
Dim dayLength As Integer = 12
Dim timetable As New TableLayoutPanel
timetable.CellBorderStyle = TableLayoutPanelCellBorderStyle.Inset
'Loops through days one at a time this creates the labels and adds them for reference by the user but is not needed for the timetable creation
For days As Integer = 0 To 7
timetable.ColumnCount += 1
timetable.RowCount += 1
If days > 0 Then
Dim NamePos As New TableLayoutPanelCellPosition(days, 0)
Dim lblDay As New Label
lblDay.Text = CStr(dayNames.Item(days))
timetable.SetCellPosition(lblDay, NamePos)
timetable.Controls.Add(lblDay)
End If
For time As Integer = 0 To dayLength
Dim rowPos As New TableLayoutPanelCellPosition(days, time)
Dim lblTime As New Label
Dim timeString As String
timetable.RowCount += 1
If days = 0 Then
minute += 6
If minute = 6 Then
minute = 0
hour += 1
End If
If hour = 13 Then
hour = 1
timeType = "PM"
End If
timeString = "Time is " & hour & ":" & minute & "0 " & timeType
lblTime.Text = timeString
timetable.SetCellPosition(lblTime, rowPos)
timetable.Controls.Add(lblTime)
timetable.Visible = True
End If
Next
Next
timetable.GrowStyle = TableLayoutPanelGrowStyle.AddColumns
timetable.AutoSize = True
MessageBox.Show("Working")
Return timetable
End Function
Are you able to add a breakpoint to the For loop to see at what point error is being generated? If so check what the local variable values are just before it throws the exception.
An out of range exception can be because you are trying to access an array/collection item that doesn't exist.
For instance myArray(4) has 5 items, if I try to access myArray(5) I will get an out of range exception, because the index starts at 0.
The for in VB.NET is inclusive, eg :
For i = 0 To 5
Debug.WriteLine(i)' outputs : 0,1,2,3,4,5
Next
So you might want to use some -1 when looping.
This for example iterates 8 times, while you are wanting to iterate only 7 times (unless in your country you have 8 days in a week)
For days As Integer = 0 To 7
Here is a possible correction :
For days As Integer = 0 To 6
timetable.ColumnCount += 1
timetable.RowCount += 1
If days > 0 Then
Dim NamePos As New TableLayoutPanelCellPosition(days, 0)
Dim lblDay As New Label
lblDay.Text = CStr(dayNames.Item(days))
timetable.SetCellPosition(lblDay, NamePos)
timetable.Controls.Add(lblDay)
End If
For time As Integer = 0 To dayLength - 1
Dim rowPos As New TableLayoutPanelCellPosition(days, time)
Dim lblTime As New Label
Dim timeString As String
timetable.RowCount += 1
If days = 0 Then
Minute += 6
If Minute() = 6 Then
Minute = 0
Hour += 1
End If
If Hour() = 13 Then
Hour = 1
timeType = "PM"
End If
timeString = "Time is " & Hour() & ":" & Minute() & "0 " & timeType
lblTime.Text = timeString
timetable.SetCellPosition(lblTime, rowPos)
timetable.Controls.Add(lblTime)
timetable.Visible = True
End If
Next
Next