'function.sbp

Const _System_PI = 3.14159265358979323846264
Const _System_LOG2 = 0.6931471805599453094172321214581765680755
Const _System_SQRT2 = 1.41421356237309504880168872421
Const _System_Log_N = 7 As Long

'------------- サポート関数の定義 -------------

Function ldexp(x As Double, n As Long) As Double
	If x = 0 Then
		ldexp = 0
		Exit Function
	End If
	Dim pSrc = VarPtr(x) As *QWord
	Dim pDest = VarPtr(ldexp) As *QWord
	n += (pSrc[0] >> 52) As DWord And &h7FF
	pDest[0] = n << 52 Or (pSrc[0] And &h800FFFFFFFFFFFFF)
End Function

Function frexp(x As Double, ByRef n As Long) As Double
	If x = 0 Then
		n = 0
		frexp = 0
		Exit Function
	End If

	Dim pSrc = VarPtr(x) As *QWord
	Dim pDest = VarPtr(frexp) As *QWord
	n = ((pSrc[0] >> 52) As DWord And &h7FF) - 1022
	pDest[0] = (pSrc[0] And &h800FFFFFFFFFFFFF) Or &h3FE0000000000000
End Function

Function frexp(x As Single, ByRef n As Long) As Single
	If x = 0 Then
		n = 0
		frexp = 0
		Exit Function
	End If

	Dim pSrc As *DWord, pDest As *DWord
	pSrc = VarPtr(x) As *DWord
	pDest = VarPtr(frexp) As *DWord
	n = ((pSrc[0] >> 23) And &hFF) - 126
	pDest[0] = (pSrc[0] And &h807FFFFF) Or &h7E000000
End Function

Function ipow(x As Double, n As Long) As Double
	Dim abs_n As Long
	Dim r = 1 As Double

	abs_n=Abs(n) As Long
	While abs_n<>0
		If abs_n and 1 Then r *= x
		x = x * x
		abs_n >>= 1 ' abs_n \= 2
	Wend

	If n>=0 Then
		ipow=r
	Else
		ipow=1/r
	End If
End Function

Function pow(x As Double, y As Double) As Double
'	If -LONG_MAX<=y and y<=LONG_MAX and y=CDbl(Int(y)) Then
	If y = (y As Long) Then
		pow = ipow(x, y As Long)
	ElseIf x>0 Then
		pow = Exp(y * Log(x))
		Exit Function
	ElseIf x<>0 or y<=0 Then
		pow = ActiveBasic.Math.Detail.GetNaN()
	Else
		pow = 0
	End If
End Function

Const RAND_MAX = &H7FFFFFFF
Dim _System_RndNext = 1 As DWord

Function rand() As Long
	_System_RndNext = _System_RndNext * 1103515245 + 12345
	rand = (_System_RndNext >> 1) As Long
End Function

Sub srand(dwSeek As DWord)
	_System_RndNext = dwSeek
End Sub


'------------- ここからBasic標準関数の定義 -------------

'------------------
' データ型変換関数
'------------------

Function CDbl(number As Double) As Double
	CDbl=number
End Function

Function _CUDbl(number As QWord) As Double
	_CUDbl=number As Double
End Function

Function CDWord(num As Double) As DWord
	CDWord=num As DWord
End Function

Function CInt(number As Double) As Long
	CInt=number As Long
End Function

Function CSng(number As Double) As Single
	CSng=number As Single
End Function

#ifdef _WIN64
Function Fix(number As Double) As Long
	Fix=number As Long
End Function
#else
'Fix関数はコンパイラに組み込まれている
'Function Fix(number As Double) As Long
#endif

Function Int(number As Double) As Long
	Int = Fix(number)
	If number < 0 Then
		If number < Fix(number) Then Int--
	End If
End Function


'-------------------------------------
' ポインタ関数（コンパイラに組み込み）
'-------------------------------------

