Any simpler VB samples for custom data?
Printed From: Codejock Forums
Category: Codejock Products
Forum Name: Calendar
Forum Description: Topics Related to Codejock Calendar
URL: http://forum.codejock.com/forum_posts.asp?TID=15068
Printed Date: 16 July 2025 at 9:06am
Software Version: Web Wiz Forums 12.04 - http://www.webwizforums.com
Topic: Any simpler VB samples for custom data?
Posted By: dgmoriarty
Subject: Any simpler VB samples for custom data?
Date Posted: 28 August 2009 at 8:53am
|
Hi, I really like how this calendar control works, but does ANYONE have a simpler sample in VB? I want to use my own custom data. Just looking to add two columns and populate the calendar with data from my own database. Nothing fancy yet. I can figure out the rest from there once I can get the data to display. I could even do without the classes for the moment. I have the trial for 30 days, but don't have 28 days to read through the documentation and trace through the sample code and classes to see what is going on. I see a lot of requests for a simpler example. If anyone has one, can you please pass it on? Thanks, David |
Replies:
Posted By: Mr.Den
Date Posted: 28 August 2009 at 12:02pm
|
This code works for an access database, hope it helps:
Option Explicit
Private m_pEditingEvent As CalendarEvent
Private Sub AddToCalendar()
Dim rs As ADODB.Recordset
Dim sConn As String
Dim sSQL As String Dim sDB As String On Error GoTo errHandler
sDB = "YourDatabase.mdb" sConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sDB & ";Persist Security Info=False" sSQL = "SELECT * FROM ActionLog" Set rs = New ADODB.Recordset rs.Open sSQL, sConn, adOpenDynamic, adLockOptimistic Do While rs.EOF = False Set m_pEditingEvent = CalendarControl.DataProvider.CreateEvent If m_pEditingEvent.RecurrenceState <> xtpCalendarRecurrenceMaster Then m_pEditingEvent.StartTime = rs!dStart m_pEditingEvent.EndTime = rs!dEnd End If m_pEditingEvent.Subject = rs!sOperation m_pEditingEvent.Location = rs!sStation m_pEditingEvent.Body = rs!Body m_pEditingEvent.AllDayEvent = False m_pEditingEvent.Label = GetStationColor(rs!sStation) m_pEditingEvent.BusyStatus = 0 m_pEditingEvent.ScheduleID = 0 m_pEditingEvent.PrivateFlag = False m_pEditingEvent.MeetingFlag = False m_pEditingEvent.Reminder = 0 m_pEditingEvent.CustomProperties.Property("Errors") = rs!lFilesProcErr m_pEditingEvent.CustomProperties.Property("BackupComment") = rs!sBackupComment m_pEditingEvent.CustomProperties.Property("RestoreComment") = rs!sRestoreComment m_pEditingEvent.CustomProperties.Property("BackupUser") = rs!sUser m_pEditingEvent.CustomProperties.Property("BackupStation") = rs!sStation m_pEditingEvent.CustomProperties.Property("RefNo") = rs!sRefNo m_pEditingEvent.CustomProperties.Property("FileErr") = rs!sFileError CalendarControl.DataProvider.AddEvent m_pEditingEvent Loop rs.Close CalendarControl.Populate
errHandler: If Err.Number Then MsgBox Err.Number & ", " & Err.Description, vbCritical, "" End If Set rs = Nothing End Sub Public Function GetStationColor(ByVal sPStation As String) As Integer
On Error GoTo errHandler
Select Case UCase$(sPStation) Case "DEVELOPMENT" GetStationColor = 2 Case "16-2" GetStationColor = 3 Case "10XP" GetStationColor = 8 Case "11XP" GetStationColor = 10 Case Else GetStationColor = 9 End Select errHandler: If Err.Number Then MsgBox Err.Number & ", " & Err.Description, vbCritical, "" End If End Function ------------- Product: Xtreme SuitePro (ActiveX) version 16.3.1 Platform: Windows 7 Professional (64bit) - SP 1 Language: Visual Basic 6.0 SP 6 |
Posted By: dgmoriarty
Date Posted: 28 August 2009 at 2:29pm
|
Wow...Thanks! That worked beautifully. And so simple. (just forgot the rs.movenext in the loop! I was freaking out when I ran it and it locked up on me..lol) Now...anyone have a sample for multiple columns that is as easy as this? Thanks - David |
Posted By: johnp
Date Posted: 31 August 2009 at 9:47am
|
Not sure if this is what you want... I am using the calendar control as part of a room booking application where each room is represented as a separate column on the calendar. I use the following code to add each room as a schedule on the calendar. Of course, when you add events to the calendar you need to make sure that a each one has a scheduleid.
Dim pRCDesc As CalendarResourceDescription, pResourceCount As Integer Dim pData As CalendarDataProvider Dim pEvents As CalendarEvents Dim pSchedules As CalendarSchedules, pSchedCount As Integer ' The calendar control uses schedule id's to group events by individual. Since we are dealing with rooms as opposed to individuals we will use the roomid as a schedule id. g_DataResourcesMan.RemoveDataProvider (0) Do Until g_DataResourcesMan.ResourcesCount = 0 g_DataResourcesMan.RemoveResource (0) Loop bResult = g_DataResourcesMan.AddDataProvider("Provider=custom;DSN=" & gAppSettings.DSN, xtpCalendarDPF_CreateIfNotExists + _ xtpCalendarDPF_SaveOnDestroy + xtpCalendarDPF_CloseOnDestroy) If Not bResult Then Exit Function
Set pData = g_DataResourcesMan.DataProvider(0)
Set pSchedules = pData.Schedules If pSchedules Is Nothing Then Exit Function
With prsFacilityRooms
.ActiveConnection = gconLocalDatabase .CursorType = adOpenDynamic .LockType = adLockReadOnly pstrSQL = "SELECT ID, ROOM FROM rbs_event..FACILITY_ROOMS WHERE FACILITYID = " & cboFacilityLocation.ItemData(cboFacilityLocation.ListIndex) If cboFacilityRooms.ListIndex > 0 Then pstrSQL = pstrSQL & " AND ID = " & cboFacilityRooms.ItemData(cboFacilityRooms.ListIndex) .Open pstrSQL & " ORDER BY ROOM" Do Until .EOF pSchedules.AddNewSchedule CStr(!Id) g_DataResourcesMan.AddResource !ROOM, True .MoveNext Loop pData.Save For pSchedCount = 0 To .RecordCount - 1
Set pRCDesc = g_DataResourcesMan.Resource(pSchedCount)
pRCDesc.Resource.SetDataProvider pData, False
pRCDesc.Resource.ScheduleIDs.Add CInt(pSchedules(pSchedCount).Name) pRCDesc.GenerateName = True Next
.Close End With |
Posted By: Mr.Den
Date Posted: 31 August 2009 at 10:25am
Glad to be of assistance 
You are right, I forgot to paste in the rs.movenext  my apologies.------------- Product: Xtreme SuitePro (ActiveX) version 16.3.1 Platform: Windows 7 Professional (64bit) - SP 1 Language: Visual Basic 6.0 SP 6 |