Changeset 355 for trunk/Include/com

Timestamp:

Oct 13, 2007, 2:11:22 PM (17 years ago)

Author:

イグトランス (egtra)

Message:

FormatIntegerDを実装。
UnitTestの失敗時の表示を目立つようにした。
ArrayListを名前空間System.Collectionsに入れた。

Location:

trunk/Include/com

Files:

• currency.ab (modified) (2 diffs)
• decimal.ab (modified) (2 diffs)
• index.ab (modified) (1 diff)
• variant.ab (modified) (21 diffs)
• vbobject.ab (modified) (1 diff)

trunk/Include/com/currency.ab

@@ -56 +56 @@
         Return ret
     End Function
-
+/*
     Const Function Operator /(y As Variant) As Double
         Dim vx = New Variant(This)
         Dim ret = vx / y
-        Return ret.ValR4
+        Return ret.ValR8
     End Function
 
@@ -67 +67 @@
         Dim vy = New Variant(y)
         Dim ret = vx / vy
-        Return ret.ValR4
-    End Function
-
+        Return ret.ValR8
+    End Function
+*/
     Const Function Operator +(y As Currency) As Currency
         Dim ret = New Currency

trunk/Include/com/decimal.ab

@@ -15 +15 @@
     Sub Decimal(d As Decimal)
 '       dec = d なぜかコンパイルできない
+        memcpy(VarPtr(dec), VarPtr(d.dec), Len(dec))
+    End Sub
+
+    Sub Decimal(ByRef d As DECIMAL)
         memcpy(VarPtr(dec), VarPtr(d), Len(dec))
     End Sub
@@ -340 +344 @@
 
     Const Function ToVariant() As Variant
-        Return New Variant(dec)
+        Return New Variant(This)
     End Function
 

trunk/Include/com/index.ab

@@ -3 +3 @@
 #require <com/bstring.ab>
 #require <com/variant.ab>
-#require <com/vbobject.ab>
+'#require <com/vbobject.ab>
 #require <com/currency.ab>
 #require <com/decimal.ab>

trunk/Include/com/variant.ab

@@ -6 +6 @@
 '#require <oaidl.ab>
 '#require <oleauto.ab>
-#require <com/index.ab>
+'#require <com/index.ab>
 
 Namespace ActiveBasic
@@ -109 +109 @@
 
     Sub Variant(s As String)
-        Dim bs As BString(s)
-        Variant(bs)
+        ValStr = New BString(s)
     End Sub
 
@@ -118 +117 @@
     End Sub
 
+    Sub Variant(n As Decimal)
+        Dim p = VarPtr(v) As *DECIMAL
+        p[0] = n.Dec
+        v.vt = VT_DECIMAL
+    End Sub
+
 
     Sub ~Variant()
@@ -127 +132 @@
         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)
@@ -171 +168 @@
 */
     'Operators
-
+/*
     Const Function Operator ^(y As Variant) As Variant
         Dim ret = New Variant
@@ -265 +262 @@
         Return ret
     End Function
-
+*/
     Const Function Abs() As Variant
-        Dim ret = New Variant
-        VarAbs(This.v, ret.v)
-        Return ret
+        Abs = New Variant
+        VarAbs(This.v, Abs.v)
     End Function
 
     Const Function Fix() As Variant
-        Dim ret = New Variant
-        VarFix(This.v, ret.v)
-        Return ret
+        Fix = New Variant
+        VarFix(This.v, Fix.v)
     End Function
 
     Const Function Int() As Variant
-        Dim ret = New Variant
-        VarInt(This.v, ret.v)
-        Return ret
-    End Function
-
-    Const Function Round(cDecimals As Long) As Variant
-        Dim ret = New Variant
-        VarRound(This.v, cDecimals, ret)
-        Return ret
-    End Function
-
-    Const Function Round() As Variant
-        Return Round(0)
+        Int = New Variant
+        VarInt(This.v, Int.v)
+    End Function
+
+    Const Function Round(cDecimals = 0 As Long) As Variant
+        Round = New Variant
+        VarRound(This.v, cDecimals, Round.v)
     End Function
 
@@ -301 +290 @@
         Return VarCmp(x.v, y.v, LOCALE_USER_DEFAULT, 0) 'VARCMP_NULL = 3を返す場合があるので注意
     End Function