'Function GetDouble(p As DWord) As Double
'Function GetSingle(p As DWord) As Single
'Function GetDWord(p As DWord) As DWord
'Function GetWord(p As DWord) As Word
'Function GetByte(p As DWord) As Byte
'Sub SetDouble(p As DWord, dblData As Double)
'Sub SetSingle(p As DWord, fltData As Single)
'Sub SetDWord(p As DWord, dwData As DWord)
'Sub SetWord(p As DWord, wData As Word)
'Sub SetByte(p As DWord, byteData As Byte)


'----------
' 算術関数
'----------

Function Abs(number As Double) As Double
	'Abs = System.Math.Abs(number)
	If number < 0 then
		Abs = -number
	Else
		Abs = number
	End If
End Function

Function Abs(number As Int64) As Int64
	If number < 0 then
		Abs = -number
	Else
		Abs = number
	End If
End Function

Function Abs(number As Long) As Long
	If number < 0 then
		Abs = -number
	Else
		Abs = number
	End If
End Function

Function Exp(x As Double) As Double
	Exp = System.Math.Exp(x)
End Function

Function Log(x As Double) As Double
	Log = System.Math.Log(x)
End Function

Function Sgn(number As Double) As Long
	Sgn = System.Math.Sign(number)
End Function

Function Sqr(number As Double) As Double
	Sqr = System.Math.Sqrt(number)
End Function

Function Atn(number As Double) As Double
	Atn = System.Math.Atan(number)
End Function

Function Atn2(y As Double, x As Double) As Double
	Atn2 = System.Math.Atan2(y, x)
End Function

Function Sin(number As Double) As Double
	Sin = System.Math.Sin(number)
End Function

Function Cos(number As Double) As Double
	Cos = System.Math.Cos(number)
End Function

Function Tan(number As Double) As Double
	Tan = System.Math.Tan(number)
End Function

Const RAND_UNIT = (1.0 / (LONG_MAX + 1.0))
Function Rnd() As Double
	Rnd = RAND_UNIT * rand()
End Function

Const HIDWORD(qw) = (((qw As QWord) >> 32) And &HFFFFFFFF) As DWord
Const LODWORD(qw) = ((qw As QWord) And &HFFFFFFFF) As DWord

Const MAKEDWORD(l, h) = (((l As DWord) And &HFFFF) Or (((h As DWord) And &HFFFF) << 16)) As DWord
Const MAKEQWORD(l, h) = (((l As QWord) And &HFFFFFFFF) Or (((h As QWord) And &HFFFFFFFF) << 32)) As QWord

'------------
' 文字列関数
'------------

Function Asc(buf As String) As Char
	Asc = buf[0]
End Function

Function Chr$(code As Char) As String
	Chr$ = New String(code, 1)
End Function

#ifdef UNICODE
Function AscW(s As String) As UCSCHAR
	If String.IsNullOrEmpty(s) Then
		AscW = 0
		'ArgumentNullExceptionに変えるかも
	Else
		If _System_IsHighSurrogate(s[0]) Then
			'有効なサロゲートペアになっていない場合には、
			'例外を投げるようにしたほうがよいかもしれない。
			If s.Length > 1 Then
				If _System_IsLowSurrogate(s[0]) Then
					AscW = ((s[0] And &h3FF) As DWord << 10) Or (s[1] And &h3FF)
					AscW += &h10000
					Exit Function
				End If
			End If
		Else
			AscW = s[0]
		End If
	End If
End Function

Function ChrW(c As UCSCHAR) As String
	If c <= &hFFFF Then
		Return New String(c As Char, 1)
	ElseIf c <= &h10FFFF Then
		c -= &h10000
		Dim t[1] As WCHAR
		t[0] = (&hD800 Or (c >> 10)) As WCHAR
		t[1] = (&hDC00 Or (c And &h3FF)) As WCHAR
		Return New String(t, 2)
	Else
		Throw New System.ArgumentOutOfRangeException("ChrW: c is invalid Unicode code point.", "c")
	End If
End Function
#endif

