by ゲスト » 2006年5月19日(金) 13:11
ありがとうございます。初心者なので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
コード: 全て選択
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
ありがとうございます。初心者なので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]
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[/code]