-
+/*
     Const Function Operator ==(y As Variant) As Boolean
         Dim c = Compare(This, y)
@@ -338 +327 @@
     End Function
 */
+/*
     Const Function Operator <=(y As Variant) As Boolean
         Dim c = Compare(This, y)
@@ -355 +345 @@
         End If
     End Function
-
+*/
     Const Function ChangeType(vt As VARTYPE, flags As Word) As Variant
         Dim ret = New Variant
@@ -435 +425 @@
     Const Function ValI1() As SByte
         Dim r = ChangeType(VT_I1)
-        Return GetByte(VarPtr(r.val)) As SByte
+        Return GetByte(VarPtr(r.v.val)) As SByte
     End Function
 
@@ -446 +436 @@
     Const Function ValI2() As Integer
         Dim r = ChangeType(VT_I2)
-        Return GetWord(VarPtr(r.val)) As Integer
+        Return GetWord(VarPtr(r.v.val)) As Integer
     End Function
 
@@ -457 +447 @@
     Const Function ValI4() As Long
         Dim r = ChangeType(VT_I4)
-        Return GetDWord(VarPtr(r.val)) As Long
+        Return GetDWord(VarPtr(r.v.val)) As Long
     End Function
 
@@ -468 +458 @@
     Const Function ValI8() As Int64
         Dim r = ChangeType(VT_I8)
-        Return GetQWord(VarPtr(r.val)) As Int64
+        Return GetQWord(VarPtr(r.v.val)) As Int64
     End Function
 
@@ -479 +469 @@
     Const Function ValR4() As Single
         Dim r = ChangeType(VT_R4)
-        Return GetSingle(VarPtr(r.val))
+        Return GetSingle(VarPtr(r.v.val))
     End Function
 
@@ -490 +480 @@
     Const Function ValR8() As Double
         Dim r = ChangeType(VT_UI8)
-        Return GetDouble(VarPtr(r.val))
+        Return GetDouble(VarPtr(r.v.val))
     End Function
 
@@ -512 +502 @@
     Const Function ValError() As SCODE
         Dim r = ChangeType(VT_ERROR)
-        Return GetDWord(VarPtr(r.val))
+        Return GetDWord(VarPtr(r.v.val))
     End Function
 
@@ -524 +514 @@
         Dim r = ChangeType(VT_CY)
         ValCy = New Currency
-        ValCy.Cy = GetQWord(VarPtr(r.val))
+        ValCy.Cy = GetQWord(VarPtr(r.v.val))
     End Function
 
@@ -561 +551 @@
         v.vt = VT_UNKNOWN
     End Sub
-
+/*
     Const Function ValObject() As VBObject
         Dim r As VARIANT
@@ -576 +566 @@
         v.vt = VT_DISPATH
     End Sub
-
+*/
     'ValArray
 
     Const Function ValDecimal() As Decimal
         Dim p = VarPtr(v) As *Decimal
-        Return New Deciaml(p[0])
+        Return New Deciaml(ByVal p)
     End Function
 
     Sub ValDecimal(x As Decimal)
         Clear()
-        Dim p = VarPtr(v) As *Decimal
+        Dim p = VarPtr(v) As *DECIMAL
         p[0] = x.Dec
         v.vt = VT_DECIMAL '念の為
@@ -599 +589 @@
 '       If _System_VariantOptionalParam = Nothing Then
 '           'ToDo マルチスレッド対応
-            _System_VariantOptionalParam = New Variant
-            _System_VariantOptionalParam.ValError = DISP_E_PARAMNOTFOUND
+            VariantOptionalParam = New Variant
+            VariantOptionalParam.ValError = DISP_E_PARAMNOTFOUND
 '       End If
-        Return _System_VariantOptionalParam
+        Return VariantOptionalParam
     End Function
 Private
@@ -617 +607 @@
 End Class
 
-'Dim _System_VariantOptionalParam = Nothing As Variant
+Dim VariantOptionalParam = Nothing As Variant
 
 /*

trunk/Include/com/vbobject.ab

@@ -295 +295 @@
     Return CallByName
 End Function
-
+/*
 Function CreateObject(className As PCWSTR) As VBObject
     Return New VBObject(className, 0, CLSCTX_ALL)