Function Date$() As String
	Dim date = System.DateTime.Now
	Dim buf = New System.Text.StringBuilder(10)

	'year
	buf.Append(date.Year)

	'month
	If date.Month < 10 Then
		buf.Append("/0")
	Else
		buf.Append("/")
	End If
	buf.Append(date.Month)

	'day
	If date.Day < 10 Then
		buf.Append("/0")
	Else
		buf.Append("/")
	End If
	buf.Append(date.Day)

	Date$ = buf.ToString
End Function

Function Hex$(x As DWord) As String
	Imports ActiveBasic.Strings.Detail
	Hex$ = FormatIntegerX(x, 1, 0, None)
End Function

Function Hex$(x As QWord) As String
	Imports ActiveBasic.Strings.Detail
	Hex$ = FormatIntegerLX(x, 1, 0, None)
End Function

Function InStr(StartPos As Long, buf1 As String, buf2 As String) As Long
	Dim i As Long, i2 As Long, i3 As Long

	Dim len1 = 0 As Long
	Dim len2 = 0 As Long
	If Not ActiveBasic.IsNothing(buf1) Then len1 = buf1.Length
	If Not ActiveBasic.IsNothing(buf2) Then len2 = buf2.Length

	If len2 = 0 Then
		InStr = StartPos
		Exit Function
	End If

	StartPos--
	If StartPos < 0 Then
		'error
		InStr = 0
		Exit Function
	End If

	i=StartPos:InStr=0
	While i<=len1-len2
		i2=i:i3=0
		Do
			If i3=len2 Then
				InStr=i+1
				Exit Do
			End If
			If buf1[i2]<>buf2[i3] Then Exit Do

			i2++
			i3++
		Loop
		If InStr Then Exit While
		i++
	Wend
End Function

Function Left$(s As String, length As Long) As String
	If Not ActiveBasic.IsNothing(s) Then
		Left$ = s.Substring(0, System.Math.Min(s.Length, length))
	Else
		Left$ = ""
	End If
End Function

Function Mid$(s As String, startPos As Long) As String
	If Not ActiveBasic.IsNothing(s) Then
		startPos--
		Mid$ = s.Substring(startPos)
	Else
		Mid$ = ""
	End If
End Function

Function Mid$(s As String, startPos As Long, readLength = 0 As Long) As String
	If Not ActiveBasic.IsNothing(s) Then
		startPos--
		Dim length = s.Length
		Mid$ = s.Substring(System.Math.Min(startPos, length), System.Math.Min(readLength, length - startPos))
	Else
		Mid$ = ""
	End If
End Function

Function Oct$(n As QWord) As String
	Imports ActiveBasic.Strings.Detail
	Oct$ = FormatIntegerLO(n, 1, 0, None)
End Function

Function Oct$(n As DWord) As String
	Imports ActiveBasic.Strings.Detail
	Oct$ = FormatIntegerO(n, 1, 0, None)
End Function

Function Right$(s As String, length As Long) As String
	If Not ActiveBasic.IsNothing(s) Then
		Right$ = s.Substring(System.Math.Max(0, s.Length - length), s.Length)
	Else
		Right$ = ""
	End If
End Function

Function Space$(length As Long) As String
	Return New String(&h20 As Char, length)
End Function

Sub _ecvt_support(buf As *Char, count As Long, size As Long)
	Dim i As Long
	If buf[count] = 9 Then
		buf[count] = 0
		If count = 0 Then
			For i = size To 1 Step -1
				buf[i] = buf[i-1]
			Next
			buf[0] = 1
		Else
			_ecvt_support(buf, count-1, size)
		End If
	Else
		buf[count]++
	End If
End Sub

