新しく発言する EXIT インデックスへ

画像ファイルを作る

　　画像ファイルを作る しばっち 2008/02/27 22:00:06 
　　├続き しばっち 2008/02/27 22:01:10 
　　│└モノクロBMPファイルを作る しばっち 2008/02/27 22:28:03 
　　│　└続き しばっち 2008/02/27 22:31:04 
　　│　　└続き しばっち 2008/02/27 22:31:57 
　　│　　　└PPM,PGMファイル しばっち 2008/02/28 22:45:00 
　　├TGAファイルを作る しばっち 2008/03/02 21:22:32 
　　├PSDファイルを作る(Ver2.5) しばっち 2008/03/02 21:23:50 
　　├TIFFファイルを作る しばっち 2008/03/02 21:25:07 
　　├SVGファイルを作る しばっち 2008/03/08 10:19:42 
　　└PCXファイルを作る しばっち 2008/03/10 22:44:16 

　　画像ファイルを作る しばっち 2008/02/27 22:00:06   ツリーへ
画像ファイルを作る 返事を書く ノートメニュー
しばっち <dihjvcfsyu> 2008/02/27 22:00:06
OPTION CHARACTER BYTE
FILE GETNAME F$, "BMP,JPG,GIFファイル|*.BMP;*.JPG;*.GIF"
CALL PICTURELOAD(F$,XSIZE,YSIZE)
INPUT PROMPT "SAVE FILENAME(.BMP)=":F$
CALL BMPSAVEFULL(F$,0,0,XSIZE-1,YSIZE-1)
END

EXTERNAL SUB BMPSAVEFULL(F$,XS,YS,XE,YE)
OPTION CHARACTER BYTE
IF F$="" THEN STOP
IF POS(F$,".")=0 THEN LET F$=F$ & ".BMP"
LET BFTYPE$="BM"
LET OFFSET=54
LET HEADERSIZE=40
LET PLANE=1
LET BITCOLOR=24
LET XSIZE=XE-XS+1
LET YSIZE=YE-YS+1
LET BW=3*XSIZE+3
LET BW=INT(BW/4)*4
LET BFSIZE=BW*YSIZE+OFFSET
OPEN #1:NAME F$,ACCESS OUTPUT
PRINT #1:BFTYPE$;
PRINT #1:MKL$(BFSIZE);
PRINT #1:MKI$(0);
PRINT #1:MKI$(0);
PRINT #1:MKL$(OFFSET);
PRINT #1:MKL$(HEADERSIZE);
PRINT #1:MKL$(XSIZE);
PRINT #1:MKL$(YSIZE);
PRINT #1:MKI$(PLANE);
PRINT #1:MKI$(BITCOLOR);
PRINT #1:REPEAT$(CHR$(0),24);
FOR Y=YE TO YS STEP -1
FOR X=XS TO XE
CALL GETPOINT(X,Y,R,G,B)
LET C$=C$ & CHR$(B) & CHR$(G) & CHR$(R)
NEXT X
LET C$=LEFT$(C$ & REPEAT$(CHR$(0),4),BW)
PRINT #1:C$;
LET C$=""
NEXT Y
CLOSE #1
END SUB

EXTERNAL SUB BMPSAVE256(F$,XS,YS,XE,YE)
OPTION CHARACTER BYTE
OPTION BASE 0
IF F$="" THEN STOP
DIM R(255),G(255),B(255)
LET RN=INT(255/6)
LET GN=INT(255/5)
LET BN=INT(255/5)
FOR GG = 0 TO 255 STEP GN
FOR RR = 0 TO 255 STEP RN
FOR BB = 0 TO 255 STEP BN
LET R(N)=RR
LET G(N)=GG
LET B(N)=BB
LET N = N + 1
NEXT BB
NEXT RR
NEXT GG
IF POS(F$,".")=0 THEN LET F$=F$ & ".BMP"
LET BFTYPE$="BM"
LET OFFSET=54+4*256
LET HEADERSIZE=40
LET PLANE=1
LET BITCOLOR=8
LET XSIZE=XE-XS+1
LET YSIZE=YE-YS+1
LET BW=XSIZE+3
LET BW=INT(BW/4)*4
LET BFSIZE=BW*YSIZE+OFFSET
OPEN #1:NAME F$,ACCESS OUTPUT
PRINT #1:BFTYPE$;
PRINT #1:MKL$(BFSIZE);
PRINT #1:MKI$(0);
PRINT #1:MKI$(0);
PRINT #1:MKL$(OFFSET);
PRINT #1:MKL$(HEADERSIZE);
PRINT #1:MKL$(XSIZE);
PRINT #1:MKL$(YSIZE);
PRINT #1:MKI$(PLANE);
PRINT #1:MKI$(BITCOLOR);
PRINT #1:REPEAT$(CHR$(0),24);
FOR I=0 TO 255
PRINT #1:CHR$(B(I));
PRINT #1:CHR$(G(I));
PRINT #1:CHR$(R(I));
PRINT #1:CHR$(0);
NEXT I
FOR Y=YE TO YS STEP -1
FOR X=XS TO XE
CALL GETPOINT(X,Y,RR,GG,BB)
LET RR=INT(RR/RN)*RN
LET GG=INT(GG/GN)*GN
LET BB=INT(BB/BN)*BN
FOR N=0 TO 255
IF R(N)=RR AND B(N)=BB AND G(N)=GG THEN
LET C$=C$ & CHR$(N)
EXIT FOR
END IF
NEXT N
CALL PSET(X,Y,R(N),G(N),B(N))
NEXT X
LET C$=LEFT$(C$ & REPEAT$(CHR$(0),4),BW)
PRINT #1:C$;
LET C$=""
NEXT Y
CLOSE #1
END SUB
 
