'function.sbp


#ifndef _INC_FUNCTION
#define _INC_FUNCTION


Const _System_PI = 3.14159265358979323846264
Const _System_LOG2 = 0.6931471805599453094172321214581765680755
Const _System_SQRT2 = 1.41421356237309504880168872421


#include <Classes/System/Math.ab>


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

Function ldexp(x As Double, n As Long) As Double
	If x = 0 Then
		ldexp = 0
		Exit Function
	End If
	Dim pSrc As *QWord, pDest As *QWord
	pSrc = VarPtr(x) As *QWord
	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 As *QWord, pDest As *QWord
	pSrc = VarPtr(x) As *QWord
	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

#ifdef _WIN64

Function _System_GetNaN() As Double
	SetQWord(VarPtr(_System_GetNaN) As *QWord, &H7FF8000000000000)
End Function

Function _System_GetInf(sign As BOOL) As Double
	Dim s = 0 As QWord
	If sign Then s = 1 << 63
	SetQWord(VarPtr(_System_GetInf) As *QWord, &h7FF0000000000000 Or s)
End Function

#else

Function _System_GetNaN() As Double
	Dim p As *DWord
	p = VarPtr(_System_GetNaN) As *DWord
	p[0] = 0
	p[1] = &H7FF80000
End Function

Function _System_GetInf(sign As BOOL) As Double
	Dim s = 0 As DWord
	If sign Then s = (1 As DWord) << 31
	Dim p As *DWord
	p = VarPtr(_System_GetInf) As *DWord
	p[0] = 0
	p[1] = &h7FF00000 Or s
End Function

#endif

' xの符号だけをyのものにした値を返す。
' 引数 x 元となる絶対値
' 引数 y 元となる符号
Function CopySign(x As Double, y As Double) As Double
	SetQWord(VarPtr(CopySign), (GetQWord(VarPtr(x)) And &h7fffffffffffffff) Or (GetQWord(VarPtr(y)) And &h8000000000000000))
End Function

Function CopySign(x As Single, y As Single) As Single
	SetDWord(VarPtr(CopySign), (GetDWord(VarPtr(x)) And &h7fffffff) Or (GetDWord(VarPtr(y)) And &h80000000))
End Function

Function _System_SetSign(x As Double, isNegative As Long) As Double
#ifdef _WIN64
	SetQWord(VarPtr(CopySign), (GetQWord(VarPtr(x)) And &h7fffffffffffffff) Or (isNegative << 63))
#else
	SetDWord(VarPtr(CopySign), GetDWord(VarPtr(x)))
	SetDWord(VarPtr(CopySign) + SizeOf (DWord), GetQWord(VarPtr(x) + SizeOf (DWord)) And &h7fffffff Or (isNegative << 31))
#endif
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
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
End Function

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

Function CSng(number As Double) As Single
	CSng=number
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=Int-1
	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 = Math.Abs(number)
	If number < 0 then
		return -number
	Else
		return number
	End If
End Function

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

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

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

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

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

Function _Support_tan(x As Double, ByRef k As Long) As Double
	Dim i As Long
	Dim t As Double, x2 As Double

	If x>=0 Then
		k=Fix(x/(_System_PI/2)+0.5)
	Else
		k=Fix(x/(_System_PI/2)-0.5)
	End If

	x=(x-(CDbl(3217)/CDbl(2048))*k)+4.4544551033807686783083602485579e-6*k

	x2=x*x
	t=0

	For i=19 To 3 Step -2
		t=x2/(i-t)
	Next

	_Support_tan=x/(1-t)
End Function

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

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

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

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

Function IsNaN(ByVal x As Double) As BOOL
	Dim p As *DWord
	p = VarPtr(x) As *DWord
	IsNaN = FALSE
	If (p[1] And &H7FF00000) = &H7FF00000 Then
		If (p[0] <> 0) Or ((p[1] And &HFFFFF) <> 0) Then
			IsNaN = TRUE
		End If
	End If

'	IsNaN=FALSE
End Function

Function IsInf(x As Double) As BOOL
	Dim p As *DWord, nan As Double
	p = VarPtr(x) As *DWord
	p[1] And= &h7fffffff
	nan = _System_GetInf(FALSE)
	IsInf = (memcmp(p As *Byte, VarPtr(nan), SizeOf (Double)) = 0)
End Function

Function IsNaNOrInf(x As Double) As BOOL
	IsNaNOrInf = IsFinite(x)
End Function

Function IsFinite(x As Double) As BOOL
	Dim p As *DWord, nan As Double
	p = VarPtr(x) As *DWord