Sub _ecvt(buffer As *Char, value As Double, count As Long, ByRef dec As Long, ByRef sign As Boolean)
	Dim i As Long, i2 As Long

	'値が0の場合
	If value = 0 Then
		ActiveBasic.Strings.ChrFill(buffer, count As SIZE_T, &h30 As Char)
		buffer[count] = 0
		dec = 0
		sign = 0
		Exit Function
	End If

	'符号の判断（同時に符号を取り除く）
	If value < 0 Then
		sign = True
		value = -value
	Else
		sign = False
	End If

	'正規化
	dec = 1
	While value < 0.999999999999999 'value<1
		value *= 10
		dec--
	Wend
	While 9.99999999999999 <= value '10<=value
		value /= 10
		dec++
	Wend

	For i = 0 To count - 1
		buffer[i] = Int(value) As Char
		value = (value-CDbl(Int(value))) * 10
	Next

	i--
	If value >= 5 Then
		'切り上げ処理
		_ecvt_support(buffer, i, count)
	End If

	For i = 0 To count - 1
		buffer[i] += &H30
	Next
	buffer[i] = 0
End Sub

Function Str$(dbl As Double) As String
	Imports ActiveBasic.Math
	Imports ActiveBasic.Strings
	If IsNaN(dbl) Then
		Return "NaN"
	ElseIf IsInf(dbl) Then
		If dbl > 0 Then
			Return "Infinity"
		Else
			Return "-Infinity"
		End If
	End If
	Dim dec As Long, sign As Boolean
	Dim buffer[32] As Char, temp[15] As Char
	Dim i = 0 As Long

	'浮動小数点を文字列に変換
	_ecvt(temp, dbl, 15, dec, sign)

	'符号の取り付け
	If sign Then
		buffer[i] = Asc("-")
		i++
	End If

	If dec > 15 Or dec < -3 Then
		'指数表示
		buffer[i] = temp[0]
		i++
		buffer[i] = Asc(".")
		i++
		ChrCopy(VarPtr(buffer[i]), VarPtr(temp[1]), 14 As SIZE_T)
		i += 14
		buffer[i] = 0
		Return MakeStr(buffer) + SPrintf("e%+03d", New System.Int32(dec - 1))
	End If

	'整数部
	Dim i2 = dec
	Dim i3 = 0
	If i2>0 Then
		While i2>0
			buffer[i]=temp[i3]
			i++
			i3++
			i2--
		Wend
		buffer[i]=Asc(".")
		i++
	Else
		buffer[i]=&H30
		i++
		buffer[i]=Asc(".")
		i++

		i2=dec
		While i2<0
			buffer[i]=&H30
			i++
			i2++
		Wend
	End If

	'小数部
	While i3<15
		buffer[i]=temp[i3]
		i++
		i3++
	Wend

	While buffer[i-1]=&H30
		i--
	Wend
	If buffer[i-1]=Asc(".") Then i--

	buffer[i]=0
	Return MakeStr(buffer)
End Function

Function Str$(x As Int64) As String
	Imports ActiveBasic.Strings.Detail
	Return FormatIntegerEx(TraitsIntegerD[1], x As QWord, 1, 0, None)
End Function

Function Str$(x As QWord) As String
	Imports ActiveBasic.Strings.Detail
	Return FormatIntegerEx(TraitsIntegerU[1], x, 1, 0, None)
End Function

Function Str$(x As Long) As String
	Imports ActiveBasic.Strings.Detail
	Return FormatIntegerEx(TraitsIntegerD[0], x, 1, 0, None)
End Function

Function Str$(x As DWord) As String
	Imports ActiveBasic.Strings.Detail
	Return FormatIntegerEx(TraitsIntegerU[0], x, 1, 0, None)
End Function

Function Str$(x As Word) As String
	Return Str$(x As DWord)
End Function

Function Str$(x As Integer) As String
	Return Str$(x As Long)
End Function

Function Str$(x As Byte) As String
	Return Str$(x As DWord)
End Function

Function Str$(x As SByte) As String
	Return Str$(x As Long)
End Function

Function Str$(x As Single) As String
	Return Str$(x As Double)
End Function

Function Str$(b As Boolean) As String
	If b Then
		Return "True"
	Else
		Return "False"
	End If
End Function

Function Str$(s As String) As String
	Str$ = s
End Function

Function String$(n As Long, s As Char) As String
	Return New String(s, n)
End Function

