ボードレコーダー

 投稿者：しばっち  投稿日：2018年12月22日(土)19時59分31秒
  これはグラフィック画面にマウスで文字や絵を書いてそれを記録するツールです。
実行すると、画像ファイルダイアログを開きます。これは下絵として読み込むものです。

ぜひ、人物画を読み込んで思う存分「落書き」してください。
但し、大きな画像を読み込むと処理が重くなります。また、当然ファイルサイズも大きくなります。

下絵が必要ない場合はキャンセルしてください。バックは白となります。
マウスの左ボタンを押したままでグラフィック画面上を移動させてください。
8ドット以上動かすと記録し、左ボタンを離すと記録をやめます。

初期値は
  ペンの太さ:10
  色:1(黒)
スライドバーで調整してください。

右クリックまたはスペースキーで描画を終了し、簡易再生してプログラムを終了します。
'-'キーまたは'+'キーで画像間を移動します。
表示画像が最後の画像として、'-'キーで戻した場合はそれ以降の画像ファイルを削除します。
保存された画像はgifアニメ等のコマとしてご利用ください。

このプログラムは下記の「ScreenToGif」のBoard Recoderツールを模倣したものです。
https://github.com/NickeManarin/ScreenToGif/releases


私も「文字」を書いてみました。
http://www.geocities.jp/ekakisong/list_all.htm


OPTION ARITHMETIC NATIVE
FILE GETOPENNAME F$,"BMP,JPG,GIF,PNGファイル|*.BMP;*.JPG;*.GIF;*.PNG"
IF F$<>"" THEN GLOAD F$ !'下絵の読み込み
ASK BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE,YSIZE,0
ASK DIRECTORY PATH$ !'保存パス
LET EXT$=".png"     !'保存形式
LOCATE VALUE NOWAIT(1),RANGE 1 TO 50,AT 10: WID
LOCATE VALUE NOWAIT(2),RANGE 0 TO 255,AT 1: COL
DO
   DO
      LOCATE VALUE NOWAIT(1): WID !'太さ
      LOCATE VALUE NOWAIT(2): COL !'色
      MOUSE POLL X,Y,LEFT,RIGHT
      IF GETKEYSTATE(27)<0 THEN STOP !'ESC
      IF GETKEYSTATE(32)<0 OR RIGHT=1 THEN !'スペースキー又は右クリック
         IF KMAX=0 THEN
            PRINT "画像ファイルがありません"
            STOP
         END IF
         IF KKMAX>KMAX THEN !'表示画像以降の画像は削除
            FOR I=KMAX+1 TO KKMAX
               PRINT "削除中:";PATH$;"\image";USING$("%%%%%",I);EXT$
               FILE DELETE PATH$ & "\image" & USING$("%%%%%",I) & EXT$
            NEXT I
         END IF
         CALL PLAY
         STOP    !'ここでプログラム終了
      END IF
      IF GETKEYSTATE(107)<0 OR GETKEYSTATE(187)<0 THEN !' "+"キー
         LET T=TIME
         DO
         LOOP WHILE (GETKEYSTATE(107)<0 OR GETKEYSTATE(187)<0) AND TIME-T<.2  !' 0.2秒以上でキーリピート
         IF K<=KKMAX-1 THEN
            LET K=K+1
            CALL LOAD
         END IF
      END IF
      IF GETKEYSTATE(109)<0 OR GETKEYSTATE(189)<0 THEN !' "-"キー
         LET T=TIME
         DO
         LOOP WHILE (GETKEYSTATE(109)<0 OR GETKEYSTATE(189)<0) AND TIME-T<.2
         IF K>0 THEN
            LET K=K-1
            CALL LOAD
         END IF
      END IF
   LOOP UNTIL LEFT=1
   LET XX=-1
   LET YY=-1
   LET WID=INT(WID)
   LET COL=INT(COL)
   SET LINE WIDTH WID
   SET LINE COLOR COL
   DO
      MOUSE POLL X,Y,LEFT,RIGHT
      IF (XX<>X OR YY<>Y) AND SQR((X-XX)^2+(Y-YY)^2)>8 THEN !'8ドット以上動かした時にライン描画
         PLOT LINES:X,Y;
         IF XX<>-1 OR YY<>-1 THEN !'始点でないなら保存する
            LET K=K+1
            GSAVE PATH$ & "\image" & USING$("%%%%%",K) & EXT$  !'コマの保存
            LET KMAX=K
            LET KKMAX=MAX(KKMAX,KMAX)
            PRINT "保存中: ";PATH$;"\image";USING$("%%%%%",K);EXT$;"/";KKMAX
         END IF
         LET XX=X
         LET YY=Y
      END IF
   LOOP WHILE LEFT=1
   PLOT LINES
LOOP

SUB PLAY !'簡易再生
   LET ID$=CONFIRM$("再生しますか?")
   IF ID$="YES" THEN
      FOR K=1 TO KMAX
         IF GETKEYSTATE(32)<0 OR GETKEYSTATE(27)<0 THEN EXIT FOR
         CALL LOAD
         SET DRAW MODE EXPLICIT
         WAIT DELAY .1
         SET DRAW MODE HIDDEN
      NEXT K
   END IF
END SUB

SUB LOAD
   GLOAD PATH$ & "\image" & USING$("%%%%%",K) & EXT$
   PRINT "Load ";PATH$;"\image";USING$("%%%%%",K);EXT$;"/";KKMAX
END SUB
END
 

戻る