?? classimageprocessing.cls
字號(hào):
yy = sy + 1
direction = 135
End If
End If
End If
End If
If (sy < height - 1) Then
value = image(sx, sy + 1)
If ((value > thresh) And (temp(sx, sy + 1) = False)) Then
If (value > max) And ((averagedirection > 90) And (averagedirection < 270)) Then
max = value
xx = sx
yy = sy + 1
direction = 180
End If
End If
End If
If (sx > 0) Then
If (sy < height - 1) Then
value = image(sx - 1, sy + 1)
If ((value > thresh) And (temp(sx - 1, sy + 1) = False)) Then
If (value > max) And ((averagedirection > 135) And (averagedirection < 315)) Then
max = value
xx = sx - 1
yy = sy + 1
direction = 225
End If
End If
End If
value = image(sx - 1, sy)
If ((value > thresh) And (temp(sx - 1, sy) = False)) Then
If (value > max) And ((averagedirection > 180) Or (averagedirection = 0)) Then
max = value
xx = sx - 1
yy = sy
direction = 270
End If
End If
If (sy > 0) Then
value = image(sx - 1, sy - 1)
If ((value > thresh) And (temp(sx - 1, sy - 1) = False)) Then
If (value > max) And ((averagedirection > 225) Or (averagedirection < 45)) Then
max = value
xx = sx - 1
yy = sy - 1
direction = 315
End If
End If
End If
End If
If (averagedirection > 0) Then
intensity = (intensity + max) / 2
directionDifference = Abs(averagedirection - direction)
If (directionDifference > 180) Then
directionDifference = 360 - directionDifference
End If
averagedirection = averagedirection - (directionDifference / 2)
If (averagedirection < 0) Then
averagedirection = 360 + averagedirection
End If
If (averagedirection > 360) Then
averagedirection = averagedirection - 360
End If
If ((edgeLength > 3) And (directionDifference > 20) And (traceEdgesFromPoint)) Then
Call addEdgeVector(initialX, initialY, xx, yy, intensity)
initialX = xx
initialY = yy
End If
Else
intensity = max
averagedirection = direction
End If
Wend
If (traceEdgesFromPoint = True) Then
Call addEdgeVector(initialX, initialY, xx, yy, intensity)
End If
If (initialEdgeLength = 0) Then
'If (edgeLength > minEdgeLength) Then
For i = 0 To width - 1
For j = 0 To height - 1
If (temp(i, j) = True) Then
edgeTraced(i, j) = True
End If
Next
Next
'End If
End If
x = xx
y = yy
traceDirection = direction
End Function
Private Sub addEdgeVector(x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer, intensity As Single)
'adds a new edge vector
If (currEdgeVector < EDGE_VECTOR_LENGTH) Then
EdgeVector(0, currEdgeVector) = x1
EdgeVector(1, currEdgeVector) = y1
EdgeVector(2, currEdgeVector) = x2
EdgeVector(3, currEdgeVector) = y2
EdgeVector(4, currEdgeVector) = intensity
If (intensity > maxEdgeVectorIntensity) Then
maxEdgeVectorIntensity = intensity
End If
currEdgeVector = currEdgeVector + 1
End If
End Sub
Private Sub sortEdgeVector()
'sorts the edge vector by distance
Dim dx As Integer
Dim dy As Integer
Dim length As Long
Dim mindist As Long
Dim closest As Integer
Dim vect As Single
Dim i As Integer
Dim j As Integer
For i = 0 To currEdgeVector - 2
mindist = 99999
closest = 0
For j = i + 1 To currEdgeVector - 1
dx = EdgeVector(2, i) - EdgeVector(0, j)
dy = EdgeVector(3, i) - EdgeVector(1, j)
length = (dx * dx) + (dy * dy)
If (length < mindist) Then
mindist = length
closest = j
End If
Next
If ((closest > 0) And (closest <> i + 1)) Then
'swap
For j = 0 To 4
vect = EdgeVector(j, i + 1)
EdgeVector(j, i + 1) = EdgeVector(j, closest)
EdgeVector(j, closest) = vect
Next
End If
Next
'For i = 0 To currEdgeVector - 1
' For j = 0 To currEdgeVector - 1
' If (i <> j) Then
' dx = EdgeVector(0, i) - EdgeVector(0, j)
' dy = EdgeVector(1, i) - EdgeVector(1, j)
' length = ((dx * dx) + (dy * dy))
' If (length < 3 * 3) Then
' EdgeVector(0, i) = EdgeVector(0, i) - (dx / 2)
' EdgeVector(1, i) = EdgeVector(1, i) - (dy / 2)
' EdgeVector(0, j) = EdgeVector(0, j) + (dx / 2)
' EdgeVector(1, j) = EdgeVector(1, j) + (dy / 2)
' End If
' dx = EdgeVector(2, i) - EdgeVector(2, j)
' dy = EdgeVector(3, i) - EdgeVector(3, j)
' length = ((dx * dx) + (dy * dy))
' If (length < 3 * 3) Then
' EdgeVector(2, i) = EdgeVector(2, i) - (dx / 2)
' EdgeVector(3, i) = EdgeVector(3, i) - (dy / 2)
' EdgeVector(2, j) = EdgeVector(2, j) + (dx / 2)
' EdgeVector(3, j) = EdgeVector(3, j) + (dy / 2)
' End If
' End If
' Next
'Next
End Sub
Private Function dist(x1 As Single, y1 As Single, x2 As Single, y2 As Single) As Single
Dim dx As Single
Dim dy As Single
dx = x1 = x2
dy = y1 - y2
dist = Sqr((dx * dx) + (dy * dy))
End Function
Public Sub getEdges()
'updates the edges
Dim mask
Dim i As Integer
Dim j As Integer
Dim x As Integer
Dim y As Integer
Dim xx As Integer
Dim yy As Integer
Dim diff As Long
Dim thresh As Integer
Dim diff2 As Long
Dim estr As String
Dim minDiff As Long
Dim winner As Integer
Dim ex As Integer
Dim ey As Integer
Dim av As Integer
thresh = 100
For i = 0 To NO_OF_EDGE_TYPES - 1
EdgeHistogram(i) = 0
Next
x = 0
ex = 0
While (x < width - 2)
y = 0
ey = 0
While (y < height - 2)
Edges(ex, ey) = 0
minDiff = 9999999
winner = -1
For i = 0 To NO_OF_EDGE_MASKS - 1
mask = EdgeMask(i)
diff = 0
j = 0
av = 0
For yy = y To y + 2
For xx = x To x + 2
av = av + image(xx, yy)
diff2 = Abs((mask(j) * 255) - image(xx, yy))
diff = diff + diff2
j = j + 1
Next
Next
If (av / 9 > 30) Then
'edge
diff = diff / 9
If (diff < minDiff) And (diff < thresh) Then
winner = mask(9)
minDiff = diff
Edges(ex, ey) = winner
End If
Else
'blank
winner = 0
Edges(ex, ey) = winner
End If
Next
'Edges(ex, ey) = Rnd * 5 'test
If (winner > 0) Then
EdgeHistogram(winner - 1) = EdgeHistogram(winner - 1) + 1
End If
ey = ey + 1
y = y + 2
Wend
ex = ex + 1
x = x + 2
Wend
'fill in the gaps
Call getEdges_secondary
End Sub
Public Sub getEdges_secondary()
'fills in edges where they "should" appear
Dim x As Integer
Dim y As Integer
For x = 1 To edgesWidth - 1
For y = 1 To edgesHeight - 1
'horizontal
If ((Edges(x - 1, y) > 0) And (Edges(x + 1, y) > 0)) Then
Edges(x, y) = 1
Else
'vertical
If ((Edges(x, y - 1) > 0) And (Edges(x, y + 1) > 0)) Then
Edges(x, y) = 2
Else
'diagonal
If ((Edges(x - 1, y - 1) > 0) And (Edges(x + 1, y + 1) > 0)) Then
'Edges(x, y) = 4
Else
'diagonal
If ((Edges(x + 1, y - 1) > 0) And (Edges(x - 1, y + 1) > 0)) Then
'Edges(x, y) = 3
End If
End If
End If
End If
If ((Edges(x + 1, y) <> 1) And (Edges(x + 1, y) = Edges(x, y))) Then
Edges(x, y) = 0
End If
If ((Edges(x, y + 1) <> 2) And (Edges(x, y + 1) = Edges(x, y))) Then
Edges(x, y) = 0
End If
'surrounded by edges
If ((Edges(x - 1, y - 1) > 0) And (Edges(x - 1, y) > 0) And (Edges(x - 1, y + 1) > 0) And (Edges(x, y - 1) > 0) And (Edges(x, y + 1) > 0) And (Edges(x + 1, y - 1) > 0) And (Edges(x + 1, y) > 0) And (Edges(x + 1, y + 1) > 0)) Then
Edges(x, y) = 0
End If
Next
Next
End Sub
Public Sub init(imageWidth As Integer, imageHeight As Integer)
width = imageWidth
height = imageHeight
ReDim image(width, height)
ReDim edgeTraced(width, height)
ReDim temp(width, height)
minEdgeLength = 10
scanInterval = 1
edgesWidth = width / 2
edgesHeight = height / 2
ReDim Edges(edgesWidth, edgesHeight)
EdgeThreshold = 0
processType = 0
Call initEdgeMasks
averageContrast = 1
ReDim picked(width, height)
Histogram_levels = 40
ReDim ColourHistogram(Histogram_levels)
ReDim Hist(Histogram_levels)
End Sub
Public Sub setHistogramLevels(levels As Integer)
Histogram_levels = levels
ReDim ColourHistogram(Histogram_levels)
ReDim Hist(Histogram_levels)
End Sub
Public Sub save(FileNumber As Integer)
'save the image
Dim x As Integer
Dim y As Integer
Print #FileNumber, width
Print #FileNumber, height
For x = 0 To width - 1
For y = 0 To height - 1
Print #FileNumber, image(x, y)
Next
Next
End Sub
Public Sub load(FileNumber As Integer)
'save the image
Dim x As Integer
Dim y As Integer
Dim b As Byte
Input #FileNumber, width
Input #FileNumber, height
Call init(width, height)
For x = 0 To width - 1
For y = 0 To height - 1
Input #FileNumber, b
image(x, y) = b
Next
Next
End Sub
Public Sub whiteNoise()
Dim x As Integer
Dim y As Integer
For x = 0 To width - 1
For y = 0 To height - 1
image(x, y) = Rnd * 255
Next
Next
End Sub
Public Function getPoint(x As Integer, y As Integer) As Byte
getPoint = image(x, y)
End Function
Public Function setPoint(x As Integer, y As Integer, value As Byte)
image(x, y) = value
End Function
Public Sub update(canvas As PictureBox, Optional left As Variant, Optional top As Variant, Optional wdth As Variant, Optional hght As Variant)
'import a picture
'processtype = 0 greyscale
' 1 red
' 2 green
' 3 blue
' 4 edges
' 5 movement
Dim x As Integer
Dim y As Integer
Dim screenX As Integer
Dim screenY As Integer
Dim w As Integer
Dim h As Integer
Dim xx As Integer
Dim yy As Integer
Dim value As Double
Dim RGBval As Long
Dim pixels As Double
Dim maxcol As Long
Dim edgeValue As Single
Dim screenWidth As Single
Dim screenHeight As Single
Dim screenLeft As Single
Dim screenTop As Single
Dim rgbsource As RGBthingy
Dim rgbdest As RGBpoint
Dim r As Single
Dim g As Single
Dim b As Single
If (Not IsMissing(left)) And (Not IsMissing(top)) Then
screenLeft = left
screenTop = top
screenWidth = wdth
screenHeight = hght
Else
screenLeft = 0
screenTop = 0
screenWidth = canvas.ScaleWidth
screenHeight = canvas.ScaleHeight
End If
w = CInt(screenWidth / width)
If (w < 1) Then
w = 1
End If
h = CInt(screenHeight / height)
If (h < 1) Then
h = 1
End If
pixels = w * h
maxcol = RGB(255, 255, 255)
For x = 0 To width - 1
For y = 0 To height - 1
edgeTraced(x, y) = False
screenX = screenLeft + ((x / width) * screenWidth)
screenY = screenTop + ((y / height) * screenHeight)
value = 0
For xx = screenX To screenX + w - 1 Step scanInterval
For yy = screenY To screenY + h - 1 Step scanInterval
RGBval = canvas.Point(xx, yy)
rgbsource.value = RGBval
Call CopyMemory(rgbdest, rgbsource, 3)
r = rgbdest.red
g = rgbdest.Green
b = rgbdest.Blue
Select Case processType
Case 0 'greyscale
value = value + ((r + g + b) / 765)
Case 1 'red
value = value + (r / 255)
Case 2 'green
value = value + (g / 255)
Case 3 'blue
value = value + (b / 255)
Case 5 'motion
value = value + (RGBval / maxcol)
End Select
Next
Next
value = (value / pixels) * 255
If (processType <> 5) Then
image(x, y) = value
Else
'difference between successive images
image(x, y) = Abs(value - image(x, y))
End If
Next
Next
End Sub
Public Sub updateColourHistogram(canvas As PictureBox, Optional left As Variant, Optional top As Variant, Optional wdth As Variant, Optional hght As Variant)
?? 快捷鍵說(shuō)明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -