⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 abstimelist.ctl

📁 Abstract TimeList Control v1.0
💻 CTL
📖 第 1 页 / 共 2 页
字号:
    intOriginalHour = inthour
    
    UserControl.Line (LEFT_INSET, Y)-(UserControl.ScaleWidth - (LEFT_INSET * 2), Y)
    
    SetPos LEFT_INSET, Y + 50
    
    UserControl.Font.Bold = True
    UserControl.Font.Size = 12
                
    lngNormalColor = UserControl.ForeColor
    UserControl.ForeColor = mlngHourColor
                
    If inthour < 12 Then
        If inthour = 0 Then
            If mintClockType = abs12HourClock Then
                inthour = 12
            Else
                inthour = 0
            End If
        End If
        
        If mintClockType = abs12HourClock Then
            UserControl.Print inthour
        Else
            UserControl.Print String(2 - Len(CStr(inthour)), "0") & inthour
        End If
                
        SetPos LEFT_INSET + 150, Y + 300
        
        UserControl.Font.Bold = False
        UserControl.Font.Size = 8
                
        If mintClockType = abs12HourClock Then
            UserControl.Print "am"
        End If
    Else
        If inthour = 12 Then
            UserControl.Print inthour
        Else
            If mintClockType = abs12HourClock Then
                UserControl.Print inthour - 12
            Else
                UserControl.Print inthour
            End If
        End If
        
        SetPos LEFT_INSET + 150, Y + 300
        
        UserControl.Font.Bold = False
        UserControl.Font.Size = 8
    
        If mintClockType = abs12HourClock Then
            UserControl.Print "pm"
        End If
    End If
    
    UserControl.ForeColor = lngNormalColor
    
    'Minutes
    lngOffset = 50
    mTimeBox(intOriginalHour).tX_00 = MINUTE_INSET
    mTimeBox(intOriginalHour).tY_00 = Y + lngOffset + 15
    mTimeBox(intOriginalHour).X1_00 = MINUTE_INSET
    mTimeBox(intOriginalHour).Y1_00 = Y + lngOffset + 15
    mTimeBox(intOriginalHour).X2_00 = UserControl.ScaleWidth - MINUTE_INSET
    
    If Not mTimeBox(intOriginalHour).i_00 Is Nothing Then
        UserControl.PaintPicture mTimeBox(intOriginalHour).i_00, ICON_INSET, Y + lngOffset + 15
    End If
    
    If Not mTimeBox(intOriginalHour).t_00 = "" Then
        SetPos TEXT_INSET, Y + lngOffset + 15
        UserControl.Print mTimeBox(intOriginalHour).t_00
    End If
    
    SetPos MINUTE_INSET, Y + lngOffset + 15
    
    lngOffset = lngOffset + MINUTE_HEIGHT
    mTimeBox(intOriginalHour).Y2_00 = Y + lngOffset
        
    If mTimeBox(intOriginalHour).B_00 = True Then
        lngNormalColor = UserControl.ForeColor
        UserControl.ForeColor = mlngMarkedColor
        UserControl.Font.Bold = True
        UserControl.Print "00"
        UserControl.Font.Bold = False
        UserControl.ForeColor = lngNormalColor
    Else
        lngNormalColor = UserControl.ForeColor
        UserControl.ForeColor = mlngMinuteColor
        UserControl.Print "00"
        UserControl.ForeColor = lngNormalColor
    End If
        
    lngNormalColor = UserControl.ForeColor
    UserControl.ForeColor = MINUTE_LINE_COLOR
    UserControl.Line (MINUTE_INSET, Y + lngOffset + 5)-(UserControl.ScaleWidth - MINUTE_INSET, Y + lngOffset + 5)
    UserControl.ForeColor = lngNormalColor
        
    mTimeBox(intOriginalHour).tX_15 = MINUTE_INSET
    mTimeBox(intOriginalHour).tY_15 = Y + lngOffset + 15
    mTimeBox(intOriginalHour).X1_15 = MINUTE_INSET
    mTimeBox(intOriginalHour).Y1_15 = Y + lngOffset + 15
    mTimeBox(intOriginalHour).X2_15 = UserControl.ScaleWidth - MINUTE_INSET
    
    If Not mTimeBox(intOriginalHour).i_15 Is Nothing Then
        UserControl.PaintPicture mTimeBox(intOriginalHour).i_15, ICON_INSET, Y + lngOffset + 15
    End If
    
    If Not mTimeBox(intOriginalHour).t_15 = "" Then
        SetPos TEXT_INSET, Y + lngOffset + 15
        UserControl.Print mTimeBox(intOriginalHour).t_15
    End If
    
    SetPos MINUTE_INSET, Y + lngOffset + 15
    
    lngOffset = lngOffset + MINUTE_HEIGHT
    mTimeBox(intOriginalHour).Y2_15 = Y + lngOffset
        
    If mTimeBox(intOriginalHour).B_15 = True Then
        lngNormalColor = UserControl.ForeColor
        UserControl.ForeColor = mlngMarkedColor
        UserControl.Font.Bold = True
        UserControl.Print "15"
        UserControl.Font.Bold = False
        UserControl.ForeColor = lngNormalColor
    Else
        lngNormalColor = UserControl.ForeColor
        UserControl.ForeColor = mlngMinuteColor
        UserControl.Print "15"
        UserControl.ForeColor = lngNormalColor
    End If
        
    UserControl.ForeColor = MINUTE_LINE_COLOR
    UserControl.Line (MINUTE_INSET, Y + lngOffset + 5)-(UserControl.ScaleWidth - MINUTE_INSET, Y + lngOffset + 5)
    UserControl.ForeColor = lngNormalColor
    
    mTimeBox(intOriginalHour).tX_30 = MINUTE_INSET
    mTimeBox(intOriginalHour).tY_30 = Y + lngOffset + 15
    mTimeBox(intOriginalHour).X1_30 = MINUTE_INSET
    mTimeBox(intOriginalHour).Y1_30 = Y + lngOffset + 15
    mTimeBox(intOriginalHour).X2_30 = UserControl.ScaleWidth - MINUTE_INSET
    
    If Not mTimeBox(intOriginalHour).i_30 Is Nothing Then
        UserControl.PaintPicture mTimeBox(intOriginalHour).i_30, ICON_INSET, Y + lngOffset + 15
    End If
    
    If Not mTimeBox(intOriginalHour).t_30 = "" Then
        SetPos TEXT_INSET, Y + lngOffset + 15
        UserControl.Print mTimeBox(intOriginalHour).t_30
    End If
    
    SetPos MINUTE_INSET, Y + lngOffset + 15
    
    lngOffset = lngOffset + MINUTE_HEIGHT
    mTimeBox(intOriginalHour).Y2_30 = Y + lngOffset
        
    If mTimeBox(intOriginalHour).B_30 = True Then
        lngNormalColor = UserControl.ForeColor
        UserControl.ForeColor = mlngMarkedColor
        UserControl.Font.Bold = True
        UserControl.Print "30"
        UserControl.Font.Bold = False
        UserControl.ForeColor = lngNormalColor
    Else
        lngNormalColor = UserControl.ForeColor
        UserControl.ForeColor = mlngMinuteColor
        UserControl.Print "30"
        UserControl.ForeColor = lngNormalColor
    End If
    
    UserControl.ForeColor = MINUTE_LINE_COLOR
    UserControl.Line (MINUTE_INSET, Y + lngOffset + 5)-(UserControl.ScaleWidth - MINUTE_INSET, Y + lngOffset + 5)
    UserControl.ForeColor = lngNormalColor
    
    mTimeBox(intOriginalHour).tX_45 = MINUTE_INSET
    mTimeBox(intOriginalHour).tY_45 = Y + lngOffset + 15
    mTimeBox(intOriginalHour).X1_45 = MINUTE_INSET
    mTimeBox(intOriginalHour).Y1_45 = Y + lngOffset + 15
    mTimeBox(intOriginalHour).X2_45 = UserControl.ScaleWidth - MINUTE_INSET
    
    If Not mTimeBox(intOriginalHour).i_45 Is Nothing Then
        UserControl.PaintPicture mTimeBox(intOriginalHour).i_45, ICON_INSET, Y + lngOffset + 15
    End If
    
    If Not mTimeBox(intOriginalHour).t_45 = "" Then
        SetPos TEXT_INSET, Y + lngOffset + 15
        UserControl.Print mTimeBox(intOriginalHour).t_45
    End If
    
    SetPos MINUTE_INSET, Y + lngOffset + 15
    
    lngOffset = lngOffset + MINUTE_HEIGHT
    mTimeBox(intOriginalHour).Y2_45 = Y + lngOffset
        
    If mTimeBox(intOriginalHour).B_45 = True Then
        lngNormalColor = UserControl.ForeColor
        UserControl.ForeColor = mlngMarkedColor
        UserControl.Font.Bold = True
        UserControl.Print "45"
        UserControl.Font.Bold = False
        UserControl.ForeColor = lngNormalColor
    Else
        lngNormalColor = UserControl.ForeColor
        UserControl.ForeColor = mlngMinuteColor
        UserControl.Print "45"
        UserControl.ForeColor = lngNormalColor
    End If
    
    HighlightMinute mintCurrentIndex, mintCurrentMinute