　　├続き しばっち 2008/02/27 22:01:10   ツリーへ
Re: 画像ファイルを作る 返事を書く ノートメニュー
しばっち <dihjvcfsyu> 2008/02/27 22:01:10
続き

EXTERNAL FUNCTION MKI$(A)
OPTION CHARACTER BYTE
DECLARE STRING A$,B$
IF A<0 THEN LET A=A+65536
LET A$=CHR$(MOD(A,256))
LET B$=CHR$(INT(A/256))
LET MKI$=A$ & B$
END FUNCTION

EXTERNAL FUNCTION MKL$(A)
OPTION CHARACTER BYTE
DECLARE STRING A$,B$,C$,D$
IF A<0 THEN LET A=A+2^32
LET A$=CHR$(MOD(A,256))
LET B$=CHR$(MOD(INT(A/256),256))
LET C$=CHR$(MOD(INT(A/65536),256))
LET D$=CHR$(MOD(INT(A/16777216),256))
LET MKL$=A$ & B$ & C$ & D$
END FUNCTION

EXTERNAL SUB RGB(X,R,G,B)
LET B=MOD(INT(X/65536),256)
LET G=MOD(INT(X/256),256)
LET R=MOD(X,256)
END SUB

EXTERNAL SUB GETPOINT(X,Y,R,G,B)
ASK PIXEL VALUE (X,Y) C
CALL RGB(C,R,G,B)
END SUB

EXTERNAL SUB PSET(X,Y,R,G,B)
SET COLOR COLORINDEX(R/255,G/255,B/255)
PLOT POINTS: X , Y
END SUB

EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
IF N$="" THEN STOP
GLOAD N$
LET XSIZE=PIXELX(1)+1
LET YSIZE=PIXELY(1)+1
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
 
　　│└モノクロBMPファイルを作る しばっち 2008/02/27 22:28:03   ツリーへ
Re: 続き 返事を書く ノートメニュー
しばっち <dihjvcfsyu> 2008/02/27 22:28:03
モノクロBMPファイルを作る


OPTION BASE 0
PUBLIC NUMERIC XSIZE, M2(-1 TO 1,1),M(-2 TO 2,2)
FILE GETNAME F$, "BMP,JPG,GIFファイル|*.BMP;*.JPG;*.GIF"
IF F$="" THEN STOP
CALL PICTURELOAD(F$,XSIZE,YSIZE)
DIM BUF(XSIZE - 1, 2)
INPUT PROMPT "MODE JARVIS(1) OR FLOYD(2) ": MD
SELECT CASE MD
CASE 1
RESTORE 10
FOR J = 0 TO 2
FOR I = -2 TO 2
READ M(I, J)
NEXT I
NEXT J
CASE 2
RESTORE 20
FOR J = 0 TO 1
FOR I = -1 TO 1
READ M2(I, J)
NEXT I
NEXT J
END SELECT
FOR Y = 0 TO YSIZE - 1
FOR X = 0 TO XSIZE - 1
CALL GETPOINT(X,Y,R,G,B)
LET V = (151 * B + 77 * G + 28 * R) / 256
SELECT CASE MD
CASE 1
CALL ERRORDIFF(BUF,V,X,RV)
IF RV<>0 THEN CALL PSET(X,Y,255,255,255) ELSE CALL PSET(X,Y,0,0,0)
CASE 2
CALL ERRORDIFF2(BUF,V,X,RV)
IF RV<>0 THEN CALL PSET(X,Y,255,255,255) ELSE CALL PSET(X,Y,0,0,0)
END SELECT
NEXT X
NEXT Y
10 DATA 5,7,0,0,0
DATA 3,5,7,5,3
DATA 1,3,5,3,1
20 DATA 7,0,0
DATA 1,5,3

INPUT PROMPT "SAVE FILENAME(.BMP)=":F$
IF POS(F$,".")=0 THEN LET F$=F$ & ".BMP"
CALL BMPMONOSAVE(F$,0,0,XSIZE-1,YSIZE-1)
END

EXTERNAL SUB ERRORDIFF (ERRBUF(,),LV,X,RV)
LET S = 0
FOR J = 0 TO 2
FOR I = -2 TO 2
IF X + I >= 0 AND X + I <= XSIZE - 1 THEN LET S = S + ERRBUF(X + I, J) * M(I, J)
NEXT I
NEXT J
LET S = (S + 24) / 48
IF S + LV > LEVEL THEN LET RV = 255 ELSE LET RV = 0
LET ERRBUF(X, 0) = S + LV - RV
IF X = XSIZE - 1 THEN
FOR XX = 0 TO XSIZE - 1
LET ERRBUF(XX, 2) = ERRBUF(XX, 1)
LET ERRBUF(XX, 1) = ERRBUF(XX, 0)
NEXT XX
END IF
END SUB

