VERSION 5.00
Begin VB.UserControl ctTimeBoxA 
   BackColor       =   &H80000005&
   BorderStyle     =   1  'Fixed Single
   ClientHeight    =   300
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   870
   ClipBehavior    =   0  'None
   ClipControls    =   0   'False
   EditAtDesignTime=   -1  'True
   FillStyle       =   0  'Solid
   FontTransparent =   0   'False
   HasDC           =   0   'False
   HitBehavior     =   0  'None
   KeyPreview      =   -1  'True
   PaletteMode     =   4  'None
   ScaleHeight     =   20
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   58
   Begin VB.TextBox eText 
      Alignment       =   1  'Right Justify
      Appearance      =   0  'Flat
      BorderStyle     =   0  'None
      Height          =   285
      Index           =   1
      Left            =   330
      MaxLength       =   2
      TabIndex        =   3
      TabStop         =   0   'False
      Text            =   "00"
      Top             =   15
      Width           =   240
   End
   Begin VB.VScrollBar eScroll 
      CausesValidation=   0   'False
      Height          =   240
      Left            =   600
      Max             =   2
      TabIndex        =   1
      TabStop         =   0   'False
      Top             =   0
      Value           =   1
      Width           =   210
   End
   Begin VB.TextBox eText 
      Alignment       =   1  'Right Justify
      Appearance      =   0  'Flat
      BorderStyle     =   0  'None
      Height          =   285
      Index           =   0
      Left            =   30
      MaxLength       =   2
      TabIndex        =   0
      TabStop         =   0   'False
      Text            =   "00"
      Top             =   15
      Width           =   240
   End
   Begin VB.Label eLabel 
      Alignment       =   2  'Center
      BackColor       =   &H80000005&
      Caption         =   ":"
      ForeColor       =   &H80000008&
      Height          =   375
      Left            =   270
      TabIndex        =   2
      Top             =   15
      UseMnemonic     =   0   'False
      Width           =   105
   End
End
Attribute VB_Name = "ctTimeBoxA"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' usercontrol for Visual Basic 6
' Copyright (C) 2003,2004 Jan Vorel
' This program is free software; you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation; either version 2 of the License, or
' (at your option) any later version.

' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU General Public License for more details.

' You should have received a copy of the GNU General Public License
' along with this program; if not, write to the Free Software
' Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

' This is a shared modul, class modul, usercontrol or form. It is also
' published under the GNU General Public License.

' If you have any questions, suggestions or bug reports about this product,
' contact me: info@ctuser.net; Do not contact me about general B.A.S.I.C.
' language or A.P.I. issues



Option Explicit
Option Base 0

Private xCur(1&) As Long
Private xInitWidth As Single
Private xInitHeight As Single
Private xLocked As Boolean
Private xCurBox As Long
Private xTabbing As Boolean
Private xOldPushValue As Long

Public Event ValueChange(ByVal NewValue As String)

Public Property Let Enabled(ByVal NewValue As Boolean)
eText(0).Enabled = NewValue
eText(1).Enabled = NewValue
eScroll.Enabled = NewValue
UserControl.Enabled = NewValue
End Property

Public Property Let Grayed(ByVal NewValue As Boolean)
If NewValue Then
  eText(0).BackColor = &H8000000F
  eText(0).ForeColor = &H80000012
  eText(1).BackColor = &H8000000F
  eText(1).ForeColor = &H80000012
  eLabel.BackColor = &H8000000F
  eLabel.ForeColor = &H80000012
  Else
  eText(0).BackColor = &H80000005
  eText(0).ForeColor = &H80000008
  eText(1).BackColor = &H80000005
  eText(1).ForeColor = &H80000008
  eLabel.BackColor = &H80000005
  eLabel.ForeColor = &H80000008
  End If
End Property

Public Property Let Value(ByVal NewValue As String)
Dim xLong1 As Long
Dim xLong2 As Long
If Len(NewValue) = 5& Then
  xLong1 = Val(Left(NewValue, 2))
  xLong2 = Val(Right(NewValue, 2))
  If xLong1 > -1& And xLong1 < 24 And _
     xLong2 > -1& And xLong2 < 60& Then
    xCur(0&) = xLong1
    xCur(1&) = xLong2
    ReWrite 2&
    End If
  xOldPushValue = xLong1 * 100& + xLong2
  End If
End Property

Public Property Get Value() As String
Value = Right("00" & xCur(0&), 2) & ":" & Right("00" & xCur(1&), 2)
End Property

Private Sub eScroll_Change()
If Not xLocked Then
  xLocked = True
  If Not eScroll.Value = 1 Then
    If eScroll.Value = 2 Then
      UserControl_KeyDown 40, 0
      Else
      UserControl_KeyDown 38, 0
      End If
    xLocked = True
    eScroll.Value = 1
    xLocked = False
    End If
'      RaiseEvent ValueChange(xCur)
  End If
End Sub

Private Sub eScroll_Scroll()
eScroll_Change
End Sub

