Namespace ActiveBasic Namespace OpenGL '色情報を扱うためのインターフェース Class GLColor Public /* property */ Abstract Function A() As Single Abstract Function B() As Single Abstract Function G() As Single Abstract Function R() As Single Abstract Function GetPtr() As *Single Public /* method */ Function Equals(c As GLColor) As Boolean If (This.R = c.R) and (This.G = c.G) and (This.B = c.B) and (This.A = c.A) Then Return True Else Return False End If End Function Function GetBrightness() As Single Return Detail.RGBToBrightness(This.R,This.G,This.B) End Function Function GetHue() As Single Return Detail.RGBToHue(This.R,This.G,This.B) End Function Function GetSaturation() As Single Return Detail.RGBToSaturation(This.R,This.G,This.B) End Function Public /* operator */ Function Operator == (c As GLColor) As Boolean Return Equals(c) End Function Function Operator <> (c As GLColor) As Boolean Return Not Equals(c) End Function End Class Class Color3 Inherits GLColor Public /* constractor */ Sub Color3() color[0]=0.0 color[1]=0.0 color[2]=0.0 color[3]=1.0 End Sub Sub Color3(red As Single, green As Single, blue As Single) color[0]=red color[1]=green color[2]=blue color[3]=1.0 End Sub Sub Color3(c As System.Drawing.Color) color[0]=c.R color[1]=c.G color[2]=c.B color[3]=1.0 End Sub Sub Color3(c As Color4) color[0]=c.R color[1]=c.G color[2]=c.B color[3]=1.0 End Sub Public /* property */ Override Function A() As Single Return color[3] End Function Sub B(blue As Single) color[2]=blue End Sub Override Function B() As Single Return color[2] End Function Sub G(green As Single) color[1]=green End Sub Function G() As Single Return color[1] End Function Sub R(red As Single) color[0]=red End Sub Override Function R() As Single Return color[0] End Function Public /* operator */ Function Operator () As Color4 Return New Color4(This,1.0) End Function Public /* method */ Override Function GetPtr() As *Single Return color End Function Public /* static method */ Static Function FromCOLORREF(c As COLORREF) As GLColor Dim r As Byte, g As Byte, b As Byte r = c As Byte g = (c>>8) As Byte b = (c>>16) As Byte Return New Color3(r/255.0,g/255.0,b/255.0) End Function Static Function FromHSB(hue As Single, saturation As Single, brightness As Single) As Color3 Return Detail.HSBToColor3(hue,saturation,brightness) End Function Static Function FromHLS(hue As Single, lightness As Single, saturation As Single) As Color3 Return Detail.HLSToColor3(hue, lightness, saturation) End Function Protected color[3] As Single End Class Class Color4 Inherits GLColor Public /* constractor */ Sub Color4() color[0]=0.0 color[1]=0.0 color[2]=0.0 color[3]=1.0 End Sub Sub Color4(red As Single, green As Single, blue As Single, alpha As Single) color[0]=red color[1]=green color[2]=blue color[3]=alpha End Sub Sub Color4(c As System.Drawing.Color) color[0]=c.R color[1]=c.G color[2]=c.B color[3]=c.A End Sub Sub Color4(c As Color3, alpha As Single) color[0]=c.R color[1]=c.G color[2]=c.B color[3]=alpha End Sub Public /* property */ Sub A(alpha As Single) color[3]=alpha End Sub Override Function A() As Single Return color[3] End Function Sub B(blue As Single) color[2]=blue End Sub Override Function B() As Single Return color[2] End Function Sub G(green As Single) color[1]=green End Sub Function G() As Single Return color[1] End Function Sub R(red As Single) color[0]=red End Sub Override Function R() As Single Return color[0] End Function Function Operator () As Color3 Return New Color3(This) End Function Public /* method */ Override Function GetPtr() As *Single Return color End Function Public /* static method */ Static Function FromCOLORREF(c As COLORREF) As Color4 Dim r As Byte, g As Byte, b As Byte r = c As Byte g = (c>>8) As Byte b = (c>>16) As Byte Return New Color4(r/255.0,g/255.0,b/255.0,1.0) End Function Static Function FromHSB(hue As Single, saturation As Single, brightness As Single) As Color4 Return Detail.HSBToColor3(hue,saturation,brightness) End Function Static Function FromHLS(hue As Single, lightness As Single, saturation As Single) As Color4 Return Detail.HLSToColor3(hue, lightness, saturation) End Function Protected color[3] As Single End Class Namespace Detail Function HSBToColor3(hue As Single, saturation As Single, brightness As Single) As Color3 'cramping If hue >= 360.0 Then hue = 0.0 If hue < 0.0 Then hue = 0.0 If saturation > 1.0 Then saturation = 1.0 If saturation < 0.0 Then saturation = 0.0 If brightness > 1.0 Then brightness = 1.0 If brightness < 0.0 Then brightness = 0.0 'grayscale If saturation = 0.0 Then Return New Color3(brightness,brightness,brightness) End If Dim i = Int(hue/60.0) As Long Dim f = hue/60.0 - i As Single Dim v = brightness As Single Dim m = brightness * (1.0 - saturation) As Single Dim n = brightness * (1.0 - saturation*f) As Single Dim k = brightness * (1.0 - saturation*(1.0 - f)) As Single Dim r As Single, g As Single, b As Single Select Case i Case 0 r = v g = k b = m Case 1 r = n g = v b = m Case 2 r = m g = v b = k Case 3 r = m g = n b = v Case 4 r = k g = m b = v Case 5 r = v g = m b = n End Select Return New Color3(r,g,b) End Function Function HLSToColor3(hue As Single, lightness As Single, saturation As Single) As Color3 'cramping If hue >= 360.0 Then hue = 0.0 If hue < 0.0 Then hue = 0.0 If lightness > 1.0 Then lightness = 1.0 If lightness < 0.0 Then lightness = 0.0 If saturation > 1.0 Then saturation = 1.0 If saturation < 0.0 Then saturation = 0.0 'max - min Dim max As Single Dim min As Single If lightness =< 0.5 Then min = lightness * (1.0 - saturation) max = 2*lightness - min Else max = lightness * (1.0 - saturation) + saturation min = 2*lightness - max End If 'grayscale If saturation = 0.0 Then Return New Color3(lightness,lightness,lightness) End If Dim r As Single, g As Single, b As Single 'red Dim h = hue + 120.0 As Single If h > 360.0 Then h -= 360.0 If h < 60.0 Then r = min + (max - min)*h/60.0 ElseIf (h => 60.0) and (h < 180.0) Then r = max ElseIf (h => 180.0) and (h < 240.0) Then r = min + (max - min)*(240.0-h)/60.0 ElseIf h => 240.0 Then r = min End If 'green h = hue If h < 60.0 Then g = min + (max - min)*h/60.0 ElseIf (h => 60.0) and (h < 180.0) Then g = max ElseIf (h => 180.0) and (h < 240.0) Then g = min + (max - min)*(240.0-h)/60.0 ElseIf h => 240.0 Then g = min End If 'blue h = hue - 120.0 As Single If h < 0.0 Then h += 360.0 If h < 60.0 Then b = min + (max - min)*h/60.0 ElseIf (h => 60.0) and (h < 180.0) Then b = max ElseIf (h => 180.0) and (h < 240.0) Then b = min + (max - min)*(240.0-h)/60.0 ElseIf h => 240.0 Then b = min End If Return New Color3(r,g,b) End Function Function RGBToHue(red As Single, green As Single, blue As Single) As Single Dim max As Single, min As Single, d As Single max = System.Math.Max(System.Math.Max(red, green), blue) min = System.Math.Min(System.Math.Min(red, green), blue) d = max - min If green = max Then Return ((blue - red) / d * 60.0 + 120.0) As Single ElseIf blue = max Then Return ((red - green) / d * 60 + 240) As Single ElseIf green < blue Then Return ((green - blue) / d * 60 + 360) As Single Else Return ((green - blue) / d * 60) As Single EndIf End Function Function RGBToSaturation(red As Single, green As Single, blue As Single) As Single Dim max = System.Math.Max(System.Math.Max(red, green), blue) As Single Dim min = System.Math.Min(System.Math.Min(red, green), blue) As Single Return (max - min) / max End Function Function RGBToBrightness(red As Single, green As Single, blue As Single) As Single Dim max = System.Math.Max(System.Math.Max(red, green), blue) Return max End Function End Namespace End Namespace End Namespace