十進BASIC 第2掲示板 過去ログ

!BMPファイル（圧縮なし）画像の部分領域（切り出し）を表示する
!参考 http://www.kk.iij4u.or.jp/~kondo/bmp/

OPTION CHARACTER byte


LET CX1=0 !切り出す画像領域の左上座標（ピクセル単位）
LET CY1=0
LET CX2=640 !右下座標
LET CY2=480

SET COLOR mode "NATIVE"
SET bitmap SIZE CX2-CX1,CY2-CY1 !スクリーン座標へ
SET WINDOW 0,CX2-CX1-1,CY2-CY1-1,0 !画面を画像サイズへ
SET POINT STYLE 1 !ドット形式


LET BFile$=REPEAT$(CHR$(0),14) !Dim BFile As BITMAPFILEHEADER
LET BInfo$=REPEAT$(CHR$(0),40) !Dim BInfo As BITMAPINFOHEADER
LET BPalt$=REPEAT$(CHR$(0),4) !Dim BPalt As RGBQUAD


file getname f$,"BMPファイル|*.BMP" !ファイル名を得る
IF f$="" THEN STOP


OPEN #1: NAME f$, ACCESS INPUT
LET cp=0 !読み込み現在位置

!---------- ファイルヘッダ部
LET p=0 !読み込み位置
CALL fseek(p) !Get #1,0,BFile　※VisualBasic
CALL fread(BFile$,p)

IF BFile$(1:2)="MB" THEN !BFile.bfType
   PRINT "ＢＭＰファイルではありません。"
   STOP
END IF
LET bfOffBits=CVI(BFile$,10,4) !BFile.bfOffBits
PRINT "bfOffBits=";bfOffBits
PRINT


!---------- 情報ヘッダ部（Windows Bitmap）
CALL fread(BInfo$,p) !Get #1, ,BInfo

LET biWidth=CVI(BInfo$,4,4) !BInfo.biWidth
PRINT "biWidth=";biWidth
LET biHeight=CVI(BInfo$,8,4) !BInfo.biHeight
PRINT "biHeight=";biHeight
LET biBitCount=CVI(BInfo$,14,2) !BInfo.biBitCount
PRINT "biBitCount=";biBitCount
LET biCompression=CVI(BInfo$,16,4) !BInfo.biCompression
PRINT "biCompression=";biCompression
PRINT


!---------- 情報ヘッダ部（パレット部）
DIM PAL(0 TO 255,4)
IF biBitCount<=8 THEN
   FOR k=0 TO 2^biBitCount-1
      CALL fread(BPalt$,p) !Get #1, ,BPalt

      !!PRINT USING "### 番　": k;
      !!PRINT CVI2(BPalt$,0,1), !BPalt.rgbBlue　※符号なし
      !!PRINT CVI2(BPalt$,1,1), !BPalt.rgbGreen
      !!PRINT CVI2(BPalt$,2,1), !BPalt.rgbRed
      !!PRINT CVI2(BPalt$,3,1) !BPalt.rgbReserved

      LET PAL(k,3)=CVI2(BPalt$,0,1)/255 !BPalt.rgbBlue　※符号なし
      LET PAL(k,2)=CVI2(BPalt$,1,1)/255 !BPalt.rgbGreen
      LET PAL(k,1)=CVI2(BPalt$,2,1)/255 !BPalt.rgbRed
      LET PAL(k,4)=CVI2(BPalt$,3,1)/255 !BPalt.rgbReserved
   NEXT k
END IF
PRINT


IF biCompression<>0 THEN
   PRINT "圧縮形式は未サポートです。"
   STOP
END IF


!---------- 画像データ部
!SET DRAW mode hidden !ちらつき防止の開始

LET p=bfOffBits !ファイル内の画像データの先頭位置
CALL fseek(p)

LET L1=biWidth*biBitCount/8
LET L1b=(INT((L1-1)/4)+1)*4 !４バイト境界

