source: trunk/ab5.0/ablib/src/Classes/ActiveBasic/OpenGL/Color.ab@ 694

Last change on this file since 694 was 694, checked in by NoWest, 15 years ago

カラー情報を扱うためのクラス群
(#240)

File size: 8.6 KB
RevLine 
[694]1
2Namespace ActiveBasic
3Namespace OpenGL
4
5 '色情報を扱うためのインターフェース
6 Class GLColor
7 Public /* property */
8 Abstract Function A() As Single
9 Abstract Function B() As Single
10 Abstract Function G() As Single
11 Abstract Function R() As Single
12 Abstract Function GetPtr() As *Single
13
14 Public /* method */
15 Function Equals(c As GLColor) As Boolean
16 If (This.R = c.R) and (This.G = c.G) and (This.B = c.B) and (This.A = c.A) Then
17 Return True
18 Else
19 Return False
20 End If
21 End Function
22 Function GetBrightness() As Single
23 Return Detail.RGBToBrightness(This.R,This.G,This.B)
24 End Function
25 Function GetHue() As Single
26 Return Detail.RGBToHue(This.R,This.G,This.B)
27 End Function
28 Function GetSaturation() As Single
29 Return Detail.RGBToSaturation(This.R,This.G,This.B)
30 End Function
31
32 Public /* operator */
33 Function Operator == (c As GLColor) As Boolean
34 Return Equals(c)
35 End Function
36 Function Operator <> (c As GLColor) As Boolean
37 Return Not Equals(c)
38 End Function
39 End Class
40
41 Class Color3
42 Inherits GLColor
43 Public /* constractor */
44 Sub Color3()
45 color[0]=0.0
46 color[1]=0.0
47 color[2]=0.0
48 color[3]=1.0
49 End Sub
50 Sub Color3(red As Single, green As Single, blue As Single)
51 color[0]=red
52 color[1]=green
53 color[2]=blue
54 color[3]=1.0
55 End Sub
56 Sub Color3(c As System.Drawing.Color)
57 color[0]=c.R
58 color[1]=c.G
59 color[2]=c.B
60 color[3]=1.0
61 End Sub
62 Sub Color3(c As Color4)
63 color[0]=c.R
64 color[1]=c.G
65 color[2]=c.B
66 color[3]=1.0
67 End Sub
68
69 Public /* property */
70 Override Function A() As Single
71 Return color[3]
72 End Function
73 Sub B(blue As Single)
74 color[2]=blue
75 End Sub
76 Override Function B() As Single
77 Return color[2]
78 End Function
79 Sub G(green As Single)
80 color[1]=green
81 End Sub
82 Function G() As Single
83 Return color[1]
84 End Function
85 Sub R(red As Single)
86 color[0]=red
87 End Sub
88 Override Function R() As Single
89 Return color[0]
90 End Function
91
92 Public /* operator */
93 Function Operator () As Color4
94 Return New Color4(This,1.0)
95 End Function
96
97 Public /* method */
98 Override Function GetPtr() As *Single
99 Return color
100 End Function
101
102 Public /* static method */
103 Static Function FromCOLORREF(c As COLORREF) As GLColor
104 Dim r As Byte, g As Byte, b As Byte
105 r = c As Byte
106 g = (c>>8) As Byte
107 b = (c>>16) As Byte
108 Return New Color3(r/255.0,g/255.0,b/255.0)
109 End Function
110 Static Function FromHSB(hue As Single, saturation As Single, brightness As Single) As Color3
111 Return Detail.HSBToColor3(hue,saturation,brightness)
112 End Function
113 Static Function FromHLS(hue As Single, lightness As Single, saturation As Single) As Color3
114 Return Detail.HLSToColor3(hue, lightness, saturation)
115 End Function
116
117 Protected
118 color[3] As Single
119 End Class
120
121 Class Color4
122 Inherits GLColor
123
124 Public /* constractor */
125 Sub Color4()
126 color[0]=0.0
127 color[1]=0.0
128 color[2]=0.0
129 color[3]=1.0
130 End Sub
131 Sub Color4(red As Single, green As Single, blue As Single, alpha As Single)
132 color[0]=red
133 color[1]=green
134 color[2]=blue
135 color[3]=alpha
136 End Sub
137 Sub Color4(c As System.Drawing.Color)
138 color[0]=c.R
139 color[1]=c.G
140 color[2]=c.B
141 color[3]=c.A
142 End Sub
143 Sub Color4(c As Color3, alpha As Single)
144 color[0]=c.R
145 color[1]=c.G
146 color[2]=c.B
147 color[3]=alpha
148 End Sub
149
150 Public /* property */
151 Sub A(alpha As Single)
152 color[3]=alpha
153 End Sub
154 Override Function A() As Single
155 Return color[3]
156 End Function
157 Sub B(blue As Single)
158 color[2]=blue
159 End Sub
160 Override Function B() As Single
161 Return color[2]
162 End Function
163 Sub G(green As Single)
164 color[1]=green
165 End Sub
166 Function G() As Single
167 Return color[1]
168 End Function
169 Sub R(red As Single)
170 color[0]=red
171 End Sub
172 Override Function R() As Single
173 Return color[0]
174 End Function
175
176 Function Operator () As Color3
177 Return New Color3(This)
178 End Function
179
180 Public /* method */
181 Override Function GetPtr() As *Single
182 Return color
183 End Function
184
185 Public /* static method */
186 Static Function FromCOLORREF(c As COLORREF) As Color4
187 Dim r As Byte, g As Byte, b As Byte
188 r = c As Byte
189 g = (c>>8) As Byte
190 b = (c>>16) As Byte
191 Return New Color4(r/255.0,g/255.0,b/255.0,1.0)
192 End Function
193 Static Function FromHSB(hue As Single, saturation As Single, brightness As Single) As Color4
194 Return Detail.HSBToColor3(hue,saturation,brightness)
195 End Function
196 Static Function FromHLS(hue As Single, lightness As Single, saturation As Single) As Color4
197 Return Detail.HLSToColor3(hue, lightness, saturation)
198 End Function
199
200 Protected
201 color[3] As Single
202 End Class
203
204 Namespace Detail
205 Function HSBToColor3(hue As Single, saturation As Single, brightness As Single) As Color3
206 'cramping
207 If hue >= 360.0 Then hue = 0.0
208 If hue < 0.0 Then hue = 0.0
209 If saturation > 1.0 Then saturation = 1.0
210 If saturation < 0.0 Then saturation = 0.0
211 If brightness > 1.0 Then brightness = 1.0
212 If brightness < 0.0 Then brightness = 0.0
213
214 'grayscale
215 If saturation = 0.0 Then
216 Return New Color3(brightness,brightness,brightness)
217 End If
218
219 Dim i = Int(hue/60.0) As Long
220 Dim f = hue/60.0 - i As Single
221 Dim v = brightness As Single
222 Dim m = brightness * (1.0 - saturation) As Single
223 Dim n = brightness * (1.0 - saturation*f) As Single
224 Dim k = brightness * (1.0 - saturation*(1.0 - f)) As Single
225
226 Dim r As Single, g As Single, b As Single
227
228 Select Case i
229 Case 0
230 r = v
231 g = k
232 b = m
233 Case 1
234 r = n
235 g = v
236 b = m
237 Case 2
238 r = m
239 g = v
240 b = k
241 Case 3
242 r = m
243 g = n
244 b = v
245 Case 4
246 r = k
247 g = m
248 b = v
249 Case 5
250 r = v
251 g = m
252 b = n
253 End Select
254 Return New Color3(r,g,b)
255 End Function
256
257 Function HLSToColor3(hue As Single, lightness As Single, saturation As Single) As Color3
258 'cramping
259 If hue >= 360.0 Then hue = 0.0
260 If hue < 0.0 Then hue = 0.0
261 If lightness > 1.0 Then lightness = 1.0
262 If lightness < 0.0 Then lightness = 0.0
263 If saturation > 1.0 Then saturation = 1.0
264 If saturation < 0.0 Then saturation = 0.0
265
266 'max - min
267 Dim max As Single
268 Dim min As Single
269 If lightness =< 0.5 Then
270 min = lightness * (1.0 - saturation)
271 max = 2*lightness - min
272 Else
273 max = lightness * (1.0 - saturation) + saturation
274 min = 2*lightness - max
275 End If
276
277 'grayscale
278 If saturation = 0.0 Then
279 Return New Color3(lightness,lightness,lightness)
280 End If
281
282 Dim r As Single, g As Single, b As Single
283
284 'red
285 Dim h = hue + 120.0 As Single
286 If h > 360.0 Then h -= 360.0
287 If h < 60.0 Then
288 r = min + (max - min)*h/60.0
289 ElseIf (h => 60.0) and (h < 180.0) Then
290 r = max
291 ElseIf (h => 180.0) and (h < 240.0) Then
292 r = min + (max - min)*(240.0-h)/60.0
293 ElseIf h => 240.0 Then
294 r = min
295 End If
296
297 'green
298 h = hue
299 If h < 60.0 Then
300 g = min + (max - min)*h/60.0
301 ElseIf (h => 60.0) and (h < 180.0) Then
302 g = max
303 ElseIf (h => 180.0) and (h < 240.0) Then
304 g = min + (max - min)*(240.0-h)/60.0
305 ElseIf h => 240.0 Then
306 g = min
307 End If
308
309
310 'blue
311 h = hue - 120.0 As Single
312 If h < 0.0 Then h += 360.0
313
314 If h < 60.0 Then
315 b = min + (max - min)*h/60.0
316 ElseIf (h => 60.0) and (h < 180.0) Then
317 b = max
318 ElseIf (h => 180.0) and (h < 240.0) Then
319 b = min + (max - min)*(240.0-h)/60.0
320 ElseIf h => 240.0 Then
321 b = min
322 End If
323
324 Return New Color3(r,g,b)
325 End Function
326
327 Function RGBToHue(red As Single, green As Single, blue As Single) As Single
328 Dim max As Single, min As Single, d As Single
329 max = System.Math.Max(System.Math.Max(red, green), blue)
330 min = System.Math.Min(System.Math.Min(red, green), blue)
331 d = max - min
332 If green = max Then
333 Return ((blue - red) / d * 60.0 + 120.0) As Single
334 ElseIf blue = max Then
335 Return ((red - green) / d * 60 + 240) As Single
336 ElseIf green < blue Then
337 Return ((green - blue) / d * 60 + 360) As Single
338 Else
339 Return ((green - blue) / d * 60) As Single
340 EndIf
341 End Function
342
343 Function RGBToSaturation(red As Single, green As Single, blue As Single) As Single
344 Dim max = System.Math.Max(System.Math.Max(red, green), blue) As Single
345 Dim min = System.Math.Min(System.Math.Min(red, green), blue) As Single
346 Return (max - min) / max
347 End Function
348
349 Function RGBToBrightness(red As Single, green As Single, blue As Single) As Single
350 Dim max = System.Math.Max(System.Math.Max(red, green), blue)
351 Return max
352 End Function
353 End Namespace
354End Namespace
355End Namespace
Note: See TracBrowser for help on using the repository browser.