FreeBASIC マニュアルのトップに戻る

FreeBASIC PSet

目次→描画ライブラリ参考→2次元 描画関数PSet←オリジナル・サイト

PSet 左にメニュー・フレームが表示されていない場合は、ここをクリックして下さい

←リンク元に戻る プログラム開発関連に戻る

1画素をプロットします。

構文:
PSet [target ,] [STEP] (x, y) [,color]

パラメタ:
target (目標)
描画するためのバッファを指定します。
STEP (ステップ)
開始座標が、相対的であることを示します。
(x, y)
画素の座標。
color (色)
カラー属性。

解説:

target (目標) は、描画するためのバッファを指定します。
target (目標) は、ImageCreateGet (描画) で作られた画像でもかまいません。
省略すると、現在の画面の、作業中のページが、デフォルト選択されます。

(x, y) は画素の座標です。
STEP を付けると、(x, y) 座標は、グラフィックス・カーソル位置からの相対位置になります。
STEP を省略すると、(x, y)は、target(目標)の左上の角からの相対位置になります。
x、y 座標は、View (描画)WINDOW 命令文 の最後の呼び出しに、影響されます。 そして、View (描画)命令文によって設定される、現在の切り取り領域に、従います。

color (色)は、カラー属性を指定します。
8bpp 索引モードでは、8ビットのパレット索引が使われます。16bppモードでは 24ビットの RGB 値が使われます(整数の8ビットより上位は使われず、R、G、B の精度は限定されます)。そして、32bppモードでは 32ビットの RGB か RGBA 値が使われます(8ビットより上位は未使用か、アルファーを保持します)。
16ビットの値(5ビットR + 6ビットG + 5ビットB)を受け入れないことに、注意してください。
省略すると、color(色)は、現在の前景色が使われます。
Color(色)を参考してください。
color(色) は、グラフィックスモード特有です。詳細は、ColorScreen (描画) を参考下さい。

最適化注意: Pset は、妥当な結果を提供しますが、追加計算とチェックのオーバーヘッドのため、繰り返し呼ぶ場合に、まったく遅くなります。
ImageinfoScreeninfo/ScreenPtr から得られた結果を使って、直接メモリにアクセスすると、はるかに良い性能を達成できます。

例:
'適切な Screen mode を設定します。- 320 x 240 x 8bpp 索引カラー
ScreenRes 320, 240, 8

'座標100、100、白色(Color 15)で、画素をプロットします。
PSet (100, 100), 15
'操作を確認してください。
Locate 1: Print "Pixel plotted at 100, 100"
'キー入力を待ちます。
Sleep

'座標150、150、赤色(Color4)で別の画素をプロットします。
PSet (150, 150), 4
'操作を確認してください。
Locate 1: Print "Pixel plotted at 150, 150"
'キー入力を待ちます。
Sleep

'2 番目の点を基準にして、3 番目の画素を、白色(Color15)でプロットします。
'この画素は、座標60、60が、あたえられています。
'それは前の座標(150、150)に、60、60 を加えた位置、つまり、210、210にプロットされます。
PSet Step (60, 60), 15
'操作を確認してください。
Locate 1: Print "Pixel plotted at 150 + 60, 150 + 60"
'キー入力を待ちます。
Sleep

'プログラムを終了します。
End
 渡辺注:プロットする点が小さいので、表示をよく見てくださいね。
Screen mode の設定は、下記でもOKです。
Screen 14


TBから移植したフラクタル

 下は、「Tiny Basic による Basic 入門」
http://www2.cc.niigata-u.ac.jp/~takeuchi/tbasic/TBIntro/tbasic.html
で紹介されている、フラクタルを描くプログラムの例です。
小変更で、FBで動きました。ご参考まで。


'$lang: "qb"                   'TB用のコードに追加
Screen 14                      '追加

'BackColor = "Black"           'コメント・アウト
'Open GScreen(400,400)         'コメント・アウト
'MathGraph On                  'コメント・アウト

