Public Sub DoRotate(Optional ByVal RotaryAngle As Long = 0) ‘任意角度旋转
Dim sDIB As New cDIB
 Dim sBits() As RGBQUAD
    Dim dBits() As RGBQUAD
    Dim stSA    As SAFEARRAY2D
    Dim dtSA    As SAFEARRAY2D
    Dim Lev     As Long
    Dim Wgt     As Long
    Dim x As Long
    Dim y As Long
    Dim newW As Long, W As Long
    Dim newH As Long, H As Long
    Dim f1 As Double, f2 As Double
If (m_hDIB <> 0) Then
‘+++++++++++++++
        Dim OldWidth, OldHeight As Integer
        Dim NewWidth, NewHeight As Integer
        Dim Theta As Double
        Dim dx, dy As Single
        Dim dxx, dyy As Integer
        Dim rx0, ry0 As Double
        ‘ 源图四个角的坐标(以图像中心为坐标系原点)
        Dim SrcX1, SrcY1, SrcX2, SrcY2, SrcX3, SrcY3, SrcX4, SrcY4, ThetaCos, ThetaSin As Double
        
        OldWidth = m_tBIH.biWidth - 1
        OldHeight = m_tBIH.biHeight - 1
        
        SrcX1 = -(OldWidth - 1) / 2
        SrcY1 = (OldHeight - 1) / 2
        SrcX2 = (OldWidth - 1) / 2
        SrcY2 = (OldHeight - 1) / 2
        SrcX3 = -(OldWidth - 1) / 2
        SrcY3 = -(OldHeight - 1) / 2
        SrcX4 = (OldWidth - 1) / 2
        SrcY4 = -(OldHeight - 1) / 2
        
        Theta = RotaryAngle / 180 * 3.141592653
        ThetaCos = Cos(Theta)
        ThetaSin = Sin(Theta)
    
        ‘// 旋转后四个角的坐标(以图像中心为坐标系原点)
        Dim DstX1, DstY1, DstX2, DstY2, DstX3, DstY3, DstX4, DstY4 As Double
        DstX1 = Cos(Theta) * SrcX1 + Sin(Theta) * SrcY1
        DstY1 = -Sin(Theta) * SrcX1 + Cos(Theta) * SrcY1
        DstX2 = Cos(Theta) * SrcX2 + Sin(Theta) * SrcY2
        DstY2 = -Sin(Theta) * SrcX2 + Cos(Theta) * SrcY2
        DstX3 = Cos(Theta) * SrcX3 + Sin(Theta) * SrcY3
        DstY3 = -Sin(Theta) * SrcX3 + Cos(Theta) * SrcY3
        DstX4 = Cos(Theta) * SrcX4 + Sin(Theta) * SrcY4
        DstY4 = -Sin(Theta) * SrcX4 + Cos(Theta) * SrcY4
        
        NewWidth = IIf(Abs(DstX4 - DstX1) > Abs(DstX3 - DstX2), Abs(DstX4 - DstX1), Abs(DstX3 - DstX2)) + 0.5 ‘+ 50
        NewHeight = IIf(Abs(DstY4 - DstY1) > Abs(DstY3 - DstY2), Abs(DstY4 - DstY1), Abs(DstY3 - DstY2)) + 0.5 ‘+ 50
        
        rx0 = OldWidth * 0.5 ‘(rx0,ry0)为旋转中心
        ry0 = OldHeight * 0.5
        f1 = -0.5 * (NewWidth - 1) * ThetaCos + 0.5 * (NewHeight - 1) * ThetaSin + 0.5 * (OldWidth - 1)
        f2 = -0.5 * (NewWidth - 1) * ThetaSin - 0.5 * (NewHeight - 1) * ThetaCos + 0.5 * (OldHeight - 1)
