B4J Tutorial [ABMaterial] Creating Dynamic Legend specific Calendar Events at runtime

Hi there...

Well, this is just my approach of how I have developed my dynamic calendar with calendar events being loaded from a database. This is what I wanted to achieve...

1. Each CalendarEvent has textcolor and background color - i did not want to specify the colors per event and wanted to link each event to a legend.
2. A Legend per Calendar Event should be able to keep the textcolor and background color that should be specific to a group of events. The legend can be changed at any time.

This is depicted in the image below.

calendar.png
 

Mashiane

Expert
Licensed User
Longtime User
Calendar Legends

Calendar Legends store the Legend Title and also the text and background color for each calendar event that will be added to the calendar. These legends should be dynamic and can be changed at anytime. With the change in the legend, the linked calendar event text and background color can be changed.

For this to be flexible, I need to create a database table where I would store my legends...

B4X:
CREATE TABLE [CalendarLegends] (
    [id] integer NOT NULL PRIMARY KEY AUTOINCREMENT,
    [BackgroundColor] nvarchar(254),
    [BackgroundColorIntensity] nvarchar(254),
    [TextColor] nvarchar(254),
    [TextColorIntensity] nvarchar(254),
    [Title] nvarchar(254)
);

CalendarLegends.png


I then created a table and a modal sheet to add my legends linked to this table.

B4X:
Private Sub BuildModalSheetmsCalendarLegends() As ABMModalSheet
    Dim msCalendarLegends As ABMModalSheet
    msCalendarLegends.Initialize(page, "msCalendarLegends", True, ABM.MODALSHEET_TYPE_NORMAL, "")
    msCalendarLegends.Size = ABM.MODALSHEET_SIZE_NORMAL
    msCalendarLegends.IsDismissible = False
    msCalendarLegends.IsTextSelectable = True
    msCalendarLegends.Footer.AddRowsM(1, True, 0, 0, "").AddCellsOS(1, 0, 0, 0, 12, 12, 12, "")
    msCalendarLegends.Header.AddRowsM(1, True, 0, 0, "").AddCellsOS(1, 0, 0, 0, 12, 12, 12, "")
    msCalendarLegends.Content.AddRowsM(5, True, 0, 0, "").AddCellsOS(1, 0, 0, 0, 12, 12, 12, "")
    msCalendarLegends.Header.BuildGrid  'IMPORTANT once you loaded the complete grid AND before you start adding components
    msCalendarLegends.Content.BuildGrid 'IMPORTANT once you loaded the complete grid AND before you start adding components
    msCalendarLegends.Footer.BuildGrid  'IMPORTANT once you loaded the complete grid AND before you start adding components
    'Add components to ModalSheet
    Dim lblCalendarLegends As ABMLabel
    lblCalendarLegends.Initialize(page, "lblCalendarLegends", "{NBSP}Add / Edit Calendar Legend", ABM.SIZE_H5, False, "whitefc")
    msCalendarLegends.Header.Cell(1,1).AddComponent(lblCalendarLegends)
    Dim txtCalendarLegendsTitle As ABMInput
    txtCalendarLegendsTitle.Initialize(page, "txtCalendarLegendsTitle", ABM.INPUT_TEXT, "Title", False, "")
    msCalendarLegends.Content.Cell(2,1).AddComponent(txtCalendarLegendsTitle)
    Dim cboCalendarLegendsTextColor As ABMCombo
    cboCalendarLegendsTextColor.Initialize(page, "cboCalendarLegendsTextColor", "Text Color", 650, "")
    cboCalendarLegendsTextColor.DataBelow = ABM.COMBO_DATA_BELOWINPUT
    cboCalendarLegendsTextColor.IsValid = ABM.VALID_TRUE
    msCalendarLegends.Content.Cell(2,1).AddComponent(cboCalendarLegendsTextColor)
    Dim cboCalendarLegendsTextColorIntensity As ABMCombo
    cboCalendarLegendsTextColorIntensity.Initialize(page, "cboCalendarLegendsTextColorIntensity", "Text Color Intensity", 650, "")
    cboCalendarLegendsTextColorIntensity.DataBelow = ABM.COMBO_DATA_BELOWINPUT
    cboCalendarLegendsTextColorIntensity.IsValid = ABM.VALID_TRUE
    msCalendarLegends.Content.Cell(2,1).AddComponent(cboCalendarLegendsTextColorIntensity)
    Dim cboCalendarLegendsBackgroundColor As ABMCombo
    cboCalendarLegendsBackgroundColor.Initialize(page, "cboCalendarLegendsBackgroundColor", "Background Color", 650, "")
    cboCalendarLegendsBackgroundColor.DataBelow = ABM.COMBO_DATA_BELOWINPUT
    cboCalendarLegendsBackgroundColor.IsValid = ABM.VALID_TRUE
    msCalendarLegends.Content.Cell(2,1).AddComponent(cboCalendarLegendsBackgroundColor)
    Dim cboCalendarLegendsBackgroundColorIntensity As ABMCombo
    cboCalendarLegendsBackgroundColorIntensity.Initialize(page, "cboCalendarLegendsBackgroundColorIntensity", "Background Color Intensity", 650, "")
    cboCalendarLegendsBackgroundColorIntensity.DataBelow = ABM.COMBO_DATA_BELOWINPUT
    cboCalendarLegendsBackgroundColorIntensity.IsValid = ABM.VALID_TRUE
    msCalendarLegends.Content.Cell(2,1).AddComponent(cboCalendarLegendsBackgroundColorIntensity)
    Dim btnApplyCalendarLegends As ABMButton
    btnApplyCalendarLegends.InitializeFlat(page, "btnApplyCalendarLegends", "", "", "Save", "transparent")
    btnApplyCalendarLegends.Size = ABM.BUTTONSIZE_NORMAL
    msCalendarLegends.Footer.Cell(1,1).AddComponent(btnApplyCalendarLegends)
    Dim btnCancelCalendarLegends As ABMButton
    btnCancelCalendarLegends.InitializeFlat(page, "btnCancelCalendarLegends", "", "", "Cancel", "transparent")
    btnCancelCalendarLegends.Size = ABM.BUTTONSIZE_NORMAL
    msCalendarLegends.Footer.Cell(1,1).AddComponent(btnCancelCalendarLegends)
    Return msCalendarLegends
