54 lines
1.6 KiB
OpenEdge ABL
54 lines
1.6 KiB
OpenEdge ABL
|
VERSION 1.0 CLASS
|
||
|
|
BEGIN
|
||
|
|
MultiUse = -1 'True
|
||
|
|
END
|
||
|
|
Attribute VB_Name = "CSE_CallbackCalendar"
|
||
|
|
Attribute VB_GlobalNameSpace = False
|
||
|
|
Attribute VB_Creatable = False
|
||
|
|
Attribute VB_PredeclaredId = False
|
||
|
|
Attribute VB_Exposed = False
|
||
|
|
' =========== Calendar picker native VBA - Label clicks callback ================
|
||
|
|
' Shared module version: 20210130
|
||
|
|
' Dependencies: z_CalendarUI, CSE_Calendar
|
||
|
|
Option Explicit
|
||
|
|
|
||
|
|
Private Const CAL_MOVE_MARGIN = 2
|
||
|
|
|
||
|
|
Public WithEvents control_ As MSForms.Label
|
||
|
|
Attribute control_.VB_VarHelpID = -1
|
||
|
|
|
||
|
|
Private underline_ As Boolean
|
||
|
|
|
||
|
|
Public Function Init(aControl As MSForms.Label, Optional bUnderline As Boolean = False)
|
||
|
|
Set control_ = aControl
|
||
|
|
underline_ = bUnderline
|
||
|
|
End Function
|
||
|
|
|
||
|
|
Private Sub control__Click()
|
||
|
|
Dim controlType$: controlType = Left(control_.Name, 1)
|
||
|
|
Select Case controlType
|
||
|
|
Case "D": Call CSE_Calendar.OnDayClicked(control_)
|
||
|
|
Case "M": Call CSE_Calendar.OnMonthClicked(control_)
|
||
|
|
Case "Y": Call CSE_Calendar.OnYearClicked(control_)
|
||
|
|
End Select
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
Private Sub control__MouseMove(ByVal nBtn As Integer, ByVal nShift As Integer, ByVal mvX As Single, ByVal mvY As Single)
|
||
|
|
Dim bIsOutside As Boolean: bIsOutside = IsMoveOutside(mvX, mvY)
|
||
|
|
If underline_ Then
|
||
|
|
control_.Font.Underline = Not bIsOutside
|
||
|
|
control_.Font.Bold = Not bIsOutside
|
||
|
|
Else
|
||
|
|
control_.BorderStyle = IIf(bIsOutside, fmBorderStyleNone, fmBorderStyleSingle)
|
||
|
|
End If
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
' =======
|
||
|
|
Private Function IsMoveOutside(mvX As Single, mvY As Single)
|
||
|
|
IsMoveOutside = _
|
||
|
|
mvX >= control_.Width - CAL_MOVE_MARGIN Or _
|
||
|
|
mvX <= CAL_MOVE_MARGIN Or _
|
||
|
|
mvY <= CAL_MOVE_MARGIN Or _
|
||
|
|
mvY >= control_.Height - CAL_MOVE_MARGIN
|
||
|
|
End Function
|