'	p[1] And= &h7ffe0000
	p[1] And= &H7FF00000
	p[0] = 0
	nan = _System_GetInf(/*x,*/ FALSE)
	IsNaNOrInf = (memcmp(p, VarPtr(nan), SizeOf (Double)) = 0)
End Function

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

Const HIBYTE(w) = (((w As Word) >> 8) and &HFF) As Byte
Const LOBYTE(w) = ((w As Word) and &HFF) As Byte
Const HIWORD(dw) = (((dw As DWord) >> 16) and &HFFFF) As Word
Const LOWORD(dw) = ((dw As DWord) and &HFFFF) As Word

Const MAKEWORD(a,b) = (((a As Word) and &HFF) or (((b As Word) and &HFF)<<8)) As Word
Const MAKELONG(a,b) = (((a As DWord) and &HFFFF) or (((b As DWord) and &HFFFF)<<16)) As Long



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

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

Function Chr$(code As Byte) As String
	Chr$=ZeroString(1)
	Chr$[0]=code
End Function

Function Date$() As String
	Dim st As SYSTEMTIME

	GetLocalTime(st)

	'year
	Date$=Str$(st.wYear)

	'month
	If st.wMonth<10 Then
		Date$=Date$+"/0"
	Else
		Date$=Date$+"/"
	End If
	Date$=Date$+Str$(st.wMonth)

	'day
	If st.wDay<10 Then
		Date$=Date$+"/0"
	Else
		Date$=Date$+"/"
	End If
	Date$=Date$+Str$(st.wDay)
End Function

Function Hex$(num As DWord) As String
	Dim length As Long
	Hex$=ZeroString(8)
	length=wsprintf(Hex$, "%X", num)
	Hex$=Left$(Hex$,length)
End Function

Function Hex$(num As QWord) As String
	Dim length As Long
	Hex$=ZeroString(16)
	length=wsprintf(Hex$, "%X%X", num)
	Hex$=Left$(Hex$,length)
End Function

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

	len1=Len(buf1)
	len2=Len(buf2)

	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$(buf As String, length As Long) As String
	Left$=ZeroString(length)
	memcpy(
		StrPtr(Left$),
		StrPtr(buf),
		length)
End Function

Function Mid$(buf As String, StartPos As Long)(ReadLength As Long) As String
	Dim length As Long

	StartPos--
	If StartPos<0 Then
		'error
		'Debug
		Exit Function
	End If

	length=Len(buf)
	If length<=StartPos Then Exit Function

	If ReadLength=0 Then
		ReadLength=length-StartPos
	End If

	If ReadLength>length-StartPos Then
		ReadLength=length-StartPos
	End If

	Mid$=ZeroString(ReadLength)
	memcpy(StrPtr(Mid$),StrPtr(buf)+StartPos,ReadLength)
End Function

Function Oct$(num As DWord) As String
	Dim i As DWord, i2 As DWord

	For i=10 To 1 Step -1
		If (num\CDWord(8^i)) And &H07 Then
			Exit For
		End If
	Next

	Oct$=ZeroString(i+1)
	i2=0
	Do
		Oct$[i2]=Asc("0")+((num\CDWord(8^i)) And &H07)
		If i=0 Then Exit Do
		i--
		i2++
	Loop
End Function

Function Right$(buf As String, length As Long) As String
	Dim i As Long

	i=Len(buf)
	If i>length Then
		Right$=ZeroString(length)
		memcpy(StrPtr(Right$),StrPtr(buf)+i-length,length)
	Else
		Right$=buf
	End If
End Function

Function Space$(length As Long) As String
	Space$=ZeroString(length)
	FillMemory(StrPtr(Space$),length,&H20)
End Function

Dim _System_ecvt_buffer[16] As Byte
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]=_System_ecvt_buffer[count]+1 As Byte
	End If
End Sub
Function _ecvt(value As Double, count As Long, ByRef dec As Long, ByRef sign As Long) As BytePtr
	Dim temp As BytePtr
	Dim i As Long, i2 As Long

	_ecvt=_System_ecvt_buffer

	'値が0の場合
	If value=0 Then
		FillMemory(_System_ecvt_buffer,count,&H30)
		_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=value*10
		dec=dec-1
	Wend
	While 9.99999999999999<=value  '10<=value
		value=value/10
		dec=dec+1
	Wend

	For i=0 To count-1
		_System_ecvt_buffer[i]=Int(value) As Byte

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

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

	For i=0 To count-1
		_System_ecvt_buffer[i]=_System_ecvt_buffer[i]+&H30
	Next
	_System_ecvt_buffer[i]=0
End Function