#ifdef _AB4_COMPATIBILITY_STRING$_
Function String$(n As Long, s As String) As String
	If n < 0 Then
		'Throw ArgumentOutOfRangeException
	End If
	Dim buf = New System.Text.StringBuilder(s.Length * n)
	Dim i As Long
	For i = 1 To n
		buf.Append(s)
	Next
End Function
#else
Function String$(n As Long, s As String) As String
	Dim c As Char
	If String.IsNullOrEmpty(s) Then
		c = 0
	Else
		c = s[0]
	End If
	String$ = New String(c, n)
End Function
#endif

Function Time$() As String
	Dim time = System.DateTime.Now
	Dim buf = New System.Text.StringBuilder(8)
	'hour
	If time.Hour < 10 Then
		buf.Append("0")
	End If
	buf.Append(time.Hour)

	'minute
	If time.Minute < 10 Then
		buf.Append(":0")
	Else
		buf.Append(":")
	End If
	buf.Append(time.Minute)

	'second
	If time.Second < 10 Then
		buf.Append(":0")
	Else
		buf.Append(":")
	End If
	buf.Append(time.Second)
	Time$ = buf.ToString
End Function

Function Val(buf As *Char) As Double
	If buf = 0 Then
		Exit Function
	End If

	Dim i As Long, i2 As Long, i3 As Long, i4 As Long
	Dim temporary As String
	Dim TempPtr As *Char
	Dim dbl As Double
	Dim i64data As Int64

	Val=0

	While ActiveBasic.CType.IsSpace(buf[0])
		buf = VarPtr(buf[1])
	Wend

	If buf[0]=Asc("&") Then
		temporary = New String( buf )
		temporary = temporary.ToUpper()
		TempPtr = StrPtr(temporary)
		If TempPtr(1) = Asc("O") Then
			'8進数
			i=2
			While 1
				'数字以外の文字の場合は抜け出す
				i3=TempPtr[i]-&H30
				If Not (0<=i3 And i3<=7) Then Exit While

				TempPtr[i]=i3 As Char
				i++
			Wend
			i--

			i64data=1
			While i>=2
				Val += ( i64data * TempPtr[i] ) As Double

				i64data *= &O10
				i--
			Wend
		ElseIf TempPtr(1)=Asc("H") Then
			'16進数
			i=2
			While 1
				'数字以外の文字の場合は抜け出す
				i3=TempPtr[i]-&H30
				If Not(0<=i3 and i3<=9) Then
					i3=TempPtr[i]-&H41+10
					If Not(&HA<=i3 and i3<=&HF) Then Exit While
				End If

				TempPtr[i]=i3 As Char
				i++
			Wend
			i--

			i64data=1
			While i>=2
				Val += (i64data*TempPtr[i]) As Double

				i64data *= &H10
				i--
			Wend
		End If
	Else
		'10進数
#ifdef UNICODE
		swscanf(buf,"%lf",VarPtr(Val))
#else
		sscanf(buf,"%lf",VarPtr(Val))
#endif
	End If
End Function


'--------------
' ファイル関数
'--------------

Function Eof(FileNum As Long) As Long
	FileNum--
	Dim dwCurrent = SetFilePointer(_System_hFile(FileNum), 0,NULL, FILE_CURRENT)
	Dim dwEnd = SetFilePointer(_System_hFile(FileNum), 0, NULL, FILE_END)
	SetFilePointer(_System_hFile(FileNum), dwCurrent, NULL, FILE_BEGIN)

	If dwCurrent>=dwEnd Then
		Eof=-1
	Else
		Eof=0
	End If
End Function

Function Lof(FileNum As Long) As Long
	Lof = GetFileSize(_System_hFile(FileNum-1), 0)
End Function

Function Loc(FileNum As Long) As Long
	FileNum--

	Dim NowPos = SetFilePointer(_System_hFile(FileNum), 0, 0, FILE_CURRENT)
	Dim BeginPos = SetFilePointer(_System_hFile(FileNum), 0, 0, FILE_BEGIN)
	SetFilePointer(_System_hFile(FileNum), NowPos - BeginPos, 0, FILE_BEGIN)

	Loc = NowPos - BeginPos
