#ifndef _INC_ABGL #define _INC_ABGL #require #require Enum VertexFormatsf PositionOnly PositionColoered End Enum Enum VertexFormatsd PositionOnly PositionColoered End Enum NameSpace CustomVertexf Type PositionOnly x As GLfloat y As GLfloat z As GLfloat Public End Type Type PositionColoered Public x As GLfloat y As GLfloat z As GLfloat r As GLfloat g As GLfloat b As GLfloat a As GLfloat End Type End NameSpace NameSpace CustomVertexd Type PositionOnly Public x As GLdouble y As GLdouble z As GLdouble End Type Type PositionColoered Public x As GLdouble y As GLdouble z As GLdouble r As GLdouble g As GLdouble b As GLdouble a As GLdouble End Type End NameSpace Class VertexBuffer Public Sub VertexBuffer() End Sub Sub ~VertexBuffer() End Sub Public Function Size() As GLuint Return 0 End Function Function Lock() As VoidPtr Return NULL End Function Sub Unlock() End Sub End Class Type XY_FLOAT x As GLfloat y As GLfloat End Type Type XY_DOUBLE x As GLdouble y As GLdouble End Type Class Vector2f Public /* constructor */ Sub Vector2f() This.X=0.0 As GLfloat This.Y=0.0 As GLfloat End Sub Sub Vector2f(x As GLfloat, y As GLfloat) This.X=x This.Y=y End Sub Sub Vector2f(Vec As Vector2d) This.X=Vec.X As GLfloat This.Y=Vec.Y As GLfloat End Sub Public /* destructor */ Sub ~Vector2f() End Sub Public /* property */ Function X() As GLfloat Return xy.x End Function Function Y() As GLfloat Return xy.y End Function Sub X(x As GLfloat) xy.x=x End Sub Sub Y(y As GLfloat) xy.y=y End Sub Public /* operator */ Sub Operator = (ByRef SrcVec As Vector2f) This.X=SrcVec.X This.Y=SrcVec.Y End Sub Function Operator + (SrcVec As Vector2f) As Vector2f Return Add(This,SrcVec) End Function Function Operator - (SrcVec As Vector2f) As Vector2f Return Substract(This,SrcVec) End Function /* Function Operator * (SrcVec As Vector2f) As GLfloat Return Dot(This,SrcVec) End Function*/ Function Operator * (Src As GLint) As Vector2f Dim ret As Vector2f(This.X*Src,This.Y*Src) Return ret End Function Function Operator * (Src As GLfloat) As Vector2f Dim ret As Vector2f(This.X*Src,This.Y*Src) Return ret End Function Function Operator * (Src As GLdouble) As Vector2f Dim ret As Vector2f(This.X*Src As GLfloat,This.Y*Src As GLfloat) Return ret End Function Function Operator / (Src As GLint) As Vector2f Dim ret As Vector2f(This.X/Src,This.Y/Src) Return ret End Function Function Operator / (Src As GLfloat) As Vector2f Dim ret As Vector2f(This.X/Src,This.Y/Src) Return ret End Function Function Operator / (Src As GLdouble) As Vector2f Dim ret As Vector2f(This.X/Src,This.Y/Src) Return ret End Function Function Operator == (Vec As Vector2f) As Boolean If This.X=Vec.X and This.Y=Vec.Y Then Return True Else Return False End If End Function Public /* method */ Function Add(SrcVec1 As Vector2f, SrcVec2 As Vector2f) As Vector2f Dim ret As Vector2f(SrcVec1.X+SrcVec2.X,SrcVec1.Y+SrcVec2.Y) Return ret End Function Function Distance(SrcVec1 As Vector2f, SrcVec2 As Vector2f) As GLfloat Dim ret As Vector2f ret=SrcVec1-SrcVec2 Return ret.Magnitude End Function Function Dot(SrcVec1 As Vector2f, SrcVec2 As Vector2f) As GLfloat Return (SrcVec1.X*SrcVec2.X)+(SrcVec1.Y*SrcVec2.Y) End Function Function Empty() As Vector2f Return New Vector2f() End Function Function Magnitude() As GLfloat Return Math.Sqrt(This.X^2+This.Y^2) As GLfloat End Function Sub Normalize() Dim ret As Vector2f(This.X/This.Magnitude,This.Y/This.Magnitude) This = ret End Sub Function NormalizedVector() As Vector2f Dim ret As Vector2f(This.X/This.Magnitude,This.Y/This.Magnitude) Return ret End Function Function Substract(SrcVec1 As Vector2f, SrcVec2 As Vector2f) As Vector2f Dim ret As Vector2f(SrcVec1.X-SrcVec2.X,SrcVec1.Y-SrcVec2.Y) Return ret End Function Sub Reverse() Dim ret As Vector2f(-This.X,-This.Y) This = ret End Sub Function ReversedVector() As Vector2f Dim ret As Vector2f(-This.X,-This.Y) Return ret End Function Public /* Object Class Override */ Override Function Equals( object As Object ) As Boolean If This.GetHashCode() = object.GetHashCode() Then Return True Else Return False End If End Function Override Function ToString() As String Return GetType().Name End Function Protected /* Data */ xy As XY_FLOAT End Class Class Vector2d Public /* constructor */ Sub Vector2d() This.X=0.0 As GLdouble This.Y=0.0 As GLdouble End Sub Sub Vector2d(x As GLdouble, y As GLdouble) xy.x=x xy.y=y End Sub Sub Vector2d(Vec As Vector2f) This.X=Vec.X As GLdouble This.Y=Vec.Y As GLdouble End Sub Public /* destructor */ Sub ~Vector2d() End Sub Public /* property */ Function X() As GLdouble Return xy.x End Function Function Y() As GLdouble Return xy.y End Function Sub X(x As GLdouble) xy.x=x End Sub Sub Y(y As GLdouble) xy.y=y End Sub Public /* operator */ Sub Operator = (ByRef SrcVec As Vector2d) This.X=SrcVec.X This.Y=SrcVec.Y End Sub Function Operator + (SrcVec As Vector2d) As Vector2d Return Add(This,SrcVec) End Function Function Operator - (SrcVec As Vector2d) As Vector2d Return Substract(This,SrcVec) End Function /* Function Operator * (SrcVec As Vector2d) As GLdouble Return Dot(This,SrcVec) End Function*/ Function Operator * (Src As GLint) As Vector2d Dim ret As Vector2d(This.X*Src,SrcVec.Y*Src) Return ret End Function Function Operator * (Src As GLfloat) As Vector2d Dim ret As Vector2d(This.X*Src,SrcVec.Y*Src) Return ret End Function Function Operator * (Src As GLdouble) As Vector2d Dim ret As Vector2d(This.X*Src,SrcVec.Y*Src) Return ret End Function Function Operator / (Src As GLint) As Vector2d Dim ret As Vector2d(This.X/Src,SrcVec.Y/Src) Return ret End Function Function Operator / (Src As GLfloat) As Vector2d Dim ret As Vector2d(This.X/Src,SrcVec.Y/Src) Return ret End Function Function Operator / (Src As GLdouble) As Vector2d Dim ret As Vector2d(This.X/Src,SrcVec.Y/Src) Return ret End Function Function Operator == (Vec As Vector2d) As Boolean If This.X=Vec.X and This.Y=Vec.Y Then Return True Else Return False End If End Function Public /* method */ Function Add(SrcVec1 As Vector2d, SrcVec2 As Vector2d) As Vector2d Dim ret As Vector2d(SrcVec1.X+SrcVec2.X,SrcVec1.Y+SrcVec2.Y) Return ret End Function Function Distance(SrcVec1 As Vector2d, SrcVec2 As Vector2d) As GLdouble Dim ret As Vector2d ret=SrcVec1-SrcVec2 Return ret.Magnitude End Function Function Dot(SrcVec1 As Vector2d, SrcVec2 As Vector2d) As GLdouble Return SrcVec1.X*SrcVec2.X+SrcVec1.Y*SrcVec2.Y End Function Function Empty() As Vector2d Return New Vector2d() End Function Function Magnitude() As GLdouble Return Math.Sqrt(This.X^2+This.Y^2) As GLdouble End Function Sub Normalize() Dim ret As Vector2d(This.X/This.Magnitude,This.Y/This.Magnitude) This = ret End Sub Function NormalizedVector() As Vector2d Dim ret As Vector2d(This.X/This.Magnitude,This.Y/This.Magnitude) Return ret End Function Function Substract(SrcVec1 As Vector2d, SrcVec2 As Vector2d) As Vector2d Dim ret As Vector2d(SrcVec1.X-SrcVec2.X,SrcVec1.Y-SrcVec2.Y) Return ret End Function Sub Reverse() Dim ret As Vector2d(-This.X,-This.Y) This = ret End Sub Function ReversedVector() As Vector2d Dim ret As Vector2d(-This.X,-This.Y) Return ret End Function Public /* Object Class Override */ Override Function Equals( object As Object ) As Boolean If This.GetHashCode() = object.GetHashCode() Then Return True Else Return False End If End Function Override Function ToString() As String Return GetType().Name End Function Public /* Data */ xz As XY_DOUBLE End Class Type XYZ_FLOAT x As GLfloat y As GLfloat z As GLfloat End Type Type XYZ_DOUBLE x As GLdouble y As GLdouble z As GLdouble End Type Class Vector3f Public /* constructor */ Sub Vector3f() This.X=0.0 As GLfloat This.Y=0.0 As GLfloat This.Z=0.0 As GLfloat End Sub Sub Vector3f(x As GLfloat, y As GLfloat, z As GLfloat) xyz.x=x xyz.y=y xyz.z=z End Sub Sub Vector3f(Vec As Vector3d) This.X=Vec.X As GLfloat This.Y=Vec.Y As GLfloat This.Z=Vec.Z As GLfloat End Sub Public /* destructor */ Sub ~Vector3f() End Sub Public /* property */ Function X() As GLfloat Return xyz.x End Function Function Y() As GLfloat Return xyz.y End Function Function Z() As GLfloat Return xyz.z End Function Sub X(x As GLfloat) xyz.x=x End Sub Sub Y(y As GLfloat) xyz.y=y End Sub Sub Z(z As GLfloat) xyz.z=z End Sub Public /* operator */ Sub Operator = (ByRef SrcVec As Vector3f) This.X=SrcVec.X This.Y=SrcVec.Y End Sub Function Operator + (SrcVec As Vector3f) As Vector3f Return Add(This,SrcVec) End Function Function Operator - (SrcVec As Vector3f) As Vector3f Return Substract(This,SrcVec) End Function /* Function Operator * (SrcVec As Vector3f) As GLfloat Return Dot(This,SrcVec) End Function*/ Function Operator ^ (SrcVec As Vector3f) As Vector3f Return Cross(This,SrcVec) End Function Function Operator * (Src As GLint) As Vector3f Dim ret As Vector3f(This.X*Src,This.Y*Src,This.Z*Src) Return ret End Function Function Operator * (Src As GLfloat) As Vector3f Dim ret As Vector3f(This.X*Src,This.Y*Src,This.Z*Src) Return ret End Function Function Operator * (Src As GLdouble) As Vector3f Dim ret As Vector3f(This.X*Src,This.Y*Src,This.Z*Src) Return ret End Function Function Operator / (Src As GLint) As Vector3f Dim ret As Vector3f(This.X/Src,This.Y/Src,This.Z/Src) Return ret End Function Function Operator / (Src As GLfloat) As Vector3f Dim ret As Vector3f(This.X/Src,This.Y/Src,This.Z/Src) Return ret End Function Function Operator / (Src As GLdouble) As Vector3f Dim ret As Vector3f(This.X/Src,This.Y/Src,This.Z/Src) Return ret End Function Function Operator == (Vec As Vector3f) As Boolean If This.X=Vec.X and This.Y=Vec.Y and This.Z=Vec.Z Then Return True Else Return False End If End Function Public /* method */ Function Add(SrcVec1 As Vector3f, SrcVec2 As Vector3f) As Vector3f Dim ret As Vector3f(SrcVec1.X+SrcVec2.X,SrcVec1.Y+SrcVec2.Y,SrcVec1.Z+SrcVec2.Z) Return ret End Function Function Cross(SrcVec1 As Vector3f, SrcVec2 As Vector3f) As Vector3f Dim ret As Vector3f(SrcVec1.Y*SrcVec2.Z-SrcVec1.Z*SrcVec2.Y,SrcVec1.Z*SrcVec2.X-SrcVec1.X*SrcVec2.Z,SrcVec1.X*SrcVec2.Y-SrcVec1.Y*SrcVec2.X) Return ret End Function Function Distance(SrcVec1 As Vector3f, SrcVec2 As Vector3f) As GLfloat Dim ret As Vector3f ret=SrcVec1-SrcVec2 Return ret.Magnitude End Function Function Dot(SrcVec1 As Vector3f, SrcVec2 As Vector3f) As GLfloat Return SrcVec1.X*SrcVec2.X+SrcVec1.Y*SrcVec2.Y+SrcVec1.Z*SrcVec2.Z End Function Function Empty() As Vector3f Return New Vector3f() End Function Function Magnitude() As GLfloat Return Math.Sqrt(This.X^2+This.Y^2+This.Z^2) As GLfloat End Function Sub Normalize() Dim ret As Vector3f(This.X/This.Magnitude,This.Y/This.Magnitude,This.Z/This.Magnitude) This = ret End Sub Function NormalizedVector() As Vector3f Dim ret As Vector3f(This.X/This.Magnitude,This.Y/This.Magnitude,This.Z/This.Magnitude) Return ret End Function Function Substract(SrcVec1 As Vector3f, SrcVec2 As Vector3f) As Vector3f Dim ret As Vector3f(SrcVec1.X-SrcVec2.X,SrcVec1.Y-SrcVec2.Y,SrcVec1.Z-SrcVec2.Z) Return ret End Function Sub Reverse() Dim ret As Vector3f(-This.X,-This.Y,-This.Z) This = ret End Sub Function ReversedVector() As Vector3f Dim ret As Vector3f(-This.X,-This.Y,-This.Z) Return ret End Function Public /* Object Class Override */ Override Function Equals( object As Object ) As Boolean If This.GetHashCode() = object.GetHashCode() Then Return True Else Return False End If End Function Override Function ToString() As String Return GetType().Name End Function Public /* Data */ xyz As XYZ_FLOAT End Class Class Vector3d Public /* constructor */ Sub Vector3d() This.X=0.0 As GLdouble This.Y=0.0 As GLdouble This.Z=0.0 As GLdouble End Sub Sub Vector3d(x As GLdouble, y As GLdouble, z As GLdouble) xyz.x=x xyz.y=y xyz.z=z End Sub Sub Vector3d(Vec As Vector3f) This.X=Vec.X As GLdouble This.Y=Vec.Y As GLdouble This.Z=Vec.Z As GLdouble End Sub Public /* destructor */ Sub ~Vector3d() End Sub Public /* property */ Function X() As GLdouble Return xyz.x End Function Function Y() As GLdouble Return xyz.y End Function Function Z() As GLdouble Return xyz.z End Function Sub X(x As GLdouble) xyz.x=x End Sub Sub Y(y As GLdouble) xyz.y=y End Sub Sub Z(z As GLdouble) xyz.z=z End Sub Public /* operator */ Sub Operator = (ByRef SrcVec As Vector3d) This.X=SrcVec.X This.Y=SrcVec.Y End Sub Function Operator + (SrcVec As Vector3d) As Vector3d Return Add(This,SrcVec) End Function Function Operator - (SrcVec As Vector3d) As Vector3d Return Substract(This,SrcVec) End Function /* Function Operator * (SrcVec As Vector3d) As GLdouble Return Dot(This,SrcVec) End Function*/ Function Operator ^ (SrcVec As Vector3d) As Vector3d Return Cross(This,SrcVec) End Function Function Operator * (Src As GLint) As Vector3d Dim ret As Vector3d(This.X*Src,This.Y*Src,This.Z*Src) Return ret End Function Function Operator * (Src As GLfloat) As Vector3d Dim ret As Vector3d(This.X*Src,This.Y*Src,This.Z*Src) Return ret End Function Function Operator * (Src As GLdouble) As Vector3d Dim ret As Vector3d(This.X*Src,This.Y*Src,This.Z*Src) Return ret End Function Function Operator / (Src As GLint) As Vector3d Dim ret As Vector3d(This.X/Src,This.Y/Src,This.Z/Src) Return ret End Function Function Operator / (Src As GLfloat) As Vector3d Dim ret As Vector3d(This.X/Src,This.Y/Src,This.Z/Src) Return ret End Function Function Operator / (Src As GLdouble) As Vector3d Dim ret As Vector3d(This.X/Src,This.Y/Src,This.Z/Src) Return ret End Function Function Operator == (Vec As Vector3d) As Boolean If This.X=Vec.X and This.Y=Vec.Y and This.Z=Vec.Z Then Return True Else Return False End If End Function Public /* method */ Function Add(SrcVec1 As Vector3d, SrcVec2 As Vector3d) As Vector3d Dim ret As Vector3d(SrcVec1.X+SrcVec2.X,SrcVec1.Y+SrcVec2.Y,SrcVec1.Z+SrcVec2.Z) Return ret End Function Function Cross(SrcVec1 As Vector3d, SrcVec2 As Vector3d) As Vector3d Dim ret As Vector3d(SrcVec1.Y*SrcVec2.Z-SrcVec1.Z*SrcVec2.Y,SrcVec1.Z*SrcVec2.X-SrcVec1.X*SrcVec2.Z,SrcVec1.X*SrcVec2.Y-SrcVec1.Y*SrcVec2.X) Return ret End Function Function Distance(SrcVec1 As Vector3d, SrcVec2 As Vector3d) As GLdouble Dim ret As Vector3d ret=SrcVec1-SrcVec2 Return ret.Magnitude End Function Function Dot(SrcVec1 As Vector3d, SrcVec2 As Vector3d) As GLdouble Return SrcVec1.X*SrcVec2.X+SrcVec1.Y*SrcVec2.Y+SrcVec1.Z*SrcVec2.Z End Function Function Empty() As Vector3d Dim ret As Vector3d() Return ret End Function Function Magnitude() As GLdouble Return Math.Sqrt(This.X^2+This.Y^2+This.Z^2) As GLdouble End Function Sub Normalize() Dim ret As Vector3d(This.X/This.Magnitude,This.Y/This.Magnitude,This.Z/This.Magnitude) This = ret End Sub Function NormalizedVector() As Vector3d Dim ret As Vector3d(This.X/This.Magnitude,This.Y/This.Magnitude,This.Z/This.Magnitude) Return ret End Function Function Substract(SrcVec1 As Vector3d, SrcVec2 As Vector3d) As Vector3d Dim ret As Vector3d(SrcVec1.X-SrcVec2.X,SrcVec1.Y-SrcVec2.Y,SrcVec1.Z-SrcVec2.Z) Return ret End Function Sub Reverse() Dim ret As Vector3d(-This.X,-This.Y,-This.Z) This = ret End Sub Function ReversedVector() As Vector3d Dim ret As Vector3d(-This.X,-This.Y,-This.Z) Return ret End Function Public /* Object Class Override */ Override Function Equals( object As Object ) As Boolean If This.GetHashCode() = object.GetHashCode() Then Return True Else Return False End If End Function Override Function ToString() As String Return GetType().Name End Function Public /* Data */ xyz As XYZ_DOUBLE End Class NameSpace Matrix Class Matrix3x3f End Class Class Matrix3x3d End Class Class Matrix4x4f End Class Class Matrix4x4d End Class End NameSpace Type RGB_FLOAT r As GLfloat g As GLfloat b As GLfloat End Type Type RGB_DOUBLE r As GLdouble g As GLdouble b As GLdouble End Type Class Color3f Public /* constructor */ Sub Color3f(r As GLfloat, g As GLfloat, b As GLfloat) rgb.r = r rgb.g = g rgb.b = b End Sub Sub Color3f(color As Color3d) rgba.r = color.R As GLfloat rgba.g = color.G As GLfloat rgba.b = color.B As GLfloat End Sub Public /* destructor */ Sub ~Color3f() End Sub Public /* property */ Function R() As GLfloat Return rgb.r End Function Function G() As GLfloat Return rgb.g End Function Function B() As GLfloat Return rgb.b End Function Sub R(r As GLfloat) rgb.r = r End Sub Sub G(g As GLfloat) rgb.g = g End Sub Sub B(b As GLfloat) rgb.b = b End Sub Public /* operator */ Sub operator = (c As Color3f) This.R=c.R This.G=c.G This.B=c.B End Sub Public /* method */ ' HSBを求める式はhttp://ofo.jp/osakana/cgtips/hsb.phtmlを参考にした ' Drawwing\Color.abをさらに参考にしました。 Function GetHue() As GLfloat Dim max As GLfloat, min As GLfloat, d As GLfloat max = Math.Max(Math.Max(rgb.r, rgb.g), rgb.b) min = Math.Min(Math.Min(rgb.r, rgb.g), rgb.b) d = max - min If rgb.g = max Then Return ((rgb.b - rgb.r) As Double / d * 60.0 + 120.0) As GLfloat ElseIf rgb.b = max Then Return ((rgb.r - rgb.g) As Double / d * 60.0 + 240.0) As GLfloat ElseIf rgb.g < rgb.b Then Return ((rgb.g - rgb.b) As Double / d * 60.0 + 360.0) As GLfloat Else Return ((rgb.g - rgb.b) As Double / d * 60.0) As GLfloat EndIf End Function Function GetSaturation() As GLfloat Dim max As GLfloat, min As GLfloat max = Math.Max(Math.Max(rgb.r, rgb.g), rgb.b) min = Math.Min(Math.Min(rgb.r, rgb.g), rgb.b) Return (max - min) / max End Function Function GetVolue() As GLfloat Dim max As GLfloat max = Math.Max(Math.Max(rgb.r, rgb.g), rgb.b) Return max End Function Public /* static method */ Static Function FromRGB(r As GLubyte, g As GLubyte, b As GLubyte) As Color3f Dim ret As Color3f((r As GLfloat)/255.0 As GLfloat,(g As GLfloat)/255.0 As GLfloat,(b As GLfloat)/255.0 As GLfloat) Return ret End Function Static Function FromCOLORREF(c As COLORREF) As Color3f Dim ret As Color3f((c and &hff) As GLfloat/255,(c>>8 and &hff) As GLfloat/255,(c>>16 and &hff) As GLfloat/255) Return ret End Function Static Function FromHSV(h As GLfloat, s As GLfloat, v As GLfloat) As Color3f Dim r As GLfloat Dim g As GLfloat Dim b As GLfloat If h<0 Then h+=360.0 If h>360.0 Then h-=360.0 Select Case (h/60) As Long Case 0 r=v g=v*(1-s*(1-(h/60-(h/60) As Long))) b=v*(1-s) Case 1 r=v*(1-s*(h/60-(h/60) As Long)) g=v b=v*(1-s) Case 2 r=v*(1-s) g=v b=v*(1-s*(1-(h/60-(h/60) As Long))) Case 3 r=v*(1-s) g=v*(1-s*(h/60-(h/60) As Long)) b=v Case 4 r=v*(1-s*(1-(h/60-(h/60) As Long))) g=v*(1-s) b=v Case 5 r=v g=v*(1-s) b=v*(1-s*(h/60-(h/60) As Long)) Case 6 r=v g=v*(1-s*(1-(h/60-(h/60) As Long))) b=v*(1-s) End Select Dim ret As Color3f(r,g,b) Return ret End Function Public rgb As RGB_FLOAT End Class Class Color3d Public /* constructor */ Sub Color3d(r As GLdouble, g As GLdouble, b As GLdouble) rgb.r = r rgb.g = g rgb.b = b End Sub Sub Color3d(color As Color3f) rgba.r = color.R As GLdouble rgba.g = color.G As GLdouble rgba.b = color.B As GLdouble End Sub Public /* destructor */ Sub ~Color3d() End Sub Public /* property */ Function R() As GLdouble Return rgb.r End Function Function G() As GLdouble Return rgb.g End Function Function B() As GLdouble Return rgb.b End Function Sub R(r As GLdouble) rgb.r = r End Sub Sub G(g As GLdouble) rgb.g = g End Sub Sub B(b As GLdouble) rgb.b = b End Sub Public /* method */ ' HSBを求める式はhttp://ofo.jp/osakana/cgtips/hsb.phtmlを参考にした ' Drawwing\Color.abをさらに参考にしました。 Function GetHue() As GLdouble Dim max As GLdouble, min As GLdouble, d As GLdouble max = Math.Max(Math.Max(rgb.r, rgb.g), rgb.b) min = Math.Min(Math.Min(rgb.r, rgb.g), rgb.b) d = max - min If rgb.g = max Then Return ((rgb.b - rgb.r) As Double / d * 60.0 + 120.0) As GLfloat ElseIf rgb.b = max Then Return ((rgb.r - rgb.g) As Double / d * 60.0 + 240.0) As GLfloat ElseIf rgb.g < rgb.b Then Return ((rgb.g - rgb.b) As Double / d * 60.0 + 360.0) As GLfloat Else Return ((rgb.g - rgb.b) As Double / d * 60.0) As GLfloat EndIf End Function Function GetSaturation() As GLdouble Dim max As GLdouble, min As GLdouble max = Math.Max(Math.Max(rgb.r, rgb.g), rgb.b) min = Math.Min(Math.Min(rgb.r, rgb.g), rgb.b) Return (max - min) / max End Function Function GetVolue() As GLdouble Dim max As GLdouble max = Math.Max(Math.Max(rgb.r, rgb.g), rgb.b) Return max End Function Public /* static method */ Static Function FromRGB(r As GLubyte, g As GLubyte, b As GLubyte) As Color3d Dim ret As Color3d(r/255,g/255,b/255) Return ret End Function Static Function FromCOLORREF(c As COLORREF) As Color3d Dim ret As Color3d((c and &hff)/255,(c>>8 and &hff)/255,(c>>16 and &hff)/255) Return ret End Function Static Function FromHSV(h As GLdouble, s As GLdouble, v As GLdouble) As Color3d Dim r As GLdouble Dim g As GLdouble Dim b As GLfloat If h<0 Then h+=360.0 If h>360.0 Then h-=360.0 Select Case (h/60) As Long Case 0 r=v g=v*(1-s*(1-(h/60-(h/60) As Long))) b=v*(1-s) Case 1 r=v*(1-s*(h/60-(h/60) As Long)) g=v b=v*(1-s) Case 2 r=v*(1-s) g=v b=v*(1-s*(1-(h/60-(h/60) As Long))) Case 3 r=v*(1-s) g=v*(1-s*(h/60-(h/60) As Long)) b=v Case 4 r=v*(1-s*(1-(h/60-(h/60) As Long))) g=v*(1-s) b=v Case 5 r=v g=v*(1-s) b=v*(1-s*(h/60-(h/60) As Long)) Case 6 r=v g=v*(1-s*(1-(h/60-(h/60) As Long))) b=v*(1-s) End Select Dim ret As Color3d(r,g,b) Return ret End Function Public rgb As RGB_DOUBLE End Class Type RGBA_FLOAT r As GLfloat g As GLfloat b As GLfloat a As GLfloat End Type Type RGBA_DOUBLE r As GLdouble g As GLdouble b As GLdouble a As GLdouble End Type Class Color4f Public /* constructor */ Sub Color4f(r As GLfloat, g As GLfloat, b As GLfloat, a As GLfloat) rgba.r = r rgba.g = g rgba.b = b rgba.a = a End Sub Sub Color4f(color As Color4d) rgba.r = color.R As GLfloat rgba.g = color.G As GLfloat rgba.b = color.B As GLfloat rgba.a = color.A As GLfloat End Sub Public /* destructor */ Sub ~Color4f() End Sub Public /* property */ Function R() As GLfloat Return rgba.r End Function Function G() As GLfloat Return rgba.g End Function Function B() As GLfloat Return rgba.b End Function Function A() As GLfloat Return rgba.a End Function Sub R(r As GLfloat) rgba.r = r End Sub Sub G(g As GLfloat) rgba.g = g End Sub Sub B(b As GLfloat) rgba.b = b End Sub Sub A(a As GLfloat) rgba.a = a End Sub Public /* operator */ Sub operator = (ByRef c As Color4f) This.R=c.R This.G=c.G This.B=c.B This.A=c.A End Sub Public /* method */ ' HSBを求める式はhttp://ofo.jp/osakana/cgtips/hsb.phtmlを参考にした ' Drawwing\Color.abをさらに参考にしました。 Function GetHue() As GLfloat Dim max As GLfloat, min As GLfloat, d As GLfloat max = Math.Max(Math.Max(rgb.r, rgb.g), rgb.b) min = Math.Min(Math.Min(rgb.r, rgb.g), rgb.b) d = max - min If rgb.g = max Then Return ((rgb.b - rgb.r) As Double / d * 60.0 + 120.0) As GLfloat ElseIf rgb.b = max Then Return ((rgb.r - rgb.g) As Double / d * 60.0 + 240.0) As GLfloat ElseIf rgb.g < rgb.b Then Return ((rgb.g - rgb.b) As Double / d * 60.0 + 360.0) As GLfloat Else Return ((rgb.g - rgb.b) As Double / d * 60.0) As GLfloat EndIf End Function Function GetSaturation() As GLfloat Dim max As GLfloat, min As GLfloat max = Math.Max(Math.Max(rgb.r, rgb.g), rgb.b) min = Math.Min(Math.Min(rgb.r, rgb.g), rgb.b) Return (max - min) / max End Function Function GetVolue() As GLfloat Dim max As GLfloat max = Math.Max(Math.Max(rgb.r, rgb.g), rgb.b) Return max End Function Public /* static method */ Static Function FromRGB(r As GLubyte, g As GLubyte, b As GLubyte) As Color4f Dim ret As Color4f(r/255,g/255,b/255,1.0) Return ret End Function Static Function FromArgb(a As GLubyte, r As GLubyte, g As GLubyte, b As GLubyte) As Color4f Dim ret As Color4f(r/255,g/255,b/255,a/255) Return ret End Function Static Function FromCOLORREF(c As COLORREF) As Color4f Dim ret As Color4f((c and &hff)/255,(c>>8 and &hff)/255,(c>>16 and &hff)/255,1.0) Return ret End Function Static Function FromHSV(h As GLfloat, s As GLfloat, v As GLfloat, a As GLfloat) As Color4f Dim r As GLfloat Dim g As GLfloat Dim b As GLfloat If h<0 Then h+=360.0 If h>360.0 Then h-=360.0 Select Case (h/60) As Long Case 0 r=v g=v*(1-s*(1-(h/60-(h/60) As Long))) b=v*(1-s) Case 1 r=v*(1-s*(h/60-(h/60) As Long)) g=v b=v*(1-s) Case 2 r=v*(1-s) g=v b=v*(1-s*(1-(h/60-(h/60) As Long))) Case 3 r=v*(1-s) g=v*(1-s*(h/60-(h/60) As Long)) b=v Case 4 r=v*(1-s*(1-(h/60-(h/60) As Long))) g=v*(1-s) b=v Case 5 r=v g=v*(1-s) b=v*(1-s*(h/60-(h/60) As Long)) Case 6 r=v g=v*(1-s*(1-(h/60-(h/60) As Long))) b=v*(1-s) End Select Dim ret As Color4f(r,g,b,a) Return ret End Function Public rgba As RGBA_FLOAT End Class Class Color4d Public /* constructor */ Sub Color4d(r As GLdouble, g As GLdouble, b As GLdouble, a As GLdouble) rgba.r = r rgba.g = g rgba.b = b rgba.a = a End Sub Sub Color4d(color As Color4f) rgba.r = color.R As GLdouble rgba.g = color.G As GLdouble rgba.b = color.B As GLdouble rgba.a = color.A As GLdouble End Sub Public /* destructor */ Sub ~Color4d() End Sub Public /* property */ Function R() As GLdouble Return rgba.r End Function Function G() As GLdouble Return rgba.g End Function Function B() As GLdouble Return rgba.b End Function Function A() As GLdouble Return rgba.a End Function Sub R(r As GLdouble) rgba.r = r End Sub Sub G(g As GLdouble) rgba.g = g End Sub Sub B(b As GLdouble) rgba.b = b End Sub Sub A(a As GLdouble) rgba.a = a End Sub Public /* operator */ Sub operator = (ByRef c As Color4d) This.R=c.R This.G=c.G This.B=c.B This.A=c.A End Sub Public /* method */ ' HSBを求める式はhttp://ofo.jp/osakana/cgtips/hsb.phtmlを参考にした ' Drawwing\Color.abをさらに参考にしました。 Function GetHue() As GLfloat Dim max As GLfloat, min As GLfloat, d As GLfloat max = Math.Max(Math.Max(rgb.r, rgb.g), rgb.b) min = Math.Min(Math.Min(rgb.r, rgb.g), rgb.b) d = max - min If rgb.g = max Then Return ((rgb.b - rgb.r) As Double / d * 60.0 + 120.0) As GLdouble ElseIf rgb.b = max Then Return ((rgb.r - rgb.g) As Double / d * 60.0 + 240.0) As GLdouble ElseIf rgb.g < rgb.b Then Return ((rgb.g - rgb.b) As Double / d * 60.0 + 360.0) As GLdouble Else Return ((rgb.g - rgb.b) As Double / d * 60.0) As GLdouble EndIf End Function Function GetSaturation() As GLdouble Dim max As GLdouble, min As GLdouble max = Math.Max(Math.Max(rgb.r, rgb.g), rgb.b) min = Math.Min(Math.Min(rgb.r, rgb.g), rgb.b) Return (max - min) / max End Function Function GetVolue() As GLdouble Dim max As GLdouble max = Math.Max(Math.Max(rgb.r, rgb.g), rgb.b) Return max End Function Public /* static method */ Static Function FromRGB(r As GLubyte, g As GLubyte, b As GLubyte) As Color4d Dim ret As Color4d(r/255,g/255,b/255,1.0) Return ret End Function Static Function FromArgb(a As GLubyte, r As GLubyte, g As GLubyte, b As GLubyte) As Color4d Dim ret As Color4d(r/255,g/255,b/255,a/255) Return ret End Function Static Function FromCOLORREF(c As COLORREF) As Color4d Dim ret As Color4d((c and &hff)/255,(c>>8 and &hff)/255,(c>>16 and &hff)/255,1.0) Return ret End Function Static Function FromHSV(h As GLdouble, s As GLdouble, v As GLdouble, a As GLdouble) As Color4d Dim r As GLdouble Dim g As GLdouble Dim b As GLdouble Dim a As GLdouble If h<0 Then h+=360.0 If h>360.0 Then h-=360.0 Select Case (h/60) As Long Case 0 r=v g=v*(1-s*(1-(h/60-(h/60) As Long))) b=v*(1-s) Case 1 r=v*(1-s*(h/60-(h/60) As Long)) g=v b=v*(1-s) Case 2 r=v*(1-s) g=v b=v*(1-s*(1-(h/60-(h/60) As Long))) Case 3 r=v*(1-s) g=v*(1-s*(h/60-(h/60) As Long)) b=v Case 4 r=v*(1-s*(1-(h/60-(h/60) As Long))) g=v*(1-s) b=v Case 5 r=v g=v*(1-s) b=v*(1-s*(h/60-(h/60) As Long)) Case 6 r=v g=v*(1-s*(1-(h/60-(h/60) As Long))) b=v*(1-s) End Select Dim ret As Color4f(r,g,b,a) Return ret End Function Public rgba As RGBA_DOUBLE End Class Class Light Private Const Number As GLenum Public Sub Enabled(enabled As GLboolean) If enabled Then glEnable(Number) Else glDisable(Number) End If End Sub Function Enabled() As GLboolean Dim lighting As GLboolean glGetBooleanv(Number,VarPtr(lighting)) Return lighting End Function Public /* constructor */ Sub Light(num As GLenum) Number=num End Sub Public Sub SetAmbient(red As GLfloat, green As GLfloat, blue As GLfloat, alpha As GLfloat) Dim amb[3] As GLfloat amb[0]=red amb[1]=green amb[2]=blue amb[3]=alpha glLightfv(Number,GL_AMBIENT,amb) End Sub Sub SetAmbient(ByRef color As Color4f) Dim amb[3] As GLfloat amb[0]=color.R amb[1]=color.G amb[2]=color.B amb[3]=color.A glLightfv(Number,GL_AMBIENT,amb) End Sub Sub SetAmbient(amb As *GLfloat) glLightfv(Number,GL_AMBIENT,amb) End Sub Sub SetDiffuse(red As GLfloat, green As GLfloat, blue As GLfloat, alpha As GLfloat) Dim dif[3] As GLfloat dif[0]=red dif[1]=green dif[2]=blue dif[3]=alpha glLightfv(Number,GL_DIFFUSE,dif) End Sub Sub SetDiffuse(ByRef color As Color4f) Dim dif[3] As GLfloat amb[0]=color.R amb[1]=color.G amb[2]=color.B amb[3]=color.A glLightfv(Number,GL_DIFFUSE,dif) End Sub Sub SetDiffuse(dif As *GLfloat) glLightfv(Number,GL_DIFFUSE,dif) End Sub Sub SetSpecular(red As GLfloat, green As GLfloat, blue As GLfloat, alpha As GLfloat) Dim spc[3] As GLfloat spc[0]=red spc[1]=green spc[2]=blue spc[3]=alpha glLightfv(Number,GL_SPECULAR,spc) End Sub Sub SetSpecular(ByRef color As Color4f) Dim spc[3] As GLfloat amb[0]=color.R amb[1]=color.G amb[2]=color.B amb[3]=color.A glLightfv(Number,GL_SPECULAR,spc) End Sub Sub SetSpecular(spc As *GLfloat) glLightfv(Number,GL_SPECULAR,spc) End Sub Sub SetPosition(pos As *GLfloat) glLightfv(Number,GL_POSITION,pos) End Sub End Class Class LightsCollection Public Function Item() As Light Return End Function End Class Class MaterialManager Public Sub Ambient(red As GLfloat, green As GLfloat, blue As GLfloat, alpha As GLfloat) Dim face As GLenum glGetIntegerv(GL_COLOR_MATERIAL_FACE,VarPtr(face)) Dim amb[3] As GLfloat amb[0]=red amb[1]=green amb[2]=blue amb[3]=alpha glMaterialfv(face,GL_AMBIENT,amb) End Sub Sub Ambient(ByRef color As Color4f) Dim face As GLenum glGetIntegerv(GL_COLOR_MATERIAL_FACE,VarPtr(face)) Dim amb[3] As GLfloat amb[0]=color.R amb[1]=color.G amb[2]=color.B amb[3]=color.A glMaterialfv(face,GL_AMBIENT,amb) End Sub Sub Ambient(amb As *GLfloat) glMaterialfv(face,GL_AMBIENT,amb) End Sub Sub Diffuse(red As GLfloat, green As GLfloat, blue As GLfloat, alpha As GLfloat) Dim face As GLenum glGetIntegerv(GL_COLOR_MATERIAL_FACE,VarPtr(face)) Dim dif[3] As GLfloat dif[0]=red dif[1]=green dif[2]=blue dif[3]=alpha glMaterialfv(face,GL_DIFFUSE,dif) End Sub Sub Diffuse(ByRef color As Color4f) Dim face As GLenum glGetIntegerv(GL_COLOR_MATERIAL_FACE,VarPtr(face)) Dim dif[3] As GLfloat dif[0]=color.R dif[1]=color.G dif[2]=color.B dif[3]=color.A glMaterialfv(face,GL_DIFFUSE,dif) End Sub Sub Diffuse(dif As *GLfloat) glMaterialfv(face,GL_DIFFUSE,dif) End Sub Sub Specular(red As GLfloat, green As GLfloat, blue As GLfloat, alpha As GLfloat) Dim face As GLenum glGetIntegerv(GL_COLOR_MATERIAL_FACE,VarPtr(face)) Dim spc[3] As GLfloat spc[0]=red spc[1]=green spc[2]=blue spc[3]=alpha glMaterialfv(face,GL_SPECULAR,spc) End Sub Sub Specular(ByRef color As Color4f) Dim face As GLenum glGetIntegerv(GL_COLOR_MATERIAL_FACE,VarPtr(face)) Dim spc[3] As GLfloat spc[0]=color.R spc[1]=color.G spc[2]=color.B spc[3]=color.A glMaterialfv(face,GL_SPECULAR,spc) End Sub Sub Specular(spc As *GLfloat) glMaterialfv(face,GL_SPECULAR,spc) End Sub Sub Shininess(shin As GLfloat) Dim face As GLenum glGetIntegerv(GL_COLOR_MATERIAL_FACE,VarPtr(face)) glMaterialf(face,GL_SHININESS,shin) End Sub Sub Emission(red As GLfloat, green As GLfloat, blue As GLfloat, alpha As GLfloat) Dim face As GLenum glGetIntegerv(GL_COLOR_MATERIAL_FACE,VarPtr(face)) Dim ems[3] As GLfloat ems[0]=red ems[1]=green ems[2]=blue ems[3]=alpha glMaterialfv(face,GL_EMISSION,ems) End Sub End Class Class ModelViewMatrix Public Sub LoadIdentity() Dim mode As GLenum glGetIntegerv(GL_MATRIX_MODE,VarPtr(mode) As *Long) If mode<>GL_MODELVIEW Then glMatrixMode(GL_MODELVIEW) glLoadIdentity() If mode<>GL_MODELVIEW Then glMatrixMode(mode) End Sub Sub LookAt(eyex As GLdouble, eyey As GLdouble, eyez As GLdouble, centerx As GLdouble, centery As GLdouble, centerz As GLdouble, upx As GLdouble, upy As GLdouble, upz As GLdouble) Dim mode As GLenum glGetIntegerv(GL_MATRIX_MODE,VarPtr(mode)) If mode<>GL_MODELVIEW Then glMatrixMode(GL_MODELVIEW) gluLookAt(eyex, eyey, eyez, centerx, centery, centerz, upx, upy, upz) If mode<>GL_MODELVIEW Then glMatrixMode(mode) End Sub Sub RotateX(angle As GLdouble) Dim mode As GLenum glGetIntegerv(GL_MATRIX_MODE,VarPtr(mode) As *Long) If mode<>GL_MODELVIEW Then glMatrixMode(GL_MODELVIEW) glRotated(angle, 1.0 As GLdouble, 0.0 As GLdouble, 0.0 As GLdouble) If mode<>GL_MODELVIEW Then glMatrixMode(mode) End Sub Sub RotateX(angle As GLfloat) Dim mode As GLenum glGetIntegerv(GL_MATRIX_MODE,VarPtr(mode)) If mode<>GL_MODELVIEW Then glMatrixMode(GL_MODELVIEW) glRotatef(angle, 1.0 As GLfloat, 0.0 As GLfloat, 0.0 As GLfloat) If mode<>GL_MODELVIEW Then glMatrixMode(mode) End Sub Sub RotateY(angle As GLdouble) Dim mode As GLenum glGetIntegerv(GL_MATRIX_MODE,VarPtr(mode) As *Long) If mode<>GL_MODELVIEW Then glMatrixMode(GL_MODELVIEW) glRotated(angle, 0.0 As GLdouble, 1.0 As GLdouble, 0.0 As GLdouble) If mode<>GL_MODELVIEW Then glMatrixMode(mode) End Sub Sub RotateY(angle As GLfloat) Dim mode As GLenum glGetIntegerv(GL_MATRIX_MODE,VarPtr(mode)) If mode<>GL_MODELVIEW Then glMatrixMode(GL_MODELVIEW) glRotatef(angle, 0.0 As GLfloat, 1.0 As GLfloat, 0.0 As GLfloat) If mode<>GL_MODELVIEW Then glMatrixMode(mode) End Sub Sub RotateZ(angle As GLdouble) Dim mode As GLenum glGetIntegerv(GL_MATRIX_MODE,VarPtr(mode)) If mode<>GL_MODELVIEW Then glMatrixMode(GL_MODELVIEW) glRotated(angle, 0.0 As GLdouble, 0.0 As GLdouble, 1.0 As GLdouble) If mode<>GL_MODELVIEW Then glMatrixMode(mode) End Sub Sub RotateZ(angle As GLfloat) Dim mode As GLenum glGetIntegerv(GL_MATRIX_MODE,VarPtr(mode)) If mode<>GL_MODELVIEW Then glMatrixMode(GL_MODELVIEW) glRotatef(angle, 0.0 As GLfloat, 0.0 As GLfloat, 1.0 As GLfloat) If mode<>GL_MODELVIEW Then glMatrixMode(mode) End Sub Sub Scale(x As GLdouble, y As GLdouble, z As GLdouble) Dim mode As GLenum glGetIntegerv(GL_MATRIX_MODE,VarPtr(mode)) If mode<>GL_MODELVIEW Then glMatrixMode(GL_MODELVIEW) glScaled(x, y, z) If mode<>GL_MODELVIEW Then glMatrixMode(mode) End Sub Sub Scale(x As GLfloat, y As GLfloat, z As GLfloat) Dim mode As GLenum glGetIntegerv(GL_MATRIX_MODE,VarPtr(mode)) If mode<>GL_MODELVIEW Then glMatrixMode(GL_MODELVIEW) glScalef(x, y, z) If mode<>GL_MODELVIEW Then glMatrixMode(mode) End Sub Sub Translate(x As GLdouble, y As GLdouble, z As GLdouble) Dim mode As GLenum glGetIntegerv(GL_MATRIX_MODE,VarPtr(mode) As *GLint) If mode<>GL_MODELVIEW Then glMatrixMode(GL_MODELVIEW) glTranslated(x, y, z) If mode<>GL_MODELVIEW Then glMatrixMode(mode) End Sub Sub Translate(x As GLfloat, y As GLfloat, z As GLfloat) Dim mode As GLenum glGetIntegerv(GL_MATRIX_MODE,VarPtr(mode) As *Long) If mode<>GL_MODELVIEW Then glMatrixMode(GL_MODELVIEW) glTranslatef(x, y, z) If mode<>GL_MODELVIEW Then glMatrixMode(mode) End Sub End Class Class ProjectionMatrix Public Sub LoadIdentity() Dim mode As GLenum glGetIntegerv(GL_MATRIX_MODE,VarPtr(mode) As *Long) If mode<>GL_PROJECTION Then glMatrixMode(GL_PROJECTION) glLoadIdentity() If mode<>GL_PROJECTION Then glMatrixMode(mode) End Sub Sub Ortho2D(left As GLdouble, right As GLdouble, bottom As GLdouble, top As GLdouble) Dim mode As GLenum glGetIntegerv(GL_MATRIX_MODE,VarPtr(mode) As *Long) If mode<>GL_PROJECTION Then glMatrixMode(GL_PROJECTION) gluOrtho2D(left, right, bottom, top) If mode<>GL_PROJECTION Then glMatrixMode(mode) End Sub Sub Ortho3D(left As GLdouble, right As GLdouble, bottom As GLdouble, top As GLdouble, zNear As GLdouble, zFar As GLdouble) Dim mode As GLenum glGetIntegerv(GL_MATRIX_MODE,VarPtr(mode)) If mode<>GL_PROJECTION Then glMatrixMode(GL_PROJECTION) glOrtho(left, right, bottom, top, zNear, zFar) If mode<>GL_PROJECTION Then glMatrixMode(mode) End Sub Sub Frustum(left As GLdouble, right As GLdouble, bottom As GLdouble, top As GLdouble, zNear As GLdouble, zFar As GLdouble) Dim mode As GLenum glGetIntegerv(GL_MATRIX_MODE,VarPtr(mode)) If mode<>GL_PROJECTION Then glMatrixMode(GL_PROJECTION) glFrustum(left, right, bottom, top, zNear, zFar) If mode<>GL_PROJECTION Then glMatrixMode(mode) End Sub Sub Perspective(fovy As GLdouble, aspect As GLdouble, zNear As GLdouble, zFar As GLdouble) Dim mode As GLenum glGetIntegerv(GL_MATRIX_MODE,VarPtr(mode) As *Long) If mode<>GL_PROJECTION Then glMatrixMode(GL_PROJECTION) gluPerspective(fovy, aspect, zNear, zFar) If mode<>GL_PROJECTION Then glMatrixMode(mode) End Sub End Class Class TransformMatrix Public Projection As ProjectionMatrix ModelView As ModelViewMatrix Public Sub Transform() Projection=New ProjectionMatrix ModelView=New ModelViewMatrix End Sub End Class Class LightModelManager Public Function Ambient () As Color4f Dim amb As Color4f glGetFloatv(GL_LIGHT_MODEL_AMBIENT,VarPtr(amb.rgba)) Return amb End Function Sub Ambient(amb As Color4f) glLightModelfv(GL_LIGHT_MODEL_AMBIENT,VarPtr(amb.rgba)) End Sub Function LocalView() As GLboolean Dim local As GLboolean glGetBooleanv(GL_LIGHT_MODEL_LOCAL_VIEW,VarPtr(local)) Return local End Function Sub LocalView(enable As GLboolean) If enable Then glLightModeli(GL_LIGHT_MODEL_LOCAL_VIEW,GL_TRUE) Else glLightModeli(GL_LIGHT_MODEL_LOCAL_VIEW,GL_FALSE) End If End Sub Function TwoSide() As GLboolean Dim local As GLboolean glGetBooleanv(GL_LIGHT_MODEL_TWO_SIDE,VarPtr(local)) Return local End Function Sub TwoSide(enable As GLboolean) If enable Then glLightModeli(GL_LIGHT_MODEL_TWO_SIDE,GL_TRUE) Else glLightModeli(GL_LIGHT_MODEL_TWO_SIDE,GL_FALSE) End If End Sub End Class Class RenderStateManager Public /* Composiotion */ LightModel As LightModelManager Public Sub RenderStateManager() LightModel = New LightModelManager() End Sub Function AlphaTestEnable() As GLboolean Dim alpha As GLboolean glGetBooleanv(GL_ALPHA_TEST,VarPtr(alpha)) Return alpha End Function Sub AlphaTestEnable(enable As GLboolean) If enable Then glEnable(GL_ALPHA_TEST) Else glDisable(GL_ALPHA_TEST) End If End Sub Function AlphaFunction() As GLenum Dim func As GLenum glGetIntegerv(GL_ALPHA_TEST_FUNC,VarPtr(func)) Return func End Function Sub AlphaFunction(func As GLenum) Dim ref As GLclampf glGetFloatv(GL_ALPHA_TEST_REF,VarPtr(ref)) glAlphaFunc(func,ref) End Sub Function BlendEnable() As GLboolean Dim blend As GLboolean glGetBooleanv(GL_BLEND,VarPtr(blend)) Return blend End Function Sub BlendEnable(enable As GLboolean) If enable Then glEnable(GL_BLEND) Else glDisable(GL_BLEND) End If End Sub Function BlendDestinationFactor() As GLenum Dim dfactor As GLenum glGetIntegerv(GL_BLEND_DST,VarPtr(dfactor)) Return dfactor End Function Sub BlendDestinationFactor(dfactor As GLenum) Dim sfactor As GLenum glGetIntegerv(GL_BLEND_SRC,VarPtr(sfactor)) glBlendFunc(sfactor,dfactor) End Sub Function BlendSourceFactor() As GLenum Dim sfactor As GLenum glGetIntegerv(GL_BLEND_SRC,VarPtr(sfactor)) Return sfactor End Function Sub BlendSourceFactor(sfactor As GLenum) Dim dfactor As GLenum glGetIntegerv(GL_BLEND_DST,VarPtr(dfactor)) glBlendFunc(sfactor,dfactor) End Sub Function CullFaceEnable() As GLboolean Dim cull As GLboolean glGetBooleanv(GL_CULL_FACE,VarPtr(cull)) Return cull End Function Sub CullFaceEnable(enable As GLboolean) If enable Then glEnable(GL_CULL_FACE) Else glDisable(GL_CULL_FACE) End If End Sub Function CullFaceMode () As GLenum Dim mode As GLenum glGetIntegerv(GL_CULL_FACE_MODE,VarPtr(mode)) Return mode End Function Sub CullFaceMode(mode As GLenum) glCullFace(mode) End Sub Function DepthTestEnable () As GLboolean Dim depth As GLboolean glGetBooleanv(GL_DEPTH_TEST,VarPtr(depth)) Return depth End Function Sub DepthTestEnable(enable As GLboolean) If enable Then glEnable(GL_DEPTH_TEST) Else glDisable(GL_DEPTH_TEST) End If End Sub Function DepthFunction () As GLenum Dim func As GLenum glGetIntegerv(GL_DEPTH_FUNC,VarPtr(func)) Return func End Function Sub DepthFunction(func As GLenum) glDepthFunc(func) End Sub Function DepthBufferWritable() As GLboolean Dim writable As GLboolean glGetBooleanv(GL_DEPTH_WRITEMASK,VarPtr(writable)) Return writable End Function Sub DepthBufferWritable(enable As GLboolean) If enable Then glDepthMask(GL_DEPTH_WRITEMASK) Else glDepthMask(GL_DEPTH_WRITEMASK) End If End Sub Function DitherEnable() As GLboolean Dim dither As GLboolean glGetBooleanv(GL_DITHER,VarPtr(dither)) Return dither End Function Sub DitherEnable(enable As GLboolean) If enable Then glEnable(GL_DITHER) Else glDisable(GL_DITHER) End If End Sub Function FogEnable () As GLboolean Dim fog As GLboolean glGetBooleanv(GL_FOG,VarPtr(fog)) Return fog End Function Sub FogEnable(enable As GLboolean) If enable Then glEnable(GL_FOG) Else glDisable(GL_FOG) End If End Sub Function FogMode() As GLenum Dim mode As GLenum glGetIntegerv(GL_FOG_MODE,VarPtr(mode)) Return mode End Function Sub FogMode(mode As GLenum) glFogi(GL_FOG_MODE,mode) End Sub Function FogColor() As Color4f Dim ret As Color4f glGetFloatv(GL_FOG_COLOR,VarPtr(ret.rgba)) Return ret End Function Sub FogColor(fcolor As Color4f) glFogfv(GL_FOG_COLOR,VarPtr(fcolor.rgba)) End Sub Function FogDensity() As GLfloat Dim density As GLfloat glGetFloatv(GL_FOG_DENSITY,density) Return density End Function Sub FogDensity(density As GLfloat) glFogf(GL_FOG_DENSITY,density) End Sub Function FogStart() As GLfloat Dim fstrat As GLfloat glGetFloatv(GL_FOG_START,fstrat) Return fstrat End Function Sub FogStart(fstrat As GLfloat) glFogf(GL_FOG_START,fstrat) End Sub Function FogEnd() As GLfloat Dim fend As GLfloat glGetFloatv(GL_FOG_END,fend) Return fend End Function Sub FogEnd(fend As GLfloat) glFogf(GL_FOG_END,fend) End Sub Function Lighting() As GLboolean Dim lighting As GLboolean glGetBooleanv(GL_LIGHTING,VarPtr(lighting)) Return lighting End Function Sub Lighting(enable As GLboolean) If enable Then glEnable(GL_LIGHTING) Else glDisable(GL_LIGHTING) End If End Sub Function LineSmoothEnable() As GLboolean Dim smooth As GLboolean glGetBooleanv(GL_LINE_SMOOTH,VarPtr(smooth)) Return smooth End Function Sub LineSmoothEnable(enable As GLboolean) If enable Then glEnable(GL_LINE_SMOOTH) Else glDisable(GL_LINE_SMOOTH) End If End Sub Function LogicOpEnable() As GLboolean Dim logic As GLboolean glGetBooleanv(GL_COLOR_LOGIC_OP,VarPtr(logic)) Return logic End Function Sub LogicOpEnable(enable As GLboolean) If enable Then glEnable(GL_COLOR_LOGIC_OP) Else glDisable(GL_COLOR_LOGIC_OP) End If End Sub Function LogicOpCode() As GLenum Dim code As GLenum glGetFloatv(GL_COLOR_LOGIC_OP_MODE,code) Return code End Function Sub LogicOpCode(code As GLenum) glLogicOp(code) End Sub Function PointSmoothEnable() As GLboolean Dim smooth As GLboolean glGetBooleanv(GL_POINT_SMOOTH,VarPtr(smooth)) Return smooth End Function Sub PointSmoothEnable(enable As GLboolean) If enable Then glEnable(GL_POINT_SMOOTH) Else glDisable(GL_POINT_SMOOTH) End If End Sub Function PolygonSmoothEnable() As GLboolean Dim smooth As GLboolean glGetBooleanv(GL_POLYGON_SMOOTH,VarPtr(smooth)) Return smooth End Function Sub PolygonSmoothEnable(enable As GLboolean) If enable Then glEnable(GL_POLYGON_SMOOTH) Else glDisable(GL_POLYGON_SMOOTH) End If End Sub Function ReferenceAlpha() As GLclampf Dim ref As GLclampf glGetFloatv(GL_ALPHA_TEST_REF,VarPtr(ref)) Return ref End Function Sub ReferenceAlpha(ref As GLclampf) Dim func As GLenum glGetIntegerv(GL_ALPHA_TEST_FUNC,VarPtr(func)) glAlphaFunc(func,ref) End Sub Function ShadeModel() As GLenum Dim mode As GLenum glGetIntegerv(GL_SHADE_MODEL,VarPtr(mode)) Return mode End Function Sub ShadeModel(mode As GLenum) glShadeModel(mode) End Sub End Class Enum ColorType RgbColor=0 RgbaColor=0 IndexColor End Enum Enum BufferType SingleBuffer=0 DoubleBuffer End Enum Enum ClearBuffer DepthBufferBit = &H00000100 AccumBufferBit = &H00000200 StencilBufferBit = &H00000400 ColorBufferBit = &H00004000 End Enum Enum PrimitiveMode Points = &H0000 Lines = &H0001 LineLoop = &H0002 LineStrip = &H0003 Triangles = &H0004 TriangleStrip = &H0005 TriangleFan = &H0006 Quads = &H0007 QuadStrip = &H0008 Polygon = &H0009 End Enum Class RenderingContext Public /* Composiotion */ Material As MaterialManager RenderState As RenderStateManager Transform As TransformMatrix Lights As LightsCollection Public /* Constructor */ Sub RenderingContext() Dim hrc As HGLRC hrc=wglGetCurrentContext() If hrc Then wglMakeCurrent(NULL,NULL) wglDeleteContext(hrc) End If Material = New MaterialManager() RenderState = New RenderStateManager() Transform = New TransformMatrix() Lights = New LightsCollection() End Sub Sub RenderingContext(hdc As HDC, ByRef pfd As PIXELFORMATDESCRIPTOR) RenderingContext() Dim pf As Long pf=ChoosePixelFormat(hdc,pfd) If pf=0 Then MessageBox(NULL,"Choose Pixel Format failed","error",MB_OK) Exit Sub End If If SetPixelFormat(hdc,pf,pfd)=FALSE Then MessageBox(NULL,"Set Pixel Format failed","error",MB_OK) Exit Sub End If Dim hrc As HGLRC hrc=wglCreateContext(hdc) wglMakeCurrent(hdc,hrc) End Sub Sub RenderingContext(hdc As HDC, ctype As ColorType, btype As BufferType) RenderingContext() Dim pfd As PIXELFORMATDESCRIPTOR pfd.nSize=SizeOf(PIXELFORMATDESCRIPTOR) As Word pfd.nVersion=GL_VERSION_1_1 If btype=BufferType.DoubleBuffer Then pfd.dwFlags or=PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER Else pfd.dwFlags or=PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL End If If ctype=ColorType.RgbColor Then pfd.iPixelType=PFD_TYPE_RGBA Else pfd.iPixelType=PFD_TYPE_COLORINDEX End If pfd.cColorBits=24 pfd.cRedBits=0 pfd.cRedShift=0 pfd.cGreenBits=0 pfd.cGreenShift=0 pfd.cBlueBits=0 pfd.cBlueShift=0 pfd.cAlphaBits=0 pfd.cAlphaShift=0 pfd.cAccumBits=0 pfd.cAccumRedBits=0 pfd.cAccumGreenBits=0 pfd.cAccumBlueBits=0 pfd.cAccumAlphaBits=0 pfd.cDepthBits=32 pfd.cStencilBits=0 pfd.cAuxBuffers=0 pfd.iLayerType=PFD_MAIN_PLANE pfd.bReserved=0 pfd.dwLayerMask=0 pfd.dwVisibleMask=0 pfd.dwDamageMask=0 RenderingContext(hdc,pfd) End Sub Sub RenderingContext(hdc As HDC) RenderingContext(hdc As HDC, ColorType.RgbColor, BufferType.DoubleBuffer) End Sub Public /* Destructor */ Sub ~RenderingContext() Dim hrc As HGLRC hrc=wglGetCurrentContext() wglMakeCurrent(NULL,NULL) wglDeleteContext(hrc) End Sub Public /* Method */ Sub Begin(mode As GLenum) glBegin(mode) End Sub Sub Begin(mode As PrimitiveMode) glBegin(mode) End Sub Sub Clear(mask As GLbitfield) glClear(mask) End Sub Sub Clear(mask As ClearBuffer) glClear(mask) End Sub Sub ClearAccum(red As GLfloat, green As GLfloat, blue As GLfloat, alpha As GLfloat) glClearAccum(red, green, blue, alpha) End Sub Sub ClearAccum(color As Color4f) glClearAccum(color.R, color.G, color.B, color.A) End Sub Sub ClearColor(red As GLclampf, green As GLclampf, blue As GLclampf, alpha As GLclampf) glClearColor(red, green, blue, alpha) End Sub Sub ClearColor(color As Color4f) glClearColor(color.R, color.G, color.B, color.A) End Sub Sub ClearDepth(depth As GLclampd) glClearDepth(depth) End Sub Sub ClearIndex(c As GLfloat) glClearIndex(c) End Sub Sub ClearStencil(s As GLint) glClearStencil(s) End Sub Sub Color(red As GLdouble, green As GLdouble, blue As GLdouble) glColor3d(red,green,blue) End Sub Sub Color(red As GLdouble, green As GLdouble, blue As GLdouble, alpha As GLdouble) glColor4d(red,green,blue,alpha) End Sub Sub Color(red As GLfloat, green As GLfloat, blue As GLfloat) glColor3f(red,green,blue) End Sub Sub Color(red As GLfloat, green As GLfloat, blue As GLfloat, alpha As GLfloat) glColor4f(red,green,blue,alpha) End Sub Sub Color(c As Color3f) glColor3fv(VarPtr(c.rgb) As *Single) End Sub Sub Color(c As Color4f) glColor4fv(VarPtr(c.rgba) As *Single) End Sub Sub Color(c As Color3d) glColor3dv(VarPtr(c.rgb) As *Double) End Sub Sub Color(c As Color4d) glColor4dv(VarPtr(c.rgba) As *Double) End Sub Sub DrawPrimiteve() End Sub Sub End() glEnd() End Sub Sub Finish() glFinish() End Sub Sub Flush() glFlush() End Sub Function GenerateTexures() As GLint glGenTextures() End Function Sub MatrixMode(mode As GLenum) glMatrixMode(mode) End Sub Sub Present() SwapBuffers(wglGetCurrentDC()) End Sub Sub Present(hdc As HDC) SwapBuffers(hdc) End Sub Sub PopMatrix() glPopMatrix() End Sub Sub PushMatrix() glPushMatrix() End Sub Sub Vertex(x As GLdouble, y As GLdouble) glVertex2d(x,y) End Sub Sub Vertex(x As GLdouble, y As GLdouble, z As GLdouble) glVertex3d(x,y,z) End Sub Sub Vertex(x As GLdouble, y As GLdouble, z As GLdouble, w As GLdouble) glVertex4d(x,y,z,w) End Sub Sub Vertex(x As GLfloat, y As GLfloat) glVertex2f(x,y) End Sub Sub Vertex(x As GLfloat, y As GLfloat, z As GLfloat) glVertex3f(x,y,z) End Sub Sub Vertex(x As GLfloat, y As GLfloat, z As GLfloat, w As GLfloat) glVertex4f(x,y,z,w) End Sub Sub Viewport(x As GLint, y As GLint, width As GLsizei, height As GLsizei) glViewport(x, y, width, height) End Sub End Class #endif