End Sub

Private Sub SetPos(X As Single, Y As Single)
    UserControl.CurrentX = X
    UserControl.CurrentY = Y
End Sub

Public Property Get Value() As Date
Attribute Value.VB_ProcData.VB_Invoke_Property = "pagGeneral"
Attribute Value.VB_MemberFlags = "234"
    Value = mdteTime
End Property

Public Property Let Value(ByVal NewTime As Date)
    mdteTime = NewTime
    
    PropertyChanged Value
End Property

Public Property Get Caption() As String
Attribute Caption.VB_UserMemId = -518
    Caption = pneTop.Caption
End Property

Public Property Let Caption(ByVal NewCaption As String)
    pneTop.Caption = NewCaption
    
    PropertyChanged Caption
End Property

Public Property Get IntegralHeight() As Boolean
    IntegralHeight = mblnIntegralHeight
End Property

Public Property Let IntegralHeight(ByVal NewValue As Boolean)
    mblnIntegralHeight = NewValue
    
    Call UserControl_Resize
    
    PropertyChanged IntegralHeight
End Property

Public Property Get ClockType() As TimeConstants
    ClockType = mintClockType
End Property

Public Property Let ClockType(ByVal NewValue As TimeConstants)
    mintClockType = NewValue
    DrawTimeBlocks
    
    PropertyChanged ClockType