End Sub

The table for listing the CalendarLegends

B4X:
Dim tblCL As ABMTable
    tblCL.Initialize(page, "tblCL", True, True, True, "tblTheme")
    tblCL.IsBordered = True
    tblCL.IsResponsive = True
    tblCL.IgnoreFormattingCodes = False
    tblCL.IsTextSelectable = True
    tblCL.SetFooter("Number of legends: ",12,"")
    tblCL.SetHeaders(Array As String("ID", "Title", "Text Color", "Text Color Intensity", "Background Color", "Background Color Intensity", "Open/Edit", "Delete"))
    tblCL.SetHeaderThemes(Array As String("bg", "bg", "bg", "bg", "bg", "bg", "bgc", "bgc"))
    tblCL.SetHeaderHeights(Array As Int(0, 0, 0, 0, 0, 0, 48, 48))
    tblCL.SetColumnVisible(Array As Boolean(False, True, True, True, True, True, True, True))
    tblCL.SetColumnSortable(Array As Boolean(False, True, True, True, True, True, False, False))
    tblCL.SetColumnDataFields(Array As String("id", "Title", "TextColor", "TextColorIntensity", "BackgroundColor", "BackgroundColorIntensity", "", ""))
    page.Cell(4,1).AddComponent(tblCL)
    Dim frmCalendarLegendsAddToTable As ABMActionButton
    frmCalendarLegendsAddToTable.Initialize(page, "frmCalendarLegendsAddToTable", "mdi-content-add", "", "bigblue")
    frmCalendarLegendsAddToTable.MainButton.Size = ABM.BUTTONSIZE_LARGE
    page.AddActionButton(frmCalendarLegendsAddToTable)
 
Last edited:

Mashiane

Expert
Licensed User
Longtime User
Colors and Intensities

As you might have noted above, the legends use Colors and Intensities to select those from a dropdown list. As these will also be used in generating the calendar, I needed a way to make these easier to access. So I created two extra tables to store the colors and the intensities.

B4X:
CREATE TABLE [Colors] (
    [id] integer NOT NULL PRIMARY KEY AUTOINCREMENT,
    [Color] nvarchar(254)
);

B4X:
CREATE TABLE [Intensities] (
    [id] integer NOT NULL PRIMARY KEY AUTOINCREMENT,
    [intensity] nvarchar(254)
);


intensities.png


colors.png


As these are stored as text, we need a way, after assigning them to each Legend, to read these back and be able to draw the colors as required.

To achieve this, I added two methods to my ABMShared, GetColor and GetIntensity.

B4X:
public Sub GetIntensity(sIntensity As String) As String
    Select Case sIntensity
    Case "ABM.INTENSITY_NORMAL"
        Return ABM.INTENSITY_NORMAL
    Case "ABM.INTENSITY_LIGHTEN5"
        Return ABM.INTENSITY_LIGHTEN5
    Case "ABM.INTENSITY_LIGHTEN4"
        Return ABM.INTENSITY_LIGHTEN4
    Case "ABM.INTENSITY_LIGHTEN3"
        Return ABM.INTENSITY_LIGHTEN3
    Case "ABM.INTENSITY_LIGHTEN2"
        Return ABM.INTENSITY_LIGHTEN2
    Case "ABM.INTENSITY_LIGHTEN1"
        Return ABM.INTENSITY_LIGHTEN1
    Case "ABM.INTENSITY_DARKEN1"
        Return ABM.INTENSITY_DARKEN1
    Case "ABM.INTENSITY_DARKEN2"
        Return ABM.INTENSITY_DARKEN2
    Case "ABM.INTENSITY_DARKEN3"
        Return ABM.INTENSITY_DARKEN3
    Case "ABM.INTENSITY_DARKEN4"
        Return ABM.INTENSITY_DARKEN4
    Case "ABM.INTENSITY_ACCENT1"
        Return ABM.INTENSITY_ACCENT1
    Case "ABM.INTENSITY_ACCENT2"
        Return ABM.INTENSITY_ACCENT2
    Case "ABM.INTENSITY_ACCENT3"
        Return ABM.INTENSITY_ACCENT3
    Case "ABM.INTENSITY_ACCENT4"
        Return ABM.INTENSITY_ACCENT4
    Case Else
        Return ABM.INTENSITY_NORMAL
    End Select
