How to compute the duration of time in and time out using 4 DTPicker
Dim d1, d2, d3 As Date
Dim d4 As Integer
Dim x As Long
Option Explicit
Private Sub Command1_Click()
d1 = DTPicker1.Value + TimePicker.Value
d2 = DTPicker2.Value + TimePicker2.Value
x = DateDiff("h", d1, d2)
MsgBox x
End Sub
Private Sub Form_Load()
TimePicker.Format = dtpTime
TimePicker2.Format = dtpTime
End Sub
========================================================================see attached image here
I expect the output of 7:00 AM - 3:00 PM = 8hrs, when I add more days the actual output is 32 hrs in 2 days, it should be 16hrs
As long as the start and end times are in the same day, this should work:
Dim hoursPerDay As Integer
Dim days As Integer
Private Sub Command1_Click()
hoursPerDay = DateDiff("h", TimePicker1.Value, TimePicker2.Value)
days = DateDiff("d", DTPicker1.Value, DTPicker2.Value)
MsgBox hoursPerDay * days
End Sub
Otherwise, check if hoursPerDay is negative:
If hoursPerDay < 0 Then hoursPerDay = hoursPerDay + 24
Related
here is my GUI
Dim d1, d2, d3 As Date
Dim d4 As Integer
Dim x As Long
Option Explicit
Private Sub Command1_Click()
d1 = TimePicker.Value + DTPicker1.Value
d2 = TimePicker2.Value + DTPicker3.Value
x = DateDiff("h", d1, d2)
MsgBox x
End Sub
Private Sub Form_Load()
TimePicker.Format = dtpTime
TimePicker2.Format = dtpTime
End Sub
============================================
i want to calculate more number of hours in three or more days, I can only add two days it gaves me a value of 16hours and its correct, if i add more day it will add 24hours so it become 40 how can i fix this.I want to get 8hrs per day
If you use x = DateDiff("h", d1, d2), you will get the number of hours between d1 and d2.
If you use x = DateDiff("d", d1, d2), you will get the number of days between d1 and d2.
If you want to get 8 hours for each day, just multiply the DateDiff value by 8:
x = DateDiff("d", d1, d2) * 8
Is there any way in Classic ASP VBScript to get the number of weekdays between 2 dates? Obviously, we have the DateDiff() function but this will pull back the total number of days but I would like to omit the weekends.
You're right, DateDiff() doesn't cover this but it can be used in conjunction with WeekDay() to work out if a Day falls on a weekend.
By using DateDiff() to get the number of days we can then use a For loop to step through the days using DateAdd() to increment the day as we go and check whether the incremented date value is a particular WeekDay(). We can then decide based on this outcome whether to increment a counter that is storing our resulting number of weekdays.
Below is an example of how you would do this, the main logic has been encapsulated in a Function that you could include in a #include script file to use in multiple pages.
<%
Function DateDiffWeekDays(d1, d2)
Dim dy: dy = 0
Dim dys: dys = DateDiff("d", d1, d2)
Dim isWeekDay: isWeekDay = False
Dim wkd
Dim wd: wd = 0
For dy = 0 To dys
wkd = Weekday(DateAdd("d", dy, d1))
isWeekDay = Not (wkd = vbSunday Or wkd = vbSaturday)
If isWeekDay Then wd = wd + 1
Next
DateDiffWeekDays = wd
End Function
'Example of how to call the function and output to the page
Call Response.Write(DateDiffWeekDays(Date(), CDate("12 Nov 2018")))
%>
Output:
16
This is just a quick example and doesn't cover every possible usage case, the idea is it gives you a starting point that you can work from and improve.
VBScript does not include the requested operation, but as DateDiff with a ww interval returns the number of Sundays between two dates, ensuring that start and end dates are out of the weekend we can directly calculate the number of working days:
Option Explicit
Function WorkingDaysBetween( ByVal d1, ByVal d2 )
Dim d
' Adjust date order to simplify calcs and always return 0 or positive number
If d1 > d2 Then
d = d1 : d1 = d2 : d2 = d
End If
' Move start date forward if it is a weekend
d = WeekDay( d1, vbMonday )
If d > 5 Then d1 = DateAdd( "d", 3-(d\6 + d\7), d1)
' Move end date backward if it is a weekend
d = WeekDay( d2, vbMonday )
If d > 5 Then d2 = DateAdd( "d", -1*(d\6 + d\7), d2)
' Calculate
' DateDiff("d") = Number of days between dates
' +1 to include start day
' -2 * DateDiff("ww") to exclude weekends between dates
WorkingDaysBetween = 1 + DateDiff("d", d1, d2, vbMonday) - 2*DateDiff("ww", d1, d2, vbMonday)
' If the result is negative, there are no working days between both dates
If WorkingDaysBetween < 0 Then WorkingDaysBetween = 0
End Function
Trying to make the game "21" in visual basic 6, i have everything done but MsgBox is not displaying when its Bust, or Blackjack. Any ideas?
Private Sub cmdCheckScore_Click()
lblPC1.Visible = True
lblPC2.Visible = True
lblPC3.Visible = True
End Sub
Private Sub cmdDrawCard_Click()
If lblDraw1.Caption = "" Then 'Draws 3 random numbers with 3 button clicks
intDraw1 = Int(Rnd * 10 + 1)
lblDraw1.Caption = intDraw1
ElseIf lblDraw2.Caption = "" Then
intDraw2 = Int(Rnd * 10 + 1)
lblDraw2.Caption = intDraw2
ElseIf lblDraw3.Caption = "" Then
intDraw3 = Int(Rnd * 10 + 1)
lblDraw3.Caption = intDraw3
End If
intPlayerScore = intPlayer1 + intPlayer2 + intDraw1 + intDraw2 + intDraw3
intComputerScore = intPC1 + intPC2 + intPC3
If intPlayerScore > 21 Then
MsgBox "Bust!"
ElseIf intPlayerScore = 21 Then
MsgBox "Blackjack!"
End If
End Sub
Private Sub Form_Load()
Randomize
Dim intPlayer1 As Integer
Dim intPlayer2 As Integer
Dim intPlayer3 As Integer
Dim intPC1 As Integer
Dim intPC2 As Integer
Dim intPC3 As Integer
Dim intDraw1 As Integer
Dim intDraw2 As Integer
Dim intDraw3 As Integer
Dim PlayerScore As Integer
Dim ComputerScore As Integer
intDraw1 = 0
intDraw2 = 0
intDraw3 = 0
intPlayer1 = Int(Rnd * 10 + 1)
intPlayer2 = Int(Rnd * 10 + 1)
lblPlayer1.Caption = intPlayer1
lblPlayer2.Caption = intPlayer2
intPC1 = Int(Rnd * 10 + 1)
intPC2 = Int(Rnd * 10 + 1)
intPC3 = Int(Rnd * 10 + 1)
lblPC1.Caption = intPC1
lblPC2.Caption = intPC2
lblPC3.Caption = intPC3
End Sub
I've been trying to figure this out for 2 hours, and still no solution.
I believe your variables are getting created out of scope, and therefore when the click code runs, they're all variants.
Move your declares out of Form_Load to above cmdCheckScore
Dim intPlayer1 As Integer 'at the top of your FORM
Dim intPlayer2 As Integer
Dim intPlayer3 As Integer
Dim intPC1 As Integer
Dim intPC2 As Integer
Dim intPC3 As Integer
Dim intDraw1 As Integer
Dim intDraw2 As Integer
Dim intDraw3 As Integer
Dim PlayerScore As Integer
Dim ComputerScore As Integer 'at the top of your FORM
Private Sub cmdCheckScore_Click()
Next, click off to the left and set a breakpoint on this line to verify the values are getting there!
intPlayerScore = intPlayer1 + intPlayer2 + intDraw1 + intDraw2 + intDraw3
How can i find if a control exists on the left side of another control.
For example we usually place labels on the left to text box. in my from I have more than 50
controls and i want to enlarge them. Enlarging one by one is time consuming. How can i find a control and its width, placed left to another. Can anyone suggest an way to achieve this in code. I am using vb6. This is my code and this is not working
For Each crl In Me.Controls
'crl.Width = crl.Width + 750
If crl.Left < 150 Then
crl.Left = crl.Left + 2000
Else
crl.Left = (crl.Width / 2) + crl.Left + 1000
End If
crl.Top = crl.Top + 500
'crl.Height = crl.Height + 100
'crl.Width = crl.Width + 750
Next
Is there some logical structure in the layout of your controls?
If that is the case then you can use the Form_Resize() event to position (and resize) the controls
for example a form with 10 labels and 10 textboxes in a layout of 5 x 2 rows x columns
'1 form with:
'1 textbox : name=Text1 Index=0
'1 label : name=Label1 Index=0
Option Explicit
Private Sub Form_Load()
Dim intIndex As Integer
'load extra labels and textboxes
For intIndex = 1 To 9
Load Label1(intIndex)
Label1(intIndex).Caption = "Label" & CStr(intIndex + 1)
Label1(intIndex).Visible = True
Load Text1(intIndex)
Text1(intIndex).Text = "Text" & CStr(intIndex + 1)
Text1(intIndex).Visible = True
Next intIndex
End Sub
Private Sub Form_Resize()
Dim intIndex As Integer
Dim intRow As Integer, intCol As Integer
Dim sngWidth As Single, sngHeight As Single
'calculate width and height of each control
sngWidth = ScaleWidth / 4
sngHeight = ScaleHeight / 5
'loop through all controls and position and resize them
For intIndex = 0 To 9
intCol = intIndex \ 5
intRow = intIndex Mod 5
Label1(intIndex).Move 2 * intCol * sngWidth, intRow * sngHeight, sngWidth, sngHeight
Text1(intIndex).Move (2 * intCol + 1) * sngWidth, intRow * sngHeight, sngWidth, sngHeight
Next intIndex
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.