Changeset 167 for Include/basic/function.sbp

Timestamp:

Mar 13, 2007, 11:58:58 AM (18 years ago)

Author:

イグトランス (egtra)

Message:

String関連の変更とHex$の修正

File:

• Include/basic/function.sbp (modified) (22 diffs)

Include/basic/function.sbp

@@ -11 +11 @@
 
 
-#include <Classes/System/Math.ab>
+#require <Classes/System/Math.ab>
 
 
@@ -330 +330 @@
 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
-
-
+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 HIDWORD(qw) = (((qw As QWord) >> 32) And &HFFFFFFFF) As DWord
+Const LODWORD(qw) = ((qw As QWord) And &HFFFFFFFF) As DWord
+
+Const MAKEWORD(l, h) = (((l As Word) And &HFF) Or (((h As Word) And &HFF) << 8)) As Word
+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
+Const MAKELONG(l, h) = MAKEDWORD(l, h) As Long
 
 '------------
@@ -406 +408 @@
 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
-    Dim i = 0
-    Hex$ = ZeroString(8)
-    While (x And &hf0000000) = 0
-        x <<= 4
-    Wend
-    While x <> 0
-        Hex$[i] = _System_HexadecimalTable[(x And &hf0000000) >> 28] As Char
-        x <<= 4
-        i++
-    Wend
-    Hex$.ReSize(i)
+    Hex$ = _System_Hex(x, True)
 End Function
 
 Function Hex$(x As QWord) As String
-    Hex$ = Hex$((x >> 32) As DWord) + Hex$((x And &hffffffff) As DWord)
+    Hex$ = _System_Hex(HIDWORD(x), True) + _System_Hex(LODWORD(x), False)
 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)
+    Dim i As Long, i2 As Long, i3 As Long
+
+    Dim len1 = buf1.Length
+    Dim len2 = buf2.Length
 
     If len2=0 Then
@@ -462 +474 @@
 Function Left$(buf As String, length As Long) As String
     Left$ = ZeroString(length)
-    memcpy(StrPtr(Left$), StrPtr(buf), SizeOf (Char) * length)
+    memcpy(StrPtr(Left$), StrPtr(buf), SizeOf (StrChar) * length)
 End Function
 
@@ -487 +499 @@
 
     Mid$=ZeroString(ReadLength)
-    memcpy(StrPtr(Mid$), VarPtr(buf.Chars[StartPos]), SizeOf (Char) * ReadLength)
+    memcpy(StrPtr(Mid$), VarPtr(buf.Chars[StartPos]), SizeOf (StrChar) * ReadLength)
 End Function
 
@@ -515 +527 @@
     If i>length Then
         Right$=ZeroString(length)
-        memcpy(StrPtr(Right$), VarPtr(buf.Chars[i-length]), SizeOf (Char) * length)
+        memcpy(StrPtr(Right$), VarPtr(buf.Chars[i-length]), SizeOf (StrChar) * length)
     Else
         Right$=buf
@@ -522 +534 @@
 
 Function Space$(length As Long) As String
-    Space$.ReSize(length, &H20 As Char)
-End Function
-
-Dim _System_ecvt_buffer[16] As Char
+    Space$.ReSize(length, &H20 As StrChar)
+End Function
+
+Dim _System_ecvt_buffer[16] As StrChar
 Sub _ecvt_support(count As Long)
     Dim i As Long
@@ -542 +554 @@
     End If
 End Sub
-Function _ecvt(value As Double, count As Long, ByRef dec As Long, ByRef sign As Long) As *Char
-    Dim temp As *Char
+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
 
@@ -549 +560 @@
 
     '値が0の場合
-    If value=0 Then
+    If value = 0 Then
         _System_FillChar(_System_ecvt_buffer, count, &H30)
         _System_ecvt_buffer[count] = 0
@@ -558 +569 @@
 
     '符号の判断（同時に符号を取り除く）
-    If value<0 Then
-        sign=1
-        value=-value
-    Else
-        sign=0
+    If value < 0 Then
+        sign = 1
+        value = -value
+    Else
+        sign = 0
     End If
 
     '正規化
-    dec=1
-    While value<0.999999999999999  'value<1
+    dec = 1
+    While value < 0.999999999999999 'value<1
         value *= 10
         dec--
     Wend
-    While 9.99999999999999<=value  '10<=value
+    While 9.99999999999999 <= value '10<=value
         value /= 10
         dec++
@@ -577 +588 @@
 
     For i=0 To count-1
-        _System_ecvt_buffer[i]=Int(value) As Char
-
-        value=(value-CDbl(Int(value)))*10
+        _System_ecvt_buffer[i] = Int(value) As StrChar
+
+        value = (value-CDbl(Int(value))) * 10
     Next