End Sub
public Sub GetColor(sColor As String) As String
    Select Case sColor
    Case "ABM.COLOR_AMBER"
        Return ABM.COLOR_AMBER
    Case "ABM.COLOR_BLACK"
        Return ABM.COLOR_BLACK
    Case "ABM.COLOR_BLUE"
        Return ABM.COLOR_BLUE
    Case "ABM.COLOR_BLUEGREY"
        Return ABM.COLOR_BLUEGREY
    Case "ABM.COLOR_BROWN"
        Return ABM.COLOR_BROWN
    Case "ABM.COLOR_CYAN"
        Return ABM.COLOR_CYAN
    Case "ABM.COLOR_DEEPORANGE"
        Return ABM.COLOR_DEEPORANGE
    Case "ABM.COLOR_DEEPPURPLE"
        Return ABM.COLOR_DEEPPURPLE
    Case "ABM.COLOR_GREEN"
        Return ABM.COLOR_GREEN
    Case "ABM.COLOR_GREY"
        Return ABM.COLOR_GREY
    Case "ABM.COLOR_INDIGO"
        Return ABM.COLOR_INDIGO
    Case "ABM.COLOR_LIGHTBLUE"
        Return ABM.COLOR_LIGHTBLUE
    Case "ABM.COLOR_LIGHTGREEN"
        Return ABM.COLOR_LIGHTGREEN
    Case "ABM.COLOR_LIME"
        Return ABM.COLOR_LIME
    Case "ABM.COLOR_ORANGE"
        Return ABM.COLOR_ORANGE
    Case "ABM.COLOR_PINK"
        Return ABM.COLOR_PINK
    Case "ABM.COLOR_PURPLE"
        Return ABM.COLOR_PURPLE
    Case "ABM.COLOR_RED"
        Return ABM.COLOR_RED
    Case "ABM.COLOR_TEAL"
        Return ABM.COLOR_TEAL
    Case "ABM.COLOR_TRANSPARENT"
        Return ABM.COLOR_TRANSPARENT
    Case "ABM.COLOR_WHITE"
        Return ABM.COLOR_WHITE
    Case "ABM.COLOR_YELLOW"
        Return ABM.COLOR_YELLOW
    Case Else
        Return ABM.COLOR_LIGHTBLUE
    End Select
End Sub

I could have just used lists and maps in my code without having to store these in database tables.
 

Mashiane

Expert
Licensed User
Longtime User
CalendarEvents

Each calendar event being added to the database is linked to a legend, I needed to create a table to store these events.

CalendarEvents.png


B4X:
CREATE TABLE [CalendarEvents] (
    [id] integer NOT NULL PRIMARY KEY AUTOINCREMENT,
    [LegendID] int,
    [Title] nvarchar(254),
    [AllDay] int,
    [StartTime] nvarchar(254),
    [EndTime] nvarchar(254),
    [StartTimeNumeric] bigint,
    [EndTimeNumeric] bigint,
);

CREATE INDEX [EventTitle]
    ON [CalendarEvents] ([Title]);

CREATE INDEX [EndTimeNumeric]
    ON [CalendarEvents] ([EndTimeNumeric]);

CREATE INDEX [StartTimeNumeric]
    ON [CalendarEvents] ([StartTimeNumeric]);

You will note here that there are two extra fields StartTimeNumeric and EndTimeNumeric. These are used to store the numeric equivalent of the DateTime value for both fields. This method below get the contents of the CalendarEvent from the modal sheet. These numeric values are used to select the calendarevents from the database when <calendar>FetchData is called.

B4X:
Public Sub msCalendarEventsGetContents() As Map
    Dim pMap As Map
    pMap.Initialize
    Dim msCalendarEvents As ABMModalSheet
    msCalendarEvents = page.ModalSheet("msCalendarEvents")
    Dim txtCalendarEventsTitle As ABMInput = msCalendarEvents.Content.Component("txtCalendarEventsTitle")
    Dim dpCalendarEventsStartTime As ABMDateTimePicker = msCalendarEvents.Content.Component("dpCalendarEventsStartTime")
    Dim dpCalendarEventsEndTime As ABMDateTimePicker = msCalendarEvents.Content.Component("dpCalendarEventsEndTime")
    Dim chkCalendarEventsAllDay As ABMCheckbox = msCalendarEvents.Content.Component("chkCalendarEventsAllDay")
    Dim cboCalendarEventsLegendID As ABMCombo = msCalendarEvents.Content.Component("cboCalendarEventsLegendID")
    pMap.put("title", txtCalendarEventsTitle.Text)
    Dim dpCalendarEventsStartTimeContents As String
    Dim dpCalendarEventsStartTimeDate As Long
    dpCalendarEventsStartTimeDate = dpCalendarEventsStartTime.GetDate
    dpCalendarEventsStartTimeContents = ABM.Util.ConvertToDateTimeString(dpCalendarEventsStartTimeDate, "yyyy-MM-dd HH:mm")
    pMap.put("starttime", dpCalendarEventsStartTimeContents)
    Dim dpCalendarEventsStartTimeNumeric As Long
    dpCalendarEventsStartTimeContents = ABMShared.MvField(dpCalendarEventsStartTimeContents,1, " ")
    dpCalendarEventsStartTimeNumeric = ABMShared.String2Date(dpCalendarEventsStartTimeContents.Trim)
    pMap.put("starttimenumeric", dpCalendarEventsStartTimeNumeric)
    Dim dpCalendarEventsEndTimeContents As String
    Dim dpCalendarEventsEndTimeDate As Long
    dpCalendarEventsEndTimeDate = dpCalendarEventsEndTime.GetDate
    dpCalendarEventsEndTimeContents = ABM.Util.ConvertToDateTimeString(dpCalendarEventsEndTimeDate, "yyyy-MM-dd HH:mm")
    pMap.put("endtime", dpCalendarEventsEndTimeContents)
    Dim dpCalendarEventsEndTimeNumeric As Long
    dpCalendarEventsEndTimeContents = ABMShared.MvField(dpCalendarEventsEndTimeContents,1, " ")
    dpCalendarEventsEndTimeNumeric = ABMShared.String2Date(dpCalendarEventsEndTimeContents.Trim)
    pMap.put("endtimenumeric", dpCalendarEventsEndTimeNumeric)
    Dim chkCalendarEventsAllDayContents As String
    If chkCalendarEventsAllDay.State Then
        chkCalendarEventsAllDayContents = 1
    Else
        chkCalendarEventsAllDayContents = 0
    End If
    chkCalendarEventsAllDayContents = ABMShared.ZeroOne2YN(chkCalendarEventsAllDayContents)
    pMap.put("allday", chkCalendarEventsAllDayContents)
    pMap.put("legendid", cboCalendarEventsLegendID.GetActiveItemId)
    Return pMap