FOR y=1 TO biHeight
   LET BData$=REPEAT$(CHR$(0),L1b) !１行分の画像データ
   CALL fread(BData$,p) !Get #1, ,BData

   IF y>=biHeight-CY2 AND y<=biHeight-CY1 THEN !切り出し領域内なら　※下から格納されている

      SELECT CASE biBitCount
      CASE 1 !2色

         FOR x=MAX(INT((CX1-1)/8),0) TO L1b-1 !１行分の画像データ（切り出し領域内左端から）

         !!PRINT "(";8/biBitCount*x+1;",";y;")",
            LET b=CVI2(BData$,x,1)
            !!!PRINT right$("0000000"&BSTR$(b,2),8)

            LET t$=right$("0000000"&BSTR$(b,2),8)
            LET bb=1
            DO UNTIL bb>8
               LET xx=x*8+bb-1
               IF xx>CX2 THEN EXIT FOR !切り出し領域内右端なら
               IF xx>=CX1 THEN
                  IF xx<=biWidth THEN
                     LET t=VAL(t$(bb:bb))
                     SET POINT COLOR colorindex(PAL(t,1),PAL(t,2),PAL(t,3))
                     PLOT POINTS: xx - CX1, biHeight-y - CY1 !※下から格納されている
                  END IF
               END IF
               LET bb=bb+1
            LOOP

         NEXT x

      CASE 4 !16色

         FOR x=MAX(INT((CX1-1)/2),0) TO L1b-1 !１行分の画像データ（切り出し領域内左端から）

         !!PRINT "(";8/biBitCount*x+1;",";y;")",
            LET b=CVI2(BData$,x,1)
            !!PRINT INT(b/16); !上4bit
            !!PRINT MOD(b,16) !下4bit

            LET xx=8/biBitCount*x+1

            IF xx>CX2 THEN EXIT FOR !切り出し領域内右端なら
            IF xx>=CX1 THEN
               IF xx<=biWidth THEN
                  LET t=INT(b/16) !上4bit
                  SET POINT COLOR colorindex(PAL(t,1),PAL(t,2),PAL(t,3))
                  PLOT POINTS: xx - CX1, biHeight-y - CY1 !※下から格納されている
               END IF
            END IF
            IF xx+1>CX2 THEN EXIT FOR !切り出し領域内なら
            IF xx+1>=CX1 THEN
               IF xx<=biWidth THEN
                  LET t=MOD(b,16) !下4bit
                  SET POINT COLOR colorindex(PAL(t,1),PAL(t,2),PAL(t,3))
                  PLOT POINTS: xx+1 - CX1, biHeight-y - CY1 !※下から格納されている
               END IF
            END IF

         NEXT x

      CASE ELSE !256色、24ビット色、32ビット色

         FOR x=MAX(CX1,1) TO MIN(CX2,biWidth) !切り出し領域内

            LET t=(x-1)*biBitCount/8

            !!PRINT "(";x;",";y;")",
            !!FOR k=0 TO biBitCount/8-1
            !!   PRINT CVI2(BData$,t+k,1); !BData　※符号なし
            !!NEXT k
            !!PRINT

            IF biBitCount=8 THEN !256色なら
               LET tt=CVI2(BData$,t+0,1)
               SET POINT COLOR colorindex(PAL(tt,1),PAL(tt,2),PAL(tt,3))
            ELSE
               LET bb=CVI2(BData$,t+0,1) !BData　※符号なし
               LET gg=CVI2(BData$,t+1,1)
               LET rr=CVI2(BData$,t+2,1)
               SET POINT COLOR colorindex(rr/255,gg/255,bb/255)
            END IF
            PLOT POINTS: x - CX1, biHeight-y - CY1 !※下から格納されている

         NEXT x

      END SELECT

   END IF

NEXT y

!SET DRAW mode explicit !ちらつき防止の終了


CLOSE #1


!ファイル関連
SUB fseek(p) !読み込み位置を設定する
   IF p<cp THEN !前へ
      SET #1: POINTER BEGIN
      LET cp=0
   END IF
   FOR i=1 TO p-cp !skip it
      CHARACTER INPUT #1: tmp$
   NEXT i
   LET cp=p !現在位置の更新
END SUB
SUB fread(r$,p) !レコードを読み込む
   FOR i=1 TO LEN(r$) !read it
      CHARACTER INPUT #1: r$(i:i)
   NEXT i
   LET p=p+LEN(r$) !現在位置の更新
   LET cp=p
END SUB

END


EXTERNAL FUNCTION CVI(s$,p,m) !文字列に埋め込まれたm*8ビット符号付き整数を取り出す
OPTION CHARACTER byte
LET n=0
FOR i=1 TO m
   LET n=n+256^(i-1)*ORD(s$(p+i:p+i))
NEXT i
IF n<2^(m*8-1) THEN LET CVI=n ELSE LET CVI=n-2^(m*8)
END FUNCTION
EXTERNAL FUNCTION CVI2(s$,p,m) !文字列に埋め込まれたm*8ビット符号なし整数を取り出す
OPTION CHARACTER byte
LET n=0
FOR i=1 TO m
   LET n=n+256^(i-1)*ORD(s$(p+i:p+i))
NEXT i
LET CVI2=n
END FUNCTION