End Function


'------------------
' メモリ関連の関数
'------------------

Function malloc(stSize As SIZE_T) As VoidPtr
	Return _System_pGC->__malloc(stSize,_System_GC_FLAG_NEEDFREE or _System_GC_FLAG_ATOMIC)
End Function

Function calloc(stSize As SIZE_T) As VoidPtr
	Return _System_pGC->__malloc(stSize,_System_GC_FLAG_NEEDFREE or _System_GC_FLAG_ATOMIC or _System_GC_FLAG_INITZERO)
End Function

Function realloc(lpMem As VoidPtr, stSize As SIZE_T) As VoidPtr
	If lpMem = 0 Then
		Return malloc(stSize)
	Else
		Return _System_pGC->__realloc(lpMem,stSize)
	End If
End Function

Sub free(lpMem As VoidPtr)
	_System_pGC->__free(lpMem)
End Sub

Function _System_malloc(stSize As SIZE_T) As VoidPtr
	Return HeapAlloc(_System_hProcessHeap, 0, stSize)
End Function

Function _System_calloc(stSize As SIZE_T) As VoidPtr
	Return HeapAlloc(_System_hProcessHeap, HEAP_ZERO_MEMORY, stSize)
End Function

Function _System_realloc(lpMem As VoidPtr, stSize As SIZE_T) As VoidPtr
	If lpMem = 0 Then
		Return HeapAlloc(_System_hProcessHeap, 0, stSize)
	Else
		Return HeapReAlloc(_System_hProcessHeap, 0, lpMem, stSize)
	End If
End Function

Sub _System_free(lpMem As VoidPtr)
	HeapFree(_System_hProcessHeap, 0, lpMem)
End Sub


'--------
' その他
'--------

Sub _splitpath(path As PCSTR, drive As PSTR, dir As PSTR, fname As PSTR, ext As PSTR)
	Dim i As Long, i2 As Long, i3 As Long, length As Long
	Dim buffer[MAX_PATH] As SByte

	'":\"をチェック
	If not(path[1]=&H3A and path[2]=&H5C) Then Exit Sub

	'ドライブ名をコピー
	If drive Then
		drive[0]=path[0]
		drive[1]=path[1]
		drive[2]=0
	End If

	'ディレクトリ名をコピー
	i=2
	i2=0
	Do
		If IsDBCSLeadByte(path[i]) <> FALSE and path[i + 1] <> 0 Then
			If dir Then
				dir[i2]=path[i]
				dir[i2+1]=path[i+1]
			End If

			i += 2
			i2 += 2
			Continue
		End If

		If path[i]=0 Then Exit Do

		If path[i]=&H5C Then '"\"記号であるかどうか
			i3=i2+1
		End If

		If dir Then dir[i2]=path[i]

		i++
		i2++
	Loop
	If dir Then dir[i3]=0
	i3 += i-i2

	'ファイル名をコピー
	i=i3
	i2=0
	i3=-1
	Do
'#ifdef UNICODE
'		If _System_IsSurrogatePair(path[i], path[i + 1]) Then
'#else
		If IsDBCSLeadByte(path[i]) <> FALSE and path[i + 1] <> 0 Then
'#endif
			If fname Then
				fname[i2]=path[i]
				fname[i2+1]=path[i+1]
			End If

			i += 2
			i2 += 2
			Continue
		End If

		If path[i]=0 Then Exit Do

		If path[i]=&H2E Then	'.'記号であるかどうか
			i3=i2
		End If

		If fname Then fname[i2]=path[i]

		i++
		i2++
	Loop
	If i3=-1 Then i3=i2
	If fname Then fname[i3]=0
	i3 += i-i2

	'拡張子名をコピー
	If ext Then
		If i3 Then
			lstrcpy(ext,path+i3)
		End If
		else ext[0]=0
	End If
End Sub

Function GetBasicColor(ColorCode As Long) As Long
	Select Case ColorCode
		Case 0
			GetBasicColor=RGB(0,0,0)
		Case 1
			GetBasicColor=RGB(0,0,255)
		Case 2
			GetBasicColor=RGB(255,0,0)
		Case 3
			GetBasicColor=RGB(255,0,255)
		Case 4
			GetBasicColor=RGB(0,255,0)
		Case 5
			GetBasicColor=RGB(0,255,255)
		Case 6
			GetBasicColor=RGB(255,255,0)
		Case 7
			GetBasicColor=RGB(255,255,255)
	End Select
End Function

Function _System_BSwap(x As Word) As Word
	Dim src = VarPtr(x) As *Byte
	Dim dst = VarPtr(_System_BSwap) As *Byte
	dst[0] = src[1]
	dst[1] = src[0]
End Function

Function _System_BSwap(x As DWord) As DWord
	Dim src = VarPtr(x) As *Byte
	Dim dst = VarPtr(_System_BSwap) As *Byte
	dst[0] = src[3]
	dst[1] = src[2]
	dst[2] = src[1]
	dst[3] = src[0]
End Function

Function _System_BSwap(x As QWord) As QWord
	Dim src = VarPtr(x) As *Byte
	Dim dst = VarPtr(_System_BSwap) As *Byte
	dst[0] = src[7]
	dst[1] = src[6]
	dst[2] = src[5]
	dst[3] = src[4]
	dst[4] = src[3]
	dst[5] = src[2]
	dst[6] = src[1]
	dst[7] = src[0]
End Function

Function _System_HashFromUInt(x As QWord) As Long
	Return (HIDWORD(x) Xor LODWORD(x)) As Long
End Function

Function _System_HashFromUInt(x As DWord) As Long
	Return x As Long
End Function

Function _System_HashFromPtr(p As VoidPtr) As Long
	Return _System_HashFromUInt(p As ULONG_PTR)
End Function

/*!
@brief	ObjPtrの逆。ABオブジェクトを指すポインタをObject型へ変換。
@author	Egtra
@date	2007/08/24
@param[in]	p	オブジェクトを指すポインタ
@return Object参照型
*/
Function _System_PtrObj(p As VoidPtr) As Object
	SetPointer(VarPtr(_System_PtrObj), p)
End Function

/*!
@brief	IUnknownその他COMインタフェースを指すポインタをIUnknown参照型へ変換。
@author	Egtra
@date	2007/09/24
@param[in]	p	COMインタフェースを指すポインタ
@return IUnknown参照型
*/
Function _System_PtrUnknown(p As VoidPtr) As IUnknown
	SetPointer(VarPtr(_System_PtrUnknown), p)
End Function

'--------
' 文字列関数その2
'--------
Function _System_IsSurrogatePair(wcHigh As WCHAR, wcLow As WCHAR) As Boolean
	If _System_IsHighSurrogate(wcHigh) Then
		If _System_IsLowSurrogate(wcLow) Then
			Return True
		End If
	End If
	Return False
End Function

Function _System_IsHighSurrogate(c As WCHAR) As Boolean
	Return &hD800 <= c And c < &hDC00
End Function

Function _System_IsLowSurrogate(c As WCHAR) As Boolean
	Return &hDC00 <= c And c < &hE000
End Function

Function _System_IsDoubleUnitChar(lead As WCHAR, trail As WCHAR) As Boolean
	Return _System_IsSurrogatePair(lead, trail)
End Function

Function _System_IsDoubleUnitChar(lead As SByte, trail As SByte) As Boolean
	Return IsDBCSLeadByte(lead) <> FALSE
End Function

Function _System_GetHashFromWordArray(p As *Word, n As SIZE_T) As Long
	Dim hash = 0 As DWord
	Dim i As Long
	For i = 0 To ELM(n)
		hash = ((hash << 16) + p[i]) Mod &h7fffffff
	Next
	_System_GetHashFromWordArray = hash As Long
End Function