KL=100 :KS=400 :RR=400/2.7
RSt=-2.2 :REd=0.5 :ISt=-1.35 :IEd=1.35 
Window (RSt,-IEd)-(REd,-ISt)
DR=(REd-RSt)/KS :DI=(IEd-ISt)/KS
For CR=RSt to REd step DR
  For CI=ISt to IEd step DI
  ZR=0 :ZI=0
    For K=1 to 100 
      R=ZR*ZR-ZI*ZI+CR
      I=2*ZR*ZI+CI
      If (R*R+I*I)>4 then
        C=7+K mod 16
        PSet (CR,CI),C
        Exit for
      End if
      ZR=R :ZI=I
    Next K
  Next CI
Next CR

Sleep                          '追加
End

 下は、ab.com の、コミュニティ フォーラム の、「プログラミング質問板」に掲載されていた、N88BASICのプログラムの例です。
http://www.activebasic.com/forum/viewtopic.php?t=2399

ヒルベルト曲線

'$lang: "qb"

 ' --------------------------
 ' *     ヒルベルト曲線     * 
 ' --------------------------
 '
 DIM STACK(1000)
 Dim N As Integer
 Dim L As Integer
 Dim ANGLE As Integer
 Dim ZDEG As Integer
 Dim ZLENG As Integer
 Dim ZX As Integer
 Dim ZY As Integer
 Dim ZP As Integer
 Dim SP As Integer
 
 SP=0
 '
 SCREEN 12
'  SCREEN 3,0,0,1:CLS 3
 'POINT(240,280)
  Pset(240,280)
 N=4:L=10:ANGLE=90: GOSUB HILBERT
 Sleep
 END
 HILBERT:
   IF N=0 THEN RETURN
   ZDEG=ANGLE:GOSUB TURN
   GOSUB PUSH
   N=N-1:ANGLE=-ANGLE:GOSUB HILBERT
   GOSUB POP
   ZLENG=L:GOSUB MOVE
   ZDEG=-ANGLE:GOSUB TURN
   GOSUB PUSH
   N=N-1:GOSUB HILBERT
   GOSUB POP
   ZLENG=L:GOSUB MOVE
   GOSUB PUSH
   N=N-1:GOSUB HILBERT
   GOSUB POP
   ZDEG=-ANGLE:GOSUB TURN
   ZLENG=L:GOSUB MOVE
   GOSUB PUSH
   N=N-1:ANGLE=-ANGLE:GOSUB HILBERT
   GOSUB POP
   ZDEG=ANGLE:GOSUB TURN
 Return
 
 PUSH:
   STACK(SP)=N:STACK(SP+1)=ANGLE:SP=SP+2
 Return
 
 POP:
   ANGLE=STACK(SP-1):N=STACK(SP-2):SP=SP-2
 Return
 
 MOVE:
   ZX=ZLENG*COS(ZP*3.14159/180)
   ZY=ZLENG*SIN(ZP*3.14159/180)
   LINE -STEP(ZX,-ZY),15
 Return
 
 TURN:
   ZP=(ZP+ZDEG) MOD 360
 Return

 下は、モンテカルロ法による、円周率の推定です。
 わずか一秒で、百万個の点をプロットできるのは、コンパイラーの威力ですね。
モンテカルロ法による、円周率の推定

'$lang: "qb"

10 DIM CL,NAKA,X1,Y1,I,SOTO AS LONG
20 DIM X,Y,PAI AS Single

30 Screen 12
35 View Print 16 To 30
40 Randomize ()
100 CLS 3
110 LOCATE 11,0
120 COLOR 4
130 print "Start" , Time$,"Calculate 'pi' by using the Monte Carlo method. "
134 t0=Val(left$(Time$,2))*3600+Val(mid$(Time$,4,2))*60+Val(Right$(Time$,2))

140 LINE (100,30)-(300,230),7,B
150 X=Rnd(1)
160 Y=Rnd(1)
170 IF X*X+Y*Y<1 THEN 
171 CL=2 
172 NAKA=NAKA+1 
175  ELSE 
176  CL=7 
177  SOTO=SOTO+1
178 END IF 
180 X1=Int(X*200+0.5)
190 Y1=Int(Y*200+0.5)
200 PSET (X1+100,230-Y1),CL
202 I=I+1 
203 PAI=NAKA/(NAKA+SOTO)*4 
205 If (I mod 100000)=0 then Locate 10,16: PRINT I,PAI
206 IF I<1000000 THEN 
210 GOTO 150
220 ELSE
240 END IF
241 print "End" , Time$
242 t1=Val(left$(Time$,2))*3600+Val(mid$(Time$,4,2))*60+Val(Right$(Time$,2))
244 print using"Time Required=### Seconds";t1-t0
245 Print "Please type any key. "

