' com/variant.ab

#ifndef _COM_VARIANT_AB
#define _COM_VARIANT_AB

#require <oaidl.ab>
#require <oleauto.ab>
#require <com/bstring.ab>
#include <com/vbobject.ab>

Class Variant
Public
	Sub Variant()
		VariantInit(v)
	End Sub

	Sub Variant(y As Variant)
		VariantInit(v)
		VariantCopy(v, y.v)
	End Sub

	Sub Variant(v As VARIANT)
		VariantInit(v)
		VariantCopy(v, y)
	End Sub

	Sub Variant(n As SByte)
		v.vt = VT_I1
		SetByte(VarPtr(v.val), n)
	End Sub

	Sub Variant(n As Byte)
		v.vt = VT_UI1
		SetByte(VarPtr(v.val), n)
	End Sub

	Sub Variant(n As Integer)
		v.vt = VT_I2
		SetWord(VarPtr(v.val), n)
	End Sub

	Sub Variant(n As Word)
		v.vt = VT_UI2
		SetWord(VarPtr(v.val), n)
	End Sub

	Sub Variant(n As Long)
		v.vt = VT_I4
		SetDWord(VarPtr(v.val), n)
	End Sub

	Sub Variant(n As DWord)
		v.vt = VT_UI4
		SetDWord(VarPtr(v.val), n)
	End Sub

	Sub Variant(n As Int64)
		v.vt = VT_I8
		SetQWord(VarPtr(v.val), n)
	End Sub

	Sub Variant(n As QWord)
		v.vt = VT_UI8
		SetQWord(VarPtr(v.val), n)
	End Sub

	Sub Variant(n As Single)
		v.vt = VT_R4
		SetSingle(VarPtr(v.val), n)
	End Sub

	Sub Variant(n As Double)
		v.vt = VT_R8
		SetDouble(VarPtr(v.val), n)
	End Sub

	Sub Variant(bs As BString)
		v.vt = VT_BSTR
		SetPointer(VarPtr(v.val), SysAllocStringLen(bs.BStr, bs.Length))
	End Sub

	Sub Variant(p As *IUnknown)
		p->AddRef()
		v.vt = VT_UNKNOWN
		SetPointer(VarPtr(v.val), p)
	End Sub

	Sub Variant(p As *IDispatch)
		p->AddRef()
		v.vt = VT_DISPATCH
		SetPointer(VarPtr(v.val), p)
	End Sub
/*
	Sub Variant(b As VARIANT_BOOL)
		v.vt = VT_BOOL
		SetWord(VarPtr(v.val), b)
	End Sub
*/
	Sub Variant(b As Boolean)
		v.vt = VT_BOOL
		If b Then
			SetWord(VarPtr(v.val), VARIANT_TRUE)
		Else
			SetWord(VarPtr(v.val), VARIANT_FALSE)
		End If
	End Sub

	Sub Variant(s As String)
		Dim bs As BString(s)
		Variant(bs)
	End Sub

	Sub ~Variant()
		Clear()
	End Sub

	Sub Clear()
		VariantClear(v)
		v.vt = VT_EMPTY
	End Sub

	Sub Operator =(y As Variant)
		Assign(y.v)
	End Sub

	Sub Operator =(y As VARIANT)
		Assign(y)
	End Sub

	Sub Assign(from As Variant)
		Assign(from.v)
	End Sub

	Sub Assign(from As VARIANT)
		Clear()
		Variant.Copy(v, from)
	End Sub

	Sub Attach(ByRef from As VARIANT)
		Variant.Move(v, from)
	End Sub

	Function Detach() As VARIANT
		Variant.Move(Detach, v)
	End Function

	'Operators

	Const Function Operator ^(y As Variant) As Variant
		Dim ret As Variant
		VarPow(This.v, y.v, ret.v)
		Return ret
	End Function

	Function Operator -() As Variant
		Dim ret As Variant
		VarNeg(This.v, ret.v)
		Return ret
	End Function

	Const Function Operator *(y As Variant) As Variant
		Dim ret As Variant
		VarMul(This.v, y.v, ret.v)
		Return ret
	End Function

	Const Function Operator /(y As Variant) As Variant
		Dim ret As Variant
		VarDiv(This.v, y.v, ret.v)
		Return ret
	End Function

	Const Function Operator \(y As Variant) As Variant
		Dim ret As Variant
		VarIDiv(This.v, y.v, ret.v)
		Return ret
	End Function

	Const Function Operator Mod(y As Variant) As Variant
		Dim ret As Variant
		VarMod(This.v, y.v, ret.v)
		Return ret
	End Function

	Const Function Operator +(y As Variant) As Variant
		Dim ret As Variant
		VarAdd(This.v, y.v, ret.v)
		Return ret
	End Function

	Const Function Operator -(y As Variant) As Variant
		Dim ret As Variant
		VarSub(This.v, y.v, ret.v)
		Return ret
	End Function

	Const Function Operator &(y As Variant) As Variant
		Dim ret As Variant
		VarCat(This.v, y.v, ret.v)
		Return ret
	End Function

	Const Function Operator And(y As Variant) As Variant
		Dim ret As Variant
		VarAnd(This.v, y.v, ret.v)
		Return ret
	End Function

	Const Function Operator Or(y As Variant) As Variant
		Dim ret As Variant
		VarOr(This.v, y.v, ret.v)
		Return ret
	End Function

	Const Function Operator Xor(y As Variant) As Variant
		Dim ret As Variant
		VarXor(This.v, y.v, ret.v)
		Return ret
	End Function

	Function Operator Not() As Variant
		Dim ret As Variant
		VarNot(This.v, ret.v)
		Return ret
	End Function

	Static Function Imp(x As Variant, y As Variant) As Variant
		Dim ret As Variant
		VarImp(x.v, y.v, ret.v)
		Return ret
	End Function

	Static Function Eqv(x As Variant, y As Variant) As Variant
		Dim ret As Variant
		VarEqv(x.v, y.v, ret.v)
		Return ret
	End Function

	Function Abs() As Variant
		Dim ret As Variant
		VarAbs(This.v, ret.v)
		Return ret
	End Function

	Function Fix() As Variant
		Dim ret As Variant
		VarFix(This.v, ret.v)
		Return ret
	End Function

	Function Int() As Variant
		Dim ret As Variant
		VarInt(This.v, ret.v)
		Return ret
	End Function

	Function Round(cDecimals As Long) As Variant
		Dim ret As Variant
		VarRound(This.v, cDecimals, ret)
		Return ret
	End Function

	Function Round() As Variant
		Return Round(0)
	End Function

	Static Function Compare(x As Variant, y As Variant, lcid As LCID, flags As DWord) As HRESULT
		Return VarCmp(x.v, y.v, lcid, flags)
	End Function

	Static Function Compare(x As Variant, y As Variant) As HRESULT
		Return VarCmp(x.v, y.v, GetUserDefaultLCID(), 0) 'VARCMP_NULL = 3を返す場合があるので注意
	End Function

	Const Function Operator ==(y As Variant) As Boolean
		Return Compare(This, y) = VARCMP_EQ
	End Function

	Const Function Operator <>(y As Variant) As Boolean
		Return Compare(This, y) <> VARCMP_EQ
	End Function

	Const Function Operator <(y As Variant) As Boolean
		Return Compare(This, y) = VARCMP_LT
	End Function