EXTERNAL SUB ERRORDIFF2 (ERRBUF(,), LV, X,RV)
LET S = 0
FOR J = 0 TO 1
FOR I = -1 TO 1
IF X + I >= 0 AND X + I <= XSIZE - 1 THEN LET S = S + ERRBUF(X + I, J) * M2(I, J)
NEXT I
NEXT J
LET S = (S + 8) / 16
IF S + LV > LEVEL THEN LET RV = 255 ELSE LET RV = 0
LET ERRBUF(X, 0) = S + LV - RV
IF X = XSIZE - 1 THEN
FOR XX = 0 TO XSIZE - 1
SWAP ERRBUF(XX, 1), ERRBUF(XX, 0)
NEXT XX
END IF
END SUB
 
　　│　└続き しばっち 2008/02/27 22:31:04   ツリーへ
Re: モノクロBMPファイルを作る 返事を書く ノートメニュー
しばっち <dihjvcfsyu> 2008/02/27 22:31:04
続き


EXTERNAL SUB BMPMONOSAVE (N$, XS, YS, XE, YE)
OPTION CHARACTER BYTE
IF N$="" THEN EXIT SUB
LET XSIZE=XE-XS+1
LET YSIZE=YE-YS+1
LET BW=INT((INT((XSIZE+7)/8)+3)/4)*4
LET SIZE=INT(XSIZE*YSIZE/8)+62
LET BITMAPHEADER$="BM" & MKL$(SIZE) & REPEAT$(CHR$(0),4) & MKL$(62)
LET BITMAPINFO$=MKL$(40) & MKL$(XSIZE) & MKL$(YSIZE) & CHR$(1) & CHR$(0) & CHR$(1) & CHR$(0) & REPEAT$(CHR$(0),24)
LET PALET$=CHR$(0) & CHR$(0) & CHR$(0) & CHR$(0) & CHR$(255) & CHR$(255) & CHR$(255) & CHR$(0)
OPEN #1:NAME N$,ACCESS OUTPUT
PRINT #1: BITMAPHEADER$;
PRINT #1: BITMAPINFO$;
PRINT #1: PALET$;
FOR Y = YE TO YS STEP -1
FOR X = XS TO XE STEP 8
CALL GETPOINT(X,Y,R1,G1,B1)
IF X+1<=XE THEN CALL GETPOINT(X+1,Y,R2,G2,B2)
IF X+2<=XE THEN CALL GETPOINT(X+2,Y,R3,G3,B3)
IF X+3<=XE THEN CALL GETPOINT(X+3,Y,R4,G4,B4)
IF X+4<=XE THEN CALL GETPOINT(X+4,Y,R5,G5,B5)
IF X+5<=XE THEN CALL GETPOINT(X+5,Y,R6,G6,B6)
IF X+6<=XE THEN CALL GETPOINT(X+6,Y,R7,G7,B7)
IF X+7<=XE THEN CALL GETPOINT(X+7,Y,R8,G8,B8)
IF R1=255 AND G1=255 AND B1=255 THEN LET C1=1 ELSE LET C1=0
IF R2=255 AND G2=255 AND B2=255 THEN LET C2=1 ELSE LET C2=0
IF R3=255 AND G3=255 AND B3=255 THEN LET C3=1 ELSE LET C3=0
IF R4=255 AND G4=255 AND B4=255 THEN LET C4=1 ELSE LET C4=0
IF R5=255 AND G5=255 AND B5=255 THEN LET C5=1 ELSE LET C5=0
IF R6=255 AND G6=255 AND B6=255 THEN LET C6=1 ELSE LET C6=0
IF R7=255 AND G7=255 AND B7=255 THEN LET C7=1 ELSE LET C7=0
IF R8=255 AND G8=255 AND B8=255 THEN LET C8=1 ELSE LET C8=0
LET A$ = A$ & CHR$(C1 * 128 + C2 * 64 + C3 * 32 + C4 * 16 + C5 * 8 + C6 * 4 + C7 * 2 + C8)
LET R2=0
LET G2=0
LET B2=0
LET R3=0
LET G3=0
LET B3=0
LET R4=0
LET G4=0
LET B4=0
LET R5=0
LET G5=0
LET B5=0
LET R6=0
LET G6=0
LET B6=0
LET R7=0
LET G7=0
LET B7=0
LET R8=0
LET G8=0
LET B8=0
NEXT X
LET A$ = LEFT$(A$ & REPEAT$(CHR$(0),10), BW)
PRINT #1: A$;
LET A$ = ""
NEXT Y
CLOSE #1
END SUB

EXTERNAL SUB RGB(X,R,G,B)
LET B=MOD(INT(X/65536),256)
LET G=MOD(INT(X/256),256)
LET R=MOD(X,256)
END SUB