End Property

Public Property Get BackColor() As OLE_COLOR
    BackColor = UserControl.BackColor
End Property

Public Property Let BackColor(ByVal NewColor As OLE_COLOR)
    UserControl.BackColor = NewColor
    DrawTimeBlocks
    
    PropertyChanged BackColor
End Property

Public Property Get ForeColor() As OLE_COLOR
Attribute ForeColor.VB_ProcData.VB_Invoke_Property = ";Appearance"
    ForeColor = UserControl.ForeColor
End Property

Public Property Let ForeColor(ByVal NewColor As OLE_COLOR)
    UserControl.ForeColor = NewColor
    DrawTimeBlocks
    
    PropertyChanged ForeColor
End Property

Public Sub MarkTime(dteTime As Date, Optional Icon As Picture = Nothing, Optional Text As String = "")
    Dim intMin As Integer

    intMin = Minute(dteTime)

    Select Case intMin
    Case 0, 15, 30, 45
    Case 1 - 14
        If intMin < (15 - intMin) Then
            intMin = 0
        Else
            intMin = 15
        End If
    Case 16 - 29
        If (15 - intMin) < (30 - intMin) Then
            intMin = 15
        Else
            intMin = 30
        End If
    Case 31 - 44
        If (30 - intMin) < (45 - intMin) Then
            intMin = 30
        Else
            intMin = 45
        End If
    Case 46 - 59
        If (45 - intMin) < (60 - intMin) Then
            intMin = 45
        Else
            intMin = 0
        End If
    
    End Select
    
    Select Case intMin
    Case 0
        mTimeBox(Hour(dteTime)).B_00 = True
        Set mTimeBox(Hour(dteTime)).i_00 = Icon
        mTimeBox(Hour(dteTime)).t_00 = Text
    Case 15
        mTimeBox(Hour(dteTime)).B_15 = True
        Set mTimeBox(Hour(dteTime)).i_15 = Icon
        mTimeBox(Hour(dteTime)).t_15 = Text
    Case 30
        mTimeBox(Hour(dteTime)).B_30 = True
        Set mTimeBox(Hour(dteTime)).i_30 = Icon
        mTimeBox(Hour(dteTime)).t_30 = Text
    Case 45
        mTimeBox(Hour(dteTime)).B_45 = True
        Set mTimeBox(Hour(dteTime)).i_45 = Icon
        mTimeBox(Hour(dteTime)).t_45 = Text
    End Select
    
    DrawTimeBlocks