-    _System_ecvt_buffer[i]=0
+    _System_ecvt_buffer[i] = 0
 
     i--
-    If value>=5 Then
+    If value >= 5 Then
         '切り上げ処理
         _ecvt_support(i)
     End If
 
-    For i=0 To count-1
+    For i=0 To ELM(count)
         _System_ecvt_buffer[i] += &H30
     Next
-    _System_ecvt_buffer[i]=0
+    _System_ecvt_buffer[i] = 0
 End Function
 
@@ -606 +617 @@
     End If
     Dim dec As Long, sign As Long
-    Dim buffer[32] As Char, temp As *Char
+    Dim buffer[32] As StrChar, temp As *StrChar
     Dim i As Long, i2 As Long, i3 As Long
 
     '浮動小数点を文字列に変換
-    temp=_ecvt(dbl,15,dec,sign)
+    temp = _ecvt(dbl, 15, dec, sign)
 
     i=0
@@ -616 +627 @@
     '符号の取り付け
     If sign Then
-        buffer[i]=Asc("-")
+        buffer[i] = Asc("-")
         i++
     End If
@@ -622 +633 @@
     If dec>15 Then
         '指数表示（桁が大きい場合）
-        buffer[i]=temp[0]
-        i++
-        buffer[i]=Asc(".")
-        i++
-        memcpy(VarPtr(buffer[i]), VarPtr(temp[1]), SizeOf (Char) * 14)
+        buffer[i] = temp[0]
+        i++
+        buffer[i] = Asc(".")
+        i++
+        memcpy(VarPtr(buffer[i]), VarPtr(temp[1]), SizeOf (StrChar) * 14)
+        i += 14
+        buffer[i] = Asc("e")
+        i++
+        _stprintf(VarPtr(buffer[i]), "+%03d", dec - 1)
+
+        Return MakeStr(buffer)
+    End If
+
+    If dec < -3 Then
+        '指数表示（桁が小さい場合）
+        buffer[i] = temp[0]
+        i++
+        buffer[i] = Asc(".")
+        i++
+        memcpy(VarPtr(buffer[i]), VarPtr(temp[1]), SizeOf (StrChar) * 14)
         i+=14
-        buffer[i]=Asc("e")
-        i++
-        _stprintf(VarPtr(buffer[i]), "+%03d", dec-1)
-
-        Return MakeStr(buffer)
-    End If
-
-    If dec<-3 Then
-        '指数表示（桁が小さい場合）
-        buffer[i]=temp[0]
-        i++
-        buffer[i]=Asc(".")
-        i++
-        memcpy(VarPtr(buffer[i]), VarPtr(temp[1]), SizeOf (Char) * 14)
-        i+=14
-        buffer[i]=Asc("e")
-        i++
-        _stprintf(VarPtr(buffer[i]), "+%03d", dec-1)
+        buffer[i] = Asc("e")
+        i++
+        _stprintf(VarPtr(buffer[i]), "+%03d", dec - 1)
 
         Return MakeStr(buffer)
@@ -691 +702 @@
     Return MakeStr(buffer)
 End Function
+
 Function Str$(value As Int64) As String
     Dim temp[255] As Char
@@ -709 +721 @@
     Dim i As Long
     For i=0 To num-1
-        memcpy(VarPtr(String$[i*length]), StrPtr(buf), SizeOf (Char) * length)
+        memcpy(VarPtr(String$[i*length]), StrPtr(buf), SizeOf (StrChar) * length)
     Next
 End Function
@@ -741 +753 @@
 End Function
 
-Function Val(buf As *Char) As Double
+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 *Char
+    Dim TempPtr As *StrChar
     Dim dbl As Double
     Dim i64data As Int64
@@ -766 +778 @@
                 If Not (0<=i3 And i3<=7) Then Exit While
 
-                TempPtr[i]=i3 As Char
+                TempPtr[i]=i3 As StrChar
                 i++
             Wend
@@ -789 +801 @@
                 End If
 
-                TempPtr[i]=i3 As Char
+                TempPtr[i]=i3 As StrChar
                 i++
             Wend
@@ -945 +957 @@
 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 Char
+    Dim buffer[MAX_PATH] As SByte
 
     '":\"をチェック
@@ -961 +973 @@
     i2=0
     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 dir Then
                 dir[i2]=path[i]
@@ -1055 +1063 @@
 End Function
 
+Function _System_BSwap(x As Word) As Word
+    Dim src = VarPtr(x) As *Byte
+    Dim dst = VarPtr(_System_BSwap) As *SByte
+    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 *SByte
+    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 *SByte
+    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
+
 '--------
 ' 文字列関数その2