This repository has been archived by the owner on Jun 28, 2024. It is now read-only.
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Form1.vb
84 lines (74 loc) · 3.82 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
Imports System
Imports System.Drawing
Imports System.Windows.Forms
Imports System.IO
#Region "#usings"
Imports DevExpress.XtraScheduler
Imports DevExpress.XtraScheduler.Drawing
Imports System.Drawing.Drawing2D
#End Region ' #usings
Namespace CustomDrawDayHeader
Partial Public Class Form1
Inherits Form
Private Const aptDataFileName As String = "..\..\Data\appointments.xml"
Private Const resDataFileName As String = "..\..\Data\resources.xml"
Public Sub New()
InitializeComponent()
schedulerControl1.Start = New Date(2008, 7, 11)
FillData()
End Sub
#Region "FillData"
Private Sub FillData()
Dim customNameMapping As New AppointmentCustomFieldMapping("CustomName", "CustomName")
Dim customStatusMapping As New AppointmentCustomFieldMapping("CustomStatus", "CustomStatus")
schedulerStorage1.Appointments.CustomFieldMappings.Add(customNameMapping)
schedulerStorage1.Appointments.CustomFieldMappings.Add(customStatusMapping)
FillResourcesStorage(schedulerStorage1.Resources.Items, resDataFileName)
FillAppointmentsStorage(schedulerStorage1.Appointments.Items, aptDataFileName)
End Sub
Private Shared Function GetFileStream(ByVal fileName As String) As Stream
Return (New StreamReader(fileName)).BaseStream
End Function
Private Shared Sub FillAppointmentsStorage(ByVal c As AppointmentCollection, ByVal fileName As String)
Using stream As Stream = GetFileStream(fileName)
c.ReadXml(stream)
stream.Close()
End Using
End Sub
Private Shared Sub FillResourcesStorage(ByVal c As ResourceCollection, ByVal fileName As String)
Using stream As Stream = GetFileStream(fileName)
c.ReadXml(stream)
stream.Close()
End Using
End Sub
#End Region
Private Sub schedulerStorage_AppointmentsChanged(ByVal sender As Object, ByVal e As PersistentObjectsEventArgs) Handles schedulerStorage1.AppointmentsChanged, schedulerStorage1.AppointmentsInserted, schedulerStorage1.AppointmentsDeleted
schedulerStorage1.Appointments.Items.WriteXml(aptDataFileName)
End Sub
Private Sub cb_CustomDraw_CheckedChanged(ByVal sender As Object, ByVal e As EventArgs) Handles cb_CustomDraw.CheckedChanged
If cb_CustomDraw.Checked Then
AddHandler schedulerControl1.CustomDrawDayHeader, AddressOf schedulerControl1_CustomDrawDayHeader
Else
RemoveHandler schedulerControl1.CustomDrawDayHeader, AddressOf schedulerControl1_CustomDrawDayHeader
End If
schedulerControl1.Refresh()
End Sub
#Region "#customdrawdayheader"
Private Sub schedulerControl1_CustomDrawDayHeader(ByVal sender As Object, ByVal e As CustomDrawObjectEventArgs)
Dim header As DayHeader = TryCast(e.ObjectInfo, DayHeader)
' Draws the outer rectangle.
Using backBrush = New LinearGradientBrush(e.Bounds, Color.LightBlue, Color.Blue, LinearGradientMode.Vertical)
e.Cache.FillRectangle(backBrush, e.Bounds)
End Using
Dim innerRect As Rectangle = Rectangle.Inflate(e.Bounds, -2, -2)
' Draws the inner rectangle.
Using backBrush = New LinearGradientBrush(e.Bounds, Color.Blue, Color.LightSkyBlue, LinearGradientMode.Vertical)
e.Cache.FillRectangle(backBrush, innerRect)
End Using
' Draws the header's caption.
e.Cache.DrawString(header.Caption, header.Appearance.HeaderCaption.Font, Brushes.White, innerRect, header.Appearance.HeaderCaption.GetStringFormat())
e.Handled = True
End Sub
#End Region ' #customdrawdayheader
End Class
End Namespace