EXTERNAL SUB GETPOINT(X,Y,R,G,B)
ASK PIXEL VALUE (X,Y) C
CALL RGB(C,R,G,B)
END SUB
 
　　│　　└続き しばっち 2008/02/27 22:31:57   ツリーへ
Re: 続き 返事を書く ノートメニュー
しばっち <dihjvcfsyu> 2008/02/27 22:31:57
続き


EXTERNAL SUB PSET(X,Y,R,G,B)
SET COLOR COLORINDEX(R/255,G/255,B/255)
PLOT POINTS: X , Y
END SUB

EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
CLEAR
SET COLOR MODE "NATIVE"
SET POINT STYLE 1
GLOAD N$
LET XSIZE=PIXELX(1)+1
LET YSIZE=PIXELY(1)+1
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB

EXTERNAL FUNCTION MKI$(A)
OPTION CHARACTER BYTE
DECLARE STRING A$,B$
IF A<0 THEN LET A=A+65536
LET A$=CHR$(MOD(A,256))
LET B$=CHR$(INT(A/256))
LET MKI$=A$ & B$
END FUNCTION

EXTERNAL FUNCTION MKL$(A)
OPTION CHARACTER BYTE
DECLARE STRING A$,B$,C$,D$
IF A<0 THEN LET A=A+2^32
LET A$=CHR$(MOD(A,256))
LET B$=CHR$(MOD(INT(A/256),256))
LET C$=CHR$(MOD(INT(A/65536),256))
LET D$=CHR$(MOD(INT(A/16777216),256))
LET MKL$=A$ & B$ & C$ & D$
END FUNCTION
 
　　│　　　└PPM,PGMファイル しばっち 2008/02/28 22:45:00   ツリーへ
Re: 続き 返事を書く ノートメニュー
しばっち <dihjvcfsyu> 2008/02/28 22:45:00
PPM,PGMファイル


FILE GETNAME F$, "BMP,JPG,GIFファイル|*.BMP;*.JPG;*.GIF"
IF F$="" THEN STOP
CALL PICTURELOAD(F$,XSIZE,YSIZE)
INPUT PROMPT "SAVE FILENAME(.PPM)=":N$
INPUT PROMPT "MODE ASCII(0) or BINARY(1) ":MODE
CALL PPMSAVE(MODE,N$,0,0,XSIZE-1,YSIZE-1)
END

EXTERNAL SUB PPMSAVE(MODE,F$,XS,YS,XE,YE)
OPTION CHARACTER BYTE
IF F$="" THEN STOP
IF POS(F$,".")=0 THEN LET F$=F$ & ".PPM"
LET XSIZE=XE-XS+1
LET YSIZE=YE-YS+1
OPEN #1:NAME F$
SELECT CASE MODE
CASE 0
PRINT #1:"P3";CHR$(10);
PRINT #1:XSIZE;YSIZE;CHR$(10);
PRINT #1:"255";CHR$(10);
FOR Y=YS TO YE
FOR X=XS TO XE
CALL GETPOINT(X,Y,R,G,B)
PRINT #1:R;G;B;
NEXT X
PRINT #1:CHR$(10);
NEXT Y
CASE 1
PRINT #1:"P6";CHR$(10);
PRINT #1:XSIZE;YSIZE;CHR$(10);
PRINT #1:"255";CHR$(10);
FOR Y=YS TO YE
FOR X=XS TO XE
CALL GETPOINT(X,Y,R,G,B)
PRINT #1:CHR$(R);CHR$(G);CHR$(B);
NEXT X
NEXT Y
END SELECT
CLOSE #1
END SUB

EXTERNAL SUB PGMSAVE(MODE,F$,XS,YS,XE,YE)
OPTION CHARACTER BYTE
IF F$="" THEN STOP
IF POS(F$,".")=0 THEN LET F$=F$ & ".PGM"
LET XSIZE=XE-XS+1
LET YSIZE=YE-YS+1
OPEN #1:NAME F$
SELECT CASE MODE
CASE 0
PRINT #1:"P2";CHR$(10);
PRINT #1:XSIZE;YSIZE;CHR$(10);
PRINT #1:"255";CHR$(10);
FOR Y=YS TO YE
FOR X=XS TO XE
CALL GETPOINT(X,Y,R,G,B)
LET GR = (151 * B + 77 * G + 28 * R) / 256
CALL PSET(X,Y,GR,GR,GR)
PRINT #1:GR;
NEXT X
PRINT #1:CHR$(10);
NEXT Y
CASE 1
PRINT #1:"P5";CHR$(10);
PRINT #1:XSIZE;YSIZE;CHR$(10);
PRINT #1:"255";CHR$(10);
FOR Y=YS TO YE
FOR X=XS TO XE
CALL GETPOINT(X,Y,R,G,B)
LET GR = (151 * B + 77 * G + 28 * R) / 256
CALL PSET(X,Y,GR,GR,GR)
PRINT #1:CHR$(GR);
NEXT X
NEXT Y
END SELECT
CLOSE #1
END SUB

EXTERNAL SUB PSET(X,Y,R,G,B)
SET COLOR COLORINDEX(R/255,G/255,B/255)
PLOT POINTS: X , Y
END SUB

EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
CLEAR
SET COLOR MODE "NATIVE"
SET POINT STYLE 1
GLOAD N$
LET XSIZE=PIXELX(1)+1
LET YSIZE=PIXELY(1)+1
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB

EXTERNAL SUB GETPOINT(X,Y,R,G,B)
ASK PIXEL VALUE (X,Y) C
CALL RGB(C,R,G,B)
END SUB

EXTERNAL SUB RGB(X,R,G,B)
LET B=MOD(INT(X/65536),256)
LET G=MOD(INT(X/256),256)
LET R=MOD(X,256)
END SUB
 
　　├TGAファイルを作る しばっち 2008/03/02 21:22:32   ツリーへ
Re: 画像ファイルを作る 返事を書く ノートメニュー
しばっち <dihjvcfsyu> 2008/03/02 21:22:32
TGAファイルを作る


FILE GETNAME F$, "BMP,JPG,GIFファイル|*.BMP;*.JPG;*.GIF"
IF F$="" THEN STOP
CALL PICTURELOAD(F$,XSIZE,YSIZE)
INPUT PROMPT "SAVE FILENAME(.TGA)=":F$
IF POS(F$,".")=0 THEN LET F$=F$ & ".TGA"
CALL TGASAVEFULL(F$,0,0,XSIZE-1,YSIZE-1)
END

EXTERNAL SUB TGASAVEFULL(F$,XS,YS,XE,YE)
OPTION CHARACTER BYTE
IF F$="" THEN STOP
LET XSIZE=XE-XS+1
LET YSIZE=YE-YS+1
OPEN #1:NAME F$,ACCESS OUTPUT
PRINT #1:CHR$(0);
PRINT #1:CHR$(0);
PRINT #1:CHR$(2);
PRINT #1:MKI$(0);
PRINT #1:MKI$(0);
PRINT #1:CHR$(0);
PRINT #1:MKI$(0);
PRINT #1:MKI$(0);
PRINT #1:MKI$(XSIZE);
PRINT #1:MKI$(YSIZE);
PRINT #1:CHR$(24);
PRINT #1:CHR$(0);
FOR Y=YE TO YS STEP -1
FOR X=XS TO XE
CALL GETPOINT(X,Y,R,G,B)
PRINT #1:CHR$(B);
PRINT #1:CHR$(G);
PRINT #1:CHR$(R);
NEXT X
NEXT Y
CLOSE #1
END SUB

EXTERNAL FUNCTION MKI$(A)
OPTION CHARACTER BYTE
DECLARE STRING A$,B$
IF A<0 THEN LET A=A+65536
LET A$=CHR$(MOD(A,256))
LET B$=CHR$(INT(A/256))
LET MKI$=A$ & B$
END FUNCTION

EXTERNAL FUNCTION MKL$(A)
OPTION CHARACTER BYTE
DECLARE STRING A$,B$,C$,D$
IF A<0 THEN LET A=A+2^32
LET A$=CHR$(MOD(A,256))
LET B$=CHR$(MOD(INT(A/256),256))
LET C$=CHR$(MOD(INT(A/65536),256))
LET D$=CHR$(MOD(INT(A/16777216),256))
LET MKL$=A$ & B$ & C$ & D$
END FUNCTION

EXTERNAL SUB RGB(X,R,G,B)
LET B=MOD(INT(X/65536),256)
LET G=MOD(INT(X/256),256)
LET R=MOD(X,256)
END SUB

EXTERNAL SUB GETPOINT(X,Y,R,G,B)
ASK PIXEL VALUE (X,Y) C
CALL RGB(C,R,G,B)
END SUB

EXTERNAL SUB PSET(X,Y,R,G,B)
SET COLOR COLORINDEX(R/255,G/255,B/255)
PLOT POINTS: X , Y
END SUB

EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
GLOAD N$
LET XSIZE=PIXELX(1)+1
LET YSIZE=PIXELY(1)+1
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
 
　　├PSDファイルを作る(Ver2.5) しばっち 2008/03/02 21:23:50   ツリーへ
Re: 画像ファイルを作る 返事を書く ノートメニュー
しばっち <dihjvcfsyu> 2008/03/02 21:23:50
PSDファイルを作る(Ver 2.5)


OPTION CHARACTER BYTE
FILE GETNAME F$, "BMP,JPG,GIFファイル|*.BMP;*.JPG;*.GIF"
IF F$="" THEN STOP
CALL PICTURELOAD(F$,XSIZE,YSIZE)
INPUT PROMPT "SAVE FILENAME(.PSD)=":F$
IF POS(F$,".")=0 THEN LET F$=F$ & ".PSD"
CALL PSDSAVE(F$,0,0,XSIZE-1,YSIZE-1)
END

