Public Sub ZoomImage(ByVal OutPutWidth As Long, ByVal OutputHeight As Long)
Dim I As Long
Dim L As Long
Dim X As Long
Dim Y As Long
Dim Xb As Long
Dim Yb As Long
Dim Xe As Long
Dim Ye As Long
Dim M As Integer
Dim N As Integer
Dim CurR As Long
Dim CurG As Long
Dim CurB As Long
Dim NxtR As Integer
Dim NxtG As Integer
Dim NxtB As Integer
Dim DR As Single
Dim DG As Single
Dim DB As Single
Dim DRt As Single
Dim DGt As Single
Dim DBt As Single
Dim Xratio As Single
Dim Yratio As Single
Dim CurStep As Single
Dim NxtStep As Single
Dim NegN As Single
On Error GoTo ErrLine
If Not CanZoom Then Exit Sub
Done = False
NegN = 1 / Int(Yratio + 1)
For X = 0 To InPutWid
CurR = ColVal(0, X, 0)
CurG = ColVal(1, X, 0)
CurB = ColVal(2, X, 0)
CurStep = 0
NxtStep = 0
For Y = 0 To InPutHei - 1
NxtStep = CurStep + Yratio
Yb = CurStep
Ye = NxtStep
N = Ye - Yb
ColTmp(0, X, Yb) = CurR
ColTmp(1, X, Yb) = CurG
ColTmp(2, X, Yb) = CurB
M = Y + 1
NxtR = ColVal(0, X, M)
NxtG = ColVal(1, X, M)
NxtB = ColVal(2, X, M)
If N > 1 Then
DRt = (NxtR - CurR) * NegN
DGt = (NxtG - CurG) * NegN
DBt = (NxtB - CurB) * NegN
DR = 0
DG = 0
DB = 0
For L = Yb + 1 To Ye - 1
DR = DR + DRt
DG = DG + DGt
DB = DB + DBt
ColTmp(0, X, L) = CurR + DR
ColTmp(1, X, L) = CurG + DG
ColTmp(2, X, L) = CurB + DB
Next
End If
CurStep = NxtStep
CurR = NxtR
CurG = NxtG
CurB = NxtB
Next
ColTmp(0, X, OutPutHei) = NxtR
ColTmp(1, X, OutPutHei) = NxtG
ColTmp(2, X, OutPutHei) = NxtB
Next
NegN = 1 / Int(Xratio + 1)
For Y = 0 To OutPutHei
CurR = ColTmp(0, 0, Y)
CurG = ColTmp(1, 0, Y)
CurB = ColTmp(2, 0, Y)
CurStep = 0
NxtStep = 0
For X = 0 To InPutWid - 1
NxtStep = CurStep + Xratio
Xb = CurStep
Xe = NxtStep
N = Xe - Xb
ColOut(0, Xb, Y) = CurR
ColOut(1, Xb, Y) = CurG
ColOut(2, Xb, Y) = CurB
M = X + 1
NxtR = ColTmp(0, M, Y)
NxtG = ColTmp(1, M, Y)
NxtB = ColTmp(2, M, Y)
If N > 1 Then
DRt = (NxtR - CurR) * NegN
DGt = (NxtG - CurG) * NegN
DBt = (NxtB - CurB) * NegN
DR = 0
DG = 0
DB = 0
For L = Xb + 1 To Xe - 1
DR = DR + DRt
DG = DG + DGt
DB = DB + DBt
ColOut(0, L, Y) = CurR + DR
ColOut(1, L, Y) = CurG + DG
ColOut(2, L, Y) = CurB + DB
Next
End If
CurStep = NxtStep
CurR = NxtR
CurG = NxtG
CurB = NxtB
Next
ColOut(0, OutPutWid, Y) = NxtR
ColOut(1, OutPutWid, Y) = NxtG
ColOut(2, OutPutWid, Y) = NxtB
Next
Done = True
TimeZoom = timeGetTime - TimeZoom
CanPut = True
Exit Sub
ErrLine:
MsgBox Err.Description
End Sub
全局變量定義：
Dim ColTmp() As Byte '用於保存插值中間變量
Dim OutPutHei As Long '要插值的目標高度
Dim OutPutWid As Long '要插值的目標寬度
Public TimeZoom As Long '插值運算使用的時間
簡單解釋一下關於二次線性插值算法。
（為了說明算法本身，我們只計算這個圖片的紅色份量，因為紅綠藍三種顏色的計算方法完全相同）
假設我們有一個很簡單的圖片，圖片只有4個像素（2*2）
A B
C D
現在我們要把這個圖片插值到9個像素：3*3
A ab B
ac abcd bd
C cd D
其中大寫的字母代表原來的像素，小寫字母代表插值得到的新像素。
想必看到這個圖，大家心裡已經有了這個算法了。
ab=(A+B) / 2
cd=(C+D) / 2
ac=(A+C) / 2
bd=(B+D) / 2
abcd=(ab+cd) / 2＝(A+B+C+D) / 4
推導：ab= A + (B-A) / 2
cd=C +(D-C) / 2
...
很簡單，對吧，先從一個方向把只涉及兩個原始像素的新像素算出來。我們這裡假定先計算水平方向。
而在算垂直方向的插值的時候，因為ab和cd已經在前面算好了，所以abcd的計算也和計算ac和bd沒有任何區別了。
有可能為有朋友已經想到把原來的圖像插值到4*4或5*5的方法了。
A ab1 ab2 B
ac1 ab1cd11 ab2cd21 bd1
ac2 ab1cd12 ab2cd22 bd2
C cd1 cd2 D
先把
A B
C D
變成：
A ab1...abN B
C cd1...cdN D
再變成
A ab1...abN B
ac1 ............. db1
... ............ ...
acN .............. bdN
C cd1...cdN D
這兩個方向的插值算法完全相同
新浪微博
QQ空间
人人网
腾讯微博
Facebook
Google+
Plurk
Twitter
Line