Hough transform and arbitrary angle rotation based on VB

Public Sub dorotate (Optional ByVal rotaryangle as Long = 0) ' Rotation at any angle

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

' Coordinates of the source figure Four Corners (centered on the image as the coordinate system origin)
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)

The coordinates of the four Corners after rotation (in the image center as the coordinate system origin).
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) for the center of rotation
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 = up) as Integer ' binary

Dim Bits () as Rgbquad
Dim TSA as Safearray2d

Dim L as Byte

Dim NPP (0 to 0) as Integer ' Hungh transformed array
Dim MaxA, Kmax, PMax, MP, Templ as Integer ' max Angle 180
Dim Radian as Double
Dim m, N, K as Integer
Distance parameter in Dim p as Integer ' Hough transform
MaxA = 180
Kmax = 0 ' record the angle of the longest line
PMax = 0 ' record the distance of the longest straight line

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 the distance parameter in the transform
p = CInt (P/2 + mp/2) ' P-value is optimized to prevent negative values
' If p < 0 then Stop
NPP (k, p) = NPP (k, p) + 1 ' NPP corresponding to recurring point accumulation in transform domain

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 is the original diagonal distance
If NPP (M, N) > Templ Then
Templ = NPP (M, N) ' Find the longest line Templ for the intermediate variable for comparison
Kmax = M ' Records the angle of the longest line
PMax = n ' records the distance of the longest straight line
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 the distance parameter in the transform
p = CInt (P/2 + mp/2) ' P-value is optimized to prevent negative values

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

Hough transform and arbitrary angle rotation based on VB