|
|
解像度をニアレストネイバー法、バイリニア法、バイキュービック法にて変換します。
OPTION ARITHMETIC NATIVE
OPTION BASE 0
PUBLIC NUMERIC XSIZE,YSIZE
FILE GETNAME N$,"BMP,JPG,GIF,PNGファイル|*.BMP;*.JPG;*.GIF;*.PNG"
CALL PICTURELOAD(N$,XSIZE,YSIZE)
DIM VM(XSIZE,YSIZE),S$(2)
ASK PIXEL ARRAY(0,0) VM
PRINT "元画像サイズ ";XSIZE;"＊";YSIZE
MAT READ S$
DATA "NEAR","BILINEAR","BICUBIC"
LOCATE CHOICE(S$) :MODE
LOCATE VALUE ,RANGE 0.1 TO 3,AT 1 : SCALE
LET BIWIDTH=INT(XSIZE*SCALE)
LET BIHEIGHT=INT(YSIZE*SCALE)
PRINT "画像サイズ ";BIWIDTH;"＊";BIHEIGHT
PRINT S$(MODE-1)
PRINT "倍率 ";SCALE
CLEAR
SET BITMAP SIZE BIWIDTH,BIHEIGHT
SET WINDOW 0,BIWIDTH-1,BIHEIGHT-1,0
FOR Y=0 TO BIHEIGHT-1
FOR X=0 TO BIWIDTH-1
LET XX=X/SCALE
LET YY=Y/SCALE
SELECT CASE MODE
CASE 1
CALL NEAR(XX,YY,VM,R,G,B)
CASE 2
CALL BILINEAR(XX,YY,VM,R,G,B)
CASE 3
CALL BICUBIC(XX,YY,VM,R,G,B)
END SELECT
CALL PSET(X,Y,R,G,B)
NEXT X
NEXT Y
END
EXTERNAL SUB NEAR(X,Y,IMAGE(,),R,G,B) !'ニアレストネイバー法
OPTION ARITHMETIC NATIVE
IF X>=0 AND X<=XSIZE-1 THEN
LET XX=INT(X+.5)
ELSE
LET XX=MAX(0,MIN(XSIZE-1,X))
END IF
IF Y>=0 AND Y<=YSIZE-1 THEN
LET YY=INT(Y+.5)
ELSE
LET YY=MAX(0,MIN(YSIZE-1,Y))
END IF
LET C=IMAGE(XX,YY)
CALL RGB(C,R,G,B)
LET R=MAX(0,MIN(255,R))
LET G=MAX(0,MIN(255,G))
LET B=MAX(0,MIN(255,B))
END SUB
EXTERNAL SUB BILINEAR(X,Y,IMAGE(,),RR,GG,BB) !'バイリニア法
OPTION ARITHMETIC NATIVE
LET XX=X-INT(X)
LET YY=Y-INT(Y)
LET X0=INT(X)
LET Y0=INT(Y)
FOR L=0 TO 1
LET R0=0
LET G0=0
LET B0=0
FOR K=0 TO 1
IF X0+K<XSIZE AND Y0+L<YSIZE AND X0+K>=0 AND Y0+L>=0 THEN LET C=IMAGE(X0+K,Y0+L) ELSE LET C=0
CALL RGB(C,R,G,B)
LET R0=R0+(ABS(1-K)-XX*SGN_(1-K))*R
LET G0=G0+(ABS(1-K)-XX*SGN_(1-K))*G
LET B0=B0+(ABS(1-K)-XX*SGN_(1-K))*B
NEXT K
LET R1=R1+(ABS(1-L)-YY*SGN_(1-L))*R0
LET G1=G1+(ABS(1-L)-YY*SGN_(1-L))*G0
LET B1=B1+(ABS(1-L)-YY*SGN_(1-L))*B0
NEXT L
LET RR=MAX(0,MIN(255,R1))
LET GG=MAX(0,MIN(255,G1))
LET BB=MAX(0,MIN(255,B1))
END SUB
EXTERNAL SUB BICUBIC(X,Y,IMAGE(,),RR,GG,BB) !'バイキュービック法
OPTION ARITHMETIC NATIVE
LET XX=X-INT(X)
LET YY=Y-INT(Y)
LET X0=INT(X)
LET Y0=INT(Y)
FOR L=-1 TO 2
LET R0=0
LET G0=0
LET B0=0
FOR K=-1 TO 2
IF X0+K<XSIZE AND Y0+L<YSIZE AND X0+K>=0 AND Y0+L>=0 THEN LET C=IMAGE(X0+K,Y0+L) ELSE LET C=0
CALL RGB(C,R,G,B)
LET R0=R0+SINC(ABS(K)-XX*SGN_(K))*R
LET G0=G0+SINC(ABS(K)-XX*SGN_(K))*G
LET B0=B0+SINC(ABS(K)-XX*SGN_(K))*B
NEXT K
LET R1=R1+SINC(ABS(L)-YY*SGN_(L))*R0
LET G1=G1+SINC(ABS(L)-YY*SGN_(L))*G0
LET B1=B1+SINC(ABS(L)-YY*SGN_(L))*B0
NEXT L
LET RR=MAX(0,MIN(255,R1))
LET GG=MAX(0,MIN(255,G1))
LET BB=MAX(0,MIN(255,B1))
END SUB
EXTERNAL FUNCTION SINC(X)
OPTION ARITHMETIC NATIVE
LET X=ABS(X)
IF X<1 THEN
LET SINC=1-2*X*X+X*X*X
ELSEIF X<2 THEN
LET SINC=4-8*X+5*X*X-X*X*X
ELSE
LET SINC=0
END IF
END FUNCTION
!EXTERNAL FUNCTION SINC(X)
!IF X=0 THEN
! LET SINC=1
!ELSE
! LET SINC=SIN(PI*X)/(PI*X)
!END IF
!END FUNCTION
EXTERNAL FUNCTION SGN_(X)
OPTION ARITHMETIC NATIVE
IF X<=0 THEN LET SGN_=-1 ELSE LET SGN_=1
END FUNCTION
EXTERNAL SUB RGB(X,R,G,B)
OPTION ARITHMETIC NATIVE
LET B=MOD(INT(X/65536),256)
LET G=MOD(INT(X/256),256)
LET R=MOD(X,256)
END SUB
EXTERNAL SUB GINIT(XSIZE,YSIZE)
OPTION ARITHMETIC NATIVE
SET BITMAP SIZE XSIZE,YSIZE
CLEAR
SET COLOR MODE "NATIVE"
SET POINT STYLE 1
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
EXTERNAL SUB PSET(X,Y,R,G,B)
OPTION ARITHMETIC NATIVE
LET RR=MIN(255,MAX(0,INT(R)))
LET GG=MIN(255,MAX(0,INT(G)))
LET BB=MIN(255,MAX(0,INT(B)))
SET COLOR COLORINDEX(RR/255,GG/255,BB/255)
PLOT POINTS:X,Y
END SUB
EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
OPTION ARITHMETIC NATIVE
CLEAR
SET COLOR MODE "NATIVE"
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
|
|