After may attempts I succeeded on coding separable 2D DCT IDCT (II) of any size rectangular window.

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