Function Str$(dbl As Double) As String
	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 Long
	Dim buffer[32] As Byte, temp As BytePtr
	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++
		memcpy(buffer+i,temp+1,14)
		i+=14
		buffer[i]=Asc("e")
		i++
		wsprintf(buffer+i,"+%03d",dec-1)

		Return MakeStr(buffer)
	End If

	If dec<-3 Then
		'指数表示（桁が小さい場合）
		buffer[i]=temp[0]
		i++
		buffer[i]=Asc(".")
		i++
		memcpy(buffer+i,temp+1,14)
		i+=14
		buffer[i]=Asc("e")
		i++
		wsprintf(buffer+i,"%03d",dec-1)

		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$(value As LONG_PTR) As String
	Dim temp[255] As Byte
	wsprintf(temp,"%d",value)
	Str$=MakeStr(temp)
End Function

Function String$(num As Long, buf As String) As String
	Dim dwStrPtr As DWord
	Dim length As Long

	length=Len(buf)

	'バッファ領域を確保
	String$=ZeroString(length*num)

	'文字列をコピー
	Dim i As Long
	For i=0 To num-1
		memcpy(StrPtr(String$)+i*length,StrPtr(buf),length)
	Next
End Function

Function Time$() As String
	Dim st As SYSTEMTIME

	GetLocalTime(st)

	'hour
	If st.wHour<10 Then
		Time$="0"
	End If
	Time$=Time$+Str$(st.wHour)

	'minute
	If st.wMinute<10 Then
		Time$=Time$+":0"
	Else
		Time$=Time$+":"
	End If
	Time$=Time$+Str$(st.wMinute)

	'second
	If st.wSecond<10 Then
		Time$=Time$+":0"
	Else
		Time$=Time$+":"
	End If
	Time$=Time$+Str$(st.wSecond)
End Function

Function Val(buf As BytePtr) As Double
	Dim i As Long, i2 As Long, i3 As Long, i4 As Long
	Dim temporary As String
	Dim TempPtr As BytePtr
	Dim dbl As Double
	Dim i64data As Int64

	Val=0

	While buf[0]=Asc(" ") or buf[0]=Asc(Ex"\t")
		buf++
	Wend

	If buf[0]=Asc("&") Then
		temporary=ZeroString(lstrlen(buf))
		lstrcpy(temporary,buf)
		TempPtr=StrPtr(temporary)
		CharUpper(TempPtr)
		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 Byte
				i++
			Wend
			i--

			i64data=1
			While i>=2
				Val=Val+i64data*TempPtr[i]

				i64data=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 Byte
				i++
			Wend
			i--

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

				i64data *= &H10
				i--
			Wend
		End If
	Else
		'10進数
		If buf[0]=&H2D Then
			'マイナス値
			i4=1
			buf++
		Else
			'プラス値
			i4=0
			If buf[0]=&H2B Then
				buf++
			End If
		End If

		i=0

		While 1
			'数字以外の文字の場合は抜け出す
			i3=buf[i]-&H30
			If Not (0<=i3 And i3<=9) Then Exit While

			i++
		Wend

		'整数部
		dbl=1
		i3=i-1
		While i3>=0
			Val += dbl*(buf[i3]-&H30)

			dbl *= 10
			i3--
		Wend

		If buf[i]=Asc(".") Then
			'小数部
			i++
			dbl=10
			While 1
				'数字以外の文字の場合は抜け出す
				i3=buf[i]-&H30
				If Not (0<=i3 And i3<=9) Then Exit While

				Val += (buf[i] - &H30) / dbl
				dbl *= 10
				i++
			Wend
		End If

		If i4 Then Val=-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),NULL)
End Function

Function Loc(FileNum As Long) As Long
	Dim NowPos As Long, BeginPos As Long

	FileNum--

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

	Loc=NowPos-BeginPos
End Function


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

Function malloc(stSize As SIZE_T) As VoidPtr
	Return _System_GC.__malloc(stSize,_System_GC_FLAG_NEEDFREE)
End Function

Function calloc(stSize As SIZE_T) As VoidPtr
	Return _System_GC.__malloc(stSize,_System_GC_FLAG_NEEDFREE 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_GC.__realloc(lpMem,stSize)
	End If
End Function

Sub free(lpMem As VoidPtr)
	_System_GC.__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 BytePtr, drive As BytePtr, dir As BytePtr, fname As BytePtr, ext As BytePtr)
	Dim i As Long, i2 As Long, i3 As Long, length As Long
	Dim buffer[MAX_PATH] As Byte

	'":\"をチェック
	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])=TRUE 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
		If IsDBCSLeadByte(path[i])=TRUE and path[i+1]<>0 Then
			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


#endif '_INC_FUNCTION