|
|
!十進 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 "対象ＧＩＦファイルでない。"
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 の ＧＩＦファイルでない。"
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 "１）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 "２）private_パレット、から"
PRINT " common_パレット、へ 転送。"
CALL readCI( 3*2^(MOD(pflg,8)+1) )
PRINT #2: db$;
!----
PRINT "３）画像情報（修正)、の転送。"
LET pi$(10:10)=CHR$(0)
PRINT #2: pi$;
PRINT " private_パレット、の削除。"
!----
PRINT "４）画像データ ～ 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画像ファイルを表示・生成するソフトの開発が自由に…なる。
|
|