After may attempts I succeed on coding separable 2D DCT IDCT (II) of any size rectangular window.
Here is the Code:
Here is the Code:
Code:
Private Function alpha(value As Long) As Double
If value = 0 Then
alpha = 0.707106781186547 '1 / Sqr(2)
Else
alpha = 1
End If
End Function
Public Function MyDCT(INP() As Double) As Double()
Dim W As Long
Dim H As Long
Dim K() As Double
Dim aU As Double
Dim aV As Double
Dim invW As Double
Dim invH As Double
Dim DivisorW As Double
Dim DivisorH As Double
Dim Sum As Double
Dim U As Long
Dim v As Long
Dim X As Long
Dim Y As Long
Dim byX() As Double
Dim Matrix() As Double
W = UBound(INP(), 1)
H = UBound(INP(), 2)
ReDim Matrix(W, H)
invW = 1 / (2 * (W + 1))
invH = 1 / (2 * (H + 1))
DivisorW = 2 / (W + 1)
DivisorH = 2 / (H + 1)
'Do by X---------------------------------------------------------
ReDim K(W, W)
For U = 0 To W
aU = alpha(U)
For X = 0 To W
K(X, U) = aU * Cos(((2 * X + 1) * U * PI) * invW)
Next
Next
ReDim byX(W, H)
For Y = 0 To H
For X = 0 To W
Sum = 0
For U = 0 To W
Sum = Sum + INP(U, Y) * K(U, X)
Next
byX(X, Y) = Sum * DivisorW
Next
DoEvents
Next
'-------------------------------------------------------------------
'Do by y
ReDim K(H, H)
For v = 0 To H
aV = alpha(v)
For Y = 0 To H
K(Y, v) = aV * Cos(((2 * Y + 1) * v * PI) * invH)
Next
Next
For X = 0 To W
For Y = 0 To H
Sum = 0
For v = 0 To H
Sum = Sum + byX(X, v) * K(v, Y)
Next
Matrix(X, Y) = Sum * DivisorH
Next
DoEvents
Next
MyDCT = Matrix
End Function
Public Function MyIDCT(INP() As Double) As Double()
Dim W As Long
Dim H As Long
Dim K() As Double
Dim aU As Double
Dim aV As Double
Dim invW As Double
Dim invH As Double
Dim DivisorW As Double
Dim DivisorH As Double
Dim Sum As Double
Dim U As Long
Dim v As Long
Dim X As Long
Dim Y As Long
Dim byX() As Double
Dim Inverse() As Double
W = UBound(INP(), 1)
H = UBound(INP(), 2)
ReDim Inverse(W, H)
invW = 1 / (2 * (W + 1))
invH = 1 / (2 * (H + 1))
DivisorW = 2 / (W + 1)
DivisorH = 2 / (H + 1)
ReDim K(W, W)
For U = 0 To W
For X = 0 To W
aU = alpha(X)
K(X, U) = aU * Cos(((2 * U + 1) * X * PI) * invW)
Next
Next
ReDim byX(W, H)
For Y = 0 To H
For X = 0 To W
Sum = 0
For U = 0 To W
Sum = Sum + INP(U, Y) * K(U, X)
Next
byX(X, Y) = Sum '* DivisorW
Next
DoEvents
Next
'-------------------------------------------------------------------
'Do by y
ReDim K(H, H)
For v = 0 To H
For Y = 0 To H
aV = alpha(Y)
K(Y, v) = aV * Cos(((2 * v + 1) * Y * PI) * invH)
Next
Next
For X = 0 To W
For Y = 0 To H
Sum = 0
For v = 0 To H
Sum = Sum + byX(X, v) * K(v, Y)
Next
Inverse(X, Y) = Sum '* DivisorH
Next
DoEvents
Next
MyIDCT = Inverse
End Function