基於VB的hough變換和任意角度旋轉

 

 

 

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 IfEnd Function