 # Thread: VB6 - 2D DCT & IDCT - Separable Discrete Cosine Transform (Any Size)

1. ## VB6 - 2D DCT & IDCT - Separable Discrete Cosine Transform (Any Size)

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```  Reply With Quote

2. ## Re: VB6 - 2D DCT & IDCT - Separable Discrete Cosine Transform (Any Size)

Don't use doevents. Put code in a class and pit a raiseevent to return the percentage of job execution. So you make your code as part of message's process...  Reply With Quote

#### Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts
•

Featured