60 lines
1.8 KiB
Text
60 lines
1.8 KiB
Text
Const PI As Double = 3.1415926535897932
|
|
Const ScrW = 320, ScrH = 240
|
|
|
|
Type HoughParams
|
|
ntx As Integer = 460
|
|
mry As Integer = 360
|
|
End Type
|
|
Dim params As HoughParams
|
|
|
|
Screenres params.ntx, params.mry, 32
|
|
Windowtitle "Hough Transform"
|
|
|
|
Function HoughTransform(imagen As Any Ptr, params As HoughParams) As Any Ptr
|
|
Dim As Integer nimx, mimy, bypp
|
|
Imageinfo imagen, nimx, mimy, , bypp
|
|
|
|
Dim him As Any Ptr = Imagecreate(params.ntx, params.mry, Rgb(255,255,255), 32)
|
|
|
|
Dim As Double rmax = Sqr(nimx * nimx + mimy * mimy)
|
|
Dim As Double dr = rmax / (params.mry / 2)
|
|
Dim As Double dth = PI / params.ntx
|
|
|
|
For jx As Integer = 0 To nimx - 1
|
|
For iy As Integer = 0 To mimy - 1
|
|
|
|
Dim As Ulong col = Point(jx, iy, imagen)
|
|
Dim As Integer r = (col Shr 16) And 255
|
|
Dim As Integer g = (col Shr 8) And 255
|
|
Dim As Integer b = col And 255
|
|
Dim As Integer gray = (r + g + b) \ 3
|
|
|
|
If gray > 128 Then Continue For
|
|
|
|
' Hough transform
|
|
For t As Integer = 0 To params.ntx - 1
|
|
Dim As Double th = dth * t
|
|
Dim As Double rho = jx * Cos(th) + iy * Sin(th)
|
|
Dim As Integer ir = params.mry \ 2 - Int(rho / dr + 0.5)
|
|
|
|
If ir >= 0 And ir < params.mry Then
|
|
Dim As Ulong oldcol = Point(t, ir, him)
|
|
Dim As Integer v = (oldcol Shr 16) And 255
|
|
If v > 0 Then v -= 1
|
|
Pset him, (t, ir), Rgb(v, v, v)
|
|
End If
|
|
Next
|
|
Next
|
|
Next
|
|
|
|
Return him
|
|
End Function
|
|
|
|
Dim As Any Ptr imagen = Imagecreate(ScrW, ScrH)
|
|
Bload("Pentagon.bmp", imagen)
|
|
|
|
Dim resultado As Any Ptr = HoughTransform(imagen, params)
|
|
BSave "hough.bmp", resultado
|
|
Put (0,0), resultado, PSet
|
|
|
|
Sleep
|