dcsimg
Results 1 to 2 of 2

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

  1. #1

    Thread Starter
    Hyperactive Member
    Join Date
    Sep 2010
    Location
    Italy
    Posts
    430

    Post 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

  2. #2
    Fanatic Member
    Join Date
    May 2014
    Location
    Preveza Greece
    Posts
    948

    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...
    Read about WithEvents.

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


Click Here to Expand Forum to Full Width