EXTERNAL SUB PSDSAVE(F$,XS,YS,XE,YE)
OPTION CHARACTER BYTE
IF F$="" THEN STOP
LET XSIZE=XE-XS+1
LET YSIZE=YE-YS+1
OPEN #1:NAME F$,ACCESS OUTPUT
PRINT #1:"8BPS";
PRINT #1:MKI2$(1);
PRINT #1:REPEAT$(CHR$(0),6);
PRINT #1:MKI2$(3);
PRINT #1:MKL2$(YSIZE);
PRINT #1:MKL2$(XSIZE);
PRINT #1:MKI2$(8);
PRINT #1:MKI2$(3);
PRINT #1:REPEAT$(CHR$(0),12);
PRINT #1:MKI2$(0);
FOR Y=YS TO YE
FOR X=XS TO XE
CALL GETPOINT(X,Y,R,G,B)
PRINT #1:CHR$(R);
NEXT X
NEXT Y
FOR Y=YS TO YE
FOR X=XS TO XE
CALL GETPOINT(X,Y,R,G,B)
PRINT #1:CHR$(G);
NEXT X
NEXT Y
FOR Y=YS TO YE
FOR X=XS TO XE
CALL GETPOINT(X,Y,R,G,B)
PRINT #1:CHR$(B);
NEXT X
NEXT Y
CLOSE #1
END SUB

EXTERNAL SUB RGB(X,R,G,B)
LET B=MOD(INT(X/65536),256)
LET G=MOD(INT(X/256),256)
LET R=MOD(X,256)
END SUB

EXTERNAL SUB GETPOINT(X,Y,R,G,B)
ASK PIXEL VALUE (X,Y) C
CALL RGB(C,R,G,B)
END SUB

EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
GLOAD N$
LET XSIZE=PIXELX(1)+1
LET YSIZE=PIXELY(1)+1
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB

EXTERNAL FUNCTION MKI2$(A)
!'BIG-ENDIAN
OPTION CHARACTER BYTE
DECLARE STRING A$,B$
IF A<0 THEN LET A=A+65536
LET A$=CHR$(MOD(A,256))
LET B$=CHR$(INT(A/256))
LET MKI2$=B$ & A$
END FUNCTION

EXTERNAL FUNCTION MKL2$(A)
!'BIG-ENDIAN
OPTION CHARACTER BYTE
DECLARE STRING A$,B$,C$,D$
IF A<0 THEN LET A=A+2^32
LET A$=CHR$(MOD(A,256))
LET B$=CHR$(MOD(INT(A/256),256))
LET C$=CHR$(MOD(INT(A/65536),256))
LET D$=CHR$(MOD(INT(A/16777216),256))
LET MKL2$=D$ & C$ & B$ & A$
END FUNCTION
 
　　├TIFFファイルを作る しばっち 2008/03/02 21:25:07   ツリーへ
Re: 画像ファイルを作る 返事を書く ノートメニュー
しばっち <dihjvcfsyu> 2008/03/02 21:25:07
TIFFファイルを作る


OPTION CHARACTER BYTE
FILE GETNAME F$, "BMP,JPG,GIFファイル|*.BMP;*.JPG;*.GIF"
CALL PICTURELOAD(F$,XSIZE,YSIZE)
INPUT PROMPT "SAVE FILENAME(.TIF)=":F$
IF POS(F$,".")=0 THEN LET F$=F$ & ".TIF"
CALL TIFFSAVEFULL(F$,0,0,XSIZE-1,YSIZE-1)
END

EXTERNAL SUB TIFFSAVEFULL(F$,XS,YS,XE,YE)
OPTION CHARACTER BYTE
LET XSIZE=XE-XS+1
LET YSIZE=YE-YS+1
OPEN #1:NAME F$
LET OFFSET=XSIZE*YSIZE*3+8
PRINT #1:"II";
PRINT #1:MKI$(42);
PRINT #1:MKL$(OFFSET);
FOR Y=YS TO YE
FOR X=XS TO XE
CALL GETPOINT(X,Y,R,G,B)
PRINT #1:CHR$(R);CHR$(G);CHR$(B);
NEXT X
NEXT Y
PRINT #1:MKI$(14);
PRINT #1:MKI$(256);MKI$(3);MKL$(1);MKL$(XSIZE);
PRINT #1:MKI$(257);MKI$(3);MKL$(1);MKL$(YSIZE);
PRINT #1:MKI$(258);MKI$(3);MKL$(3);
PRINT #1:MKL$(XSIZE*YSIZE*3+182);
PRINT #1:MKI$(259);MKI$(3);MKL$(1);MKL$(1);
PRINT #1:MKI$(262);MKI$(3);MKL$(1);MKL$(2);
PRINT #1:MKI$(273);MKI$(4);MKL$(1);MKL$(8);
PRINT #1:MKI$(274);MKI$(3);MKL$(1);MKL$(1);
PRINT #1:MKI$(277);MKI$(3);MKL$(1);MKL$(3);
PRINT #1:MKI$(278);MKI$(3);MKL$(1);MKL$(YSIZE);
PRINT #1:MKI$(279);MKI$(4);MKL$(1);
PRINT #1:MKL$(XSIZE * YSIZE * 3);
PRINT #1:MKI$(280);MKI$(3);MKL$(3);
PRINT #1:MKL$(XSIZE * YSIZE * 3 + 188);
PRINT #1:MKI$(281);MKI$(3);MKL$(3);
PRINT #1:MKL$(XSIZE * YSIZE * 3 + 194);
PRINT #1:MKI$(284);MKI$(3);MKL$(1);MKL$(1);
PRINT #1:MKI$(339);MKI$(3);MKL$(3);
PRINT #1:MKL$(XSIZE * YSIZE * 3 + 200);
PRINT #1:MKI$(0);MKI$(0);
PRINT #1:MKI$(8);MKI$(8);MKI$(8);
PRINT #1:MKI$(0);MKI$(0);MKI$(0);
PRINT #1:MKI$(255);MKI$(255);MKI$(255);
PRINT #1:MKI$(1);MKI$(1);MKI$(1);
CLOSE #1
END SUB

