Changeset 688 for trunk

Timestamp:

2009/03/11 16:56:32 (3 years ago)

Author:

egtra

Message:

Circle命令語の描画開始・終了位置の算出をSin/Cosで行うように変更

File:

• trunk/ab5.0/ablib/src/basic/prompt.sbp (modified) (3 diffs)

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

@@ -632 +632 @@
 'Prompt graphic command functions
 
-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
-
-    Dim hPen = CreatePen(PS_SOLID,1,GetBasicColor(ColorCode))
+Sub 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)
+    Dim hPen = CreatePen(PS_SOLID, 1, GetBasicColor(ColorCode))
     Dim hBrush As HBRUSH
     If bFill Then
@@ -643 +641 @@
     End If
 
-    Dim hDC = GetDC(_PromptSys_hWnd)
-    Dim hOldPenDC = SelectObject(hDC, hPen)
-    Dim hOldBrushDC = SelectObject(hDC, hBrush)
+    Dim hdc = GetDC(_PromptSys_hWnd)
+    Dim hOldPenDC = SelectObject(hdc, hPen)
+    Dim hOldBrushDC = SelectObject(hdc, hBrush)
     Dim hOldPen = SelectObject(_PromptSys_hMemDC, hPen)
     Dim hOldBrush = SelectObject(_PromptSys_hMemDC, hBrush)
 
-    Dim radi2 As Long
-    Dim iRadius As Long
-    If Aspect<1 Then
-        radi2 = (radius * Aspect) As Long
-        iRadius = radius As Long
+    Dim yRadius As Double
+    Dim xRadius As Double
+    If Aspect = 1 Then
+        yRadius = radius
+        xRadius = radius
+    ElseIf Aspect < 1 Then
+        yRadius = radius * Aspect
+        xRadius = radius
     Else
-        radi2 = radius As Long
-        iRadius = (radius / Aspect) As Long
-    End If
-
-    If StartPos=0 And EndPos=0 Then
-        Ellipse(hDC,x-iRadius,y-radi2,x+iRadius,y+radi2)
-        Ellipse(_PromptSys_hMemDC,x-iRadius,y-radi2,x+iRadius,y+radi2)
+        yRadius = radius
+        xRadius = radius / Aspect
+    End If
+
+    Dim x1 = (x - xRadius) As Long
+    Dim x2 = (x + xRadius) As Long
+    Dim y1 = (y - yRadius) As Long
+    Dim y2 = (y + yRadius) As Long
+
+    If StartPos = 0 And EndPos = 0 Then
+        Ellipse(hdc, x1, y1, x2, y2)
+        Ellipse(_PromptSys_hMemDC, x1, y1, x2, y2)
     Else
-        Dim sw As Boolean
-        StartPos *= 100
-        EndPos *= 100
-
-        If StartPos<0 Or EndPos<0 Then
-            sw = True
+        Dim isPie As Boolean
+        If StartPos < 0 Or EndPos < 0 Then
+            isPie = True
             StartPos = Math.Abs(StartPos)
             EndPos = Math.Abs(EndPos)
         Else
-            sw = False
+            isPie = False
         End If
 
-        If StartPos<=78.5 Then
-            i1=78
-            i2=Int(StartPos)
-        ElseIf StartPos<=235.5 Then
-            StartPos -= 78.5
-            i1=78-Int(StartPos)
-            i2=78
-        ElseIf StartPos<=392.5 Then
-            StartPos -= 235.5
-            i1=-78
-            i2=78-Int(StartPos)
-        ElseIf StartPos<=549.5 Then
-            StartPos -= 392.5
-            i1=-78+Int(StartPos)
-            i2=-78
-        ElseIf StartPos<=628 Then
-            StartPos -= 549.5
-            i1=78
-            i2=-78+Int(StartPos)
+        Dim scaleRadial = (x + y) * 0.5
+        Dim startX = (x + ActiveBasic.Math.Cos(StartPos) * scaleRadial) As Long
+        Dim startY = (y - ActiveBasic.Math.Sin(StartPos) * scaleRadial) As Long
+        Dim endX = (x + ActiveBasic.Math.Cos(EndPos) * scaleRadial) As Long
+        Dim endY = (y - ActiveBasic.Math.Sin(EndPos) * scaleRadial) As Long
+
+        If isPie Then
+            Pie(hdc, x1, y1, x2, y2, startX, startY, endX, endY)
+            Pie(_PromptSys_hMemDC, x1, y1, x2, y2, startX, startY, endX, endY)
+        Else
+            Arc(hdc, x1, y1, x2, y2, startX, startY, endX, endY)
+            Arc(_PromptSys_hMemDC, x1, y1, x2, y2, startX, startY, endX, endY)
         End If
-
-        If EndPos<=78.5 Then
-            i3=78
-            i4=Int(EndPos)
-        ElseIf EndPos<=235.5 Then
-            EndPos -= 78.5
-            i3=78-Int(EndPos)
-            i4=78
-        ElseIf EndPos<=392.5 Then
-            EndPos -= 235.5
-            i3=-78
-            i4=78-Int(EndPos)
-        ElseIf EndPos<=549.5 Then
-            EndPos -= 392.5
-            i3=-78+Int(EndPos)
-            i4=-78
-        ElseIf EndPos<=628 Then
-            EndPos -= 549.5
-            i3=78
-            i4=-78+Int(EndPos)
-        End If
-
-        If sw Then
-            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-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
-
-    SelectObject(hDC, hOldPenDC)
-    SelectObject(hDC, hOldBrushDC)
-    ReleaseDC(_PromptSys_hWnd, hDC)
+    End If
+
+    SelectObject(hdc, hOldPenDC)
+    SelectObject(hdc, hOldBrushDC)
+    ReleaseDC(_PromptSys_hWnd, hdc)
     SelectObject(_PromptSys_hMemDC, hOldPen)
     SelectObject(_PromptSys_hMemDC, hOldBrush)
@@ -912 +879 @@
     '呼び出し方法は以下のようになります（コンパイラがパラメータの並びを最適化します）
     'Circle (x, y), radius [, color] [, start] [, end] [, aspect] [, f] [, color2]
-    ActiveBasic.Prompt.Detail.Circle(x As Long, y As Long, radius, ColorCode, StartPos, EndPos, Aspect, bFill, BrushColor)
+    ActiveBasic.Prompt.Detail.Circle(x, y, radius, ColorCode, StartPos, EndPos, Aspect, bFill, BrushColor)
 End Macro