End Sub

When creating a Calendar event, we need to load the calendar legends to select a legend that will give color and background to the event.

B4X:
Private Sub RefreshOnLoad_cboCalendarEventsLegendID()
    'Get access to the component in the modal sheet.
    Dim msCalendarEvents As ABMModalSheet
    msCalendarEvents = page.ModalSheet("msCalendarEvents")
    Dim cboCalendarEventsLegendID As ABMCombo = msCalendarEvents.Content.Component("cboCalendarEventsLegendID")
    'Clear the ABMCombo items
    cboCalendarEventsLegendID.Clear
    'Define list details to load to the combo
    Dim results As List
    Dim resCnt As Int
    Dim resTot As Int
    Dim resMap As Map
    'variable to hold the source field
    Dim id As String
    'variable to hold the description field
    Dim Title As String
    'Add a spinner to the page
    page.Pause
    'Get connection from current pool if MySQL/MSSQL
    Dim SQL As SQL = ABMShared.SQLGet
    'Get the records as a list of maps from the db
    results = ABMShared.SQLExecuteMaps(SQL,"select * from calendarlegends order by title", Null)
    'Close the connection to the database
    ABMShared.SQLClose(SQL)
    'Loop throught each record read and process it
    resTot = results.size - 1
    For resCnt = 0 To resTot
        'Get the record map
        resMap = results.get(resCnt)
        'process the id field
        id = resMap.get("id")
        Title = resMap.get("title")
        cboCalendarEventsLegendID.AddItem(id, Title, ABMShared.ListItemTitle(page, id, Title))
    Next
    'Refresh the ABMCombo contents
    cboCalendarEventsLegendID.Refresh
    page.Resume
End Sub
 
Last edited:

Mashiane

Expert
Licensed User
Longtime User
Calendar

I created a calendar for my page and I wanted this to have the current system date as the default date...

B4X:
'add components for the page
    DateTime.DateFormat = "yyyy-MM-dd"
    Dim dd As String = DateTime.Date(DateTime.Now)
    Dim cal1 As ABMCalendar
    cal1.Initialize(page, "cal1", dd, ABM.FIRSTDAYOFWEEK_SUNDAY, "en", ABM.CALENDAR_DEFAULTVIEW_MONTH, "")
    cal1.MinTime = "00:00:00"
    cal1.MaxTime = "24:00:00"
    cal1.ShowWeekends = True
    cal1.Editable = True
    cal1.SlotDuration = "00:30:00"
    cal1.HasPreviousButton = True
    cal1.HasNextButton = True
    cal1.HasTodayButton = True
    cal1.HasWeekButton = True
    cal1.HasDayButton = True
    cal1.HasMonthButton = True
    cal1.DisplayEventTime = True
    cal1.DisplayEventEnd = True
    cal1.HasScrollBars = True
    page.Cell(2,1).AddComponent(cal1)

The calendar is loaded each time the FetchData is called. So this is what happens..

1. Get the start and end date passed by the FetchData method
2. Use these numeric values to select the calendar events from the database using StartTimeNumeric and EndTimeNumeric
3. Read all the colors and store them in a map
4. Read all legends and store them in a map and link the color and intensity values.
5. Read all intensities and store them in a map
6. For each event, find the legend and assign the text and backcolor and add to the calendar events.
7. Refresh the calendar

