GIF ファイル

 投稿者:SECOND  投稿日:2009年 7月10日(金)17時45分47秒
  !十進 BASIC の GIF ファイルが、過去の イメージング などで、
!「ドキュメントを開けませんでした。」で、読めない事についての、参考。
!-------
! Private_パレット だけが有って Common_パレット の無いのが、原因でした。
! Private は、無くても支障ないので、Common へ転送するプログラムです。

OPTION CHARACTER BYTE
SET ECHO "OFF"
! LET file$="decGIForg.GIF" ! 入力ファイル名。

!入力ファイル名を、全く書かない場合、マウス入力。
!入力ファイル名を、書く場合、
!起動したファイル( BASIC.EXE、又は このプログラム自身) の有った所と、
!同じフォルダーが、( カレントdir.) になる。( 出力ファイル共 )

ASK DIRECTORY s$
PRINT "カレントdir.:"& s$
IF file$="" THEN
   FILE GETNAME file$, "gif" ! マウスで、入力。
   IF file$="" THEN
      PRINT "入力ファイル名が、ありません。"
      STOP
   END IF
END IF
PRINT "入力ファイル:"& file$& " (変化しません)"
OPEN #1: NAME file$, ACCESS INPUT
CALL readCI( 6+2+2+1+1+1 +1+2+2+2+2+1 )
IF db$(1:6)<>"GIF87a" THEN
   PRINT "対象GIFファイルでない。"
   STOP
END IF
LET sflg=ORD(db$(11:11))
IF bitand8( sflg,BVAL("80",16) )>0 THEN
   PRINT "Common_パレット は、すでにあります。"
   STOP
END IF
LET pi$=db$(14:23)
LET pflg=ORD(pi$(10:10))
IF ORD( pi$(1:1) )<>BVAL("2C",16) OR bitand8( pflg,BVAL("80",16) )=0 THEN
   PRINT "十進 BASIC の GIFファイルでない。"
   STOP
END IF
FILE splitname(file$) path$, name$, ext$ ! ext$は語頭に"."含む。
PRINT "出力ファイル:"& path$& name$& "##"& ext$
PRINT "Ok?[Enter]"
CHARACTER INPUT k$
IF k$<>CHR$(13) THEN
   PRINT "中止"
   STOP
END IF
PRINT "処理中"
!----
OPEN #2: NAME path$& name$& "##"& ext$
ERASE #2
!----
PRINT "1)GIF_識別文字、スクリーン情報、"
PRINT "   common_パレット情報(修正)、の転送。"
LET j= bitor8( bitand8(sflg,BVAL("70",16)), bitand8(pflg,BVAL("87",16)) )
LET db$(11:11)=CHR$(j)
PRINT #2: db$(1:13);
!----
PRINT "2)private_パレット、から"
PRINT "   common_パレット、へ 転送。"
CALL readCI( 3*2^(MOD(pflg,8)+1) )
PRINT #2: db$;
!----
PRINT "3)画像情報(修正)、の転送。"
LET pi$(10:10)=CHR$(0)
PRINT #2: pi$;
PRINT "   private_パレット、の削除。"
!----
PRINT "4)画像データ ~ GIF 終端ブロック、の転送中。"
CALL readCI( 1000000 )
PRINT #2: db$;
!----
CLOSE #2
CLOSE #1
PRINT "終了"

!-------read binary cx bytes
SUB readCI(cx) ! cx=bytes size
   LET db$=""
   FOR i=1 TO cx
      CHARACTER INPUT #1,IF MISSING THEN EXIT SUB :w9$
      LET db$=db$& w9$
   NEXT i
END SUB

!-------
FUNCTION bitand8(a,b)
   LET b9$="00000000"
   LET b8$=right$("0000000"& BSTR$(a,2),8)
   LET b7$=right$("0000000"& BSTR$(b,2),8)
   FOR b9=1 TO 8
      IF b8$(b9:b9)="1" AND b7$(b9:b9)="1" THEN LET b9$(b9:b9)="1"
   NEXT b9
   LET bitand8=BVAL(b9$,2)
END FUNCTION

FUNCTION bitor8(a,b)
   LET b9$="00000000"
   LET b8$=right$("0000000"& BSTR$(a,2),8)
   LET b7$=right$("0000000"& BSTR$(b,2),8)
   FOR b9=1 TO 8
      IF b8$(b9:b9)="1" OR b7$(b9:b9)="1" THEN LET b9$(b9:b9)="1"
   NEXT b9
   LET bitor8=BVAL(b9$,2)
END FUNCTION

END
!-------
!LZW圧縮アルゴリズム特許、国内では2004年6月20日に失効 …
! …GIF画像ファイルを表示・生成するソフトの開発が自由に…なる。
 

戻る