250 Sleep
260 END

火の鳥  「三平武男の頁」で紹介されている「数式絵」です。
http://homepage3.nifty.com/4amigos/gallerym/
F-BASIC のコードを微修正しただけで、使えました。

'$lang: "qb"
Screen 17

For x=0 To 130 Step 1.2:
For r=-10 To 110 Step 1.2
x2=r*Sin(0.04*x*3)
y2=r*Cos(0.035*x*2)*2
c=r/15+2
PSet(4*x+x2+40,220-y2/100*x),c
Next:Next
Locate 7,2:Print"Firebird":
Locate 65,21:Print"T.Mihira":
Locate 65,22:Print"Dec/2009":d$=Input$(1)

frac3FB  以下は、QB64 http://www.qb64.net/
サンプル・フォルダにあるプログラムを、FreeBASIC 用に微修正したものです。
QB64\programs\samples\misc\frac3.bas
'$lang: "qb"

Screen 12
WINDOW (-5, 0)-(5, 10)
RANDOMIZE TIMER
COLOR 10
DO
  SELECT CASE RND
    CASE IS < .01
      X = 0
      Y = .16 * Y
    CASE .01 TO .08
      X = .2 * X - .26 * Y
      Y = .23 * X + .22 * Y + 1.6
    CASE .08 TO .15
      X = -.15 * X + .28 * Y
      Y = .26 * X + .24 * Y + .44
    CASE ELSE
      X = .85 * X + .04 * Y
      Y = -.04 * X + .85 * Y + 1.6
  END SELECT
  PSET (X, Y)
LOOP UNTIL INKEY$ = CHR$(27)

sinecubeFB  以下は、QB64 http://www.qb64.net/
サンプル・フォルダにあるプログラムを、FreeBASIC 用に微修正したものです。
QB64\programs\samples\misc\sinecube.bas
'sinecube 2006 mennonite
'public domain

'$lang: "qb"

DIM blox(40, 40, 40) AS INTEGER

Screen 12: LINE (0, 0)-(639, 479), , B

l = 8

B$ = B$ + "00000000..."
B$ = B$ + "llnnnnnnl.."
B$ = B$ + "l8lnnnnnnl."
B$ = B$ + "l88llllllll"
B$ = B$ + "l88l000000l"
B$ = B$ + "l88l000000l"
B$ = B$ + "l88l000000l"
B$ = B$ + "l88l000000l"
B$ = B$ + ".l8l000000l"
B$ = B$ + "..ll000000l"
B$ = B$ + "...llllllll"

blox(2, 3, 32) = 1

FOR l = 8 * 32 TO 1 STEP -8

   FOR y = 4 TO 4 * 32 STEP 4
      FOR x = 8 * 32 TO 1 STEP -8
      
         mm = SIN(x * y * l * 3.14): if mm<0 then mm=-1 else if mm>0 then mm=1
         IF blox(x / 8, y / 4, l / 8) = mm + 1 THEN
            FOR by = 1 TO 11
               FOR bx = 1 TO 11
                  IF right$(left$(b$,(by - 1) * 11 + bx),1) <> "." THEN
                     z = 11
                     PSET (x + bx - 1 + y - 3, by - 1 + y + l + 4), ASC(right$(left$(b$,(by - 1) * 11 + bx),1)) MOD 16 + (y MOD 2)
                  END IF
               
               NEXT bx
            NEXT by
         
         END IF
         IF INKEY$ = CHR$(27) THEN END
      
      NEXT x
   
      t = TIMER: DO: LOOP UNTIL t <> TIMER
   
   NEXT y

NEXT l

Sleep

QBとの違い:

参照:

2次元描画関数に戻る

←リンク元に戻る プログラム開発関連に戻る

ページ歴史:2011-08-08 04:10:31
日本語翻訳:WATANABE Makoto、原文著作者:SysOp

ホームページのトップに戻る

表示-非営利-継承