B4X:
Public Sub cal1_FetchData(dateStart As String, dateEnd As String)
    Dim cal1List As List
    Dim FromDate As Long = ABMShared.String2Date(dateStart)
    Dim ToDate As Long = ABMShared.String2Date(dateEnd)
    cal1List.Initialize
    'Define variables to process the calendar, colors, legends, intensities, events
    Dim colorsM As Map
    Dim legendsM As Map
    Dim intensitiesM As Map
    Dim legends As List
    Dim colors As List
    Dim events As List
    Dim intensities As List
    Dim resCnt As Int
    Dim resTot As Int
    Dim resMap As Map
    'LEGENDS
    Dim id As String
    Dim Title As String
    Dim TextColor As String
    Dim BackgroundColor As String
    Dim TextColorIntensity As String
    Dim BackgroundColorIntensity As String
    'INTENSITIES
    Dim id As String
    Dim intensity As String
    'COLORS
    Dim id As String
    Dim Color As String
    'EVENTS
    Dim id As String
    Dim Title As String
    Dim StartTime As String
    Dim EndTime As String
    Dim AllDay As String
    Dim LegendID As String
    page.Pause
    'Get connection from current pool if MySQL/MSSQL
    Dim SQL As SQL = ABMShared.SQLGet
    'Get the legends as list of maps from the db
    legends = ABMShared.SQLExecuteMaps(SQL,"select * from CalendarLegends", Null)
    'get the colors
    colors = ABMShared.SQLExecuteMaps(SQL,"select * from Colors", Null)
    'get the intensities
    intensities = ABMShared.SQLExecuteMaps(SQL,"select * from Intensities", Null)
    'get the events
    events = ABMShared.SQLExecuteMaps(SQL,"select * from CalendarEvents where StartTimeNumeric >= ? and EndTimeNumeric <= ?", Array As String(FromDate, ToDate))
    'close the database connection
    ABMShared.SQLClose(SQL)
    'COLORS - SAVE
    colorsM.Initialize
    resTot = colors.size - 1
    For resCnt = 0 To resTot
        'Get the record map
        resMap = colors.get(resCnt)
        id = resMap.get("id")
        Color = resMap.get("color")
        Color = Color.Replace(" ","")
        Color = "ABM.COLOR_" & Color
        'save the color using the key
        colorsM.put(id,Color)
    Next
    'INTENSITIES - SAVE
    intensitiesM.Initialize
    resTot = intensities.size - 1
    For resCnt = 0 To resTot
        'Get the record map
        resMap = intensities.get(resCnt)
        id = resMap.get("id")
        intensity = resMap.get("intensity")
        intensity = intensity.Replace(" ","")
        intensity = "ABM.INTENSITY_" & intensity
        'save the intensity using the key
        intensitiesM.put(id,intensity)
    Next
    'LEGENDS - SAVE
    legendsM.Initialize
    resTot = legends.size - 1
    For resCnt = 0 To resTot
        'Get the record map
        resMap = legends.get(resCnt)
        id = resMap.get("id")
        Title = resMap.getDefault("title","")
        TextColor = resMap.getDefault("textcolor","-1")
        BackgroundColor = resMap.getDefault("backgroundcolor","-1")
        TextColorIntensity = resMap.getDefault("textcolorintensity","-1")
        BackgroundColorIntensity = resMap.getDefault("backgroundcolorintensity","-1")
        'get the colors from the colorsM
        TextColor = colorsM.getDefault(TextColor, "ABM.COLOR_BLACK")
        BackgroundColor = colorsM.getDefault(BackgroundColor, "ABM.COLOR_LIGHTBLUE")
        'get the intensity from the intensitiesM
        TextColorIntensity = intensitiesM.getDefault(TextColorIntensity, "ABM.INTENSITY_NORMAL")
        BackgroundColorIntensity = intensitiesM.getDefault(BackgroundColorIntensity,"ABM.INTENSITY_NORMAL")
        'save the updated legend to the map
        Dim nLegend As Map
        nLegend.Initialize
        nLegend.put("primarykey",id)
        nLegend.put("title",Title)
        nLegend.put("textcolor",TextColor)
        nLegend.put("backgroundcolor",BackgroundColor)
        nLegend.put("textcolorintensity",TextColorIntensity)
        nLegend.put("backgroundcolorintensity",BackgroundColorIntensity)
        'save the legend using the key
        legendsM.put(id,nLegend)
    Next
    'EVENTS - PROCESS
    Dim TextColor As String
    Dim BackgroundColor As String
    Dim TextColorIntensity As String
    Dim BackgroundColorIntensity As String
    cal1List.Initialize
    resTot = events.size - 1
    For resCnt = 0 To resTot
        'Get the record map
        resMap = events.get(resCnt)
        id = resMap.get("id")
        Title = resMap.get("title")
        StartTime = resMap.get("starttime")
        EndTime = resMap.get("endtime")
        AllDay = resMap.get("allday")
        LegendID = resMap.get("legendid")
        'read the legend details from saved legends
        Dim eLegend As Map = legendsM.get(LegendID)
        If eLegend.IsInitialized = True Then
            TextColor = eLegend.getDefault("textcolor", "ABM.COLOR_WHITE")
            BackgroundColor = eLegend.getDefault("backgroundcolor", "ABM.COLOR_LIGHTBLUE")
            TextColorIntensity = eLegend.getDefault("textcolorintensity", "ABM.INTENSITY_NORMAL")
            BackgroundColorIntensity = eLegend.getDefault("backgroundcolorintensity", "ABM.INTENSITY_NORMAL")
        Else
            TextColor = "ABM.COLOR_WHITE"
            BackgroundColor = "ABM.COLOR_LIGHTBLUE"
            TextColorIntensity = "ABM.INTENSITY_NORMAL"
            BackgroundColorIntensity = "ABM.INTENSITY_NORMAL"
        End If
        'create a CalendarEvent
        Dim ev As ABMCalendarEvent
        StartTime = StartTime.Replace(" ", "T")
        EndTime = EndTime.Replace(" ", "T")
        ev.Initialize("" & id, Title, StartTime)
        ev.EndTime = EndTime
        ev.TextColor = ABMShared.GetColor(TextColor)
        ev.TextColorIntensity = ABMShared.GetIntensity(TextColorIntensity)
        ev.BackgroundColor = ABMShared.GetColor(BackgroundColor)
        ev.BackgroundColorIntensity = ABMShared.GetIntensity(BackgroundColorIntensity)
        Select Case AllDay
        Case "Y", "1", "y", True
            ev.AllDay = True
        Case Else
            ev.AllDay = False
        End Select
        cal1List.Add(ev)
    Next
    Dim cal1 As ABMCalendar
    cal1 = page.Component("cal1")
    cal1.SetEvents(cal1List)
    cal1.Refresh ' IMPORTANT
    page.Resume
End Sub

That's all folks, happy ABMaterial Coding... ;)
 

Mashiane

Expert
Licensed User
Longtime User
My Next Challenge:

The next challenge I faced with this was that my events spanned across a number of years and I cannot show this on the calendar. I then decided that I should perhaps just show the start date of the event and then the end date of the event prefixed by S: for start and E: for start.

To achieve this, i needed to tweak my code to run three select statements
1. select records based on start and end date.
2. select records based on start date only where the start date is within the shown calendar window dates
3. select records based on end date only where the end date is within the shown calendar windows

Things to note: The calendar by default only shows entries within the shown calendar window and nothing else with FetchData method.

So I ended up with this, so each time the calendar dates change....

For this calendar, I have used a table called class of goods to colour code the calendar entries. This has been done in a flexible manner that I can color code any other related table to the main calendar table and just show as per my selection.


