ab.com コミュニティ

そんな簡単なことだったとは思いませんでした。
ありがとうございました。

#N88BASIC
Const Rad(N)=N*_System_PI/180
Dim A As Long
Dim X As Double,Y As Double

For A=0 To 500 
X=A/50*Cos(Rad(A)) 
Y=A/50*Sin(Rad(A)) 
PSet (X+200,Y+200),7 
Next A 

#N88BASIC
Const Rad(N)=N*_System_PI/180
Const Per=50
Dim A As Long
Dim X As Long,Y As Long
Dim wX As Long,wY As Long
Dim mX=-1 As Long,mY=-1 As Long
Dim Win As RECT
Dim lR As Double,lG As Double,lB As Double,R As Long,G As Long,B As Long
GetClientRect(_PromptSys_hWnd,Win)
wX=Fix(Win.right/2)
wY=Fix(Win.bottom/2)
A=0
PSet(wX,wY)
Do
	X=(A/Per*Cos(Rad(A))) As Long
	Y=(A/Per*Sin(Rad(A))) As Long
	HSV2RGB(lR,lG,lB,A,1,1)
	R=Int(lR*255)
	G=Int(lG*255)
	B=Int(lB*255)
	IF mX<>X or mY<>Y then
		FullColorLine(&H80000000,&H80000000,0,X+wX,Y+wY,RGB(R,G,B))
	End If
	A++
	Sleep(1)
	If Y+wY<0 then Exit Do
	If X+wX<0 then Exit Do
	If Y-wY>0 then Exit Do
	If X-wX>0 then Exit Do
	mX=X
	mY=Y
Loop
Sleep(-1)
Sub FullColorLine(sx As Long, sy As Long, bStep As Long, ex As Long, ey As Long)(ColorCode As Long, fType As Long, BrushColor As Long)
	Dim temp As Long

	If sx=&H80000000 And sy=&H80000000 Then
		sx=_PromptSys_GlobalPos.x
		sy=_PromptSys_GlobalPos.y
	End If

	If bStep Then
		ex=sx+ex
		ey=sy+ey
	Else
		If fType Then
			If sx>ex Then
				temp=ex
				ex=sx
				sx=temp
			End If
			If sy>ey Then
				temp=ey
				ey=sy
				sy=temp
			End If
		End If
	End If

	Dim hDC As HDC
	Dim hPen As HPEN, hOldPen As VoidPtr
	Dim hBrush As HBRUSH, hOldBrush As VoidPtr

	hDC=GetDC(_PromptSys_hWnd)
	hPen=CreatePen(PS_SOLID,1,ColorCode)
	If fType=2 Then
		hBrush=CreateSolidBrush(BrushColor)
	Else
		hBrush=GetStockObject(NULL_BRUSH)
	End If

	SelectObject(hDC,hPen)
	SelectObject(hDC,hBrush)
	hOldPen=SelectObject(_PromptSys_hMemDC,hPen)
	hOldBrush=SelectObject(_PromptSys_hMemDC,hBrush)

	Select Case fType
		Case 0
			MoveToEx(_PromptSys_hMemDC,sx,sy,ByVal NULL)
			LineTo(_PromptSys_hMemDC,ex,ey)
			SetPixel(_PromptSys_hMemDC,ex,ey,ColorCode)
			MoveToEx(hDC,sx,sy,ByVal NULL)
			LineTo(hDC,ex,ey)
			SetPixel(hDC,ex,ey,ColorCode)
		Case Else
			Rectangle(hDC,sx,sy,ex+1,ey+1)
			Rectangle(_PromptSys_hMemDC,sx,sy,ex+1,ey+1)
	End Select

	ReleaseDC(_PromptSys_hWnd,hDC)
	SelectObject(_PromptSys_hMemDC,hOldPen)
	SelectObject(_PromptSys_hMemDC,hOldBrush)
	DeleteObject(hPen)
	If fType=2 Then DeleteObject(hBrush)

	_PromptSys_GlobalPos.x=ex
	_PromptSys_GlobalPos.y=ey
End Sub

Sub HSV2RGB(ByRef r As Double,ByRef g As Double,ByRef b As Double,h As Double,s As Double,v As Double)
	Dim i As Long,f As Double,p1 As Double,p2 As Double,p3 As Double
	r=0
	g=0
	b=0
	if s<0 then s=0
	if s>1 then s=1
	if v<0 then v=0
	if v>1 then v=1
	h=h Mod 360
	if h<0 then h=h+360
	h=h/60
	i=Fix(h)
	f=h-i
	p1=v*(1-s)
	p2=v*(1-s*f)
	p3=v*(1-s*(1-f))
	if i=0 then r=v:g=p3:b=p1
	if i=1 then r=p2:g=v:b=p1
	if i=2 then r=p1:g=v:b=p3
	if i=3 then r=p1:g=p2:b=v
	if i=4 then r=p3:g=p1:b=v
	if i=5 then r=v:g=p1:b=p2
End Sub

[code]
#N88BASIC
Const Rad(N)=N*_System_PI/180
Dim A As Long
Dim X As Double,Y As Double

For A=0 To 500
X=A/50*Cos(Rad(A))
Y=A/50*Sin(Rad(A))
PSet (X+200,Y+200),7
Next A
[/code]
としてみてください。動くはずです。