End Sub

Public Sub UnMarkTime(ByVal dteTime As Date)
    Select Case Minute(dteTime)
    Case 0
        mTimeBox(Hour(dteTime)).B_00 = False
        Set mTimeBox(Hour(dteTime)).i_00 = Nothing
        mTimeBox(Hour(dteTime)).t_00 = ""
    Case 15
        mTimeBox(Hour(dteTime)).B_15 = False
        Set mTimeBox(Hour(dteTime)).i_15 = Nothing
        mTimeBox(Hour(dteTime)).t_15 = ""
    Case 30
        mTimeBox(Hour(dteTime)).B_30 = False
        Set mTimeBox(Hour(dteTime)).i_30 = Nothing
        mTimeBox(Hour(dteTime)).t_30 = ""
    Case 45
        mTimeBox(Hour(dteTime)).B_45 = False
        Set mTimeBox(Hour(dteTime)).i_45 = Nothing
        mTimeBox(Hour(dteTime)).t_45 = ""
    End Select
End Sub

Public Sub ClearMarked()
    Dim i As Integer

    For i = LBound(mTimeBox) To UBound(mTimeBox)
        mTimeBox(i).B_00 = False
        mTimeBox(i).B_15 = False
        mTimeBox(i).B_30 = False
        mTimeBox(i).B_45 = False
        Set mTimeBox(i).i_00 = Nothing
        Set mTimeBox(i).i_15 = Nothing
        Set mTimeBox(i).i_30 = Nothing
        Set mTimeBox(i).i_45 = Nothing
        mTimeBox(i).t_00 = ""
        mTimeBox(i).t_15 = ""
        mTimeBox(i).t_30 = ""
        mTimeBox(i).t_45 = ""
    Next
End Sub

Public Property Get MarkedColor() As OLE_COLOR
Attribute MarkedColor.VB_ProcData.VB_Invoke_Property = ";Appearance"
    MarkedColor = mlngMarkedColor
End Property

Public Property Let MarkedColor(ByVal NewColor As OLE_COLOR)
    mlngMarkedColor = NewColor
    
    PropertyChanged MarkedColor
End Property

Public Property Get HourColor() As OLE_COLOR
    HourColor = mlngHourColor
End Property

Public Property Let HourColor(ByVal NewColor As OLE_COLOR)
    mlngHourColor = NewColor
    
    DrawTimeBlocks
    
    PropertyChanged HourColor
End Property

Public Property Get MinuteColor() As OLE_COLOR
    MinuteColor = mlngMinuteColor
End Property

Public Property Let MinuteColor(ByVal NewColor As OLE_COLOR)
    mlngMinuteColor = NewColor
    
    DrawTimeBlocks
    
    PropertyChanged MinuteColor
End Property

Public Property Get HighlightColor() As OLE_COLOR
    HighlightColor = mlngHighlightColor
End Property

Public Property Let HighlightColor(ByVal NewColor As OLE_COLOR)
    mlngHighlightColor = NewColor
    
    DrawTimeBlocks
    
    PropertyChanged HighlightColor
End Property

Public Property Get HighlightTextColor() As OLE_COLOR
    HighlightTextColor = mlngHighlightTextColor
End Property

Public Property Let HighlightTextColor(ByVal NewColor As OLE_COLOR)
    mlngHighlightTextColor = NewColor
    
    DrawTimeBlocks
    
    PropertyChanged HighlightTextColor
End Property


⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -