'function.sbp


#ifndef _INC_FUNCTION
#define _INC_FUNCTION


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


#require <Classes/System/Math.ab>
#require <Classes/System/DateTime.ab>
#require <Classes/System/Text/StringBuilder.ab>
#require <Classes/ActiveBasic/Math/Math.ab>
#require <Classes/ActiveBasic/Strings/Strings.ab>


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

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
		pow=ipow(x,y As Long)
		Exit Function
	End If

	If x>0 Then
		pow=Exp(y*Log(x))
		Exit Function
	End If

	If x<>0 or y<=0 Then
		'error
	End If

	pow=0
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
		return -number
	Else
		return 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 *StrChar) As StrChar
	Asc = buf[0]
End Function

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

#ifndef __STRING_IS_NOT_UNICODE
Function AscW(s As *WCHAR) As UCSCHAR
	If s.Length = 0 Then
		AscW = 0
	Else
		If _System_IsSurrogatePair(s[0], s[1]) Then
			AscW = ((s[0] And &h3FF) As DWord << 10) Or (s[1] And &h3FF)
		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 StrChar, 1)
	ElseIf c < &h10FFFF Then
		Dim t[1] = [&hD800 Or (c >> 10), &hDC00 Or (c And &h3FF)] As StrChar
		Return New String(t, 2)
	Else
		'ArgumentOutOfRangeException
	End If
End Function
#endif

Function Date$() As String
	Dim date = 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

Dim _System_HexadecimalTable[&h10] = [&h30, &h31, &h32, &h33, &h34, &h35, &h36, &h37, &h38, &h39, &h41, &h42, &h43, &h44, &h45, &h46] As Byte

Function _System_Hex(x As DWord, zeroSuppress As Boolean) As String
	Dim s[7] As StrChar
	Dim i As Long
	For i = 0 To ELM(Len (s) \ SizeOf (StrChar))
		s[i] = _System_HexadecimalTable[x >> 28] As StrChar
		x <<= 4
	Next
	If zeroSuppress Then
		Dim i As Long
		For i = 0 To 6
			If s[i] <> &h30 Then 'Asc("0")
				Exit For
			End If
		Next
		Return New String(VarPtr(s[i]) As *StrChar, Len (s) \ SizeOf (StrChar) - i)
	Else
		Return New String(s As *StrChar, Len (s) \ SizeOf (StrChar))
	End If
End Function

Function Hex$(x As DWord) As String
	Hex$ = _System_Hex(x, True)
End Function

Function Hex$(x As QWord) As String
	If HIDWORD(x) = 0 Then
		Hex$ = _System_Hex(LODWORD(x), True)
	Else
		Hex$ = _System_Hex(HIDWORD(x), True) + _System_Hex(LODWORD(x), False)
	End If
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 = buf1.Length
	Dim 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
	Left$ = s.Substring(0, System.Math.Min(s.Length, length))
End Function

Function Mid$(s As String, startPos As Long) As String
	startPos--
	Mid$ = s.Substring(startPos)
End Function

Function Mid$(s As String, startPos As Long, readLength = 0 As Long) As String
	startPos--
	Dim length = s.Length
	Mid$ = s.Substring(System.Math.Min(startPos, length), System.Math.Min(readLength, length - startPos))
End Function

Const _System_MaxFigure_Oct_QW = 22 As DWord 'QWORD_MAX = &o1,777,777,777,777,777,777,777
Function Oct$(n As QWord) As String
	Dim s[ELM(_System_MaxFigure_Oct_QW)] As StrChar
	Dim i = ELM(_System_MaxFigure_Oct_QW) As Long
	Do
		s[i] = ((n And &o7) + &h30) As StrChar '&h30 = Asc("0")
		n >>= 3
		If n = 0 Then
			Return New String(s + i, _System_MaxFigure_Oct_QW - i)
		End If
		i--
	Loop
End Function

Const _System_MaxFigure_Oct_DW = 11 As DWord 'DWORD_MAX = &o37,777,777,777
Function Oct$(n As DWord) As String
	Dim s[ELM(_System_MaxFigure_Oct_DW)] As StrChar
	Dim i = ELM(_System_MaxFigure_Oct_DW) As Long
	Do
		s[i] = ((n And &o7) + &h30) As StrChar '&h30 = Asc("0")
		n >>= 3
		If n = 0 Then
			Return New String(s + i, _System_MaxFigure_Oct_DW - i)
		End If
		i--
	Loop
End Function

Function Right$(s As String, length As Long) As String
	Right$ = s.Substring(System.Math.Max(0, s.Length - length), s.Length)
End Function

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

Dim _System_ecvt_buffer[16] As StrChar
Sub _ecvt_support(count As Long)
	Dim i As Long
	If _System_ecvt_buffer[count]=9 Then
		_System_ecvt_buffer[count]=0
		If count=0 Then
			For i=16 To 1 Step -1
				_System_ecvt_buffer[i]=_System_ecvt_buffer[i-1]
			Next
			_System_ecvt_buffer[0]=1
		Else
			_ecvt_support(count-1)
		End If
	Else
		_System_ecvt_buffer[count]++
	End If
End Sub
Function _ecvt(value As Double, count As Long, ByRef dec As Long, ByRef sign As Long) As *StrChar
	Dim i As Long, i2 As Long

	_ecvt=_System_ecvt_buffer

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

	'符号の判断（同時に符号を取り除く）
	If value < 0 Then
		sign = 1
		value = -value
	Else
		sign = 0
	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
		_System_ecvt_buffer[i] = Int(value) As StrChar

		value = (value-CDbl(Int(value))) * 10
	Next
	_System_ecvt_buffer[i] = 0

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

	For i=0 To ELM(count)
		_System_ecvt_buffer[i] += &H30
	Next
	_System_ecvt_buffer[i] = 0
End Function

Function Str$(dbl As Double) As String
	If ActiveBasic.Math.IsNaN(dbl) Then
		Return "NaN"
	ElseIf ActiveBasic.Math.IsInf(dbl) Then
		If dbl > 0 Then
			Return "Infinity"
		Else
			Return "-Infinity"
		End If
	End If
	Dim dec As Long, sign As Long
	Dim buffer[32] As StrChar, temp As *StrChar
	Dim i As Long, i2 As Long, i3 As Long

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

	i=0

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

	If dec>15 Then
		'指数表示（桁が大きい場合）
		buffer[i] = temp[0]
		i++
		buffer[i] = Asc(".")
		i++
		ActiveBasic.Strings.ChrCopy(VarPtr(buffer[i]), VarPtr(temp[1]), 14 As SIZE_T)
		i += 14
		buffer[i] = Asc("e")
		i++
		_stprintf(VarPtr(buffer[i]), "+%03d", dec - 1) 'ToDo: __STRING_UNICODE_WINDOWS_ANSI状態への対応

		Return MakeStr(buffer)
	End If

	If dec < -3 Then
		'指数表示（桁が小さい場合）
		buffer[i] = temp[0]
		i++
		buffer[i] = Asc(".")
		i++
		ActiveBasic.Strings.ChrCopy(VarPtr(buffer[i]), VarPtr(temp[1]), 14 As SIZE_T)
		i+=14
		buffer[i] = Asc("e")
		i++
		_stprintf(VarPtr(buffer[i]), "+%03d", dec - 1) 'ToDo: __STRING_UNICODE_WINDOWS_ANSI状態への対応

		Return MakeStr(buffer)
	End If

	'整数部
	i2=dec
	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$(i As Int64) As String
	If i < 0 Then
		Return "-" & Str$(-i As QWord)
	Else
		Return Str$(i As QWord)
	End If
End Function

Function Str$(x As QWord) As String
	If x = 0 Then
		Return "0"
	End If

	Dim buf[20] As StrChar
	'buf[20] = 0
	Dim i = 19 As Long
	Do
		buf[i] = (x Mod 10 + &h30) As StrChar
		x \= 10
		If x = 0 Then
			Exit Do
		End If
		i--
	Loop
	Return New String(VarPtr(buf[i]), 20 - i)
End Function

Function Str$(x As Long) As String
#ifdef _WIN64
	Return Str$(x As Int64)
#else
	If x < 0 Then
		Return "-" & Str$(-x As DWord)
	Else
		Return Str$(x As DWord)
	End If
#endif
End Function

Function Str$(x As DWord) As String
#ifdef _WIN64
	Return Str$(x As QWord)
#else
	If x = 0 Then
		Return "0"
	End If

	Dim buf[10] As StrChar
	buf[10] = 0
	Dim i = 9 As Long
	Do
		buf[i] = (x As Int64 Mod 10 + &h30) As StrChar 'Int64への型変換は#117対策
		x \= 10
		If x = 0 Then
			Return New String(VarPtr(buf[i]), 10 - i)
		End If
		i--
	Loop	
#endif
End Function

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

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

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

Function Str$(x As SByte) As String
	Return Str$(x As LONG_PTR)
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 String$(n As Long, s As StrChar) 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 = 0 To n
		buf.Append(s)
	Next
End Function
#else
Function String$(n As Long, s As String) As String
	If String.IsNullOrEmpty(s) Then
		Return New String(0 As StrChar, n)
			Else
		Return New String(s[0], n)
	End If
End Function
#endif

Function Time$() As String
	Dim time = 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 *StrChar) As Double
	Dim i As Long, i2 As Long, i3 As Long, i4 As Long
	Dim temporary As String
	Dim TempPtr As *StrChar
	Dim dbl As Double
	Dim i64data As Int64

	Val=0

	While buf[0]=Asc(" ") or buf[0]=Asc(Ex"\t")
		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 StrChar
				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 StrChar
				i++
			Wend
			i--

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

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


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

Function Eof(FileNum As Long) As Long
	Dim dwCurrent As DWord, dwEnd As DWord

	FileNum--

	dwCurrent=SetFilePointer(_System_hFile(FileNum),0,NULL,FILE_CURRENT)
	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_HashFromPtr(p As VoidPtr) As Long
#ifdef _WIN64
	Dim qw = p As QWord
	Return (HIDWORD(qw) Xor LODWORD(qw)) As Long
#else
	Return p As Long
#endif
End Function

'--------
' 文字列関数その2
'--------
Function _System_IsSurrogatePair(wcHigh As WCHAR, wcLow As WCHAR) As Boolean
	If &hD800 <= wcHigh And wcHigh < &hDC00 Then
		If &hDC00 <= wcLow And wcLow < &hE000 Then
			Return True
		End If
	End If
	Return False
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_ASCII_IsUpper(c As WCHAR) As Boolean
	Return c As DWord - &h41 < 26 ' &h41 = Asc("A")
End Function

Function _System_ASCII_IsUpper(c As SByte) As Boolean
	Return _System_ASCII_IsUpper(c As Byte As WCHAR)
End Function

Function _System_ASCII_IsLower(c As WCHAR) As Boolean
	Return c As DWord - &h61 < 26 ' &h61 = Asc("a")
End Function

Function _System_ASCII_IsLower(c As SByte) As Boolean
	Return _System_ASCII_IsLower(c As Byte As WCHAR)
End Function

Function _System_ASCII_ToLower(c As WCHAR) As WCHAR
	If _System_ASCII_IsUpper(c) Then
		Return c Or &h20
	Else
		Return c
	End If
End Function

Function _System_ASCII_ToLower(c As SByte) As SByte
	Return _System_ASCII_ToLower(c As Byte As WCHAR) As Byte As SByte
End Function

Function _System_ASCII_ToUpper(c As WCHAR) As WCHAR
	If _System_ASCII_IsLower(c) Then
		Return c And (Not &h20)
	Else
		Return c
	End If
End Function

Function _System_ASCII_ToUpper(c As SByte) As SByte
	Return _System_ASCII_ToUpper(c As Byte As WCHAR) As Byte As SByte
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

#endif '_INC_FUNCTION