B4X:
Public Sub cal1_FetchData(dateStart As String, dateEnd As String)
    Dim cal1List As List
    Dim FromDate As Long = ABMShared.String2Date(dateStart)
    Dim ToDate As Long = ABMShared.String2Date(dateEnd)
    cal1List.Initialize
    'Define variables to process the calendar, colors, legends, intensities, events
    Dim colorsM As Map
    Dim legendsM As Map
    Dim intensitiesM As Map
    Dim legends As List
    Dim colors As List
    Dim events As List
    Dim events1 As List
    Dim events2 As List
    Dim intensities As List
    Dim resCnt As Int
    Dim resTot As Int
    Dim resMap As Map
    'LEGENDS
    Dim id As String
    Dim Description As String
    Dim textcolor As String
    Dim backgroundcolor As String
    Dim TextColorIntensity As String
    Dim BackgroundColorIntensity As String
    'INTENSITIES
    Dim id As String
    Dim intensity As String
    'COLORS
    Dim id As String
    Dim Color As String
    'EVENTS
    Dim id As String
    Dim Description As String
    Dim AdvertDate As String
    Dim CompletionDate As String
    Dim AdvertDateLong As Long
    Dim CompletionDateLong As Long
    Dim allday As String
    Dim ClassOfGoods As String
    'CALENDARS TO SHOW
    Dim showbetweenstartend As String = "1"
    Dim showstartingbetween As String = "1"
    Dim showendingbetween As String = "1"
    Dim dateshavetime As String = "0"
    Dim bdateshavetime As Boolean = False
    If dateshavetime = "1" Then
        bdateshavetime = True
    Else
        bdateshavetime = False
    End If
    page.Pause
    'Get connection from current pool if MySQL/MSSQL
    Dim SQL As SQL = ABMShared.SQLGet
    'Get the legends as list of maps from the db
    legends = ABMShared.SQLExecuteMaps(SQL,"select * from ClassOfGoods", Null)
    'get the colors
    colors = ABMShared.SQLExecuteMaps(SQL,"select * from Colors", Null)
    'get the intensities
    intensities = ABMShared.SQLExecuteMaps(SQL,"select * from Intensities", Null)
    'get the events
    If showbetweenstartend = "1" Then
        events = ABMShared.SQLExecuteMaps(SQL,"select * from ProcurementPlan where AdvertDateNumeric >= ? and CompletionDateNumeric <= ?", Array As String(FromDate, ToDate))
    End If
    If showstartingbetween = "1" Then
        events1 = ABMShared.SQLExecuteMaps(SQL,"select * from ProcurementPlan where AdvertDateNumeric >= ? and AdvertDateNumeric <= ?", Array As String(FromDate, ToDate))
    End If
    If showendingbetween = "1" Then
        events2 = ABMShared.SQLExecuteMaps(SQL,"select * from ProcurementPlan where CompletionDateNumeric >= ? and CompletionDateNumeric <= ?", Array As String(FromDate, ToDate))
    End If
    'close the database connection
    ABMShared.SQLClose(SQL)
    'COLORS - SAVE
    colorsM.Initialize
    resTot = colors.size - 1
    For resCnt = 0 To resTot
        'Get the record map
        resMap = colors.get(resCnt)
        id = resMap.get("id")
        Color = resMap.get("color")
        Color = Color.Replace(" ","")
        Color = "ABM.COLOR_" & Color
        'save the color using the key
        colorsM.put(id,Color)
    Next
    'INTENSITIES - SAVE
    intensitiesM.Initialize
    resTot = intensities.size - 1
    For resCnt = 0 To resTot
        'Get the record map
        resMap = intensities.get(resCnt)
        id = resMap.get("id")
        intensity = resMap.get("intensity")
        intensity = intensity.Replace(" ","")
        intensity = "ABM.INTENSITY_" & intensity
        'save the intensity using the key
        intensitiesM.put(id,intensity)
    Next
    'LEGENDS - SAVE
    legendsM.Initialize
    resTot = legends.size - 1
    For resCnt = 0 To resTot
        'Get the record map
        resMap = legends.get(resCnt)
        id = resMap.get("id")
        Description = resMap.getDefault("description","")
        textcolor = resMap.getDefault("textcolor","-1")
        backgroundcolor = resMap.getDefault("backgroundcolor","-1")
        TextColorIntensity = resMap.getDefault("textcolorintensity","-1")
        BackgroundColorIntensity = resMap.getDefault("backgroundcolorintensity","-1")
        'get the colors from the colorsM
        textcolor = colorsM.getDefault(textcolor, "ABM.COLOR_BLACK")
        backgroundcolor = colorsM.getDefault(backgroundcolor, "ABM.COLOR_LIGHTBLUE")
        'get the intensity from the intensitiesM
        TextColorIntensity = intensitiesM.getDefault(TextColorIntensity, "ABM.INTENSITY_NORMAL")
        BackgroundColorIntensity = intensitiesM.getDefault(BackgroundColorIntensity,"ABM.INTENSITY_NORMAL")
        'save the updated legend to the map
        Dim nLegend As Map
        nLegend.Initialize
        nLegend.put("primarykey",id)
        nLegend.put("title",Description)
        nLegend.put("textcolor",textcolor)
        nLegend.put("backgroundcolor",backgroundcolor)
        nLegend.put("textcolorintensity",TextColorIntensity)
        nLegend.put("backgroundcolorintensity",BackgroundColorIntensity)
        'save the legend using the key
        legendsM.put(id,nLegend)
    Next
    'EVENTS - PROCESS
    Dim textcolor As String
    Dim backgroundcolor As String
    Dim TextColorIntensity As String
    Dim BackgroundColorIntensity As String
    cal1List.Initialize
    If showbetweenstartend = "1" Then
        'process events between the shown dates of the calendar
        resTot = events.size - 1
        For resCnt = 0 To resTot
            'Get the record map
            resMap = events.get(resCnt)
            id = resMap.get("id")
            Description = resMap.get("description")
            AdvertDate = resMap.get("advertdate")
            CompletionDate = resMap.get("completiondate")
            allday = resMap.get("allday")
            ClassOfGoods = resMap.get("classofgoods")
            AdvertDateLong = ABMShared.String2Date(AdvertDate)
            CompletionDateLong = ABMShared.String2Date(CompletionDate)
            'read the legend details from saved legends
            Dim eLegend As Map = legendsM.get(ClassOfGoods)
            If eLegend.IsInitialized = True Then
                textcolor = eLegend.getDefault("textcolor", "ABM.COLOR_WHITE")
                backgroundcolor = eLegend.getDefault("backgroundcolor", "ABM.COLOR_LIGHTBLUE")
                TextColorIntensity = eLegend.getDefault("textcolorintensity", "ABM.INTENSITY_NORMAL")
                BackgroundColorIntensity = eLegend.getDefault("backgroundcolorintensity", "ABM.INTENSITY_NORMAL")
            Else
                textcolor = "ABM.COLOR_WHITE"
                backgroundcolor = "ABM.COLOR_LIGHTBLUE"
                TextColorIntensity = "ABM.INTENSITY_NORMAL"
                BackgroundColorIntensity = "ABM.INTENSITY_NORMAL"
            End If
            'create a CalendarEvent
            Dim ev As ABMCalendarEvent
            AdvertDate = ABMShared.Date2String(AdvertDateLong,bdateshavetime)
            CompletionDate = ABMShared.Date2String(CompletionDateLong,bdateshavetime)
            ev.Initialize("" & id, Description, AdvertDate)
            ev.EndTime = CompletionDate
            ev.TextColor = ABMShared.GetColor(textcolor)
            ev.TextColorIntensity = ABMShared.GetIntensity(TextColorIntensity)
            ev.BackgroundColor = ABMShared.GetColor(backgroundcolor)
            ev.BackgroundColorIntensity = ABMShared.GetIntensity(BackgroundColorIntensity)
            Select Case allday
            Case "Y", "1", "y", True
                ev.AllDay = True
            Case Else
                ev.AllDay = False
            End Select
            cal1List.Add(ev)
        Next
    End If
    If showstartingbetween = "1" Then
        'Process events starting within the shown calendar dates
        resTot = events1.size - 1
        For resCnt = 0 To resTot
            'Get the record map
            resMap = events1.get(resCnt)
            id = resMap.get("id")
            Description = resMap.get("description")
            AdvertDate = resMap.get("advertdate")
            CompletionDate = resMap.get("completiondate")
            'only show the end date as the start date
            CompletionDate = AdvertDate
            allday = resMap.get("allday")
            ClassOfGoods = resMap.get("classofgoods")
            AdvertDateLong = ABMShared.String2Date(AdvertDate)
            CompletionDateLong = ABMShared.String2Date(CompletionDate)
            Description = "S: " & Description
            'read the legend details from saved legends
            Dim eLegend As Map = legendsM.get(ClassOfGoods)
            If eLegend.IsInitialized = True Then
                textcolor = eLegend.getDefault("textcolor", "ABM.COLOR_WHITE")
                backgroundcolor = eLegend.getDefault("backgroundcolor", "ABM.COLOR_LIGHTBLUE")
                TextColorIntensity = eLegend.getDefault("textcolorintensity", "ABM.INTENSITY_NORMAL")
                BackgroundColorIntensity = eLegend.getDefault("backgroundcolorintensity", "ABM.INTENSITY_NORMAL")
            Else
                textcolor = "ABM.COLOR_WHITE"
                backgroundcolor = "ABM.COLOR_LIGHTBLUE"
                TextColorIntensity = "ABM.INTENSITY_NORMAL"
                BackgroundColorIntensity = "ABM.INTENSITY_NORMAL"
            End If
            'create a CalendarEvent
            Dim ev As ABMCalendarEvent
            AdvertDate = ABMShared.Date2String(AdvertDateLong,bdateshavetime)
            CompletionDate = ABMShared.Date2String(CompletionDateLong,bdateshavetime)
            ev.Initialize("" & id, Description, AdvertDate)
            ev.EndTime = CompletionDate
            ev.TextColor = ABMShared.GetColor(textcolor)
            ev.TextColorIntensity = ABMShared.GetIntensity(TextColorIntensity)
            ev.BackgroundColor = ABMShared.GetColor(backgroundcolor)
            ev.BackgroundColorIntensity = ABMShared.GetIntensity(BackgroundColorIntensity)
            Select Case allday
            Case "Y", "1", "y", True
                ev.AllDay = True
            Case Else
                ev.AllDay = False
            End Select
            cal1List.Add(ev)
        Next
    End If
    If showendingbetween = "1" Then
        'Process events ending within the shown calendar dates
        resTot = events2.size - 1
        For resCnt = 0 To resTot
            'Get the record map
            resMap = events2.get(resCnt)
            id = resMap.get("id")
            Description = resMap.get("description")
            AdvertDate = resMap.get("advertdate")
            CompletionDate = resMap.get("completiondate")
            'only show the end start as the end date
            AdvertDate = CompletionDate
            allday = resMap.get("allday")
            ClassOfGoods = resMap.get("classofgoods")
            AdvertDateLong = ABMShared.String2Date(AdvertDate)
            CompletionDateLong = ABMShared.String2Date(CompletionDate)
            Description = "E: " & Description
            'read the legend details from saved legends
            Dim eLegend As Map = legendsM.get(ClassOfGoods)
            If eLegend.IsInitialized = True Then
                textcolor = eLegend.getDefault("textcolor", "ABM.COLOR_WHITE")
                backgroundcolor = eLegend.getDefault("backgroundcolor", "ABM.COLOR_LIGHTBLUE")
                TextColorIntensity = eLegend.getDefault("textcolorintensity", "ABM.INTENSITY_NORMAL")
                BackgroundColorIntensity = eLegend.getDefault("backgroundcolorintensity", "ABM.INTENSITY_NORMAL")
            Else
                textcolor = "ABM.COLOR_WHITE"
                backgroundcolor = "ABM.COLOR_LIGHTBLUE"
                TextColorIntensity = "ABM.INTENSITY_NORMAL"
                BackgroundColorIntensity = "ABM.INTENSITY_NORMAL"
            End If
            'create a CalendarEvent
            Dim ev As ABMCalendarEvent
            AdvertDate = ABMShared.Date2String(AdvertDateLong,bdateshavetime)
            CompletionDate = ABMShared.Date2String(CompletionDateLong,bdateshavetime)
            ev.Initialize("" & id, Description, AdvertDate)
            ev.EndTime = CompletionDate
            ev.TextColor = ABMShared.GetColor(textcolor)
            ev.TextColorIntensity = ABMShared.GetIntensity(TextColorIntensity)
            ev.BackgroundColor = ABMShared.GetColor(backgroundcolor)
            ev.BackgroundColorIntensity = ABMShared.GetIntensity(BackgroundColorIntensity)
            Select Case allday
            Case "Y", "1", "y", True
                ev.AllDay = True
            Case Else
                ev.AllDay = False
            End Select
            cal1List.Add(ev)
        Next
    End If
    Dim cal1 As ABMCalendar
    cal1 = page.Component("cal1")
    cal1.SetEvents(cal1List)
    cal1.Refresh ' IMPORTANT
    page.Resume
