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
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
| Imports System.Drawing.Drawing2D
Public Class DemiCircleColor : Inherits Control
Private _Tickness As Integer
Public Property Tickness As Integer
Get
Return _Tickness
End Get
Set(value As Integer)
_Tickness = value : Invalidate()
End Set
End Property
Private _RangesColor As RangeCollection
Public ReadOnly Property RangesColor As RangeCollection
Get
Return _RangesColor
End Get
End Property
Private startAngle As Single = 180
Private endAngle As Single = 180
Private minValue As Double = 0
Private maxValue As Double = 100
Public Sub New()
SetStyle(ControlStyles.AllPaintingInWmPaint Or ControlStyles.ResizeRedraw Or ControlStyles.DoubleBuffer Or ControlStyles.SupportsTransparentBackColor, True)
Me.BackColor = Color.Transparent
Me.MaximumSize = New Size(220, 180)
Me.MinimumSize = New Size(220, 180)
Me._RangesColor = New RangeCollection(Me)
Me._Tickness = 50
End Sub
Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
e.Graphics.SmoothingMode = SmoothingMode.AntiAlias
DrawBackground(e.Graphics)
DrawZones(e.Graphics)
End Sub
Protected Overridable Sub DrawBackground(ByVal g As Graphics)
Using br As New SolidBrush(Me.BackColor)
g.FillRectangle(br, Me.ClientRectangle)
End Using
End Sub
Protected Overridable Sub DrawZones(ByVal g As Graphics)
Dim rc As New Rectangle(25, 50, Me.Width - _Tickness, Me.Height - 1)
g.SmoothingMode = SmoothingMode.AntiAlias
g.DrawArc(New Pen(New SolidBrush(Color.LightGray), _Tickness), rc, startAngle, endAngle)
For Each zone As RangeColor In Me._RangesColor
If (zone.EndValue > zone.StartValue) Then
Using path As New GraphicsPath()
Using pen As New Pen(zone.Color, _Tickness)
Dim startPathAngle As Single = (startAngle + (((zone.StartValue - Me.minValue) * endAngle) / (Me.maxValue - Me.minValue)))
Dim EndPathAngle As Single = (((zone.EndValue - zone.StartValue) * endAngle) / (Me.maxValue - Me.minValue))
path.AddArc(rc, startPathAngle, EndPathAngle)
g.DrawPath(pen, path)
End Using
End Using
End If
Next
End Sub
Sub RepaintControl()
Me.Refresh()
End Sub
End Class
Public Class RangeCollection : Inherits CollectionBase
Private Owner As DemiCircleColor
Public Sub New(ByVal sender As DemiCircleColor)
Owner = sender
End Sub
Default Public ReadOnly Property Item(ByVal index As Integer) As RangeColor
Get
Return CType(List(index), RangeColor)
End Get
End Property
Public Function Contains(ByVal itemType As RangeColor) As Boolean
Return List.Contains(itemType)
End Function
Public Function Add(ByVal itemType As RangeColor) As Integer
itemType.SetOwner(Owner)
If String.IsNullOrEmpty(itemType.Name) Then itemType.Name = GetUniqueName()
Return List.Add(itemType)
End Function
Public Sub Remove(ByVal itemType As RangeColor)
List.Remove(itemType)
End Sub
Public Sub Insert(ByVal index As Integer, ByVal itemType As RangeColor)
itemType.SetOwner(Owner)
If String.IsNullOrEmpty(itemType.Name) Then itemType.Name = GetUniqueName()
List.Insert(index, itemType)
End Sub
Public Function IndexOf(ByVal itemType As RangeColor) As Integer
Return List.IndexOf(itemType)
End Function
Public Function FindByName(ByVal name As String) As RangeColor
For Each ptrRange As RangeColor In List
If ptrRange.Name = name Then Return ptrRange
Next
Return Nothing
End Function
Protected Overrides Sub OnInsert(ByVal index As Integer, ByVal value As Object)
If String.IsNullOrEmpty((CType(value, RangeColor)).Name) Then CType(value, RangeColor).Name = GetUniqueName()
MyBase.OnInsert(index, value)
CType(value, RangeColor).SetOwner(Owner)
End Sub
Protected Overrides Sub OnRemove(ByVal index As Integer, ByVal value As Object)
If Owner IsNot Nothing Then Owner.RepaintControl()
End Sub
Protected Overrides Sub OnClear()
If Owner IsNot Nothing Then Owner.RepaintControl()
End Sub
Private Function GetUniqueName() As String
Dim Prefix As String = "Range"
Dim index As Integer = 1
Dim valid As Boolean
While Me.Count <> 0
valid = True
For x = 0 To Me.Count - 1
If Me(x).Name = (Prefix & index.ToString()) Then
valid = False
Exit For
End If
Next
If valid Then Exit While
index += 1
End While
Return Prefix & index.ToString()
End Function
End Class
Public Class RangeColor
Private _Color As Color
Private _StartValue As Single
Private _EndValue As Single
Public Property Name As String
Private Owner As DemiCircleColor
Public Sub New()
Me._Color = Drawing.Color.Lime
End Sub
Public Sub New(ByVal color As Color, ByVal startValue As Single, ByVal endValue As Single)
color = color
_StartValue = startValue
_EndValue = endValue
End Sub
Public Sub SetOwner(ByVal value As DemiCircleColor)
Owner = value
End Sub
Private Sub NotifyOwner()
If Owner IsNot Nothing Then Owner.RepaintControl()
End Sub
Public Property Color As Color
Get
Return _Color
End Get
Set(ByVal value As Color)
_Color = value
NotifyOwner()
End Set
End Property
Public Property StartValue As Single
Get
Return _StartValue
End Get
Set(ByVal value As Single)
If value < _EndValue Then
_StartValue = value
NotifyOwner()
End If
End Set
End Property
Public Property EndValue As Single
Get
Return _EndValue
End Get
Set(ByVal value As Single)
If value > _StartValue Then
_EndValue = value
NotifyOwner()
End If
End Set
End Property
End Class |
probleme RangeColor en débogage du from
Répondre avec citation
Partager