BASICの超Bな者です。初歩的な質問です。
(Ver 4.22.00を使用)
(1)円弧の角度位置
以下を実行して、例えばStartに30度、Stopに60度を入れると、円弧の位置が合いません。（0度、90度、180度などは合うようだ）
Line命令では角度と合っているので、ラジアン角は正常だと思います。
ピッタリと合わせるにはどうすればいいのでしょうか？
ちなみに99Basicでは同じ考えでやってもピッタリと合います（但し開始角と終了角が時計回りなので逆にしないといけませんが)
'================
#N88BASIC
10 Dim pai=3.1415927 as double
Dim OX=150 as double '円の中心座標
Dim OY=150 as double
Dim R=100 as double '円の半径
Dim i as double '角度線の角度
Dim irad as double 'rad角度
Dim Pstart as double '開始角
Dim Pstop as double '終了角
Dim rad_Pstart as double
Dim rad_Pstop as double
Cls 3
For i=0 to 350 step 10
irad=i*pai/180
Line (2*OX,2*OY)-(2*OX+(R+30)*Cos(irad),2*OY-(R+30)*Sin(irad)),4
Next i
Input "Start角度(度)は?";Pstart
Input "Stop角度(度)は?" ;Pstop
Print
rad_Pstart=Pstart*pai/180
rad_Pstop =Pstop*pai/180
Circle (2*OX,2*OY),R,7,rad_Pstart,rad_Pstop,1,f,2
Line (2*OX,2*OY)-(2*OX+R*Cos(rad_Pstart),2*OY-R*Sin(rad_Pstart)),7
Line (2*OX,2*OY)-(2*OX+R*Cos(rad_Pstop),2*OY-R*Sin(rad_Pstop)),7
'================
(2)扇方円弧の中を指定の色で塗りつぶす方法がどうすればいいのでしょうか？
Circle (2*OX,2*OY),R,7,rad_Pstart,rad_Pstop,1,f,2
とやっても塗りつぶしてくれない。
円弧の角度が合わない
-
ゲスト
やはり変だと思うのですが
Verは4.22.00です。
やはりN88BASIC互換の円弧描きが変だと思うのですが・・
Circle命令で開始点と終始点にマイナスを付けると、扇形を塗りつぶすがやはり角度は合いません。
それに、
(1)
pai=3.1415927 として、
Circle (300,200),100,5,,,1,f,5
を実効すると、円を描き塗りつぶしますが、
Circle (300,200),100,5,-0,-2*pai,1,f,5
を実効すると、315度で円弧が終了します。（-0は0でも同じ、2*paiは仕様範囲内なのに）
しかしここで、pai=3.14にすると360度まで円を描きます。
(3.141でもダメ！、3.14だど円になる--->これってπは3.14しか認めないという事？）
(2)
じゃ～と、一番最初の質問のProgramでpai=3.14にすると、例えば開始=30度、終始点=60度の角度が合うかといえば合いません。やはり円弧描きは合いません。（但し3.14では360度辺りまでは描いてくれるようだ）
(3)
最初の質問のProgramでpai=3.1415927（3.141も同じ）にしておいて、開始=0度、終始=360度を入れると315度で円弧が終わります。
しかし、359.9度もダメですが、359.8度だと突然360度辺りまでは描いてくれます（ちょっと線が残るが）
Circle命令に入れている値は仕様を守っているし、同じ考え方で99Basicでは円弧の角度が合っているので、プログラミングのせいではなくActiveBasicのCircle命令は何か挙動が変と思い、このバグ掲示板に書いたのですが皆さんの所では起こっていないんですかねぇ。
仕方がないので三角関数やPsetを使って円弧描きや塗りつぶしをやっていますが、円弧描き・塗りつぶしが簡単にできるCircle命令が(私の所では)使えないので困ったものです。
やはりN88BASIC互換の円弧描きが変だと思うのですが・・
Circle命令で開始点と終始点にマイナスを付けると、扇形を塗りつぶすがやはり角度は合いません。
それに、
(1)
pai=3.1415927 として、
Circle (300,200),100,5,,,1,f,5
を実効すると、円を描き塗りつぶしますが、
Circle (300,200),100,5,-0,-2*pai,1,f,5
を実効すると、315度で円弧が終了します。（-0は0でも同じ、2*paiは仕様範囲内なのに）
しかしここで、pai=3.14にすると360度まで円を描きます。
(3.141でもダメ！、3.14だど円になる--->これってπは3.14しか認めないという事？）
(2)
じゃ～と、一番最初の質問のProgramでpai=3.14にすると、例えば開始=30度、終始点=60度の角度が合うかといえば合いません。やはり円弧描きは合いません。（但し3.14では360度辺りまでは描いてくれるようだ）
(3)
最初の質問のProgramでpai=3.1415927（3.141も同じ）にしておいて、開始=0度、終始=360度を入れると315度で円弧が終わります。
しかし、359.9度もダメですが、359.8度だと突然360度辺りまでは描いてくれます（ちょっと線が残るが）
Circle命令に入れている値は仕様を守っているし、同じ考え方で99Basicでは円弧の角度が合っているので、プログラミングのせいではなくActiveBasicのCircle命令は何か挙動が変と思い、このバグ掲示板に書いたのですが皆さんの所では起こっていないんですかねぇ。
仕方がないので三角関数やPsetを使って円弧描きや塗りつぶしをやっていますが、円弧描き・塗りつぶしが簡単にできるCircle命令が(私の所では)使えないので困ったものです。
-
ゲスト
これは、よくわからないけど”仕様”なんでしょうかね。
Circleステートメントの定義されているprompt.sbpを見てみると、
1. 円弧を描くときの始点と終点を示す座標変数i1、i2、i3、i4の定義が、360度を5区間に分けて近似してある
2. 区間の境界値は最大で小数点以下3桁である
という感じで、上記始点・終点を示す座標から計算される角度は最大で4度ちょいのズレを持ってしまってます。
なので、ゲストさんのプログラム自体は問題ないと思います。
とりあえず、既存のCirclrステートメントを下記のコードで置き換えてみるとかどうですか。
Circleステートメントの定義されているprompt.sbpを見てみると、
1. 円弧を描くときの始点と終点を示す座標変数i1、i2、i3、i4の定義が、360度を5区間に分けて近似してある
2. 区間の境界値は最大で小数点以下3桁である
という感じで、上記始点・終点を示す座標から計算される角度は最大で4度ちょいのズレを持ってしまってます。
なので、ゲストさんのプログラム自体は問題ないと思います。
とりあえず、既存のCirclrステートメントを下記のコードで置き換えてみるとかどうですか。
[ここをクリックすると内容が表示されます]
コード: 全て選択
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)
'呼び出し方法は以下のようになります（コンパイラがパラメータの並びを最適化します）
'Circle (x, y), radius [, color] [, start] [, end] [, aspect] [, f] [, color2]
Dim hDC As HANDLE
Dim hPen As HANDLE, hOldPen As HANDLE
Dim hBrush As HANDLE, hOldBrush As HANDLE
Dim tmp As Long
Dim rect As Rect
Dim start As POINTAPI, stop As POINTAPI
hPen=CreatePen(PS_SOLID,1,GetBasicColor(ColorCode))
If bFill Then
hBrush=CreateSolidBrush(GetBasicColor(BrushColor))
Else
hBrush=GetStockObject(NULL_BRUSH)
End If
hDC=GetDC(_PromptSys_hWnd)
SelectObject(hDC,hPen)
SelectObject(hDC,hBrush)
hOldPen=SelectObject(_PromptSys_hMemDC,hPen)
hOldBrush=SelectObject(_PromptSys_hMemDC,hBrush)
If Aspect = 0 Then Aspect = 1
If Aspect < 1 Then
tmp = radius * Aspect
With rect
.left = x - radius
.top = y - tmp
.right = x + radius
.bottom = y + tmp
End With
Else
tmp = radius / Aspect
With rect
.left = x - tmp
.top = y - radius
.right = x + tmp
.bottom = y + radius
End With
End If
start.x = x + radius * Cos(StartPos)
start.y = y - radius * Sin(StartPos)
stop.x = x + radius * Cos(EndPos)
stop.y = y - radius * Sin(EndPos)
Pie(hDC, rect.left, rect.top, rect.right, rect.bottom, start.x, start.y, stop.x, stop.y)
Pie(_PromptSys_hMemDC, rect.left, rect.top, rect.right, rect.bottom, start.x, start.y, stop.x, stop.y)
ReleaseDC(_PromptSys_hWnd,hDC)
SelectObject(_PromptSys_hMemDC,hOldPen)
SelectObject(_PromptSys_hMemDC,hOldBrush)
DeleteObject(hPen)
If bFill Then DeleteObject(hBrush)
End Macro-
ゲスト
ありがとうございます。初心者なのでprompt.sbpにこんな仕掛けがあるとは知りませんでした。
どうも仕様だったようですね。バグか(？)などと言って申し訳ありませんでした。
仕様なのにここで続ける事をご容赦ください。
教えて頂いたCodeをやってみました。こんどは角度がピッタリと合い、しかも三角関数とPsetで描くよりも速いのでびっくりです。
しかし、Pie関数(扇形描画)なので、
Circle(x,y),radius,color
を実効すると扇形の半径線が残ってしまいますね。
ここいらはArc関数(楕円弧描画)を使えば上手くいくのでしょうか。
Circleの指定には次の種類があると思いいじってみましたが、なにせ超Bな初心者なので条件設定がとんと判りません。
実はAPIが何なのかも判りませんし、hDCや_PromptSys_hMemDCなどが何なのかも判りませんが、一応下記Codeのようにしたら今の所Circleの種類は書いてくれています。(間違いが有るかもしれないし、もっと良いやり方があるかもしれません)
但し、扇形描画(塗りつぶしも)で0度から360度(0から2*pai)までの条件だけは上手く描きません。start.x=stop.x、start.y=stop.yとなるので、If文でEndPos*(1-1E-7)にしています。もっと上手い手があるかもしれません。
また(5)の塗りつぶさない扇形描画だけは上手く出来なかったので背景色の黒で塗っています。
Circle(x,y),radius,color,start,end,Aspect で、Pie関数を使えば塗りつぶさない扇形描画は可能ですが円弧描画との切替が出来ません。
こんな場合は、Circle(x,y),radius,color,start,end,Aspect,f,color2 にしてcolor2に(-1)を新たに設けて、これで切替えてPie関数を使えば透明色に出来るとか？ (或いはfを-fにするとか)
塗りつぶさない透明扇形描画のニ－ズがどの位あるのか不明ですが、透明色(塗りつぶさない)の扇形があっても面白いですね。
ここからは作者や皆さんにお願いするしかありません。(N88BASICモ－ドの優先順位が低ければここまでですが）
色々ご親切にありがとうございました。
<Circleの種類>
(1)円描画 Circle(x,y),radius,color
(2)楕円描画 Circle(x,y),radius,color,,,Aspect
(3)円・楕円の塗りつぶし Circle(x,y),radius,color,,,Aspect,f,color2
(4)円弧描画(円・楕円) Circle(x,y),radius,color,start,end,Aspect
(5)扇形描画(円・楕円) Circle(x,y),radius,color,start,end,Aspect,f(,?)
color2には透明色は無いので、背景色の黒にするのでしょうか。
(6)扇形の塗りつぶし Circle(x,y),radius,color,start,end,Aspect,f,color2
どうも仕様だったようですね。バグか(？)などと言って申し訳ありませんでした。
仕様なのにここで続ける事をご容赦ください。
教えて頂いたCodeをやってみました。こんどは角度がピッタリと合い、しかも三角関数とPsetで描くよりも速いのでびっくりです。
しかし、Pie関数(扇形描画)なので、
Circle(x,y),radius,color
を実効すると扇形の半径線が残ってしまいますね。
ここいらはArc関数(楕円弧描画)を使えば上手くいくのでしょうか。
Circleの指定には次の種類があると思いいじってみましたが、なにせ超Bな初心者なので条件設定がとんと判りません。
実はAPIが何なのかも判りませんし、hDCや_PromptSys_hMemDCなどが何なのかも判りませんが、一応下記Codeのようにしたら今の所Circleの種類は書いてくれています。(間違いが有るかもしれないし、もっと良いやり方があるかもしれません)
但し、扇形描画(塗りつぶしも)で0度から360度(0から2*pai)までの条件だけは上手く描きません。start.x=stop.x、start.y=stop.yとなるので、If文でEndPos*(1-1E-7)にしています。もっと上手い手があるかもしれません。
また(5)の塗りつぶさない扇形描画だけは上手く出来なかったので背景色の黒で塗っています。
Circle(x,y),radius,color,start,end,Aspect で、Pie関数を使えば塗りつぶさない扇形描画は可能ですが円弧描画との切替が出来ません。
こんな場合は、Circle(x,y),radius,color,start,end,Aspect,f,color2 にしてcolor2に(-1)を新たに設けて、これで切替えてPie関数を使えば透明色に出来るとか？ (或いはfを-fにするとか)
塗りつぶさない透明扇形描画のニ－ズがどの位あるのか不明ですが、透明色(塗りつぶさない)の扇形があっても面白いですね。
ここからは作者や皆さんにお願いするしかありません。(N88BASICモ－ドの優先順位が低ければここまでですが）
色々ご親切にありがとうございました。
<Circleの種類>
(1)円描画 Circle(x,y),radius,color
(2)楕円描画 Circle(x,y),radius,color,,,Aspect
(3)円・楕円の塗りつぶし Circle(x,y),radius,color,,,Aspect,f,color2
(4)円弧描画(円・楕円) Circle(x,y),radius,color,start,end,Aspect
(5)扇形描画(円・楕円) Circle(x,y),radius,color,start,end,Aspect,f(,?)
color2には透明色は無いので、背景色の黒にするのでしょうか。
(6)扇形の塗りつぶし Circle(x,y),radius,color,start,end,Aspect,f,color2
コード: 全て選択
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)
'呼び出し方法は以下のようになります（コンパイラがパラメータの並びを最適化します）
'Circle (x, y), radius [, color] [, start] [, end] [, aspect] [, f] [, color2]
Dim hDC As HANDLE
Dim hPen As HANDLE, hOldPen As HANDLE
Dim hBrush As HANDLE, hOldBrush As HANDLE
Dim tmp As Long
Dim rect As Rect
Dim start As POINTAPI, stop As POINTAPI
hPen=CreatePen(PS_SOLID,1,GetBasicColor(ColorCode))
If bFill Then
hBrush=CreateSolidBrush(GetBasicColor(BrushColor))
Else
hBrush=GetStockObject(NULL_BRUSH)
End If
hDC=GetDC(_PromptSys_hWnd)
SelectObject(hDC,hPen)
SelectObject(hDC,hBrush)
hOldPen=SelectObject(_PromptSys_hMemDC,hPen)
hOldBrush=SelectObject(_PromptSys_hMemDC,hBrush)
If Aspect=0 Then Aspect=1
If Aspect<1 Then
tmp=radius*Aspect
With rect
.left=x-radius
.top=y-tmp
.right=x+radius
.bottom=y+tmp
End With
Else
tmp=radius/Aspect
With rect
.left=x-tmp
.top=y-radius
.right=x+tmp
.bottom=y+radius
End With
End If
start.x=x+radius*Cos(StartPos)
start.y=y-radius*Sin(StartPos)
stop.x=x+radius*Cos(EndPos)
stop.y=y-radius*Sin(EndPos)
If StartPos=0 and EndPos=2*3.1415927 Then 'ここはfunction.sbpの_System_PIを使うのかな？
start.x=x+radius*Cos(StartPos)
start.y=y-radius*Sin(StartPos)
stop.x=x+radius*Cos(EndPos*(1-1E-7))
stop.y=y-radius*Sin(EndPos*(1-1E-7))
End If
If StartPos=0 And EndPos=0 Then
If bFill Then
Ellipse(hDC, rect.left, rect.top, rect.right, rect.bottom)
Ellipse(_PromptSys_hMemDC, rect.left, rect.top, rect.right, rect.bottom)
Else
Arc(hDC, rect.left, rect.top, rect.right, rect.bottom, start.x, start.y, stop.x, stop.y)
Arc(_PromptSys_hMemDC, rect.left, rect.top, rect.right, rect.bottom, start.x, start.y, stop.x, stop.y)
End If
Else If bFill Then
Pie(hDC, rect.left, rect.top, rect.right, rect.bottom, start.x, start.y, stop.x, stop.y)
Pie(_PromptSys_hMemDC, rect.left, rect.top, rect.right, rect.bottom, start.x, start.y, stop.x, stop.y)
Else
Arc(hDC, rect.left, rect.top, rect.right, rect.bottom, start.x, start.y, stop.x, stop.y)
Arc(_PromptSys_hMemDC, rect.left, rect.top, rect.right, rect.bottom, start.x, start.y, stop.x, stop.y)
End If
ReleaseDC(_PromptSys_hWnd,hDC)
SelectObject(_PromptSys_hMemDC,hOldPen)
SelectObject(_PromptSys_hMemDC,hOldBrush)
DeleteObject(hPen)
If bFill Then DeleteObject(hBrush)
End Macro-
ゲスト
>しかし、Pie関数(扇形描画)なので、
>Circle(x,y),radius,color
>を実効すると扇形の半径線が残ってしまいますね。
>ここいらはArc関数(楕円弧描画)を使えば上手くいくのでしょうか。
これは失礼。あまり考えずにやってしまいました。
なので、結局は「もとあるCircleステートメントの始点、終点計算を三角関数に直しただけ」というのが一番でしょう。
もともとのCircleステートメントでは始点、終点どちらかの角度指定を負の値にすれば扇形の描画になります（もちろん上記のコードもなるはず）。
>但し、扇形描画(塗りつぶしも)で0度から360度(0から2*pai)までの条件だけは上手く描きません。
これは円周率の定義を
でやっているためではないですか？ActiveBasic上（Win32API上）のπは_System_PI=3.14159265358979323846264なので、このままで計算すると360度は範囲外の値になり、描画に失敗するのでしょう。
とすれば良いはずです。
>Circle(x,y),radius,color
>を実効すると扇形の半径線が残ってしまいますね。
>ここいらはArc関数(楕円弧描画)を使えば上手くいくのでしょうか。
これは失礼。あまり考えずにやってしまいました。
なので、結局は「もとあるCircleステートメントの始点、終点計算を三角関数に直しただけ」というのが一番でしょう。
[ここをクリックすると内容が表示されます]
>また(5)の塗りつぶさない扇形描画だけは上手く出来なかったので背景色の黒で塗っています。コード: 全て選択
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)
'呼び出し方法は以下のようになります（コンパイラがパラメータの並びを最適化します）
'Circle (x, y), radius [, color] [, start] [, end] [, aspect] [, f] [, color2]
Dim hDC As HANDLE
Dim hPen As HANDLE, hOldPen As HANDLE
Dim hBrush As HANDLE, hOldBrush As HANDLE
Dim tmp As Long
Dim rect As Rect
Dim start As POINTAPI, stop As POINTAPI
hPen=CreatePen(PS_SOLID,1,GetBasicColor(ColorCode))
If bFill Then
hBrush=CreateSolidBrush(GetBasicColor(BrushColor))
Else
hBrush=GetStockObject(NULL_BRUSH)
End If
hDC=GetDC(_PromptSys_hWnd)
SelectObject(hDC,hPen)
SelectObject(hDC,hBrush)
hOldPen=SelectObject(_PromptSys_hMemDC,hPen)
hOldBrush=SelectObject(_PromptSys_hMemDC,hBrush)
If Aspect = 0 Then Aspect = 1
If Aspect < 1 Then
tmp = radius * Aspect
With rect
.left = x - radius
.top = y - tmp
.right = x + radius
.bottom = y + tmp
End With
Else
tmp = radius / Aspect
With rect
.left = x - tmp
.top = y - radius
.right = x + tmp
.bottom = y + radius
End With
End If
If StartPos = 0 And EndPos = 0 Then
Ellipse(hDC, rect.left, rect.top, rect.right, rect.bottom)
Ellipse(_PromptSys_hMemDC, rect.left, rect.top, rect.right, rect.bottom)
Else
If StartPos < 0 Or EndPos < 0 Then sw = 1 Else sw = 0
If StartPos < 0 Then StartPos = -StartPos
If EndPos < 0 Then EndPos = -EndPos
start.x = x + radius * Cos(StartPos)
start.y = y - radius * Sin(StartPos)
stop.x = x + radius * Cos(EndPos)
stop.y = y - radius * Sin(EndPos)
If sw Then
Pie(hDC, rect.left, rect.top, rect.right, rect.bottom, start.x, start.y, stop.x, stop.y)
Pie(_PromptSys_hMemDC, rect.left, rect.top, rect.right, rect.bottom, start.x, start.y, stop.x, stop.y)
Else
Arc(hDC, rect.left, rect.top, rect.right, rect.bottom, start.x, start.y, stop.x, stop.y)
Arc(_PromptSys_hMemDC, rect.left, rect.top, rect.right, rect.bottom, start.x, start.y, stop.x, stop.y)
End If
End If
ReleaseDC(_PromptSys_hWnd,hDC)
SelectObject(_PromptSys_hMemDC,hOldPen)
SelectObject(_PromptSys_hMemDC,hOldBrush)
DeleteObject(hPen)
If bFill Then DeleteObject(hBrush)
End MacroもともとのCircleステートメントでは始点、終点どちらかの角度指定を負の値にすれば扇形の描画になります（もちろん上記のコードもなるはず）。
>但し、扇形描画(塗りつぶしも)で0度から360度(0から2*pai)までの条件だけは上手く描きません。
これは円周率の定義を
コード: 全て選択
Dim pai=3.1415927コード: 全て選択
Const pai=_System_PI-
ゲスト
-
ゲスト
最初に質問した者です。以下は意見ですので軽く聞き流してください。
実はBASICプログラミングの勉強がてら以下のスミス・チャ－トをやっていて角度が合わないので質問した次第です。
教えて頂いた最終的な現状prompt.sbpのCIRCLEステートメントでは、次のアドミタンス・チャ－トを描画すると行番号10のAstartがScale単位が１以上ではマイナスになるので扇形を描画します。
インピ－ダンス・チャ－トの方はちゃんと円弧を描けていますので、Astartの出し方・考え方は合っています。
対策はAstartに2*paiを加算して、
Astart=2*pai+(pai/2-2*Atn(x(i))) --->pai*5/2-2*Atn(x(i))でもOK
とすればよいだけの事ですが、例えば計算上マイナスになる角度 -30度(330度の事)から+60度まで円弧を描かせたい場合、現行では扇形になるので2*paiを加算します。(沢山そんな箇所があると大変)
ゲストさんに最初に教えて頂いたやり方をちょっと変更した下記のCodeでは例え角度がマイナスでも -30度(330度の事)から+60度まで円弧を描いてくれます。
直感的な角度の考え方( -30度は330度の事で扇形の為のマイナスではない)はこちらの方が判り易いですが現状Codeでは扇方を描いてしまいますし、下記Codeでは切替がないので塗りつぶさない扇形がダメです。
そこで「 Circle(x,y),radius,color,start,end,Aspect,f,color2 にしてcolor2に(-1)を新たに設けて、これで切替えてPie関数を使えば透明色に出来るとか？ (或いはfを-fにするとか)」
などと思ったのですが、そうすると仕様を変更する事になり既にソ－スコ－ドを書いている皆さんの迷惑になるし、やはり扇形になる場合は2*paiを加算するしかないのかなぁ～～と思っている次第です。
実はBASICプログラミングの勉強がてら以下のスミス・チャ－トをやっていて角度が合わないので質問した次第です。
教えて頂いた最終的な現状prompt.sbpのCIRCLEステートメントでは、次のアドミタンス・チャ－トを描画すると行番号10のAstartがScale単位が１以上ではマイナスになるので扇形を描画します。
インピ－ダンス・チャ－トの方はちゃんと円弧を描けていますので、Astartの出し方・考え方は合っています。
コード: 全て選択
#N88BASIC
Const pai=_System_PI as double
Dim OX=400 as double '中心座標
Dim OY=200 as double
Dim RR=180 as double '外円半径
Dim color=4 as long 'Chartの色
Dim r(20) as double '配列 正規化抵抗
Dim x(20) as double '配列 正規化リアクタンス
Dim i as long
Dim OXarc as double 'R,X円弧の中心座標
Dim OYarc as double
Dim Rarc as double 'R,X円弧の半径
Dim Astart as double '円弧の開始点
Dim Aend as double '円弧の終了点
Cls 3
'Scale単位
r(0)=0.1 :r(1)=0.2 :r(2)=0.3 :r(3)=0.5 :r(4)=0.7 :r(5)=1 :r(6)=2 :r(7)=3 :r(8)=5 :r(9)=7 :r(10)=10
For i=0 to 10 step 1
x(i)=r(i)
'Smith Chart (Y)
Circle (OX,OY),RR,color
Line (OX-RR,OY)-(OX+RR,OY),color
Circle(OX-RR*r(i)/(r(i)+1),OY),RR/(r(i)+1),color
10 OXarc=OX-RR :OYarc=OY+RR/x(i) :Rarc=RR/x(i) :Astart=pai/2-2*Atn(x(i)) :Aend=pai/2
Circle(OXarc,OYarc),Rarc,color,Astart,Aend
OXarc=OX-RR :OYarc=OY-RR/x(i) :Rarc=RR/x(i) :Astart=pai*3/2 :Aend=pai*3/2+2*Atn(x(i))
Circle(OXarc,OYarc),Rarc,color,Astart,Aend
Next i
Astart=2*pai+(pai/2-2*Atn(x(i))) --->pai*5/2-2*Atn(x(i))でもOK
とすればよいだけの事ですが、例えば計算上マイナスになる角度 -30度(330度の事)から+60度まで円弧を描かせたい場合、現行では扇形になるので2*paiを加算します。(沢山そんな箇所があると大変)
ゲストさんに最初に教えて頂いたやり方をちょっと変更した下記のCodeでは例え角度がマイナスでも -30度(330度の事)から+60度まで円弧を描いてくれます。
直感的な角度の考え方( -30度は330度の事で扇形の為のマイナスではない)はこちらの方が判り易いですが現状Codeでは扇方を描いてしまいますし、下記Codeでは切替がないので塗りつぶさない扇形がダメです。
そこで「 Circle(x,y),radius,color,start,end,Aspect,f,color2 にしてcolor2に(-1)を新たに設けて、これで切替えてPie関数を使えば透明色に出来るとか？ (或いはfを-fにするとか)」
などと思ったのですが、そうすると仕様を変更する事になり既にソ－スコ－ドを書いている皆さんの迷惑になるし、やはり扇形になる場合は2*paiを加算するしかないのかなぁ～～と思っている次第です。
コード: 全て選択
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)
'呼び出し方法は以下のようになります（コンパイラがパラメータの並びを最適化します）
'Circle (x, y), radius [, color] [, start] [, end] [, aspect] [, f] [, color2]
Dim hDC As HANDLE
Dim hPen As HANDLE, hOldPen As HANDLE
Dim hBrush As HANDLE, hOldBrush As HANDLE
Dim tmp As Long
Dim rect As Rect
Dim start As POINTAPI, stop As POINTAPI
hPen=CreatePen(PS_SOLID,1,GetBasicColor(ColorCode))
If bFill Then
hBrush=CreateSolidBrush(GetBasicColor(BrushColor))
Else
hBrush=GetStockObject(NULL_BRUSH)
End If
hDC=GetDC(_PromptSys_hWnd)
SelectObject(hDC,hPen)
SelectObject(hDC,hBrush)
hOldPen=SelectObject(_PromptSys_hMemDC,hPen)
hOldBrush=SelectObject(_PromptSys_hMemDC,hBrush)
If Aspect=0 Then Aspect=1
If Aspect<1 Then
tmp=radius*Aspect
With rect
.left=x-radius
.top=y-tmp
.right=x+radius
.bottom=y+tmp
End With
Else
tmp=radius/Aspect
With rect
.left=x-tmp
.top=y-radius
.right=x+tmp
.bottom=y+radius
End With
End If
If StartPos=0 And EndPos=2*_System_PI Then
EndPos=0 'EndPos=0とする事で半径線出ない
End If
start.x=x+radius*Cos(StartPos)
start.y=y-radius*Sin(StartPos)
stop.x=x+radius*Cos(EndPos)
stop.y=y-radius*Sin(EndPos)
If StartPos=0 And EndPos=0 Then
If bFill Then
Ellipse(hDC, rect.left, rect.top, rect.right, rect.bottom)
Ellipse(_PromptSys_hMemDC, rect.left, rect.top, rect.right, rect.bottom)
Else
Arc(hDC, rect.left, rect.top, rect.right, rect.bottom, start.x, start.y, stop.x, stop.y)
Arc(_PromptSys_hMemDC, rect.left, rect.top, rect.right, rect.bottom, start.x, start.y, stop.x, stop.y)
End If
Else If bFill Then
Pie(hDC, rect.left, rect.top, rect.right, rect.bottom, start.x, start.y, stop.x, stop.y)
Pie(_PromptSys_hMemDC, rect.left, rect.top, rect.right, rect.bottom, start.x, start.y, stop.x, stop.y)
Else
Arc(hDC, rect.left, rect.top, rect.right, rect.bottom, start.x, start.y, stop.x, stop.y)
Arc(_PromptSys_hMemDC, rect.left, rect.top, rect.right, rect.bottom, start.x, start.y, stop.x, stop.y)
End If
ReleaseDC(_PromptSys_hWnd,hDC)
SelectObject(_PromptSys_hMemDC,hOldPen)
SelectObject(_PromptSys_hMemDC,hOldBrush)
DeleteObject(hPen)
If bFill Then DeleteObject(hBrush)
End Macro
-
ゲスト
現行のCircle命令語の仕様は、
start
円描画の開始位置を指定します。
範囲（-2π <= start <=2π）
end
円描画の終始位置を指定します。
範囲（-2π <= end <=2π）
となっており、-2πラジアンまでの角度を認めています。
にもかかわらず、
「startとendパラメータにマイナス符号をつけて指定することで、扇形を描画することができます（塗りつぶし可能）」
というようにマイナス符号にもう一つの機能を割り付けているので、上のアドミタンス・チャ－ト例のように計算上マイナス・ラジアン値（これは仕様上認められているし、計算上マイナスになる頻度は高い）になった場合に円弧を期待しているのに角度も合わない扇形を描画してしまいます。
この仕様は矛盾しているのではないでしょうか？
このチャ－トの例は結果が直にグラフとして出るので判り易いですが、結果まで色々な処理が間に入っているとチェックが大変ですし、数が多いともう気が重くなります。
やはりstartとendは本来の角度指定だけにして、扇形（この場合は塗りつぶさない扇形）は別のパラメ－タでやった方が良いと思います。
で、prompt.sbpのCIRCLEを以下Codeのようにcolor2をマイナス１（-1）指定にしてみたら一応Circleパラメ－タで指定するであろう次の種類は全部描画しています。
NULL_BRUSHの意味は判りませんが、-1では透明（塗りつぶし無し）、0～7ではその色を、これ以外は黒色の扇形描画ができます。
計算上マイナスのラジアン値が出ても、-30度から60度というように期待通りに描いてくれます。
これ使えませんか？
（まぁ～、初心者がやったので抜けが有るかもしれません、皆さんでチェックしてください。又もっと良いCodeが有るかもしれません）
追加した中でIf文で角度判定（360度 to 0度、-360度 to 0度、0度 to -360度）をやっていますが、これは反時計回りに描画する事からの私の考え方です。もしこれも 0度 to 0度（下記の(1),(2),(3)と同じ事）の描画と同じにすべきだという場合は、StartPosとEndPosをゼロにしてください。
<Circleの種類>
(1)円描画 Circle(x,y),radius,color
(2)楕円描画 Circle(x,y),radius,color,,,Aspect
(3)円・楕円の塗りつぶし Circle(x,y),radius,color,,,Aspect,f,color2
color2にマイナス１（-1）を入れると(1)や(2)と同じ描画をしますが、わざわざ(3)の指定をする必要もないので問題無しと思います。
(4)円弧描画(円・楕円) Circle(x,y),radius,color,start,end,Aspect
(5)扇形描画(円・楕円) Circle(x,y),radius,color,start,end,Aspect,f,color2(=-1)
color2にマイナス１（-1）を指定すると塗りつぶさない扇形描画をします。
(6)扇形の塗りつぶし Circle(x,y),radius,color,start,end,Aspect,f,color2
color2にカラ－コ－ド（0～7）を指定するとその色で塗りつぶした扇形描画をします。
start
円描画の開始位置を指定します。
範囲（-2π <= start <=2π）
end
円描画の終始位置を指定します。
範囲（-2π <= end <=2π）
となっており、-2πラジアンまでの角度を認めています。
にもかかわらず、
「startとendパラメータにマイナス符号をつけて指定することで、扇形を描画することができます（塗りつぶし可能）」
というようにマイナス符号にもう一つの機能を割り付けているので、上のアドミタンス・チャ－ト例のように計算上マイナス・ラジアン値（これは仕様上認められているし、計算上マイナスになる頻度は高い）になった場合に円弧を期待しているのに角度も合わない扇形を描画してしまいます。
この仕様は矛盾しているのではないでしょうか？
このチャ－トの例は結果が直にグラフとして出るので判り易いですが、結果まで色々な処理が間に入っているとチェックが大変ですし、数が多いともう気が重くなります。
やはりstartとendは本来の角度指定だけにして、扇形（この場合は塗りつぶさない扇形）は別のパラメ－タでやった方が良いと思います。
で、prompt.sbpのCIRCLEを以下Codeのようにcolor2をマイナス１（-1）指定にしてみたら一応Circleパラメ－タで指定するであろう次の種類は全部描画しています。
NULL_BRUSHの意味は判りませんが、-1では透明（塗りつぶし無し）、0～7ではその色を、これ以外は黒色の扇形描画ができます。
計算上マイナスのラジアン値が出ても、-30度から60度というように期待通りに描いてくれます。
これ使えませんか？
（まぁ～、初心者がやったので抜けが有るかもしれません、皆さんでチェックしてください。又もっと良いCodeが有るかもしれません）
追加した中でIf文で角度判定（360度 to 0度、-360度 to 0度、0度 to -360度）をやっていますが、これは反時計回りに描画する事からの私の考え方です。もしこれも 0度 to 0度（下記の(1),(2),(3)と同じ事）の描画と同じにすべきだという場合は、StartPosとEndPosをゼロにしてください。
<Circleの種類>
(1)円描画 Circle(x,y),radius,color
(2)楕円描画 Circle(x,y),radius,color,,,Aspect
(3)円・楕円の塗りつぶし Circle(x,y),radius,color,,,Aspect,f,color2
color2にマイナス１（-1）を入れると(1)や(2)と同じ描画をしますが、わざわざ(3)の指定をする必要もないので問題無しと思います。
(4)円弧描画(円・楕円) Circle(x,y),radius,color,start,end,Aspect
(5)扇形描画(円・楕円) Circle(x,y),radius,color,start,end,Aspect,f,color2(=-1)
color2にマイナス１（-1）を指定すると塗りつぶさない扇形描画をします。
(6)扇形の塗りつぶし Circle(x,y),radius,color,start,end,Aspect,f,color2
color2にカラ－コ－ド（0～7）を指定するとその色で塗りつぶした扇形描画をします。
コード: 全て選択
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)
'呼び出し方法は以下のようになります（コンパイラがパラメータの並びを最適化します）
'Circle (x, y), radius [, color] [, start] [, end] [, aspect] [, f] [, color2]
Dim hDC As HANDLE
Dim hPen As HANDLE, hOldPen As HANDLE
Dim hBrush As HANDLE, hOldBrush As HANDLE
Dim tmp As Long
Dim rect As Rect
Dim start As POINTAPI, stop As POINTAPI
hPen=CreatePen(PS_SOLID,1,GetBasicColor(ColorCode))
If bFill Then
If BrushColor=-1 Then '追加
hBrush=GetStockObject(NULL_BRUSH) '追加
Else '追加
hBrush=CreateSolidBrush(GetBasicColor(BrushColor))
End If '追加
Else
hBrush=GetStockObject(NULL_BRUSH)
End If
hDC=GetDC(_PromptSys_hWnd)
SelectObject(hDC,hPen)
SelectObject(hDC,hBrush)
hOldPen=SelectObject(_PromptSys_hMemDC,hPen)
hOldBrush=SelectObject(_PromptSys_hMemDC,hBrush)
If Aspect=0 Then Aspect=1
If Aspect<1 Then
tmp=radius*Aspect
With rect
.left=x-radius
.top=y-tmp
.right=x+radius
.bottom=y+tmp
End With
Else
tmp=radius/Aspect
With rect
.left=x-tmp
.top=y-radius
.right=x+tmp
.bottom=y+radius
End With
End If
If StartPos=2*_System_PI And EndPos=0 Then '追加、半径線だけ描画する
StartPos=1E-7*(-_System_PI) '追加、少しだけ位置をずらす
Else If StartPos=-2*_System_PI And EndPos=0 Then '追加、半径線が出ないようにする
StartPos=0 '追加
Else If StartPos=0 And EndPos=2*_System_PI Then
EndPos=0 'EndPos=0とする事で半径線出ない
Else If StartPos=0 And EndPos=-2*_System_PI Then '追加、半径線だけ描画する
EndPos=1E-7*_System_PI '追加、少しだけ位置をずらす
End If
start.x=x+radius*Cos(StartPos)
start.y=y-radius*Sin(StartPos)
stop.x=x+radius*Cos(EndPos)
stop.y=y-radius*Sin(EndPos)
If StartPos=0 And EndPos=0 Then
If bFill Then
Ellipse(hDC, rect.left, rect.top, rect.right, rect.bottom)
Ellipse(_PromptSys_hMemDC, rect.left, rect.top, rect.right, rect.bottom)
Else
Arc(hDC, rect.left, rect.top, rect.right, rect.bottom, start.x, start.y, stop.x, stop.y)
Arc(_PromptSys_hMemDC, rect.left, rect.top, rect.right, rect.bottom, start.x, start.y, stop.x, stop.y)
End If
Else If bFill Then
Pie(hDC, rect.left, rect.top, rect.right, rect.bottom, start.x, start.y, stop.x, stop.y)
Pie(_PromptSys_hMemDC, rect.left, rect.top, rect.right, rect.bottom, start.x, start.y, stop.x, stop.y)
Else
Arc(hDC, rect.left, rect.top, rect.right, rect.bottom, start.x, start.y, stop.x, stop.y)
Arc(_PromptSys_hMemDC, rect.left, rect.top, rect.right, rect.bottom, start.x, start.y, stop.x, stop.y)
End If
ReleaseDC(_PromptSys_hWnd,hDC)
SelectObject(_PromptSys_hMemDC,hOldPen)
SelectObject(_PromptSys_hMemDC,hOldBrush)
DeleteObject(hPen)
If bFill Then DeleteObject(hBrush)
End Macro