This repository has been archived by the owner on Sep 11, 2023. It is now read-only.
/
Form1.vb
177 lines (140 loc) · 6.93 KB
/
Form1.vb
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
Imports System
Imports System.Data
Imports System.Drawing
Imports System.Text
Imports System.Windows.Forms
Imports System.IO
Imports System.Collections
Imports DevExpress.XtraScheduler
Imports DevExpress.XtraScheduler.iCalendar
Imports DevExpress.XtraScheduler.Drawing
Namespace iCalendarExportImport
Partial Public Class Form1
Inherits Form
Private Const CustomFieldName As String = "MyCustomField"
Private Const CustomPropertySignature As String = "JohnDoeInc"
Public iCalendarFileName As String = ""
Public Sub New()
InitializeComponent()
schedulerControl1.Start = Date.Now
schedulerControl1.DayView.DayCount = 5
Dim mapping As New AppointmentCustomFieldMapping(CustomFieldName, CustomFieldName, FieldValueType.Object)
schedulerStorage1.Appointments.CustomFieldMappings.Add(mapping)
GenerateAppointments()
End Sub
#Region "Appointment Generation"
Private Sub GenerateAppointments()
Dim now As Date = Date.Now.Date
Dim rand As New Random()
schedulerStorage1.BeginUpdate()
Dim currentDate As Date
For n As Integer = 0 To 4
currentDate = now.AddDays(n)
For i As Integer = 0 To 4
Dim start As Date = currentDate.AddHours(rand.Next(24))
Dim apt As Appointment = schedulerStorage1.CreateAppointment(AppointmentType.Normal)
apt.Start = start
apt.Duration = TimeSpan.FromHours(4)
apt.Subject = String.Format("Appointment {0}{1}", n, i)
apt.CustomFields(CustomFieldName) = CreateCustomObject(CustomFieldName, rand.Next(2))
schedulerStorage1.Appointments.Add(apt)
Next i
Next n
schedulerStorage1.EndUpdate()
End Sub
Private objectInfos() As String = { "green_diamond.gif", "mccarran.gif" }
Private Function CreateCustomObject(ByVal name As String, ByVal index As Integer) As CustomObject
Dim obj As New CustomObject()
obj.Name = name
obj.Info = objectInfos(index)
obj.Picture = Image.FromFile(objectInfos(index))
Return obj
End Function
#End Region
#Region "Export"
Private Sub btnExport_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnExport.Click
Dim fileDialog As New SaveFileDialog()
fileDialog.Filter = "iCalendar files (*.ics)|*.ics"
fileDialog.FilterIndex = 1
If fileDialog.ShowDialog() <> System.Windows.Forms.DialogResult.OK Then
Return
End If
Try
DoiCalendarExport(fileDialog.FileName)
Catch
MessageBox.Show("Could not export appointments","Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End Sub
Private Sub DoiCalendarExport(ByVal outFileName As String)
Dim now As Date = Date.Now.Date
' Exporting 3 days only.
Dim appointments As AppointmentBaseCollection = schedulerStorage1.GetAppointments(New TimeInterval(now, now.AddDays(3)))
Dim exporter As New iCalendarExporter(schedulerStorage1, appointments)
exporter.CustomPropertyIdentifier = CustomPropertySignature
AddHandler exporter.AppointmentExporting, AddressOf OnExportAppointment
Using fs As New FileStream(outFileName, FileMode.Create)
Try
exporter.Export(fs)
iCalendarFileName = outFileName
Catch e As Exception
MessageBox.Show(e.Message, "Exception", MessageBoxButtons.OK, MessageBoxIcon.Error)
iCalendarFileName = ""
End Try
End Using
End Sub
Private Sub OnExportAppointment(ByVal sender As Object, ByVal e As AppointmentExportingEventArgs)
Dim args As iCalendarAppointmentExportingEventArgs = CType(e, iCalendarAppointmentExportingEventArgs)
Dim apt As Appointment = args.Appointment
' TO DO: Check whether the appointment being exported meets conditions.
' Export appointments starting in the work time interval only.
If apt.Start.Hour < 8 OrElse apt.Start.Hour > 17 Then
args.Cancel = True
Return
End If
End Sub
#End Region
#Region "Import"
Private Sub btnImport_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnImport.Click
DoiCalendarImport()
End Sub
Private Sub DoiCalendarImport()
Dim importer As New iCalendarImporter(schedulerStorage1)
AddHandler importer.AppointmentImporting, AddressOf OnImportAppointment
importer.CustomPropertyIdentifier = CustomPropertySignature
Using fs As New FileStream(iCalendarFileName, FileMode.Open)
Try
importer.Import(fs)
Catch e As Exception
MessageBox.Show(e.Message, "Exception", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End Using
End Sub
Private Sub OnImportAppointment(ByVal sender As Object, ByVal e As AppointmentImportingEventArgs)
Dim args As iCalendarAppointmentImportingEventArgs = CType(e, iCalendarAppointmentImportingEventArgs)
Dim apt As Appointment = args.Appointment
' TO DO: Check whether the event being imported meets conditions.
End Sub
#End Region
Private Sub btnClear_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnClear.Click
schedulerStorage1.BeginUpdate()
schedulerStorage1.Appointments.Clear()
schedulerStorage1.EndUpdate()
End Sub
#Region "Appointment Appearance"
Private Sub schedulerControl1_InitAppointmentDisplayText(ByVal sender As Object, ByVal e As AppointmentDisplayTextEventArgs) Handles schedulerControl1.InitAppointmentDisplayText
Dim obj As CustomObject = TryCast(e.Appointment.CustomFields(CustomFieldName), CustomObject)
e.Description = If(obj IsNot Nothing, obj.ToString(), "(no custom info)")
End Sub
Private Sub schedulerControl1_InitAppointmentImages(ByVal sender As Object, ByVal e As AppointmentImagesEventArgs) Handles schedulerControl1.InitAppointmentImages
Dim c As AppointmentImageInfoCollection = e.ImageInfoList
Dim obj As CustomObject = TryCast(e.Appointment.CustomFields(CustomFieldName), CustomObject)
Dim info As New AppointmentImageInfo()
If (obj IsNot Nothing) AndAlso (obj.Picture IsNot Nothing) Then
info.Image = obj.Picture
info.ImageIndex = 2
c.Add(info)
End If
End Sub
#End Region
End Class
End Namespace