[hide=おまけ][code]#N88BASIC
Const Rad(N)=N*_System_PI/180
Const Per=50
Dim A As Long
Dim X As Long,Y As Long
Dim wX As Long,wY As Long
Dim mX=-1 As Long,mY=-1 As Long
Dim Win As RECT
Dim lR As Double,lG As Double,lB As Double,R As Long,G As Long,B As Long
GetClientRect(_PromptSys_hWnd,Win)
wX=Fix(Win.right/2)
wY=Fix(Win.bottom/2)
A=0
PSet(wX,wY)
Do
X=(A/Per*Cos(Rad(A))) As Long
Y=(A/Per*Sin(Rad(A))) As Long
HSV2RGB(lR,lG,lB,A,1,1)
R=Int(lR*255)
G=Int(lG*255)
B=Int(lB*255)
IF mX<>X or mY<>Y then
FullColorLine(&H80000000,&H80000000,0,X+wX,Y+wY,RGB(R,G,B))
End If
A++
Sleep(1)
If Y+wY<0 then Exit Do
If X+wX<0 then Exit Do
If Y-wY>0 then Exit Do
If X-wX>0 then Exit Do
mX=X
mY=Y
Loop
Sleep(-1)
Sub FullColorLine(sx As Long, sy As Long, bStep As Long, ex As Long, ey As Long)(ColorCode As Long, fType As Long, BrushColor As Long)
Dim temp As Long

If sx=&H80000000 And sy=&H80000000 Then
sx=_PromptSys_GlobalPos.x
sy=_PromptSys_GlobalPos.y
End If

If bStep Then
ex=sx+ex
ey=sy+ey
Else
If fType Then
If sx>ex Then
temp=ex
ex=sx
sx=temp
End If
If sy>ey Then
temp=ey
ey=sy
sy=temp
End If
End If
End If

Dim hDC As HDC
Dim hPen As HPEN, hOldPen As VoidPtr
Dim hBrush As HBRUSH, hOldBrush As VoidPtr

hDC=GetDC(_PromptSys_hWnd)
hPen=CreatePen(PS_SOLID,1,ColorCode)
If fType=2 Then
hBrush=CreateSolidBrush(BrushColor)
Else
hBrush=GetStockObject(NULL_BRUSH)
End If

SelectObject(hDC,hPen)
SelectObject(hDC,hBrush)
hOldPen=SelectObject(_PromptSys_hMemDC,hPen)
hOldBrush=SelectObject(_PromptSys_hMemDC,hBrush)

Select Case fType
Case 0
MoveToEx(_PromptSys_hMemDC,sx,sy,ByVal NULL)
LineTo(_PromptSys_hMemDC,ex,ey)
SetPixel(_PromptSys_hMemDC,ex,ey,ColorCode)
MoveToEx(hDC,sx,sy,ByVal NULL)
LineTo(hDC,ex,ey)
SetPixel(hDC,ex,ey,ColorCode)
Case Else
Rectangle(hDC,sx,sy,ex+1,ey+1)
Rectangle(_PromptSys_hMemDC,sx,sy,ex+1,ey+1)
End Select

ReleaseDC(_PromptSys_hWnd,hDC)
SelectObject(_PromptSys_hMemDC,hOldPen)
SelectObject(_PromptSys_hMemDC,hOldBrush)
DeleteObject(hPen)
If fType=2 Then DeleteObject(hBrush)

_PromptSys_GlobalPos.x=ex
_PromptSys_GlobalPos.y=ey
End Sub

Sub HSV2RGB(ByRef r As Double,ByRef g As Double,ByRef b As Double,h As Double,s As Double,v As Double)
Dim i As Long,f As Double,p1 As Double,p2 As Double,p3 As Double
r=0
g=0
b=0
if s<0 then s=0
if s>1 then s=1
if v<0 then v=0
if v>1 then v=1
h=h Mod 360
if h<0 then h=h+360
h=h/60
i=Fix(h)
f=h-i
p1=v*(1-s)
p2=v*(1-s*f)
p3=v*(1-s*(1-f))
if i=0 then r=v:g=p3:b=p1
if i=1 then r=p2:g=v:b=p1
if i=2 then r=p1:g=v:b=p3
if i=3 then r=p1:g=p2:b=v
if i=4 then r=p3:g=p1:b=v
if i=5 then r=v:g=p1:b=p2
End Sub[/code][/hide]

変数名、関数名は大文字と小文字を区別する必要があります。

> "cos(A*3.14/180)" 無効な識別子です
> "sin(A*3.14/180)" 無効な識別子です
今実行できる環境に無いので適正な回答なのか分からないのですけど、最初の一文字を大文字にしてみてください。

> sin,cosは使えないのでしょうか？
ヘルプにSin関数とCos関数が載っていると思います。

学校でF-BASICを習っていて家でもBasicをやってみようとActiveBasicのN88BASICにたどり着きました。

for A=0 to 500
X=A/50*cos(A*3.14/180)
Y=A/50*sin(A*3.14/180)
pset (X+200,Y+200),7
next A

と言うのを教わってやって見たのですが

"cos(A*3.14/180)" 無効な識別子です
"sin(A*3.14/180)" 無効な識別子です

と出てしまいます。
sin,cosは使えないのでしょうか？