End Sub

The calendar shown is just based on records in another table.

StartDates.png EndDates.png ClassOfGoods.pngProcPlan.png
 

Mashiane

Expert
Licensed User
Longtime User
As my ABMCalendar entries are linked to an underlying database table, I wanted a way that I click buttons and then the calendar goes to the start date of the calendar and also the end date of the calendar.

CalendarOps.png


So I added two buttons to my navigation bar.

B4X:
page.NavigationBar.AddTopItemEx("CalendarStartRecord", "", "mdi-action-today", "", True, ABM.COLOR_LIGHTBLUE, ABM.INTENSITY_NORMAL, ABM.ICONALIGN_CENTER)
    page.NavigationBar.AddTopItemEx("CalendarEndRecord", "", "mdi-editor-insert-invitation", "", True, ABM.COLOR_RED, ABM.INTENSITY_NORMAL, ABM.ICONALIGN_CENTER)

After this I trap the click event of the navigation bar, depending on what is selected...

B4X:
Public Sub Page_NavigationbarClicked(Action As String, Value As String)
    page.SaveNavigationBarPosition
    If Action = "LogOff" Then
        ABMShared.LogOff(page)
        Return
    End If
    Select Case Action.ToLowerCase
    Case "newrecord"
        ExecuteNewRecord
        Return
    Case "procstatus"
        Executeprocstatus
        Return
    Case "resources"
        Executeresources
        Return
    Case "programmes"
        Executeprogrammes
        Return
    Case "calendarstartrecord"
        ExecuteCalendarStartRecord
        Return
    Case "procplan"
        Executeprocplan
        Return
    Case "calendarendrecord"
        ExecuteCalendarEndRecord
        Return
    Case "procplancalendar"
        Executeprocplancalendar
        Return
    Case "classofgoods"
        Executeclassofgoods
        Return
    Case "projectplan"
        Executeprojectplan
        Return
    Case "goback"
        ExecuteGoBack
        Return
    End Select
    ABMShared.NavigateToPage(ws, ABMPageId, Value)