EXTERNAL FUNCTION MKI$(A)
OPTION CHARACTER BYTE
DECLARE STRING A$,B$
IF A<0 THEN LET A=A+65536
LET A$=CHR$(MOD(A,256))
LET B$=CHR$(INT(A/256))
LET MKI$=A$ & B$
END FUNCTION

EXTERNAL FUNCTION MKL$(A)
OPTION CHARACTER BYTE
DECLARE STRING A$,B$,C$,D$
IF A<0 THEN LET A=A+2^32
LET A$=CHR$(MOD(A,256))
LET B$=CHR$(MOD(INT(A/256),256))
LET C$=CHR$(MOD(INT(A/65536),256))
LET D$=CHR$(MOD(INT(A/16777216),256))
LET MKL$=A$ & B$ & C$ & D$
END FUNCTION

EXTERNAL SUB RGB(X,R,G,B)
LET B=MOD(INT(X/65536),256)
LET G=MOD(INT(X/256),256)
LET R=MOD(X,256)
END SUB

EXTERNAL SUB GETPOINT(X,Y,R,G,B)
ASK PIXEL VALUE (X,Y) C
CALL RGB(C,R,G,B)
END SUB

EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
GLOAD N$
LET XSIZE=PIXELX(1)+1
LET YSIZE=PIXELY(1)+1
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
 
　　├SVGファイルを作る しばっち 2008/03/08 10:19:42   ツリーへ
Re: 画像ファイルを作る 返事を書く ノートメニュー
しばっち <dihjvcfsyu> 2008/03/08 10:19:42
SVGファイルを作る


ご注意

別途プラグイン等が必要です。
http://www.adobe.com/jp/svg/


OPTION BASE 0
INPUT PROMPT "SAVE FILENAME(.SVG)=":F$
LET XSIZE=600
LET YSIZE=600
LET L=200
CALL GINIT(XSIZE,YSIZE)
IF POS(F$,".")=0 THEN LET F$=F$ & ".SVG"
OPEN #1:NAME F$
PRINT #1:"<?xml version=";CHR$(34);"1.0";CHR$(34);" standalone=";CHR$(34);"no";CHR$(34);"?>"
PRINT #1:"<!DOCTYPE svg PUBLIC ";CHR$(34);"-//W3C//DTD SVG 20001102//EN";CHR$(34);" ";CHR$(34);"http://www.w3.org/TR/2000/CR-SVG-20001102/DTD/svg-20001102.dtd";chr$(34);">"
PRINT #1:"<svg xml:space=";CHR$(34);"default";CHR$(34);" width=";CHR$(34);STR$(XSIZE);CHR$(34);" height=";CHR$(34);STR$(YSIZE);CHR$(34);">"
10 !'INPUT PROMPT "大きさ= ": L
INPUT PROMPT "LEVEL(1-14)=": N
20 DIM XA(15), YA(15), LA(15)
LET T = PI / 180
LET R = 90
LET X0 = INT(XSIZE/2)
LET Y0 = INT(YSIZE/1.5)
30 GOSUB 40
PRINT #1:"</svg>"
CLOSE #1
STOP
40 IF N = 0 THEN 90
50 GOSUB 100
60 LET XA(N) = X
LET YA(N) = Y
LET LA(N) = L
70 LET R = R + 45
LET L = L / SQR(2)
LET N = N - 1
GOSUB 40
80 LET R = R - 90
LET L = L / SQR(2)
LET N = N - 1
GOSUB 40
LET R = R + 45
90 LET N = N + 1
LET X = XA(N)
LET Y = YA(N)
LET L = LA(N)
RETURN
100 IF N > 1 THEN RETURN
110 IF R >= 360 THEN LET R = MOD(R , 360)
120 IF R < 0 THEN LET R = R + 360
130 LET X = X0 + COS(R * T) * L
LET Y = Y0 - SIN(R * T) * L
140 IF X < 0 OR X > XSIZE-1 OR Y > YSIZE-1 OR Y < 0 THEN
LET X0 = X
LET Y0 = Y
RETURN
END IF
150 CALL LINE (INT(X0),INT(Y0),INT(X),INT(Y), 7)
PRINT #1:"<line x1=";CHR$(34);STR$(INT(X0));CHR$(34);" y1=";CHR$(34);STR$(INT(Y0));CHR$(34);" x2=";CHR$(34);STR$(INT(X));CHR$(34);" y2=";CHR$(34);STR$(INT(Y));CHR$(34);" stroke=";CHR$(34);"black";CHR$(34);" stroke-width=";CHR$(34);"1";CHR$(34);"/>"
LET X0 = X
LET Y0 = Y
RETURN
END

EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0 , XSIZE-1 , YSIZE-1, 0
SET POINT STYLE 1
SET COLOR MIX(0) 0,0,0
SET COLOR MIX(1) 0,0,1
SET COLOR MIX(2) 1,0,0
SET COLOR MIX(3) 1,0,1
SET COLOR MIX(4) 0,1,0
SET COLOR MIX(5) 0,1,1
SET COLOR MIX(6) 1,1,0
SET COLOR MIX(7) 1,1,1
CLEAR
END SUB

EXTERNAL SUB LINE(XS,YS,XE,YE,C)
SET COLOR C
PLOT LINES: XS,YS;XE,YE
END SUB 
　　└PCXファイルを作る しばっち 2008/03/10 22:44:16   ツリーへ
Re: 画像ファイルを作る 返事を書く ノートメニュー
しばっち <dihjvcfsyu> 2008/03/10 22:44:16
PCXファイルを作る


OPTION CHARACTER BYTE
FILE GETNAME F$, "BMP,JPG,GIFファイル|*.BMP;*.JPG;*.GIF"
IF F$="" THEN STOP
CALL PICTURELOAD(F$,XSIZE,YSIZE)
INPUT PROMPT "SAVE FILENAME(.PCX)=":N$
IF POS(N$,".")=0 THEN LET N$=N$ & ".PCX"
CALL PCXSAVEFULL(N$,0,0,XSIZE-1,YSIZE-1)
END

EXTERNAL SUB PCXSAVEFULL(F$,XS,YS,XE,YE)
OPTION CHARACTER BYTE
OPEN #1:NAME F$
PRINT #1:CHR$(10);CHR$(5);
PRINT #1:CHR$(1);CHR$(8);
PRINT #1:MKI$(XS);
PRINT #1:MKI$(YS);
PRINT #1:MKI$(XE);
PRINT #1:MKI$(YE);
PRINT #1:MKI$(96);
PRINT #1:MKI$(96);
PRINT #1:REPEAT$(CHR$(0),48);
PRINT #1:CHR$(0);CHR$(3);
PRINT #1:MKI$(XE-XS+1);
PRINT #1:MKI$(1);
PRINT #1:REPEAT$(CHR$(0),58);
FOR Y=YS TO YE
LET X=XS
DO
CALL GETPOINT(X,Y,R0,G0,B0)
LET NUM=0
DO
LET NUM=NUM+1
CALL GETPOINT(X+NUM,Y,R,G,B)
LOOP WHILE R0=R AND NUM<63 AND X+NUM<=XE
IF NUM=1 AND R0<192 THEN
PRINT #1:CHR$(R0);
ELSE
PRINT #1:CHR$(192+NUM);
PRINT #1:CHR$(R0);
END IF
LET X=X+NUM
LOOP WHILE X<=XE
LET X=XS
DO
CALL GETPOINT(X,Y,R0,G0,B0)
LET NUM=0
DO
LET NUM=NUM+1
CALL GETPOINT(X+NUM,Y,R,G,B)
LOOP WHILE G0=G AND NUM<63 AND X+NUM<=XE
IF NUM=1 AND G0<192 THEN
PRINT #1:CHR$(G0);
ELSE
PRINT #1:CHR$(192+NUM);
PRINT #1:CHR$(G0);
END IF
LET X=X+NUM
LOOP WHILE X<=XE
LET X=XS
DO
CALL GETPOINT(X,Y,R0,G0,B0)
LET NUM=0
DO
LET NUM=NUM+1
CALL GETPOINT(X+NUM,Y,R,G,B)
LOOP WHILE B0=B AND NUM<63 AND X+NUM<=XE
IF NUM=1 AND B0<192 THEN
PRINT #1:CHR$(B0);
ELSE
PRINT #1:CHR$(192+NUM);
PRINT #1:CHR$(B0);
END IF
LET X=X+NUM
LOOP WHILE X<=XE
NEXT Y
CLOSE #1
END SUB

EXTERNAL FUNCTION MKI$(A)
OPTION CHARACTER BYTE
DECLARE STRING A$,B$
IF A<0 THEN LET A=A+65536
LET A$=CHR$(MOD(A,256))
LET B$=CHR$(INT(A/256))
LET MKI$=A$ & B$
END FUNCTION

EXTERNAL SUB RGB(X,R,G,B)
LET B=MOD(INT(X/65536),256)
LET G=MOD(INT(X/256),256)
LET R=MOD(X,256)
END SUB

EXTERNAL SUB GETPOINT(X,Y,R,G,B)
ASK PIXEL VALUE (X,Y) C
CALL RGB(C,R,G,B)
END SUB

EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
GLOAD N$
LET XSIZE=PIXELX(1)+1
LET YSIZE=PIXELY(1)+1
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB

インデックスへ EXIT
新規発言を反映させるにはブラウザの更新ボタンを押してください。