REM ** 画像縮小補正プログラム **
OPTION ARITHMETIC NATIVE
DECLARE EXTERNAL SUB revision1,revision2
GLOAD "C:\Program Files\Decimal BASIC\BASICw32\SAMPLE\ZENKOUJI.JPG"
LET px0=PIXELX(1)
LET py0=PIXELY(1)
SET WINDOW 0,px0,0,py0
DIM pict0(0 TO px0,0 TO py0) ! 元画像(配列の下限は0以外も可)
SET COLOR MODE "NATIVE"
ASK PIXEL ARRAY (0,py0) pict0 ! 元画像の色指標
DO
LET err=0
INPUT PROMPT "[縮小率入力] 分子,分母 (分子=1 or 分子=分母-1)" : num,denom
IF num<1 OR INT(num)<>num THEN LET err=1
IF denom<2 OR INT(denom)<>denom THEN LET err=1
IF num<>1 AND num<>denom-1 THEN LET err=1
LOOP UNTIL err=0
LET t0=TIME
LET kk=num/denom ! 縮小率
MAT PLOT CELLS, IN px0-px0*kk,py0*kk ; px0,0 : pict0 !! 補正なし
!
LET px9=INT(SIZE(pict0,1)*kk+0.00001)-1 ! k=1/3,3*k<>1に対応
LET py9=INT(SIZE(pict0,2)*kk+0.00001)-1
DIM pict9(0 TO px9,0 TO py9) ! 縮小補正画像(配列の下限は0)
IF num=1 THEN
CALL revision1(pict0,pict9,denom) ! 縮小率=1/n
ELSE
CALL revision2(pict0,pict9,denom) ! 縮小率=(n-1)/n
END IF
IF TIME-t0<0.2 THEN WAIT DELAY 0.2
BEEP
SET TEXT COLOR "RED"
SET TEXT HEIGHT py0/30
PLOT TEXT ,AT 1,1 : "PUSH ANY KEY"
DO
FOR i=8 TO 239
IF GetKeyState(i)<0 THEN EXIT DO
NEXT i
LOOP
MAT PLOT CELLS, IN 0,py9 ; px9,0 : pict9 !! 補正あり
BEEP
END
REM 縮小率=1/n (1/2,1/3,1/4,...)
EXTERNAL SUB revision1(sp0(,),sp9(,),k)
OPTION ARITHMETIC NATIVE
LET kk=1/k
DIM c9(3)
LET lx0=LBOUND(sp0,1)
LET ly0=LBOUND(sp0,2)
LET ux0=UBOUND(sp0,1)
LET uy0=UBOUND(sp0,2)
LET ux9=UBOUND(sp9,1)
LET uy9=UBOUND(sp9,2)
FOR i=lx0 TO ux0-(k-1) STEP k
FOR j=ly0 TO uy0-(k-1) STEP k
MAT c9=ZER
FOR ii=0 TO k-1
FOR jj=0 TO k-1
CALL acm(i+ii,j+jj)
NEXT jj
NEXT ii
LET sp9((i-lx0)*kk,(j-ly0)*kk)=COLORINDEX(c9(1)/k^2,c9(2)/k^2,c9(3)/k^2)
NEXT j
NEXT i
LET rm2=MOD(uy0,k) ! 縁(横)の処理
IF rm2<>k-1 THEN
FOR i=lx0 TO ux0-(k-1) STEP k
MAT c9=ZER
FOR j=0 TO rm2
CALL acm(i,uy0-j)
NEXT j
LET sp9((i-lx0)*kk,uy9)=COLORINDEX(c9(1)/(rm2+1),c9(2)/(rm2+1),c9(3)/(rm2+1))
NEXT i
END IF
LET rm1=MOD(ux0,k) ! 縁(縦)の処理
IF rm1<>k-1 THEN
FOR j=ly0 TO uy0-(k-1) STEP k
MAT c9=ZER
FOR i=0 TO rm1
CALL acm(ux0-i,j)
NEXT i
LET sp9(ux9,(j-ly0)*kk)=COLORINDEX(c9(1)/(rm1+1),c9(2)/(rm1+1),c9(3)/(rm1+1))
NEXT j
END IF
IF rm1<>k-1 OR rm2<>k-1 THEN ! 角の処理
MAT c9=ZER
FOR i=0 TO rm1
FOR j=0 TO rm2
CALL acm(ux0-i,uy0-j)
NEXT j
NEXT i
LET rm12=(rm1+1)*(rm2+1)
LET sp9(ux9,uy9)=COLORINDEX(c9(1)/rm12,c9(2)/rm12,c9(3)/rm12)
END IF
SUB acm(x0,y0)
ASK COLOR MIX(sp0(x0,y0)) b,g,r
LET c9(1)=c9(1)+b
LET c9(2)=c9(2)+g
LET c9(3)=c9(3)+r
END SUB
END SUB
REM 縮小率=(n-1)/n (2/3,3/4,4/5,...)
EXTERNAL SUB revision2(sp0(,),sp9(,),k)
OPTION ARITHMETIC NATIVE
DECLARE FUNCTION c_ave
LET kk=(k-1)/k
LET num1=(k-1)-1
LET lx0=LBOUND(sp0,1)
LET ly0=LBOUND(sp0,2)
LET ux0=UBOUND(sp0,1)
LET uy0=UBOUND(sp0,2)
LET ux9=UBOUND(sp9,1)
LET uy9=UBOUND(sp9,2)
FOR i=lx0 TO ux0-k STEP k
FOR j=ly0 TO uy0-k STEP k
CALL center
CALL side1(i,j,1,0)
CALL side1(i+k,j,-1,num1)
CALL side2(i,j,1,0)
CALL side2(i,j+k,-1,num1)
CALL corner(i,j,1,1,0,0)
CALL corner(i,j+k,1,-1,0,num1)
CALL corner(i+k,j,-1,1,num1,0)
CALL corner(i+k,j+k,-1,-1,num1,num1)
NEXT j
NEXT i
LET x8=(i-lx0-k)*kk+num1
LET y8=(j-ly0-k)*kk+num1
IF uy9<>y8 THEN CALL edge1
IF ux9<>x8 THEN CALL edge2
IF ux9<>x8 AND uy9<>y8 THEN CALL edge_corner
FUNCTION c_ave(c1,c2) ! 色強度加重平均
ASK COLOR MIX(c1) b1,g1,r1
ASK COLOR MIX(c2) b2,g2,r2
LET c_ave=COLORINDEX((b1+2*b2)/3,(g1+2*g2)/3,(r1+2*r2)/3)
END FUNCTION
SUB center
FOR ii=2 TO num1
FOR jj=2 TO num1
LET sp9((i-lx0)*kk+ii-1,(j-ly0)*kk+jj-1)=sp0(i+ii,j+jj)
NEXT jj
NEXT ii
END SUB
SUB side1(x,y,ii,m)
FOR jj=2 TO num1
LET sp9((i-lx0)*kk+m,(j-ly0)*kk+jj-1)=c_ave(sp0(x,y+jj),sp0(x+ii,y+jj))
NEXT jj
END SUB
SUB side2(x,y,jj,n)
FOR ii=2 TO num1
LET sp9((i-lx0)*kk+ii-1,(j-ly0)*kk+n)=c_ave(sp0(x+ii,y),sp0(x+ii,y+jj))
NEXT ii
END SUB
SUB corner(x,y,ii,jj,m,n)
ASK COLOR MIX(sp0(x,y)) b1,g1,r1
ASK COLOR MIX(sp0(x,y+jj)) b2,g2,r2
ASK COLOR MIX(sp0(x+ii,y)) b3,g3,r3
ASK COLOR MIX(sp0(x+ii,y+jj)) b4,g4,r4
LET bb=(b1+2*b2+2*b3+4*b4)/9
LET gg=(g1+2*g2+2*g3+4*g4)/9
LET rr=(r1+2*r2+2*r3+4*r4)/9
LET sp9((i-lx0)*kk+m,(j-ly0)*kk+n)=COLORINDEX(bb,gg,rr)
END SUB
SUB edge1
FOR i=lx0 TO ux0-k STEP k ! 下辺の処理
FOR ii=0 TO num1
FOR jj=0 TO uy9-y8-2
LET sp9((i-lx0)*kk+ii,uy9-jj)=sp0(i+ii+1,uy0-jj)
NEXT jj
LET sp9((i-lx0)*kk+ii,uy9-jj)=c_ave(sp0(i+ii+1,uy0-(jj+1)),sp0(i+ii+1,uy0-jj))
NEXT ii
NEXT i
END SUB
SUB edge2
FOR j=ly0 TO uy0-k STEP k ! 右辺の処理
FOR jj=0 TO num1
FOR ii=0 TO ux9-x8-2
LET sp9(ux9-ii,(j-ly0)*kk+jj)=sp0(ux0-ii,j+jj+1)
NEXT ii
LET sp9(ux9-ii,(j-ly0)*kk+jj)=c_ave(sp0(ux0-(ii+1),j+jj+1),sp0(ux0-ii,j+jj+1))
NEXT jj
NEXT j
END SUB
SUB edge_corner
FOR ii=ux9 TO x8+1 STEP-1
FOR jj=uy9 TO y8+1 STEP-1
LET sp9(ii,jj)=sp0(ux0-(ux9-ii),uy0-(uy9-jj))
NEXT jj
NEXT ii
END SUB
END SUB
FUNCTION phi(k,i,N) !基底関数φk(i)
IF k=0 THEN
LET phi=1/SQR(N)
ELSE
LET phi=SQR(2/N)*COS((2*i+1)*k*PI/(2*N))
END IF
END FUNCTION
SUB DCT(f(,),TBL(,),iTBL(,), FF(,)) !DCT変換
MAT FF=TBL*f
MAT FF=FF*iTBL !F(k,l)=Σ[j=0,N-1]Σ[i=0,N-1]f(i,j)*φk(i)*φl(j)
END SUB
SUB iDCT(FF(,),TBL(,),iTBL(,), f(,)) !DCT逆変換
MAT f=iTBL*FF
MAT f=f*TBL !f(i,j)=Σ[l=0,N-1]Σ[k=0,N-1]F(k,l)*φk(i)*φl(j)
END SUB
DIM TBLn(0 TO N-1,0 TO N-1) !変換行列 T
MAT TBLn=ZER
FOR k=0 TO N-1 !N×Nブロックのφk(i)のテーブルをつくる
FOR i=0 TO N-1
LET TBLn(k,i)=phi(k,i,N)
NEXT i
NEXT k
!!!MAT PRINT TBLn;
DIM iTBLn(N,N) !※T^-1=T^t、∵ユニタリー行列
MAT iTBLn=TRN(TBLn)
!-------------------- ここまでがサブルーチン
SET COLOR MODE "NATIVE"
!GLOAD "c:\BASICw32\SAMPLE\ZENKOUJI.JPG" !画像を読み込む
GLOAD "c:\My Documents\test2.bmp" !画像を読み込む
ASK PIXEL SIZE (0,0; 1,1) w,h !画像の縦横の大きさ(ピクセル単位)を調べる
DIM p(w,h) !画像の大きさに対応する配列要素を用意する
ASK PIXEL ARRAY (0,1) p !画像の各点の色情報を配列に格納する
PRINT "画像の大きさ 縦:";h;" 横:";w
!SET BITMAP SIZE w,h !ウィンドウの大きさを画像に合わせる
LET A=5 !拡大縮小率 A/N
!LET A=11 !拡大縮小率
LET ww=INT(w*A/N+0.5) !変換後の画像の大きさ
LET hh=INT(h*A/N+0.5)
PRINT A;"/";N;"倍（縦横比は固定） 縦:";hh;" 横:";ww
IF ww<=0 OR hh<=0 THEN
PRINT "画像の大きさが０または負になります。"
STOP
END IF
DIM q(ww,hh) !変換後の画像を格納する配列
LET t0=TIME
DIM TBLa(0 TO A-1,0 TO A-1)
MAT TBLa=ZER
FOR k=0 TO A-1 !A×Aブロックのφk(i)のテーブルをつくる
FOR i=0 TO A-1
LET TBLa(k,i)=phi(k,i,A)
NEXT i
NEXT k
DIM iTBLa(0 TO A-1,0 TO A-1)
MAT iTBLa=TRN(TBLa)
FOR by=0 TO INT((h-1)/N) !ブロック単位に分割する
FOR bx=0 TO INT((w-1)/N)
FOR j=1 TO N !ブロック内の画像
LET y=by*N+j
IF y>h THEN EXIT FOR !下端なら
FOR i=1 TO N
LET x=bx*N+i
IF x>w THEN EXIT FOR !右端なら
!!!PRINT x;y,i;j
LET c=p(x,y)
ASK COLOR MIX(c) r,g,b !RGBを取得する
DIM Br(N,N),Bg(N,N),Bb(N,N) !画素の色濃度 ※画像信号 f(i,j)
LET Br(i,j)=r
LET Bg(i,j)=g
LET Bb(i,j)=b
NEXT i
NEXT j
!※縮小なら高周波成分の行と列を除く、拡大なら不足部分は０を補う
DIM Tr(A,A),Tg(A,A),Tb(A,A)
IF A>N THEN !拡大なら
MAT Tr=ZER(A,A)
MAT Tg=ZER(A,A)
MAT Tb=ZER(A,A)
END IF
FOR j=1 TO MIN(N,A) !copy it
FOR i=1 TO MIN(N,A)
LET Tr(i,j)=BVr(i,j)
LET Tg(i,j)=BVg(i,j)
LET Tb(i,j)=BVb(i,j)
NEXT i
NEXT j
画像縮小補正プログラム
投稿者：荒田浩二 投稿日：2008年10月15日(水)19時32分55秒MAT PLOT CELLSで画像を縮小して描画したときに生じるジャギー(ギザギザ)を補正するものです。
縮小により欠損する画素の色情報を周囲の画素と加重平均しました。
補正できる縮小率は次の2通りです。
1/2,1/3,1/4,...といった 1/n のタイプ。
2/3,3/4,4/5,...といった (n-1)/n のタイプ。
縮小率を入力すると、まず画面右下に補正なしの画像が描画されます。
ビープ音の後、何かキーを押すと左下に補正した画像が描画されます。
プログラムで読み込んでいる画像は十進BASIC添付ファイルですが、サイズが小さいためか補正の効果をあまり確認できません。
ぜひ、アップした写真をデスクトップにでもコピー＆ペーストして試してみてください。
この写真は個人が撮影したもので著作権に問題はありません。
(JPEG形式でUpしたので画質が落ちてますが、DownLoadするとBMP形式で保存されます。)
(掲示されているサイズは400×300、拡大すると元のサイズ800×600になります。どちらのサイズもダウンロードできます)
REM ** 画像縮小補正プログラム **
OPTION ARITHMETIC NATIVE
DECLARE EXTERNAL SUB revision1,revision2
GLOAD "C:\Program Files\Decimal BASIC\BASICw32\SAMPLE\ZENKOUJI.JPG"
LET px0=PIXELX(1)
LET py0=PIXELY(1)
SET WINDOW 0,px0,0,py0
DIM pict0(0 TO px0,0 TO py0) ! 元画像(配列の下限は0以外も可)
SET COLOR MODE "NATIVE"
ASK PIXEL ARRAY (0,py0) pict0 ! 元画像の色指標
DO
LET err=0
INPUT PROMPT "[縮小率入力] 分子,分母 (分子=1 or 分子=分母-1)" : num,denom
IF num<1 OR INT(num)<>num THEN LET err=1
IF denom<2 OR INT(denom)<>denom THEN LET err=1
IF num<>1 AND num<>denom-1 THEN LET err=1
LOOP UNTIL err=0
LET t0=TIME
LET kk=num/denom ! 縮小率
MAT PLOT CELLS, IN px0-px0*kk,py0*kk ; px0,0 : pict0 !! 補正なし
!
LET px9=INT(SIZE(pict0,1)*kk+0.00001)-1 ! k=1/3,3*k<>1に対応
LET py9=INT(SIZE(pict0,2)*kk+0.00001)-1
DIM pict9(0 TO px9,0 TO py9) ! 縮小補正画像(配列の下限は0)
IF num=1 THEN
CALL revision1(pict0,pict9,denom) ! 縮小率=1/n
ELSE
CALL revision2(pict0,pict9,denom) ! 縮小率=(n-1)/n
END IF
IF TIME-t0<0.2 THEN WAIT DELAY 0.2
BEEP
SET TEXT COLOR "RED"
SET TEXT HEIGHT py0/30
PLOT TEXT ,AT 1,1 : "PUSH ANY KEY"
DO
FOR i=8 TO 239
IF GetKeyState(i)<0 THEN EXIT DO
NEXT i
LOOP
MAT PLOT CELLS, IN 0,py9 ; px9,0 : pict9 !! 補正あり
BEEP
END
REM 縮小率=1/n (1/2,1/3,1/4,...)
EXTERNAL SUB revision1(sp0(,),sp9(,),k)
OPTION ARITHMETIC NATIVE
LET kk=1/k
DIM c9(3)
LET lx0=LBOUND(sp0,1)
LET ly0=LBOUND(sp0,2)
LET ux0=UBOUND(sp0,1)
LET uy0=UBOUND(sp0,2)
LET ux9=UBOUND(sp9,1)
LET uy9=UBOUND(sp9,2)
FOR i=lx0 TO ux0-(k-1) STEP k
FOR j=ly0 TO uy0-(k-1) STEP k
MAT c9=ZER
FOR ii=0 TO k-1
FOR jj=0 TO k-1
CALL acm(i+ii,j+jj)
NEXT jj
NEXT ii
LET sp9((i-lx0)*kk,(j-ly0)*kk)=COLORINDEX(c9(1)/k^2,c9(2)/k^2,c9(3)/k^2)
NEXT j
NEXT i
LET rm2=MOD(uy0,k) ! 縁(横)の処理
IF rm2<>k-1 THEN
FOR i=lx0 TO ux0-(k-1) STEP k
MAT c9=ZER
FOR j=0 TO rm2
CALL acm(i,uy0-j)
NEXT j
LET sp9((i-lx0)*kk,uy9)=COLORINDEX(c9(1)/(rm2+1),c9(2)/(rm2+1),c9(3)/(rm2+1))
NEXT i
END IF
LET rm1=MOD(ux0,k) ! 縁(縦)の処理
IF rm1<>k-1 THEN
FOR j=ly0 TO uy0-(k-1) STEP k
MAT c9=ZER
FOR i=0 TO rm1
CALL acm(ux0-i,j)
NEXT i
LET sp9(ux9,(j-ly0)*kk)=COLORINDEX(c9(1)/(rm1+1),c9(2)/(rm1+1),c9(3)/(rm1+1))
NEXT j
END IF
IF rm1<>k-1 OR rm2<>k-1 THEN ! 角の処理
MAT c9=ZER
FOR i=0 TO rm1
FOR j=0 TO rm2
CALL acm(ux0-i,uy0-j)
NEXT j
NEXT i
LET rm12=(rm1+1)*(rm2+1)
LET sp9(ux9,uy9)=COLORINDEX(c9(1)/rm12,c9(2)/rm12,c9(3)/rm12)
END IF
SUB acm(x0,y0)
ASK COLOR MIX(sp0(x0,y0)) b,g,r
LET c9(1)=c9(1)+b
LET c9(2)=c9(2)+g
LET c9(3)=c9(3)+r
END SUB
END SUB
REM 縮小率=(n-1)/n (2/3,3/4,4/5,...)
EXTERNAL SUB revision2(sp0(,),sp9(,),k)
OPTION ARITHMETIC NATIVE
DECLARE FUNCTION c_ave
LET kk=(k-1)/k
LET num1=(k-1)-1
LET lx0=LBOUND(sp0,1)
LET ly0=LBOUND(sp0,2)
LET ux0=UBOUND(sp0,1)
LET uy0=UBOUND(sp0,2)
LET ux9=UBOUND(sp9,1)
LET uy9=UBOUND(sp9,2)
FOR i=lx0 TO ux0-k STEP k
FOR j=ly0 TO uy0-k STEP k
CALL center
CALL side1(i,j,1,0)
CALL side1(i+k,j,-1,num1)
CALL side2(i,j,1,0)
CALL side2(i,j+k,-1,num1)
CALL corner(i,j,1,1,0,0)
CALL corner(i,j+k,1,-1,0,num1)
CALL corner(i+k,j,-1,1,num1,0)
CALL corner(i+k,j+k,-1,-1,num1,num1)
NEXT j
NEXT i
LET x8=(i-lx0-k)*kk+num1
LET y8=(j-ly0-k)*kk+num1
IF uy9<>y8 THEN CALL edge1
IF ux9<>x8 THEN CALL edge2
IF ux9<>x8 AND uy9<>y8 THEN CALL edge_corner
FUNCTION c_ave(c1,c2) ! 色強度加重平均
ASK COLOR MIX(c1) b1,g1,r1
ASK COLOR MIX(c2) b2,g2,r2
LET c_ave=COLORINDEX((b1+2*b2)/3,(g1+2*g2)/3,(r1+2*r2)/3)
END FUNCTION
SUB center
FOR ii=2 TO num1
FOR jj=2 TO num1
LET sp9((i-lx0)*kk+ii-1,(j-ly0)*kk+jj-1)=sp0(i+ii,j+jj)
NEXT jj
NEXT ii
END SUB
SUB side1(x,y,ii,m)
FOR jj=2 TO num1
LET sp9((i-lx0)*kk+m,(j-ly0)*kk+jj-1)=c_ave(sp0(x,y+jj),sp0(x+ii,y+jj))
NEXT jj
END SUB
SUB side2(x,y,jj,n)
FOR ii=2 TO num1
LET sp9((i-lx0)*kk+ii-1,(j-ly0)*kk+n)=c_ave(sp0(x+ii,y),sp0(x+ii,y+jj))
NEXT ii
END SUB
SUB corner(x,y,ii,jj,m,n)
ASK COLOR MIX(sp0(x,y)) b1,g1,r1
ASK COLOR MIX(sp0(x,y+jj)) b2,g2,r2
ASK COLOR MIX(sp0(x+ii,y)) b3,g3,r3
ASK COLOR MIX(sp0(x+ii,y+jj)) b4,g4,r4
LET bb=(b1+2*b2+2*b3+4*b4)/9
LET gg=(g1+2*g2+2*g3+4*g4)/9
LET rr=(r1+2*r2+2*r3+4*r4)/9
LET sp9((i-lx0)*kk+m,(j-ly0)*kk+n)=COLORINDEX(bb,gg,rr)
END SUB
SUB edge1
FOR i=lx0 TO ux0-k STEP k ! 下辺の処理
FOR ii=0 TO num1
FOR jj=0 TO uy9-y8-2
LET sp9((i-lx0)*kk+ii,uy9-jj)=sp0(i+ii+1,uy0-jj)
NEXT jj
LET sp9((i-lx0)*kk+ii,uy9-jj)=c_ave(sp0(i+ii+1,uy0-(jj+1)),sp0(i+ii+1,uy0-jj))
NEXT ii
NEXT i
END SUB
SUB edge2
FOR j=ly0 TO uy0-k STEP k ! 右辺の処理
FOR jj=0 TO num1
FOR ii=0 TO ux9-x8-2
LET sp9(ux9-ii,(j-ly0)*kk+jj)=sp0(ux0-ii,j+jj+1)
NEXT ii
LET sp9(ux9-ii,(j-ly0)*kk+jj)=c_ave(sp0(ux0-(ii+1),j+jj+1),sp0(ux0-ii,j+jj+1))
NEXT jj
NEXT j
END SUB
SUB edge_corner
FOR ii=ux9 TO x8+1 STEP-1
FOR jj=uy9 TO y8+1 STEP-1
LET sp9(ii,jj)=sp0(ux0-(ux9-ii),uy0-(uy9-jj))
NEXT jj
NEXT ii
END SUB
END SUB