VBCommons/ui/Calendar/z_CalendarUI.bas
2024-06-07 20:46:40 +03:00

50 lines
1.4 KiB
QBasic

Attribute VB_Name = "z_CalendarUI"
' =========== Calendar picker native VBA ================
' Shared module version: 20210123
' Dependencies: CSE_Calendar, CSE_CallbackCalendar
Option Private Module
Option Explicit
Public Enum TCalendarTheme
T_CT_INVALID = 0
[_First] = 1
T_CT_DARK = 1
T_CT_RED = 2
T_CT_BLUE = 3
T_CT_LIGHT = 4
[_Last] = 4
End Enum
Public Function PromptDate(initDate&, Optional ByRef cTheme As TCalendarTheme = T_CT_DARK) As Long
With CSE_Calendar
Call .Init(initDate, cTheme)
Call .Show
If .isCancelled_ Then _
Exit Function
PromptDate = .SelectedDate
cTheme = .Theme
End With
End Function
Public Function CalendarTheme2String(eTheme As TCalendarTheme) As String
Select Case eTheme
Case T_CT_DARK: CalendarTheme2String = "DARK"
Case T_CT_RED: CalendarTheme2String = "RED"
Case T_CT_BLUE: CalendarTheme2String = "BLUE"
Case T_CT_LIGHT: CalendarTheme2String = "LIGHT"
Case Else: CalendarTheme2String = "INVALID"
End Select
End Function
Public Function String2CalendarTheme(sTheme$) As TCalendarTheme
Select Case sTheme
Case "DARK": String2CalendarTheme = T_CT_DARK
Case "RED": String2CalendarTheme = T_CT_RED
Case "BLUE": String2CalendarTheme = T_CT_BLUE
Case "LIGHT": String2CalendarTheme = T_CT_LIGHT
Case Else: String2CalendarTheme = T_CT_INVALID
End Select
End Function