B4J=true Group=Default Group ModulesStructureVersion=1 Type=Class Version=9.08 @EndOfDesignText@ 'Events declaration #Event: DateChanged (NewDate As Long) #RaisesSynchronousEvents: DateChanged #DesignerProperty: Key: MinYear, DisplayName: Minimum Year, FieldType: Int, DefaultValue: 2019, MinRange: 1970, MaxRange: 2050 #DesignerProperty: Key: MaxYear, DisplayName: Maximum Year, FieldType: Int, DefaultValue: 2021, MinRange: 1970, MaxRange: 2050 #DesignerProperty: Key: FirstDay, DisplayName: First Day, FieldType: String, DefaultValue: Sunday, List: Sunday|Monday|Tuesday|Wednesday|Thursday|Friday|Saturday, Description: Sets the first day of week. #DesignerProperty: Key: BackgroundColor, DisplayName: Background Color, FieldType: Color, DefaultValue: 0xFFCFDCDC #DesignerProperty: Key: TitleColor, DisplayName: Title Color, FieldType: Color, DefaultValue: 0xFF1E90FF #DesignerProperty: Key: SelectedColor, DisplayName: Selected Color, FieldType: Color, DefaultValue: 0xFF0BA29B #DesignerProperty: Key: HighlightedColor, DisplayName: Highlighted Color, FieldType: Color, DefaultValue: 0xFFABFFFB Sub Class_Globals Private mEventName As String 'ignore Private mCallBack As Object 'ignore Public mBase As B4XView Private xui As XUI 'ignore Public Tag As Object #if B4J Private fx As JFX #End If Private boxW, boxH As Float Private vCorrection As Float Private DaysInMonth As Int Private TempSelectedDay As Int Private SelectedDate As Long = 0 Private SelectedYear, SelectedMonth, SelectedDay As Int Public FirstDay As Int = 0 Public MinYear = 1970, MaxYear = 2030 As Int Private DayOfWeekOffset,SelectedDayOfWeekOffset As Int Private Months As List Public DaysOfWeekNames As List private hasselect as boolean = False Public HighlightedColor As Int = 0xFF001BBD Public SelectedColor As Int = 0xFF0BA29B Public DaysInWeekColor As Int = xui.Color_Gray Public DaysInMonthColor As Int = xui.Color_Black Public TextColor As Int = xui.Color_Black Public selectedCanvas As B4XCanvas Private cvs As B4XCanvas Private cvsDays As B4XCanvas Private cvsBackground As B4XCanvas Private CLV As CustomListView Private DaysTitlesPane As B4XView Private DaysPaneBg As B4XView Private DaysPaneFg As B4XView Private lblMonthYear As B4XView Private Line As B4XView ' Public CloseOnSelection As Boolean = True End Sub Public Sub Initialize (CallBack As Object, EventName As String) mEventName = EventName mCallBack = CallBack Months = DateUtils.GetMonthsNames SelectedDate = DateTime.Now DaysOfWeekNames.Initialize DaysOfWeekNames.AddAll(DateUtils.GetDaysNames) End Sub 'Base type must be Object Public Sub DesignerCreateView (Base As Object, Lbl As Label, Props As Map) mBase = Base Tag = mBase.Tag mBase.Tag = Me mBase.LoadLayout("DateListview") DaysInWeekColor = xui.PaintOrColorToColor(Props.GetDefault("TitleColor", xui.Color_Black)) TextColor = xui.PaintOrColorToColor(Props.GetDefault("TextColor", xui.Color_Black)) HighlightedColor = xui.PaintOrColorToColor(Props.GetDefault("HighlightedColor", xui.Color_Cyan)) SelectedColor = xui.PaintOrColorToColor(Props.GetDefault("SelectedColor", xui.Color_Gray)) MinYear = Props.GetDefault("MinYear", 2021) MaxYear = Props.GetDefault("MaxYear", 2021) For yy = MinYear To MaxYear For mm = 1 To 12 CLV.Add(CreateListItem(mm, yy), $"${yy}-${mm}"$) Next Next setDate(SelectedDate) End Sub Private Sub Base_Resize (Width As Double, Height As Double) End Sub Sub CreateListItem(Month As Int, Year As Int) As B4XView Dim Pnl As B4XView = xui.CreatePanel("") Pnl.Width = CLV.AsView.Width Pnl.Height = Pnl.Width * 0.8 Pnl.LoadLayout("DateTemplate") #if B4J Dim p As Pane = Pnl P.MouseCursor = fx.Cursors.HAND #End If lblMonthYear.Text = Months.Get(Month - 1) & " " & Year lblMonthYear.TextColor = DaysInWeekColor Line.Color = DaysInWeekColor cvs.Initialize(DaysPaneFg) cvsBackground.Initialize(DaysPaneBg) boxW = cvs.TargetRect.Width / 7 boxH = cvs.TargetRect.Height / 6 vCorrection = 5dip cvsDays.Initialize(DaysTitlesPane) Dim days As List = DaysOfWeekNames Dim daysFont As B4XFont = xui.CreateDefaultBoldFont(14) cvsDays.ClearRect(cvsDays.TargetRect) For i = FirstDay To FirstDay + 6 Dim d As String = days.Get(i Mod 7) If d.Length > 3 Then d = d.SubString2(0, 3) cvsDays.DrawText(d, (i - FirstDay + 0.5) * boxW, 20dip, daysFont, DaysInWeekColor, "CENTER") Next cvsDays.Invalidate DrawDays(Month, Year) 'Sleep(0) Return Pnl End Sub Private Sub DrawDays(Month As Int, Year As Int) cvs.ClearRect(cvs.TargetRect) cvsBackground.ClearRect(cvsBackground.TargetRect) Dim firstDayOfMonth As Long = DateUtils.setDate(Year, Month, 1) - 1 DayOfWeekOffset = (7 + DateTime.GetDayOfWeek(firstDayOfMonth) - FirstDay) Mod 7 DaysInMonth = DateUtils.NumberOfDaysInMonth(Month, Year) If Year = SelectedYear And Month = SelectedMonth Then 'draw the selected box DrawBox(cvs, SelectedColor, (SelectedDay - 1 + DayOfWeekOffset) Mod 7, _ (SelectedDay - 1 + DayOfWeekOffset) / 7) End If Dim daysFont As B4XFont = xui.CreateDefaultBoldFont(14) For day = 1 To DaysInMonth Dim row As Int = (day - 1 + DayOfWeekOffset) / 7 cvs.DrawText(day, (((DayOfWeekOffset + day - 1) Mod 7) + 0.5) * boxW, _ (row + 0.5)* boxH + vCorrection, daysFont, DaysInMonthColor , "CENTER") Next cvsBackground.Invalidate cvs.Invalidate End Sub Private Sub DrawBox(c As B4XCanvas, clr As Int, x As Int, y As Int) Dim r As B4XRect r.Initialize(x * boxW, y * boxH, x * boxW + boxW, y * boxH + boxH) c.DrawRect(r, clr, True, 1dip) End Sub 'Gets or sets the selected date Public Sub getDate As Long Return SelectedDate End Sub Public Sub setDate(date As Long) 'The layout is not loaded immediately so we need to make sure that the layout was loaded. If lblMonthYear.IsInitialized = False Then SelectedDate = date Return 'the date will be set after the layout is loaded End If Dim year As Int = DateTime.GetYear(date) Dim month As Int = DateTime.GetMonth(date) Dim day As Int = DateTime.GetDayOfMonth(date) SelectDay(year, month, day) Dim index As Int = ((year-MinYear) * 12) + month' - 1 CLV.JumpToItem(index) End Sub Private Sub SelectDay(year As Int, month As Int, day As Int) SelectedDate = DateUtils.setDate(year, month, day) SelectedYear = year SelectedMonth = month SelectedDay = day Dim firstDayOfMonth As Long = DateUtils.setDate(SelectedYear, SelectedMonth, 1) - 1 SelectedDayOfWeekOffset = (7 + DateTime.GetDayOfWeek(firstDayOfMonth) - FirstDay) Mod 7 End Sub Private Sub HandleMouse(x As Double, y As Double, move As Boolean, pane As B4XView) Dim index As Int = CLV.GetItemFromView(pane) Dim mmyy As String = CLV.GetValue(index) Dim dd() As String = Regex.Split("-", mmyy) Dim firstDayOfMonth As Long = DateUtils.setDate(dd(0), dd(1), 1) - 1 DayOfWeekOffset = (7 + DateTime.GetDayOfWeek(firstDayOfMonth) - FirstDay) Mod 7 DaysInMonth = DateUtils.NumberOfDaysInMonth(dd(1), dd(0)) Dim boxX = x / boxW, boxY = y / boxH As Int Dim newSelectedDay As Int = boxY * 7 + boxX + 1 - DayOfWeekOffset Dim validDay As Boolean = newSelectedDay > 0 And newSelectedDay <= DaysInMonth If move Then If newSelectedDay = TempSelectedDay Then Return cvsBackground.ClearRect(cvsBackground.TargetRect) TempSelectedDay = newSelectedDay If validDay Then cvsBackground.Initialize(pane) ' test DrawBox(cvsBackground, HighlightedColor, boxX, boxY) End If ' If dd(0) = SelectedYear And dd(1) = SelectedMonth Then If (hasselect) Then selectedCanvas.ClearRect(selectedCanvas.TargetRect) Log($"Drawing move ${(SelectedDay - 1 + SelectedDayOfWeekOffset) Mod 7},${((SelectedDay - 1 + SelectedDayOfWeekOffset) / 7).As(Int)}"$) DrawBox(selectedCanvas, SelectedColor, (SelectedDay - 1 + SelectedDayOfWeekOffset) Mod 7, _ ((SelectedDay - 1 + SelectedDayOfWeekOffset) / 7).As(Int)) End If Else cvsBackground.ClearRect(cvsBackground.TargetRect) If validDay Then SelectDay(dd(0), dd(1), newSelectedDay) 'call the ValuesChanged routine if it exists If xui.SubExists(mCallBack, mEventName & "_DateChanged", 1) Then CallSub2(mCallBack, mEventName & "_DateChanged", SelectedDate) End If 'If CloseOnSelection Then ' Hide 'Else ' DrawDays 'End If 'DrawDays(dd(1), dd(0)) If dd(0) = SelectedYear And dd(1) = SelectedMonth Then 'draw the selected box Log($"Drawing new ${(SelectedDay - 1 + DayOfWeekOffset) Mod 7},${((SelectedDay - 1 + DayOfWeekOffset) / 7).As(Int)}"$) DrawBox(cvsBackground, SelectedColor, (SelectedDay - 1 + DayOfWeekOffset) Mod 7, _ (SelectedDay - 1 + DayOfWeekOffset) / 7) If (hasselect) Then selectedCanvas.ClearRect(selectedCanvas.TargetRect) selectedCanvas.Initialize(pane) hasselect = True End If End If End If cvsBackground.Invalidate 'cvs.Invalidate End Sub Private Sub DaysPaneFg_Touch (Action As Int, X As Float, Y As Float) Dim p As B4XView = DaysPaneFg HandleMouse(X, Y, Action <> p.TOUCH_ACTION_UP, Sender) End Sub 'Private Sub CLV_ItemClick (Index As Int, Value As Object) ' Log("CLV_ItemClick") 'End Sub