Private Sub eText_Change(Index As Integer)
If Not xLocked Then
  xCur(Index) = Val(eText(Index).Text)
  PrepareData
  PushData
  If xCurBox = 0& And Len(eText(0).Text) = 2& Then
    On Error Resume Next
    eText(1).SetFocus
    On Error GoTo 0
    End If
  End If
End Sub

Private Sub eText_GotFocus(Index As Integer)
Static xBool1 As Boolean

xCur(xCurBox) = Val(eText(xCurBox).Text)
ReWrite xCurBox
xCurBox = CLng(Index)

xBool1 = xLocked
xLocked = True

If xCur(xCurBox) = 0& Then
  eText(xCurBox).Text = ""
  Else
  eText(xCurBox).Text = CStr(xCur(xCurBox))
  If xTabbing Then
    If xCur(xCurBox) < 10& Then
      eText(xCurBox).SelStart = 1&
      Else
      eText(xCurBox).SelStart = 2&
      End If
    End If
  End If

xTabbing = False
xLocked = xBool1
End Sub

Private Sub eText_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
Select Case KeyCode
  Case 37
    If xCurBox = 1& Then
      If eText(1).SelStart = 0& Then
        xTabbing = True
        On Error Resume Next
        eText(0).SetFocus
        On Error GoTo 0
        End If
      End If
  Case 39
    If xCurBox = 0& Then
      If eText(0).SelStart = Len(eText(0).Text) Then
        On Error Resume Next
        eText(1).SetFocus
        On Error GoTo 0
        End If
      End If
  End Select
End Sub

Private Sub eText_KeyPress(Index As Integer, KeyAscii As Integer)
Select Case KeyAscii
  Case 8
  Case 48 To 57
  Case Else
    KeyAscii = 0
  End Select
End Sub

Private Sub UserControl_EnterFocus()
If Not xCur(0) = 0& Then
  On Error Resume Next
  eText(1).SetFocus
  On Error GoTo 0
  DoEvents
  xTabbing = True
  eText_GotFocus 1
  End If
End Sub

Private Sub UserControl_ExitFocus()
xCur(xCurBox) = Val(eText(xCurBox).Text)
'PrepareData
ReWrite 2&
End Sub

Private Sub UserControl_Initialize()
xInitWidth = UserControl.Width
xInitHeight = UserControl.Height
ReWrite 2&
End Sub

Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
  Case 8
    If xCurBox = 1& Then
      If eText(1).Text = "" Then
        xLocked = True
        xTabbing = True
        On Error Resume Next
        eText(0).SetFocus
        On Error GoTo 0
        DoEvents
        eText(1).Text = "00"
        xCur(1&) = 0
        KeyCode = 0
        xLocked = False
        End If
      End If
  Case 33, 34, 38, 40
    xCur(xCurBox) = Val(eText(xCurBox).Text)
    Call PrepareData
    If xCurBox = 0& Then
      Select Case KeyCode
        Case 38, 33 ', 40 '+1/-1
          xCur(0&) = (xCur(0&) + 1&) Mod 24&
        Case 40, 34 ', 40 '+1/-1
          xCur(0&) = (xCur(0&) + 23&) Mod 24&
        End Select
      Else
      Select Case KeyCode
        Case 38, 40
          xCur(1&) = (xCur(1&) + 99& - CLng(KeyCode)) Mod 60&
        Case 33
          xCur(1&) = (xCur(1&) + 10&) Mod 60&
        Case 34
          xCur(1&) = (xCur(1&) + 50&) Mod 60&
        End Select
      End If

    Call ReWrite(xCurBox)
    PushData
    KeyCode = 0
  End Select
End Sub

Private Sub UserControl_Resize()
UserControl.Width = xInitWidth
UserControl.Height = xInitHeight
End Sub

Private Sub ReWrite(ByVal Params As Long)
xLocked = True
PrepareData
If Not Params = 1& Then
  eText(0).Text = Right("00" & CStr(xCur(0&)), 2)
  End If
If Not Params = 0& Then
  eText(1).Text = Right("00" & CStr(xCur(1&)), 2)
  End If
xLocked = False
End Sub

Private Sub PrepareData()
If xCur(xCurBox) < 0& Then
  xCur(xCurBox) = 0&
  Else
  If xCurBox = 0& Then
    If xCur(0&) = 24 Then
      xCur(0&) = 0&
      ElseIf xCur(0&) > 24& Then
      xCur(0&) = 23&
      End If
    Else
    If xCur(1&) > 59& Then
      xCur(1&) = 59&
      End If
    End If
  End If
End Sub

Private Sub PushData()
Dim xLong1 As Long

xLong1 = xCur(0&) * 100& + xCur(1&)
If Not xLong1 = xOldPushValue Then
  RaiseEvent ValueChange(Right("00" & xCur(0&), 2) & ":" & Right("00" & xCur(1&), 2))
  xOldPushValue = xLong1
  End If
End Sub
