home *** CD-ROM | disk | FTP | other *** search
- VERSION 2.00
- Begin Form Card
- Caption = "TimeCard"
- ClientHeight = 6045
- ClientLeft = 1575
- ClientTop = 960
- ClientWidth = 5265
- ClipControls = 0 'False
- Height = 6735
- Icon = TIMECARD.FRX:0000
- Left = 1515
- LinkTopic = "Form1"
- MaxButton = 0 'False
- ScaleHeight = 6045
- ScaleWidth = 5265
- Top = 330
- Width = 5385
- Begin PictureBox picInClk
- AutoRedraw = -1 'True
- AutoSize = -1 'True
- BorderStyle = 0 'None
- Height = 330
- Left = 1680
- Picture = TIMECARD.FRX:0302
- ScaleHeight = 330
- ScaleWidth = 345
- TabIndex = 36
- Top = 240
- Width = 345
- End
- Begin PictureBox picOutClk
- AutoRedraw = -1 'True
- AutoSize = -1 'True
- BorderStyle = 0 'None
- Height = 330
- Left = 3000
- Picture = TIMECARD.FRX:0484
- ScaleHeight = 330
- ScaleWidth = 345
- TabIndex = 37
- Top = 240
- Width = 345
- End
- Begin PictureBox picCalendar
- AutoRedraw = -1 'True
- AutoSize = -1 'True
- BorderStyle = 0 'None
- Height = 480
- Left = 720
- Picture = TIMECARD.FRX:0606
- ScaleHeight = 480
- ScaleWidth = 480
- TabIndex = 35
- Top = 480
- Width = 480
- End
- Begin PictureBox picIn
- AutoRedraw = -1 'True
- AutoSize = -1 'True
- BorderStyle = 0 'None
- DragIcon = TIMECARD.FRX:0908
- DragMode = 1 'Automatic
- Height = 480
- Left = 1920
- Picture = TIMECARD.FRX:0C0A
- ScaleHeight = 480
- ScaleWidth = 480
- TabIndex = 33
- Tag = "InTime"
- Top = 480
- Width = 480
- End
- Begin PictureBox picOut
- AutoRedraw = -1 'True
- AutoSize = -1 'True
- BorderStyle = 0 'None
- DragIcon = TIMECARD.FRX:0F0C
- DragMode = 1 'Automatic
- Height = 480
- Left = 3240
- Picture = TIMECARD.FRX:120E
- ScaleHeight = 480
- ScaleWidth = 480
- TabIndex = 34
- Tag = "OutTime"
- Top = 480
- Width = 480
- End
- Begin PictureBox picHours
- AutoRedraw = -1 'True
- AutoSize = -1 'True
- BorderStyle = 0 'None
- Height = 480
- Left = 4440
- Picture = TIMECARD.FRX:1510
- ScaleHeight = 480
- ScaleWidth = 480
- TabIndex = 38
- Top = 480
- Width = 480
- End
- Begin CommandButton cmdPrint
- Caption = "Print Card"
- Height = 495
- Left = 240
- TabIndex = 32
- Top = 5400
- Width = 2055
- End
- Begin Image imgPointer
- Height = 480
- Left = 120
- Picture = TIMECARD.FRX:1812
- Stretch = -1 'True
- Top = 1080
- Width = 480
- End
- Begin Label lblTotal
- Caption = "Total Hours"
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "MS Sans Serif"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- ForeColor = &H00800000&
- Height = 255
- Left = 2520
- TabIndex = 39
- Top = 4680
- Width = 2415
- End
- Begin Image imgNotIcon
- Height = 480
- Left = 0
- Picture = TIMECARD.FRX:1A8C
- Top = 0
- Visible = 0 'False
- Width = 480
- End
- Begin Label lblOverHrs
- Alignment = 1 'Right Justify
- Caption = "0.00"
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "MS Sans Serif"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- ForeColor = &H00800000&
- Height = 255
- Left = 4200
- TabIndex = 31
- Top = 5520
- Width = 735
- End
- Begin Label lblRegHrs
- Alignment = 1 'Right Justify
- Caption = "0.00"
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "MS Sans Serif"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- ForeColor = &H00800000&
- Height = 255
- Left = 4200
- TabIndex = 30
- Top = 5040
- Width = 735
- End
- Begin Label lblOverTotal
- Caption = "Overtime"
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "MS Sans Serif"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- ForeColor = &H00800000&
- Height = 255
- Left = 2640
- TabIndex = 29
- Top = 5520
- Width = 1335
- End
- Begin Label lblRegTotal
- Caption = "Regular"
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "MS Sans Serif"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- ForeColor = &H00800000&
- Height = 255
- Left = 2640
- TabIndex = 28
- Top = 5040
- Width = 1335
- End
- Begin Image imgVaca
- BorderStyle = 1 'Fixed Single
- DragIcon = TIMECARD.FRX:1D8E
- DragMode = 1 'Automatic
- Height = 510
- Left = 960
- Picture = TIMECARD.FRX:2090
- Tag = "Vacation"
- Top = 4680
- Width = 510
- End
- Begin Image imgSick
- BorderStyle = 1 'Fixed Single
- DragIcon = TIMECARD.FRX:2392
- DragMode = 1 'Automatic
- Height = 510
- Left = 1680
- Picture = TIMECARD.FRX:2694
- Tag = "Sick"
- Top = 4680
- Width = 510
- End
- Begin Image imgHoliday
- BorderStyle = 1 'Fixed Single
- DragIcon = TIMECARD.FRX:2996
- DragMode = 1 'Automatic
- Height = 510
- Left = 240
- Picture = TIMECARD.FRX:2C98
- Tag = "Holiday"
- Top = 4680
- Width = 510
- End
- Begin Label lblHours
- Alignment = 1 'Right Justify
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "MS Sans Serif"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 255
- Index = 6
- Left = 4200
- TabIndex = 0
- Top = 4080
- Width = 735
- End
- Begin Label lblHours
- Alignment = 1 'Right Justify
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "MS Sans Serif"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 255
- Index = 5
- Left = 4200
- TabIndex = 9
- Top = 3600
- Width = 735
- End
- Begin Label lblHours
- Alignment = 1 'Right Justify
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "MS Sans Serif"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 255
- Index = 4
- Left = 4200
- TabIndex = 27
- Top = 3120
- Width = 735
- End
- Begin Label lblHours
- Alignment = 1 'Right Justify
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "MS Sans Serif"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 255
- Index = 3
- Left = 4200
- TabIndex = 26
- Top = 2640
- Width = 735
- End
- Begin Label lblHours
- Alignment = 1 'Right Justify
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "MS Sans Serif"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 255
- Index = 2
- Left = 4200
- TabIndex = 25
- Top = 2160
- Width = 735
- End
- Begin Label lblHours
- Alignment = 1 'Right Justify
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "MS Sans Serif"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 255
- Index = 1
- Left = 4200
- TabIndex = 24
- Top = 1680
- Width = 735
- End
- Begin Label lblHours
- Alignment = 1 'Right Justify
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "MS Sans Serif"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 255
- Index = 0
- Left = 4200
- TabIndex = 23
- Top = 1200
- Width = 735
- End
- Begin Label lblOutTime
- Alignment = 2 'Center
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "MS Sans Serif"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 255
- Index = 6
- Left = 2880
- TabIndex = 22
- Top = 4080
- Width = 1095
- End
- Begin Label lblOutTime
- Alignment = 2 'Center
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "MS Sans Serif"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 255
- Index = 5
- Left = 2880
- TabIndex = 21
- Top = 3600
- Width = 1095
- End
- Begin Label lblOutTime
- Alignment = 2 'Center
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "MS Sans Serif"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 255
- Index = 4
- Left = 2880
- TabIndex = 20
- Top = 3120
- Width = 1095
- End
- Begin Label lblOutTime
- Alignment = 2 'Center
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "MS Sans Serif"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 255
- Index = 3
- Left = 2880
- TabIndex = 19
- Top = 2640
- Width = 1095
- End
- Begin Label lblOutTime
- Alignment = 2 'Center
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "MS Sans Serif"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 255
- Index = 2
- Left = 2880
- TabIndex = 18
- Top = 2160
- Width = 1095
- End
- Begin Label lblOutTime
- Alignment = 2 'Center
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "MS Sans Serif"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 255
- Index = 1
- Left = 2880
- TabIndex = 17
- Top = 1680
- Width = 1095
- End
- Begin Label lblOutTime
- Alignment = 2 'Center
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "MS Sans Serif"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 255
- Index = 0
- Left = 2880
- TabIndex = 16
- Top = 1200
- Width = 1095
- End
- Begin Label lblInTime
- Alignment = 2 'Center
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "MS Sans Serif"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 255
- Index = 6
- Left = 1560
- TabIndex = 15
- Top = 4080
- Width = 1095
- End
- Begin Label lblInTime
- Alignment = 2 'Center
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "MS Sans Serif"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 255
- Index = 5
- Left = 1560
- TabIndex = 14
- Top = 3600
- Width = 1095
- End
- Begin Label lblInTime
- Alignment = 2 'Center
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "MS Sans Serif"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 255
- Index = 4
- Left = 1560
- TabIndex = 13
- Top = 3120
- Width = 1095
- End
- Begin Label lblInTime
- Alignment = 2 'Center
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "MS Sans Serif"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 255
- Index = 3
- Left = 1560
- TabIndex = 12
- Top = 2640
- Width = 1095
- End
- Begin Label lblInTime
- Alignment = 2 'Center
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "MS Sans Serif"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 255
- Index = 2
- Left = 1560
- TabIndex = 11
- Top = 2160
- Width = 1095
- End
- Begin Label lblInTime
- Alignment = 2 'Center
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "MS Sans Serif"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 255
- Index = 1
- Left = 1560
- TabIndex = 10
- Top = 1680
- Width = 1095
- End
- Begin Label lblInTime
- Alignment = 2 'Center
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "MS Sans Serif"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 255
- Index = 0
- Left = 1560
- TabIndex = 8
- Top = 1200
- Width = 1095
- End
- Begin Label lblDay
- Alignment = 2 'Center
- Caption = "MON"
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "MS Sans Serif"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 300
- Index = 0
- Left = 600
- TabIndex = 1
- Top = 1200
- Width = 735
- End
- Begin Label lblDay
- Alignment = 2 'Center
- Caption = "SUN"
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "MS Sans Serif"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 300
- Index = 6
- Left = 600
- TabIndex = 7
- Top = 4080
- Width = 735
- End
- Begin Label lblDay
- Alignment = 2 'Center
- Caption = "SAT"
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "MS Sans Serif"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 300
- Index = 5
- Left = 600
- TabIndex = 6
- Top = 3600
- Width = 735
- End
- Begin Label lblDay
- Alignment = 2 'Center
- Caption = "FRI"
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "MS Sans Serif"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 300
- Index = 4
- Left = 600
- TabIndex = 5
- Top = 3120
- Width = 735
- End
- Begin Label lblDay
- Alignment = 2 'Center
- Caption = "THU"
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "MS Sans Serif"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 300
- Index = 3
- Left = 600
- TabIndex = 4
- Top = 2640
- Width = 735
- End
- Begin Label lblDay
- Alignment = 2 'Center
- Caption = "WED"
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "MS Sans Serif"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 300
- Index = 2
- Left = 600
- TabIndex = 3
- Top = 2160
- Width = 735
- End
- Begin Label lblDay
- Alignment = 2 'Center
- Caption = "TUE"
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "MS Sans Serif"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 300
- Index = 1
- Left = 600
- TabIndex = 2
- Top = 1680
- Width = 735
- End
- Begin Menu mnuOptionsMenu
- Caption = "&Options"
- Begin Menu mnuOptionsNew
- Caption = "&New Card"
- End
- Begin Menu mnuOptionsFont
- Caption = "Select &Font..."
- End
- Begin Menu mnuOptionsSep1
- Caption = "-"
- End
- Begin Menu mnuOptionsHowTo
- Caption = "&Instructions..."
- End
- Begin Menu mnuOptionsDemo
- Caption = "&Demo Data"
- End
- Begin Menu mnuOptionsSep2
- Caption = "-"
- End
- Begin Menu mnuOptionsExit
- Caption = "&Exit"
- End
- End
- Option Explicit
- ' Variable to track week day
- Dim RowFlag
- ' Array to track daily (indexes = 0 - 6) and total hours (index = 7).
- Dim DailyHrs(8)
- ' Array to track clock in time or act as flag to show paid time off.
- Dim ClkIn(7, 2)
- ' Array to track clock out time.
- Dim ClkOut(7, 2)
- ' Variable to track total overtime hours.
- Dim OvrHrs
- ' Shared variable for width of current control.
- Dim dX As Single
- ' Shared variable for height of current control.
- Dim dY As Single
- ' X position of current control (left).
- Dim cmdX
- ' Variable to hold error messages.
- Dim ErrMsg$
- ' Y position of current control (top).
- Dim cmdY
- ' Constant to format time in 24 hour with leading zero to calculate hours.
- Const HrFormat = "hh:mm"
- ' Constant to define threshold # of hours for overtime
- Const OTLimit = 40
- ' Constant for height of a title bar or menu bar
- Const BarHgt = 325
- Sub ClearCard ()
- ' Declare local variables.
- Dim DayTotal
- ' Move pointer to Saturday.
- imgPointer.Top = 1080
- RowFlag = 0
- ' For each week day
- For DayTotal = 0 To 6
- ' Clear clock in times.
- ClkIn(DayTotal, 1) = 0
- ClkIn(DayTotal, 0) = 0
- lblInTime(DayTotal) = ""
- ' Clear clock out times.
- ClkOut(DayTotal, 0) = 0
- ClkOut(DayTotal, 1) = 0
- lblOutTime(DayTotal) = ""
- ' Clear thdaily hour totals.
- DailyHrs(DayTotal) = 0
- lblHours(DayTotal) = ""
- ' Get next week day
- Next DayTotal
- ' Update card.
- UpdateTime
- End Sub
- Sub cmdPrint_Click ()
- PrintFrm Card
- End Sub
- Sub DrawCmd (cmdCtrl As Control)
- ' Declare local variables.
- Dim capTxt
- ' Save width/height of command button
- dX = cmdCtrl.Width
- dY = cmdCtrl.Height
- ' Save X and Y-coordinates of upper left corner of command button
- cmdX = cmdCtrl.Left
- cmdY = cmdCtrl.Top
- ' Save text inside command button
- capTxt = cmdCtrl.Caption
- ' Set width of lines to draw the button.
- DrawWidth = 2
- ' Move current X and Y-coordinates of Printer object to
- ' upper left corner of command button.
- Printer.CurrentX = cmdX
- Printer.CurrentY = cmdY
- ' Draw a box on Printer object to represent command button.
- ' Use Step method to give height and
- ' width of button as relative coordinates for lower
- ' right corner of button.
- Printer.Line -Step(dX, dY), , B
- ' Move current X and Y-coordinates of the Printer object to
- ' start of caption text. Because caption is centered in the button,
- ' calculate starting coordinates by subtracting width/height of
- ' caption text from width/height of button. Add half
- ' difference in both height and with to upper left corner
- ' coordinates to get starting point of text.
- Printer.CurrentX = cmdX + ((dX - Printer.TextWidth(capTxt)) / 2)
- Printer.CurrentY = cmdY + ((dY - Printer.TextHeight(capTxt)) / 2)
- ' Print caption text from command button on Printer object.
- Printer.Print cmdCtrl.Caption
- End Sub
- Sub DrawLbl (lblCtrl As Control)
- ' Copy font attributes of label to Printer object.
- Printer.FontBold = lblCtrl.FontBold
- Printer.FontItalic = lblCtrl.FontItalic
- Printer.FontSize = lblCtrl.FontSize
- ' Declare variables for the height/width of label caption.
- Dim TxtHgt
- Dim TxtWid
- ' Save the text height/width of caption font
- TxtHgt = Printer.TextHeight(lblCtrl.Caption)
- TxtWid = Printer.TextWidth(lblCtrl.Caption)
- ' Draw the border, if label has one
- If lblCtrl.BorderStyle = 1 Then
- DrawWidth = 2
- Printer.CurrentX = lblCtrl.Left
- Printer.CurrentY = lblCtrl.Top
- Printer.Line -Step(lblCtrl.Width, lblCtrl.Height), , B
- End If
- ' Set the Y-coordinate of the Printer object.
- Printer.CurrentY = lblCtrl.Top
- ' Set the X-coordinate of the Printer object according to the Alignment
- ' property of the label.
- Select Case lblCtrl.Alignment
- ' If alignment is left
- Case 0
- Printer.CurrentX = lblCtrl.Left
- ' If alignment is right
- Case 1
- Printer.CurrentX = lblCtrl.Left + (lblCtrl.Width - TxtWid)
- ' If alignment is center
- Case 2
- Printer.CurrentX = lblCtrl.Left + ((lblCtrl.Width - TxtWid) / 2)
- End Select
- ' Print caption text.
- Printer.Print lblCtrl.Caption
- End Sub
- Sub DrawPic (picCtrl As Control)
- ' Declare local variables.
- Dim XRd
- Dim YRd
- Dim PelX
- Dim PelY
- Dim PelC
- ' Declare and initialize screen resolution variables.
- Dim ScrX
- ScrX = Screen.TwipsPerPixelX
- Dim ScrY
- ScrY = Screen.TwipsPerPixelY
- ' Set scale mode in image control to read pixels.
- picCtrl.ScaleMode = 3
- ' For each row of pixels in the source bitmap...
- For YRd = 0 To (picCtrl.ScaleHeight - 1)
- ' Calculate the Y position of the pixel.
- PelY = picCtrl.Top + (YRd * ScrY)
- ' For each pixel in the current row of the source bitmap...
- For XRd = 0 To (picCtrl.ScaleWidth - 1)
- ' Calculate the X position of the pixel.
- PelX = picCtrl.Left + (XRd * ScrX)
- ' Store the pixel color in a local variable.
- PelC = picCtrl.Point(XRd, YRd)
- ' If the current pixel in the source bitmap is white, skip it
- ' to improve the speed of the application.
- If PelC <> QBColor(7) And PelC > 0 Then
- ' Read pixel color in source bitmap and paint
- ' corresponding pixel in target object
- Printer.Line (PelX, PelY)-Step(ScrX, ScrY), PelC, BF
- End If
- ' Get next pixel.
- Next XRd
- ' Yield processing after each row so app doesn't tie up
- ' system while transferring the bitmap.
- DoEvents
- ' Get next row.
- Next YRd
- ' Return (0, 0) coordinates of the Printer object to where they
- ' were before changing the scale mode.
- SetClientPrintOrigin Card
- End Sub
- Sub Form_DragOver (Source As Control, X As Single, Y As Single, State As Integer)
- ' When dragging icons, show the universal NOT symbol when
- ' over parts of the form where dropping the icon does nothing.
- Source.DragIcon = imgNotIcon.Picture
- End Sub
- Sub Form_Load ()
- ' Position the form in the middle of the screen.
- Card.Left = (Screen.Width - Card.Width) / 2
- Card.Top = (Screen.Height - Card.Height) / 2
- ' Initialize the day of week selection to Monday when you start
- ' the time card.
- RowFlag = 0
- End Sub
- Sub Form_Paint ()
- DrawWidth = 2
- ' Draw vertical line between weekday and clock in times.
- Line (1450, 360)-Step(0, 4040), QBColor(8)
- ' Draw vertical line between clock out time and daily total hours.
- Line (4090, 360)-Step(0, 4040), QBColor(8)
- ' Draw box around total regular and overtime hours.
- Line (2500, 4950)-Step(2532, 922), QBColor(8), B
- End Sub
- Sub Form_Resize ()
- ' As long as the card is not minimized.
- If Card.WindowState = 0 Then
- ' Keep the height and width constant while displaying
- ' a border that looks resizable.
- Card.Height = 6735
- Card.Width = 5370
- End If
- End Sub
- Sub Form_Unload (Cancel As Integer)
- End
- End Sub
- Sub lblDay_Click (Index As Integer)
- ' Move pointer to selected day.
- imgPointer.Top = 1080 + (480 * Index)
- ' Set variable to track day of week to index of selected label.
- RowFlag = Index
- End Sub
- Sub lblDay_DragOver (Index As Integer, Source As Control, X As Single, Y As Single, State As Integer)
- ' When dragging icons, show the NOT symbol since you cannot drop here.
- Source.DragIcon = imgNotIcon.Picture
- End Sub
- Sub lblInTime_DragDrop (Index As Integer, Source As Control, X As Single, Y As Single)
- ' Declare local variables.
- Dim InTime
- ' If this row is the selected day of week...
- If Index = RowFlag Then
- ' If this row already has a time entry...
- If lblInTime(Index).Caption <> "" Then
- ' Prepare and display error message.
- ErrMsg$ = "You need supervisor authority to change a time entry."
- MsgBox ErrMsg$, 0, "TimeCard Error"
- ' Abort procedure
- Exit Sub
- End If
- ' Identify icon you're dropping with Tag property.
- Select Case Source.Tag
- ' If this is the clock in icon...
- Case "InTime"
- ' Store the clock in time. Subtract integer/date information.
- InTime = Now - Int(Now)
- ' Format and display clock in time using selected display
- lblInTime(Index).Caption = Format$(InTime, "Medium Time")
- ' Store current time in clock in array: hour in 1st element
- ' and minutes in 2nd element.
- ClkIn(Index, 0) = Val(Left$(Format$(InTime, HrFormat), 2))
- ClkIn(Index, 1) = Val(Right$(Format$(InTime, HrFormat), 2))
- ' If clock out icon...
- Case "OutTime"
- ' Prepare and display error message.
- ErrMsg$ = "You dropped the Out picture on the In column. Try again with the In picture."
- MsgBox ErrMsg$, 0, "TimeCard Error"
- ' If holiday icon...
- Case "Holiday"
- ' Display "Holiday" instead of clock in time
- lblInTime(Index).Caption = "Holiday"
- ' Don't display anything for the time clocked out.
- lblOutTime(Index).Caption = " "
- ' Set time clocked in as negative value to signal
- ' day is paid time off, not hours paid
- ClkIn(Index, 0) = -1
- ' If this is the sick time icon...
- Case "Sick"
- ' Display "Sick" instead of clock in time
- lblInTime(Index).Caption = "Sick"
- ' Don't display anything for the time clocked out.
- lblOutTime(Index).Caption = " "
- ' Set time clocked in as negative value to signal
- ' day is paid time off, not hours paid
- ClkIn(Index, 0) = -1
- ' If this is the vacation icon...
- Case "Vacation"
- ' Display "Vacation" instead of clock in time
- lblInTime(Index).Caption = "Vacation"
- ' Don't display anything for the time clocked out.
- lblOutTime(Index).Caption = " "
- ' Set time clocked in as negative value to signal
- ' day is paid time off, not hours paid
- ClkIn(Index, 0) = -1
- End Select
- ' If this day is paid time off, update daily and weekly time totals
- If ClkIn(Index, 0) = -1 Then
- UpdateTime
- End If
- End If
- End Sub
- Sub lblInTime_DragOver (Index As Integer, Source As Control, X As Single, Y As Single, State As Integer)
- ' If this row isn't the row you selected...
- If Index <> RowFlag Then
- ' Display the NOT symbol to show you can't drop here.
- Source.DragIcon = imgNotIcon.Picture
- ' Otherwise, show the icon itself to show you can drop here.
- Else Source.DragIcon = Source.Picture
- End If
- End Sub
- Sub lblOutTime_DragDrop (Index As Integer, Source As Control, X As Single, Y As Single)
- ' Declare local variables.
- Dim OutTime
- ' If this row is the selected day of week...
- If Index = RowFlag Then
- ' If this row already has a time entry...
- If lblOutTime(Index).Caption <> "" Then
- ' Prepare and display error message.
- ErrMsg$ = "You need supervisor authority to change a time entry."
- MsgBox ErrMsg$, 0, "TimeCard Error"
- ' Abort procedure
- Exit Sub
- End If
- ' Identify icon by Tag property.
- Select Case Source.Tag
- ' If this is the clock in icon...
- Case "InTime"
- ' Prepare and display error message.
- ErrMsg$ = "You dropped the In picture on the Out column. Try again with the Out picture."
- MsgBox ErrMsg$, 0, "TimeCard Error"
- ' If this is the clock out icon...
- Case "OutTime"
- ' If there is no clock in time for this day...
- If lblInTime(Index).Caption = "" Then
- ' Prepare and display error message.
- ErrMsg$ = "You must clock in before you can clock out."
- MsgBox ErrMsg$, 0, "TimeCard Error"
- ' Abort procedure.
- Exit Sub
- End If
- ' Store clock in time. Subtract the integer/date information.
- OutTime = Now - Int(Now)
- ' Format clock out time using selected
- ' display format. Show time on time card.
- lblOutTime(Index).Caption = Format$(OutTime, "Medium Time")
- ' Store the current time in array with hour in 1st element
- ' and minutes in 2nd element.
- ClkOut(Index, 0) = Val(Left$(Format$(OutTime, HrFormat), 2))
- ClkOut(Index, 1) = Val(Right$(Format$(OutTime, HrFormat), 2))
- Case "Holiday"
- ' Display "Holiday" instead of clock in time
- lblInTime(Index).Caption = "Holiday"
- ' Don't display anything for time clocked out.
- lblOutTime(Index).Caption = " "
- ' Set time clocked in as a negative value to signal
- ' day is paid time off, not paid hours
- ClkIn(Index, 0) = -1
- ' If this sick time icon...
- Case "Sick"
- ' Display "Sick" instead of the time clocked in.
- lblInTime(Index).Caption = "Sick"
- ' Don't display anything for the time clocked out.
- lblOutTime(Index).Caption = " "
- ' Set time clocked in as a negative value to signal
- ' day is paid time off, not paid hours
- ClkIn(Index, 0) = -1
- ' If vacation icon...
- Case "Vacation"
- ' Display "Vacation" instead of time clocked in.
- lblInTime(Index).Caption = "Vacation"
- ' Don't display anything for the time clocked out.
- lblOutTime(Index).Caption = " "
- ' Set time clocked in as a negative value to signal
- ' day is paid time off, not paid hours
- ClkIn(Index, 0) = -1
- End Select
- ' Updates daily and weekly time totals.
- UpdateTime
- End If
- End Sub
- Sub lblOutTime_DragOver (Index As Integer, Source As Control, X As Single, Y As Single, State As Integer)
- ' If this row isn't the row you selected...
- If Index <> RowFlag Then
- ' Display the NOT symbol to show you can't drop here.
- Source.DragIcon = imgNotIcon.Picture
- ' Otherwise, show the icon itself to show you can drop here.
- Else Source.DragIcon = Source.Picture
- End If
- End Sub
- Sub LinesOnPrinter ()
- DrawWidth = 2
- ' Draw vertical line between weekday and clock in times.
- Printer.Line (1450, 360)-Step(0, 4040), QBColor(0)
- ' Draw vertical line between clock out time and daily total hours.
- Printer.Line (4090, 360)-Step(0, 4040), QBColor(0)
- ' Draw box around total regular and overtime hours.
- Printer.Line (2500, 4950)-Step(2532, 922), QBColor(0), B
- End Sub
- Sub mnuOptionsDemo_Click ()
- ' Declare local variables.
- Static InDemo(7)
- Static OutDemo(7)
- Dim X
- ' Wipe out current card.
- ClearCard
- ' Populate InDemo array with demo clock in times.
- InDemo(0) = .406435185184819
- InDemo(1) = 0
- InDemo(2) = .580219907409628
- InDemo(3) = .395891203705105
- InDemo(4) = .583842592590372
- InDemo(5) = .460798611107748
- ' Populate OutDemo array with demo clock out times.
- OutDemo(0) = .729641203703068
- OutDemo(1) = 0
- OutDemo(2) = .923842592594156
- OutDemo(3) = .740092592590372
- OutDemo(4) = .901099537033588
- OutDemo(5) = .661296296297233
- ' Move the pointer to Saturday.
- imgPointer.Top = 3480
- RowFlag = 5
- ' Display the clock in and out times.
- For X = 0 To 5
- ' Format and show clock in/out times using selected display format
- lblInTime(X).Caption = Format$(InDemo(X), "Medium Time")
- lblOutTime(X).Caption = Format$(OutDemo(X), "Medium Time")
- ' Store current time in array.
- ' Place hour in 1st element and minutes in 2nd element.
- ClkIn(X, 0) = Val(Left$(Format$(InDemo(X), HrFormat), 2))
- ClkIn(X, 1) = Val(Right$(Format$(InDemo(X), HrFormat), 2))
- ClkOut(X, 0) = Val(Left$(Format$(OutDemo(X), HrFormat), 2))
- ClkOut(X, 1) = Val(Right$(Format$(OutDemo(X), HrFormat), 2))
- Next X
- ' Reset Tuesday to show a Holiday.
- lblInTime(1).Caption = "Holiday"
- lblOutTime(1).Caption = ""
- ClkIn(1, 0) = -1
- ' Update card with daily and weekly hour totals.
- UpdateTime
- End Sub
- Sub mnuOptionsExit_Click ()
- ' Remove font selection dialog box from memory.
- Unload FontDialog
- ' Exit application.
- End
- End Sub
- Sub mnuOptionsFont_Click ()
- ' Show Select Fonts dialog as modal.
- FontDialog.Show 1
- End Sub
- Sub mnuOptionsHowTo_Click ()
- Dim HowTo
- Dim NL
- NL = Chr$(13) & Chr$(10) & Chr$(13) & Chr$(10)
- HowTo = "Click on day of week to select day." & NL
- HowTo = HowTo & "Drag Clock In icon onto In column beside selected day to clock in." & NL
- HowTo = HowTo & "Drag Clock Out icon onto Out column beside selected day to clock out." & NL
- HowTo = HowTo & "Drag Holiday, Vacation, or Sick icons onto In or Out columns for paid time off." & NL
- HowTo = HowTo & "Click Print Card button to print a copy of the time card."
- MsgBox HowTo, 64, "TimeCard Instructions"
- End Sub
- Sub mnuOptionsNew_Click ()
- ' Wipe current card clean.
- ClearCard
- End Sub
- Sub PrintFrm (PFrm As Form)
- ' Declare local variables.
- Dim CtlCnt
- ' Change the mouse pointer to the hourglass.
- PFrm.MousePointer = 11
- ' Set the font size for the Printer object.
- Printer.FontSize = 8.25
- ' Move the (0, 0) coordinates of the Printer object to center the
- ' form in the page.
- Printer.ScaleLeft = -((Printer.Width - PFrm.Width) / 2)
- Printer.ScaleTop = -((Printer.Height - PFrm.Height) / 2)
- ' Draw a box that represents the outline of the form.
- DrawWidth = 2
- Printer.Line (0, 0)-Step(PFrm.Width, PFrm.Height), , B
- ' Print Title bar on Printer object.
- Printer.Line (0, BarHgt)-Step(PFrm.Width, 0)
- Printer.CurrentX = (PFrm.Width - Printer.TextWidth("TimeCard")) / 2
- Printer.CurrentY = (BarHgt - Printer.TextHeight("TimeCard")) / 2
- Printer.Print "TimeCard"
- ' Move the (0, 0) coordinates of the Printer object so that it
- ' coincides with the (0, 0) coordinates of the form's client area
- ' by moving down a distance equal to the height of the Title bar
- ' and the Menu bar.
- SetClientPrintOrigin Card
- ' Use the Line method to redraw the lines and boxes displayed on the
- ' form on the Printer object.
- LinesOnPrinter
- ' Find and print the following controls if they are on the form...
- For CtlCnt = 0 To PFrm.Controls.Count - 1
- ' If command button...
- If TypeOf PFrm.Controls(CtlCnt) Is CommandButton Then
- DrawCmd PFrm.Controls(CtlCnt)
- ' If image control...
- ElseIf TypeOf PFrm.Controls(CtlCnt) Is PictureBox Then
- DrawPic PFrm.Controls(CtlCnt)
- ' If label...
- ElseIf TypeOf PFrm.Controls(CtlCnt) Is Label Then
- DrawLbl PFrm.Controls(CtlCnt)
- End If
- Next CtlCnt
- ' Send contents of Printer object to printer.
- Printer.EndDoc
- ' Change the mouse pointer back to default.
- PFrm.MousePointer = 0
- End Sub
- Sub SetClientPrintOrigin (PFrm As Form)
- ' Move the (0, 0) coordinates of the Printer object so that it
- ' coincides with the (0, 0) coordinates of the form's client area
- ' centered in the page.
- Printer.ScaleLeft = -((Printer.Width - PFrm.Width) / 2)
- Printer.ScaleTop = -((Printer.Height - PFrm.Height) / 2) - (2 * BarHgt)
- End Sub
- Sub UpdateTime ()
- ' Declare local variables.
- Dim DayTotal
- Dim NoOutFlag
- ' Reset total time for the week to 0 then recalculate from current
- ' daily totals.
- DailyHrs(7) = 0
- ' Reset total overtime hours to 0 then recalculate from new total time.
- OvrHrs = 0
- ' For each of the seven days of the week.
- For DayTotal = 0 To 6
- ' Initialize flag that signals day with clock in but no clock out.
- NoOutFlag = False
- ' Check to see if the day is time off with pay or paid time.
- Select Case ClkIn(DayTotal, 0)
- ' If the day is paid time... (if ClkIn has a non-negative
- ' value then it was set to remember when you clock in).
- Case Is > 0
- ' Check to see if there is a clock out time for the same day.
- If ClkOut(DayTotal, 1) = 0 Then
- NoOutFlag = True
- End If
- ' If the minutes of the clock out time are less than the minutes
- ' minutes of the clock in time (assuming there is a clock out time).
- If ClkOut(DayTotal, 1) <= ClkIn(DayTotal, 1) And NoOutFlag = False Then
- ' Subtract one hour from the hours of the clock out time.
- ClkOut(DayTotal, 0) = ClkOut(DayTotal, 0) - 1
- ' Add 60 minutes to the minutes of the clock in time.
- ClkOut(DayTotal, 1) = ClkOut(DayTotal, 1) + 60
- ' Hours worked that day equals clock out less clock in time.
- DailyHrs(DayTotal) = (ClkOut(DayTotal, 0) - ClkIn(DayTotal, 0)) + ((ClkOut(DayTotal, 1) - ClkIn(DayTotal, 1)) / 60)
- ElseIf ClkOut(DayTotal, 1) > ClkIn(DayTotal, 1) And NoOutFlag = False Then
- ' Hours worked that day equals clock out less clock in time.
- DailyHrs(DayTotal) = (ClkOut(DayTotal, 0) - ClkIn(DayTotal, 0)) + ((ClkOut(DayTotal, 1) - ClkIn(DayTotal, 1)) / 60)
- ElseIf NoOutFlag = True Then
- ' Display "Error" in clock out labels missing a time.
- lblOutTime(DayTotal).Caption = "Error"
- ' Set hours worked for the day to zero.
- DailyHrs(DayTotal) = 0
- ' Prepare an error message.
- ErrMsg$ = "You have forgotten to clock out on at least one day."
- ' Display the error message.
- MsgBox ErrMsg$, 0, "TimeCard Error"
- End If
- ' If the day is time off with pay... (if ClkIn has a negative
- ' value then it was set as a flag for sick/holiday/vacation pay)
- Case Is < 0
- ' Total hours equal 8 hours paid time off
- DailyHrs(DayTotal) = 8
- End Select
- ' Display the total hours for the day on the time card
- If DailyHrs(DayTotal) >= 0 And ClkIn(DayTotal, 0) <> 0 Then
- lblHours(DayTotal).Caption = Format$(DailyHrs(DayTotal), "#0.00")
- End If
- ' Total time for the week is the sum of all the daily totals
- DailyHrs(7) = DailyHrs(7) + DailyHrs(DayTotal)
- ' Get the next day of the week
- Next DayTotal
- ' If total time for the week is over the overtime limit (set by the
- ' OTLimit constant)
- If DailyHrs(7) > OTLimit Then
- ' Overtime hours equal total time for the week less the overtime
- ' limit
- OvrHrs = DailyHrs(7) - OTLimit
- ' Total regular hours for the week now set to the overtime limit
- DailyHrs(7) = OTLimit
- End If
- ' Display the total regular hours for the week at the bottom of the
- ' time card
- lblRegHrs.Caption = Format$(DailyHrs(7), "#0.00")
- ' Display any overtime hours at the bottom of the time card
- lblOverHrs.Caption = Format$(OvrHrs, "#0.00")
- End Sub
-