End Sub

Then the respective methods for setting the calendar start and end dates are called depending on what is selected.

B4X:
Public Sub ExecuteCalendarStartRecord()
    'Go to the start date of the calendar.
    'Get the calendar component
    Dim cal1 As ABMCalendar = page.Component("cal1")
    'Get the Start Date from the calendar
    'Get connection from current pool if MySQL/MSSQL or SQLite
    Dim jSQL As SQL = ABMShared.SQLGet
    'Get the calendar min date
    Dim minValue As Long = ABMShared.SQLSelectSingleResult(jSQL, "select min(AdvertDateNumeric) from ProcurementPlan", Null)
    'Convert the date to a string
    Dim minDate As String = ABMShared.Date2String(minValue,False)
    cal1.GotoDate(minDate)
End Sub
Public Sub ExecuteCalendarEndRecord()
    'Go to the end date of the calendar.
    'Get the calendar component
    Dim cal1 As ABMCalendar = page.Component("cal1")
    'Get the End Date from the calendar
    'Get connection from current pool if MySQL/MSSQL or SQLite
    Dim jSQL As SQL = ABMShared.SQLGet
    'Get the calendar min date
    Dim minValue As Long = ABMShared.SQLSelectSingleResult(jSQL, "select max(CompletionDateNumeric) from ProcurementPlan", Null)
    'Convert the date to a string
    Dim minDate As String = ABMShared.Date2String(minValue,False)
    cal1.GotoDate(minDate)
End Sub

I have stored the numeric value of each date entered in the database as AdvertDateNumeric and CompletionDateNumeric. The min and max values for these fields are selected for each operation and these are converted using Date2String to get a string value and this is what is passed to GoToDate..

Perfectly working...
 
Top