'	Const Function Operator >(y As Variant) As Boolean
'		Return Compare(This, y) = VARCMP_GT
'	End Function

	Const Function Operator <=(y As Variant) As Boolean
		Dim result = Compare(This, y)
		Return result = VARCMP_LT Or result = VARCMP_EQ
	End Function

	Const Function Operator >=(y As Variant) As Boolean
		Dim result = Compare(This, y)
		Return result = VARCMP_GT Or result = VARCMP_EQ
	End Function

	Const Function ChangeType(vt As VARTYPE, flags As Word) As Variant
		Dim ret As Variant
		ChangeType(ret, flags, vt)
		Return ret
	End Function

	Const Function ChangeType(vt As VARTYPE) As Variant
		Return ChangeType(vt, 0)
	End Function

	Const Function ChangeType(ByRef ret As VARIANT, flags As Word, vt As VARTYPE) As HRESULT
		Return VariantChangeType(ret, v, flags, vt)
	End Function

	Const Function ChangeType(ByRef ret As Variant, flags As Word, vt As VARTYPE) As HRESULT
		Return ChangeType(ret.v, flags, vt)
	End Function

	Const Function VarType() As VARTYPE
		Return v.vt
	End Function

	Override Function ToString() As String
		Dim tmp = ChangeType(VT_BSTR)
		Dim bs = ((tmp.v.val As ULONG_PTR) As BSTR)
		Dim s As String(bs As PCWSTR, SysStringLen(bs) As Long)
		Return s
	End Function

	Override Function GetHashCode() As Long
		Dim p = (VarPtr(v) As *DWord)
		Return (p[0] Xor p[1] Xor p[2] Xor p[3]) As Long
	End Function

	Const Function ValUI1() As Byte
		Dim r = ChangeType(VT_UI1)
		Return GetByte(VarPtr(r.val))
	End Function

	Sub ValUI1(x As Byte)
		Clear()
		SetByte(VarPtr(v.val), x)
		v.vt = VT_UI1
	End Sub

	Const Function ValUI2() As Word
		Dim r = ChangeType(VT_UI2)
		Return GetWord(VarPtr(r.val))
	End Function

	Sub ValUI2(x As Word)
		Clear()
		SetWord(VarPtr(v.val), x)
		v.vt = VT_UI2
	End Sub

	Const Function ValUI4() As DWord
		Dim r = ChangeType(VT_UI4)
		Return GetDWord(VarPtr(r.val))
	End Function

	Sub ValUI4(x As DWord)
		Clear()
		SetDWord(VarPtr(v.val), x)
		v.vt = VT_UI4
	End Sub

	Const Function ValUI8() As QWord
		Dim r = ChangeType(VT_UI8)
		Return GetQWord(VarPtr(r.val))
	End Function

	Sub ValUI8(x As QWord)
		Clear()
		SetQWord(VarPtr(v.val), x)
		v.vt = VT_UI8
	End Sub

	Const Function ValI1() As SByte
		Dim r = ChangeType(VT_I1)
		Return GetByte(VarPtr(r.val)) As SByte
	End Function

	Sub ValI1(x As SByte)
		Clear()
		SetByte(VarPtr(v.val), x As Byte)
		v.vt = VT_I1
	End Sub

	Const Function ValI2() As Integer
		Dim r = ChangeType(VT_I2)
		Return GetWord(VarPtr(r.val)) As Integer
	End Function

	Sub ValI2(x As Integer)
		Clear()
		SetWord(VarPtr(v.val), x As Word)
		v.vt = VT_I2
	End Sub

	Const Function ValI4() As Long
		Dim r = ChangeType(VT_I4)
		Return GetDWord(VarPtr(r.val)) As Long
	End Function

	Sub ValI4(x As Long)
		Clear()
		SetDWord(VarPtr(v.val), x As DWord)
		v.vt = VT_I4
	End Sub

	Const Function ValI8() As Int64
		Dim r = ChangeType(VT_I8)
		Return GetQWord(VarPtr(r.val)) As Int64
	End Function

	Sub ValI8(x As Int64)
		Clear()
		SetQWord(VarPtr(v.val), x As QWord)
		v.vt = VT_I8
	End Sub

	Const Function ValR4() As Single
		Dim r = ChangeType(VT_R4)
		Return GetSingle(VarPtr(r.val))
	End Function

	Sub ValR4(x As Single)
		Clear()
		SetDWord(VarPtr(v.val), x)
		v.vt = VT_R4
	End Sub

	Const Function ValR8() As Double
		Dim r = ChangeType(VT_UI8)
		Return GetDouble(VarPtr(r.val))
	End Function

	Sub ValR8(x As Double)
		Clear()
		SetDouble(VarPtr(v.val), x)
		v.vt = VT_R8
	End Sub

	Const Function ValBool() As VARIANT_BOOL
		Dim r = ChangeType(VT_BOOL)
		Return GetWord(VarPtr(r.val))
	End Function

	Sub ValBool(x As VARIANT_BOOL)
		Clear()
		SetWord(VarPtr(v.val), x)
		v.vt = VT_BOOL
	End Sub

	Const Function ValError() As SCODE
		Dim r = ChangeType(VT_ERROR)
		Return GetDWord(VarPtr(r.val))
	End Function

	Sub ValError(x As SCODE)
		Clear()
		SetDWord(VarPtr(v.val), x)
		v.vt = VT_ERROR
	End Sub

	'ValCy

	'ValDate

	Const Function ValBStr() As BString
		Dim r As VARIANT
		ChangeType(r, 0, VT_BSTR)
		Dim bs As BString
		bs.Attach(GetPointer(VarPtr(r.val)) As BSTR)
		Return bs
	End Function

	Sub ValBStr(x As BString)
		Clear()
		v.vt = VT_BSTR
	End Sub

	Const Function ValUnknown() As *IUnknown
		Dim r As VARIANT
		ChangeType(r, 0, VT_UNKNOWN)
		Return GetPointer(VarPtr(r.val)) As *IUnknown
	End Function

	Sub ValUnknown(x As *IUnknown)
		Clear()
		SetPointer(VarPtr(v.val), x.Copy())
		x->AddRef()
		v.vt = VT_UNKNOWN
	End Sub

	Const Function ValObject() As VBObject
		Dim r As VARIANT
		ChangeType(r, 0, VT_DISPATH)
		Dim o As VBOBject
		o.Attach(GetPointer(VarPtr(r.val)) As *IDispatch)
		Return o
	End Function

	Sub ValObject(x As VBObject)
		Clear()
		SetPointer(VarPtr(v.val), x.Copy())
		x->AddRef()
		v.vt = VT_DISPATH
	End Sub

	'ValArray

	'ValDecimal

	Function PtrToVariant() As *VARIANT
		Return VarPtr(v)
	End Function
Private
	v As VARIANT

	Static Sub Copy(ByRef dst As VARIANT, ByRef src As VARIANT)
		VariantCopy(dst, src)
	End Sub
		

	Static Sub Move(ByRef dst As VARIANT, ByRef src As VARIANT)
		dst = src
'		src.vt = VT_EMPTY
	End Sub
End Class
/*
Function Abs(v As Variant) As Variant
	Return v.Abs()
End Function

Function Fix(v As Variant) As Variant
	Return v.Fix()
End Function

Function Int(v As Variant) As Variant
	Return v.Int()
End Function

Function VarType(v As Variant) As VARTYPE
	Return v.VarType()
End Function
*/

#endif '_COM_VARIANT_AB