コード: 全て選択
#N88BASIC
Type CIRCLEDATA
Pattern As Long
ColorCode As Long
x As Long
y As Long
End Type
Dim Circles[ELM(10),ELM(500)] As CIRCLEDATA
Dim Count[ELM(10)]=[0,0,0,0,0,0,0,0,0,0] As Long
Sub PutData(Num As Long,Pattern As Long,ColorCode As Long,x As Long,y As Long)
With Circles[Num,Count[Num]]
.Pattern=Pattern
.ColorCode=ColorCode
.x=x
.y=y
End With
Count[Num]=Count[Num]+1
End Sub
Dim CCC1 As Long
Dim n1 As Long
Dim n1$ As String
Dim TASUHIKU As Long
Dim dxi As Single,dyi As Single
Dim dx As Long,dy As Long
Dim dxmoji As Long,dymoji As Long
Dim xp0 As Long
Dim DTDT$ As String
Dim CCC0 As Long
Dim NUMn1 As Long
Dim I As Long
Dim NUMn1$[16] As String
Dim NDTDT As Long
Dim DTN As Long
Dim ii As Long
Dim XX As Long
Dim DT$ As String
Dim DATFROM$ As String
Dim JUJU As Long
Dim nPEN[ELM(500)] As Long
Dim CCC[ELM(500)] As Long
Dim xp[ELM(500)] As Long
Dim yp[ELM(500)] As Long
Dim dig As Long
'データ設定
4500 PutData(1,6,1,64,39)
4510 PutData(1,6,1,64,38)
4520 PutData(1,6,1,68,37)
4530 PutData(1,6,1,69,36)
4540 PutData(1,6,1,71,34)
4550 PutData(1,6,1,73,32)
4560 PutData(1,6,1,75,31)
4570 PutData(1,6,1,77,29)
4580 PutData(1,6,1,77,28)
4590 PutData(1,6,1,80,27)
4600 PutData(1,6,1,81,26)
4610 PutData(1,6,1,81,27)
4620 PutData(1,6,1,81,36)
4630 PutData(1,6,1,81,38)
4640 PutData(1,6,1,80,40)
4650 PutData(1,6,1,79,48)
4660 PutData(1,6,1,80,50)
4670 PutData(1,6,1,80,52)
4680 PutData(1,6,1,79,53)
4690 PutData(1,6,1,79,61)
4700 PutData(1,6,1,79,63)
4710 PutData(1,6,1,80,65)
4720 PutData(1,6,1,79,66)
4730 PutData(1,6,1,78,74)
4740 PutData(1,6,1,79,76)
4750 PutData(1,6,1,79,78)
4760 PutData(1,6,1,78,81)
4770 PutData(1,6,1,77,84)
4780 PutData(1,6,1,77,87)
4790 PutData(1,6,1,77,89)
4800 PutData(1,6,1,77,91)
4810 PutData(1,6,1,77,93)
4820 PutData(1,6,1,77,97)
4830 PutData(1,6,1,77,99)
4840 PutData(1,6,1,77,101)
4850 PutData(1,6,1,77,104)
4860 PutData(1,6,1,77,106)
4870 PutData(1,6,1,76,108)
4880 PutData(1,6,1,76,111)
4890 PutData(1,6,1,77,114)
4900 PutData(1,6,1,77,116)
4910 PutData(1,6,1,77,118)
4920 PutData(1,6,1,77,119)
4930 PutData(1,6,1,77,120)
4940 PutData(1,6,1,77,123)
4950 PutData(1,6,1,77,126)
4960 PutData(1,6,1,77,127)
4970 PutData(1,6,1,77,129)
4980 PutData(1,0,0,0,0)
1000 '初期設定値
1010 CCC1=2
1020 n1=1
1030 n1$=Str$(n1)
1040 TASUHIKU=0 :dxi=1.5:dx=50 :dxmoji=80 :xp0=1 :dyi=1.5:dy=100 :dymoji=0
1050 GOSUB *HYOUJI1
1820 Sleep(INFINITE)
2180 *HYOUJI1'------------------------------------------------------入力された文字を分析します。
2190 DTDT$=""
2200 CCC0=CCC1
2210 NUMn1=Len(n1$)-1 'n1の桁数
2220 FOR I=0 TO NUMn1
2230 NUMn1$="S"+Mid$(n1$,I+1,1)
2240 DTDT$=DTDT$+NUMn1$
2250 NEXT
2260 GOSUB *MOJIWOKAKU
2270 RETURN
2280 '
2650 *MOJIWOKAKU'-----------------------------------------------------文字を書きます
2660 NDTDT=Len(DTDT$)
'2670 DTN=5000
'2700 DTN=NUM-1
2770 '////////////////////////////////////////////////////////
2850 FOR ii=1 TO NDTDT STEP 2
2860 XX=ii :DT$=Mid$(DTDT$,ii,2) :GOSUB *DATINP :GOSUB *W
2880 NEXT
2890 '////////////////////////////////////////////////////////
2900 RETURN
2910 '
2920 '
3050 *DATINP'---------------------------------------------DATA行の読み込み
2950 DTN=-1 '←Changed
2960 DATFROM$=DT$
3000 if DATFROM$="S1" then dig=1 '数字の「1」を読み込む
' if DATFROM$="S2" then dig=2 '数字の「2」を読み込む
' if DATFROM$="S3" then dig=3 '数字の「3」を読み込む
' if DATFROM$="S4" then dig=4 '数字の「4」を読み込む
' if DATFROM$="S5" then dig=5 '数字の「5」を読み込む
' if DATFROM$="S6" then dig=6 '数字の「6」を読み込む
' if DATFROM$="S7" then dig=7 '数字の「7」を読み込む
' if DATFROM$="S8" then dig=8 '数字の「8」を読み込む
' if DATFROM$="S9" then dig=9 '数字の「9」を読み込む
' if DATFROM$="S0" then dig=0 '数字の「0」を読み込む
3070 *kokoko
3080 for JUJU=1 to 500
3090 DTN=DTN+1
3100 'Read nPEN(DTN),ccc(DTN),xp(DTN),yp(DTN)
With Circles[dig,DTN]
nPEN[DTN]=.Pattern
CCC[DTN]=.ColorCode
xp[DTN]=.x
yp[DTN]=.y
End With
3180 if xp[DTN]=0 and yp[DTN]=0 then goto *edatinp
3190 xp[DTN]=xp[DTN]*dxi+dx+(ii-1)*dxmoji
3200 yp[DTN]=yp[DTN]*dyi+dy+(ii-1)*dymoji
3210 CCC[DTN]=CCC0
3230 next
3240 *edatinp
3250 return
3230 '
3240 '
3250 *W'////////////////////////////////////////////////////
3260 FOR I=0 TO DTN-1
3270 GOSUB *PENPEN
3290 NEXT
3300 RETURN
3310 '
3320 '
3330 *PENPEN'///////////////////////////////////////////////////
3340 Select Case nPEN
3350 Case 1
CIRCLE(xp,yp), 1*xp0,CCC,,,,F
3360 Case 2
CIRCLE(xp,yp), 2*xp0,CCC,,,,F
3370 Case 3
CIRCLE(xp,yp[I]), 4*xp0,CCC[I],,,,F
3380 Case 4
CIRCLE(xp[I],yp[I]), 6*xp0,CCC[I],,,,F
3390 Case 5
CIRCLE(xp[I],yp[I]), 8*xp0,CCC[I],,,,F
3400 Case 6
CIRCLE(xp[I],yp[I]),10*xp0,CCC[I],,,,F
3410 Case 7
CIRCLE(xp[I],yp[I]), 2*xp0,CCC[I]
3420 Case 8
CIRCLE(xp[I],yp[I]), 4*xp0,CCC[I]
3430 Case 9
CIRCLE(xp[I],yp[I]), 6*xp0,CCC[I]
3440 Case 10
CIRCLE(xp[I],yp[I]), 8*xp0,CCC[I]
3450 End Select
3460 RETURN