Changeset 684

Timestamp:

2009/03/09 03:13:24 (3 years ago)

Author:

egtra

Message:

Circle, Sqrtを壊していたので修正。プロンプト画面の描画ステートメントの座標の引数をDoubleへ変更。

Location:

trunk/ab5.0/ablib/src

Files:

• Classes/ActiveBasic/Math/Math.ab (modified) (2 diffs)
• basic/prompt.sbp (modified) (5 diffs)

trunk/ab5.0/ablib/src/Classes/ActiveBasic/Math/Math.ab

@@ -3 +3 @@
 Namespace ActiveBasic
 Namespace Math
+
+Const PI = _System_PI
+
 '----
 '浮動小数点数補助
@@ -87 +90 @@
             Dim j = jj >> 5 As Long
             Dim k = (jj And &h0000001f) As Long
-            j = (j + 511) << 4 + k
+            j = ((j + 511) << 4) + k
             SetWord(i, j)
             Dim last As Double

trunk/ab5.0/ablib/src/basic/prompt.sbp

@@ -628 +628 @@
 'Prompt graphic command functions
 
-Sub Circle(x As Long , y As Long, radius As Long, ColorCode As Long, StartPos As Double, EndPos As Double, Aspect As Double, bFill As Long, BrushColor As Long)
+Sub Circle(x As Long , y As Long, radius As Double, ColorCode As Long, StartPos As Double, EndPos As Double, Aspect As Double, bFill As Long, BrushColor As Long)
     Dim i1 As Long, i2 As Long, i3 As Long, i4 As Long
 
@@ -646 +646 @@
 
     Dim radi2 As Long
+    Dim iRadius As Long
     If Aspect<1 Then
-        radi2=(CDbl(radius)*Aspect) As Long
+        radi2 = (radius * Aspect) As Long
+        iRadius = radius As Long
     Else
-        radi2=radius
-        radius=(CDbl(radius)/Aspect) As Long
+        radi2 = radius As Long
+        iRadius = (radius / Aspect) As Long
     End If
 
     If StartPos=0 And EndPos=0 Then
-        Ellipse(hDC,x-radius,y-radi2,x+radius,y+radi2)
-        Ellipse(_PromptSys_hMemDC,x-radius,y-radi2,x+radius,y+radi2)
+        Ellipse(hDC,x-iRadius,y-radi2,x+iRadius,y+radi2)
+        Ellipse(_PromptSys_hMemDC,x-iRadius,y-radi2,x+iRadius,y+radi2)
     Else
         Dim sw As Boolean
-        StartPos *=StartPos
-        EndPos *=EndPos
+        StartPos *= 100
+        EndPos *= 100
 
         If StartPos<0 Or EndPos<0 Then
             sw = True
+            StartPos = Math.Abs(StartPos)
+            EndPos = Math.Abs(EndPos)
         Else
             sw = False
         End If
-
-        StartPos = Math.Abs(StartPos)
-        EndPos = Math.Abs(EndPos)
 
         If StartPos<=78.5 Then
@@ -713 +714 @@
 
         If sw Then
-            Pie(hDC,x-radius,y-radi2,x+radius,y+radi2,  x+i1,y-i2,x+i3,y-i4)
-            Pie(_PromptSys_hMemDC,x-radius,y-radi2,x+radius,y+radi2,  x+i1,y-i2,x+i3,y-i4)
+            Pie(hDC,x-iRadius,y-radi2,x+iRadius,y+radi2, x+i1,y-i2,x+i3,y-i4)
+            Pie(_PromptSys_hMemDC,x-iRadius,y-radi2,x+iRadius,y+radi2, x+i1,y-i2,x+i3,y-i4)
         Else
-            Arc(hDC,x-radius,y-radi2,x+radius,y+radi2,  x+i1,y-i2,x+i3,y-i4)
-            Arc(_PromptSys_hMemDC,x-radius,y-radi2,x+radius,y+radi2,  x+i1,y-i2,x+i3,y-i4)
+            Arc(hDC,x-iRadius,y-radi2,x+iRadius,y+radi2, x+i1,y-i2,x+i3,y-i4)
+            Arc(_PromptSys_hMemDC,x-iRadius,y-radi2,x+iRadius,y+radi2, x+i1,y-i2,x+i3,y-i4)
         End If
     End If
@@ -895 +896 @@
 */
 
-Macro LOCATE(x As Long, y As Long)
-    ActiveBasic.Prompt.Detail.Locate(x, y)
+Macro LOCATE(x As Double, y As Double)
+    ActiveBasic.Prompt.Detail.Locate(x As Long, y As Long)
 End Macro
 
@@ -904 +905 @@
 '-------------------
 
-Macro CIRCLE(x As Long , y As Long, radius As Long)(ColorCode As Long, StartPos As Double, EndPos As Double, Aspect As Double, bFill As Long, BrushColor As Long)
+Macro CIRCLE(x As Double , y As Double, radius As Double)(ColorCode As Long, StartPos As Double, EndPos As Double, Aspect As Double, bFill As Long, BrushColor As Long)
     '呼び出し方法は以下のようになります（コンパイラがパラメータの並びを最適化します）
     'Circle (x, y), radius [, color] [, start] [, end] [, aspect] [, f] [, color2]
-    ActiveBasic.Prompt.Detail.Circle(x, y, radius, ColorCode, StartPos, EndPos, Aspect, bFill, BrushColor)
+    ActiveBasic.Prompt.Detail.Circle(x As Long, y As Long, radius, ColorCode, StartPos, EndPos, Aspect, bFill, BrushColor)
 End Macro
 
-Macro LINE(sx As Long, sy As Long, bStep As Long, ex As Long, ey As Long)(ColorCode As Long, fType As Long, BrushColor As Long)
+Macro LINE(sx As Double, sy As Double, bStep As Long, ex As Double, ey As Double)(ColorCode As Long, fType As Long, BrushColor As Long)
     '呼び出し方法は以下のようになります（コンパイラがパラメータの並びを最適化します）
     'Line (sx,sy)-[STEP](ex,ey),[ColorCode],[B/Bf],[BrushColor]
-    ActiveBasic.Prompt.Detail.Line(sx, sy, bStep, ex, ey, ColorCode, fType, BrushColor)
+    ActiveBasic.Prompt.Detail.Line(sx As Long, sy As Long, bStep, ex As Long, ey As Long, ColorCode, fType, BrushColor)
 End Macro
 
-Macro PSET(x As Long, y As Long)(ColorCode As Long)
+Macro PSET(x As Double, y As Double)(ColorCode As Long)
     '呼び出し方法は以下のようになります（コンパイラがパラメータの並びを最適化します）
     'PSet (x,y),ColorCode
-    ActiveBasic.Prompt.Detail.PSet(x, y, ColorCode)
+    ActiveBasic.Prompt.Detail.PSet(x As Long, y As Long, ColorCode)
 End Macro
 
-Macro PAINT(x As Long, y As Long, BrushColor As Long)(ByVal LineColor As Long)
+Macro PAINT(x As Double, y As Double, BrushColor As Long)(ByVal LineColor As Long)
     '呼び出し方法は以下のようになります（コンパイラがパラメータの並びを最適化します）
     'Paint (x,y),BrushColor,LineColor
-    ActiveBasic.Prompt.Detail.Paint(x, y, BrushColor, LineColor)
+    ActiveBasic.Prompt.Detail.Paint(x As Long, y As Long, BrushColor, LineColor)
 End Macro