‘+++++++++++++++
        ‘-- Get source Bits
        Call sDIB.Create(m_tBIH.biWidth, m_tBIH.biHeight)
        Call sDIB.LoadBlt(m_hDC)
        Call pvBuildSA(stSA, sDIB)
        Call CopyMemory(ByVal VarPtrArray(sBits()), VarPtr(stSA), 4)
        ‘-- Create new DIB
        Call Create(NewWidth, NewHeight)
        Call pvBuildSA(dtSA, Me)
        Call CopyMemory(ByVal VarPtrArray(dBits()), VarPtr(dtSA), 4)
        W = NewWidth
        H = NewHeight
        For y = 1 To H - 1
            For x = 1 To W - 1
                With dBits(x, y)
                
                    dxx = CInt(x * ThetaCos - y * ThetaSin + f1 + 0.5)
                    dyy = CInt(x * ThetaSin + y * ThetaCos + f2 + 0.5)
                    If dxx > 0 And dyy > 0 And dxx < OldWidth And dyy < OldHeight Then
                    .B = sBits(dxx, dyy).B
                    .G = sBits(dxx, dyy).G
                    .R = sBits(dxx, dyy).R
                    Else
                    .B = 0
                    .G = 0
                    .R = 0
                    End If
                End With
            Next x
            RaiseEvent Progress(y)
        Next y
        Call CopyMemory(ByVal VarPtrArray(sBits), 0&, 4)
        Call CopyMemory(ByVal VarPtrArray(dBits), 0&, 4)
        RaiseEvent ProgressEnd
    End If
End Sub
+++++++++++++++
Public Function Hungh(DIB As cDIB, Optional ByVal Level As Byte = 95) As Integer ‘二值化
    Dim Bits() As RGBQUAD
    Dim tSA    As SAFEARRAY2D
Dim L As Byte
    Dim npp(0 To 180, 0 To 1000) As Integer ‘hungh变换后数组
    Dim maxA, kmax, pMax, mp, tempL As Integer ‘最大角度 180
    Dim Radian As Double
    Dim m, n, k As Integer
    Dim p As Integer ‘hough变换中的距离参数
    maxA = 180
    kmax = 0 ‘记录最长直线的角度
    pMax = 0 ‘记录最长直线的距离
Radian = 3.141592653 / 180
    If (DIB.hDIB <> 0) Then
        pvBuildSA tSA, DIB
        CopyMemory ByVal VarPtrArray(Bits()), VarPtr(tSA), 4
        W = DIB.Width - 1
        H = DIB.Height - 1
mp = Sqr(W * W + H * H)
        For y = 2 To H - 2
            For x = 2 To W - 2
                With Bits(x, y)
                    L = 0.114 * .B + 0.587 * .G + 0.299 * .R
                    If L = 0 Then
                        For k = 1 To maxA
                            
                            p = CInt(x * Cos(Radian * k) + y * Sin(Radian * k))  ‘p hough变换中的距离参数
                            p = CInt(p / 2 + mp / 2) ‘对P值优化,防止为负值
                            ‘If p < 0 Then Stop
                            npp(k, p) = npp(k, p) + 1 ‘npp对变换域中对应重复出现的点累加
                        
                        Next k
                    End If
                End With
            Next x
            RaiseEvent Progress(y)
        Next y
        
        
        For m = 1 To maxA ‘maxa=180
            For n = 1 To mp ‘mp为原图对角线距离
                If npp(m, n) > tempL Then
                    tempL = npp(m, n) ‘找出最长直线 tempL为中间变量用于比较
                    kmax = m ‘记录最长直线的角度
                    pMax = n ‘记录最长直线的距离
                End If
            Next n
        
        Next m
         
         For y = 2 To H - 2
            For x = 2 To W - 2
                With Bits(x, y)
                    L = 0.114 * .B + 0.587 * .G + 0.299 * .R
                    If L = 0 Then
                            
                            p = CInt(x * Cos(Radian * kmax) + y * Sin(Radian * kmax))  ‘p hough变换中的距离参数
                            p = CInt(p / 2 + mp / 2) ‘对P值优化,防止为负值
                            If p = pMax Then
                                .G = 0
                                .B = 255
                                .R = 0
                            End If
End If
                End With
            Next x
            RaiseEvent Progress(y)
        Next y
        Hungh = kmax - 90
        ‘MsgBox kmax - 90
        Call CopyMemory(ByVal VarPtrArray(Bits), 0&, 4)
        RaiseEvent ProgressEnd
    End If
End Function
原文:http://www.cnblogs.com/dhaichen/p/5222074.html