-
Notifications
You must be signed in to change notification settings - Fork 2
/
Form1.vb
73 lines (65 loc) · 3.16 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
#Region "#usings"
Imports DevExpress.XtraScheduler
Imports DevExpress.XtraScheduler.Drawing
Imports System
Imports System.Drawing
Imports System.Windows.Forms
#End Region ' #usings
Namespace HitTest
Partial Public Class Form1
Inherits DevExpress.XtraEditors.XtraForm
Public Sub New()
InitializeComponent()
schedulerControl1.DayView.ShowWorkTimeOnly = True
schedulerControl1.Start = Date.Now.Date
schedulerControl1.DayView.GotoTimeInterval(New TimeInterval(schedulerControl1.Start.AddHours(17), New TimeSpan(2, 0, 0)))
LoadData()
End Sub
Private Sub LoadData()
Dim apt As Appointment = schedulerStorage1.CreateAppointment(AppointmentType.Normal)
apt.Subject = "Presentation"
apt.Start = schedulerControl1.Start.Date.AddHours(14)
apt.End = apt.Start.AddHours(3)
apt.Location = "Globus BookStore"
apt.Description = "The Sassanid Empire"
apt.LabelKey = 3
schedulerStorage1.Appointments.Add(apt)
End Sub
#Region "#hittest"
Private Sub schedulerControl1_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) Handles schedulerControl1.MouseMove
Dim scheduler As SchedulerControl = TryCast(sender, SchedulerControl)
If scheduler Is Nothing Then
Return
End If
Dim pos As New Point(e.X, e.Y)
Dim viewInfo As SchedulerViewInfoBase = schedulerControl1.ActiveView.ViewInfo
Dim hitInfo As SchedulerHitInfo = viewInfo.CalcHitInfo(pos, False)
If hitInfo.HitTest = SchedulerHitTest.AppointmentContent Then
Dim apt As Appointment = CType(hitInfo.ViewInfo, AppointmentViewInfo).Appointment
Text = apt.Subject
ElseIf scheduler.ActiveView.Type = SchedulerViewType.Day AndAlso hitInfo.HitTest = SchedulerHitTest.Cell Then
Dim diff As Integer = pos.Y - hitInfo.ViewInfo.Bounds.Y
Dim ticksPerPixel = hitInfo.ViewInfo.Interval.Duration.Ticks / hitInfo.ViewInfo.Bounds.Height
Dim ticksCount = CType(ticksPerPixel * diff, Long)
Dim actualTime As Date = hitInfo.ViewInfo.Interval.Start.AddTicks(ticksCount)
Text = actualTime.ToString()
ElseIf hitInfo.HitTest = SchedulerHitTest.None Then
Text = Application.ProductName
Else
Text = String.Empty
End If
End Sub
Private Sub schedulerControl1_DragOver(ByVal sender As Object, ByVal e As DragEventArgs) Handles schedulerControl1.DragOver
Dim scheduler As SchedulerControl = TryCast(sender, SchedulerControl)
If scheduler Is Nothing Then
Return
End If
Dim p As Point = scheduler.PointToClient(New Point(e.X, e.Y))
Dim info As SchedulerHitInfo = scheduler.DayView.ViewInfo.CalcHitInfo(p, True)
If info.HitTest = SchedulerHitTest.AllDayArea Then
e.Effect = DragDropEffects.None
End If
End Sub
#End Region ' #hittest
End Class
End Namespace