classimageprocessing.cls

vb做的摄像头程序

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "classImageProcessing"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Public width As Integer
Public height As Integer
Dim image() As Byte
Dim edgeTraced() As Boolean

Const NoOfFeatureCategories = 10
Dim FeatureVector(30000, NoOfFeatureCategories) As Single

Public mergeEdgesRadius As Integer

Public noOfEdges As Integer
Dim edges(30000, 12) As Single
Dim TrackDetails(30000, 6) As Single
Public noOfTracks As Integer
Public primaryEdge As Integer
Public minEdgeLength As Integer
Dim maxEdgeLength As Integer
Const NoOfTrackPositions = 10
Dim TrackPositions(30000, NoOfTrackPositions, 3) As Single
Const EDGE_X = 0
Const EDGE_Y = 1
Const EDGE_LENGTH = 2
Const EDGE_ANGLE = 3
Const EDGE_PROBABILITY = 4
Const EDGE_TRACK = 5
Const EDGE_X1 = 6
Const EDGE_Y1 = 7
Const EDGE_X2 = 8
Const EDGE_Y2 = 9
Const EDGE_ARC = 10
Const EDGE_ANGLECHANGE = 11
Const TRACK_EDGES = 0
Const TRACK_START = 1
Const TRACK_LENGTH = 2
Const TRACK_AXIS = 3
Const TRACK_X = 4
Const TRACK_Y = 5

Public processType As Integer

Public EdgeThreshold As Single
Dim averageContrast As Double

Const image_raw = 0
Const image_red = 1
Const image_green = 2
Const image_blue = 3
Const image_edges = 4
Const IMAGE_MOVEMENT = 5


Public scanInterval As Integer


'masks used for edge detection
Public NoOfEdgeAngles As Integer
Dim EdgeHistogram() As Single

'colour histogram levels
Dim Histogram_levels As Integer
Dim ColourHistogram() As Double
Dim Hist() As Double

'snake
Public NoOfSnakePoints As Integer
Dim SnakePoint() As Single
Dim snakeEnergy As Single
Dim elasticity As Single
Dim SnakeStationaryPoints As Integer
Public SnakeComplete As Boolean
Dim prevSnakeStationaryPoints As Integer
Dim snakeStationary As Integer
Const SNAKE_X = 0
Const SNAKE_Y = 1
Const SNAKE_DX = 2
Const SNAKE_DY = 3
Const SNAKE_DIST = 4
Const SNAKE_ANGLE = 5

'blobs
Public NoOfBlobs As Integer
Dim Blob(30000, 4) As Single
Const BLOB_X = 0
Const BLOB_Y = 1
Const BLOB_RADIUS = 2
Const BLOB_PROBABILITY = 3

Public NoOfStereoMatches As Integer
Public StereoPatchSize As Integer
Dim stereoMatch(30000, 8) As Single

Dim StereoDepth() As Single


Public Sub ShowRowIntensity(canvas As PictureBox, Row As Integer)
  Dim x As Integer
  Dim y As Integer
  Dim prev_x As Integer
  Dim prev_y As Integer
  Dim p As Integer
  Dim c As Long
  Dim r As Integer
  
  c = RGB(0, 255, 0)
  canvas.ForeColor = c
  canvas.BackColor = 0
  canvas.Cls
  For r = 0 To width - 1
    x = (r / width) * canvas.ScaleWidth
    p = image(r, Row)
    y = ((p / 255) * canvas.ScaleHeight)
    If (r > 0) Then
      canvas.Line (prev_x, prev_y)-(x, y), c
      Else
      canvas.Line (x, y)-(x, y), c
    End If
    prev_x = x
    prev_y = y
  Next
  
End Sub



Public Sub Snake(NoOfSnakePts As Integer, tx As Integer, ty As Integer, w As Integer, h As Integer)
  Dim i As Integer
  Dim j As Integer
  Dim sidePoints As Integer
  
  NoOfSnakePoints = NoOfSnakePts
  ReDim SnakePoint(NoOfSnakePoints, 6)
  
  'initialise the snake
  sidePoints = NoOfSnakePoints / 4
  For i = 0 To sidePoints
    For j = 0 To 4
      Select Case j
        Case 0
          SnakePoint(i, SNAKE_X) = tx + ((w / sidePoints) * i)
          SnakePoint(i, SNAKE_Y) = ty
        Case 1
          SnakePoint(i + (sidePoints * 1), SNAKE_X) = tx + w
          SnakePoint(i + (sidePoints * 1), SNAKE_Y) = ty + ((h / sidePoints) * i)
        Case 2
          SnakePoint(i + (sidePoints * 2), SNAKE_X) = tx + w - ((w / sidePoints) * i)
          SnakePoint(i + (sidePoints * 2), SNAKE_Y) = ty + h
        Case 3
          SnakePoint(i + (sidePoints * 3), SNAKE_X) = tx
          SnakePoint(i + (sidePoints * 3), SNAKE_Y) = ty + h - ((h / sidePoints) * i)
      End Select
    Next
  Next
    
  snakeEnergy = ((w * 2) + (h * 2)) / NoOfSnakePoints
  'snakeEnergy = 0.1
  elasticity = 0.4
  SnakeComplete = False
  prevSnakeStationaryPoints = 0
  snakeStationary = 0
  
End Sub


Public Sub updateSnake()
  Dim i As Integer
  Dim j As Integer
  Dim dx As Single
  Dim dy As Single
  Dim sidePoints As Integer
  Dim distNext As Single
  Dim distPrevious As Single
  Dim px As Single
  Dim py As Single
  Dim mx As Single
  Dim my As Single
  Dim distBase As Single
  Dim dp As Single
    
  SnakeStationaryPoints = 0
  
  'calculate distances between snake points
  For i = 0 To NoOfSnakePoints - 1
    If (i > 0) Then
      dx = SnakePoint(i, SNAKE_X) - SnakePoint(i - 1, SNAKE_X)
      dy = SnakePoint(i, SNAKE_Y) - SnakePoint(i - 1, SNAKE_Y)
      Else
      dx = SnakePoint(i, SNAKE_X) - SnakePoint(NoOfSnakePoints - 1, SNAKE_X)
      dy = SnakePoint(i, SNAKE_Y) - SnakePoint(NoOfSnakePoints - 1, SNAKE_Y)
    End If
    SnakePoint(i, SNAKE_DX) = dx
    SnakePoint(i, SNAKE_DY) = dy
    SnakePoint(i, SNAKE_DIST) = Sqr((dx * dx) + (dy * dy))
        
    If (SnakePoint(i, SNAKE_DIST) > 0) Then
      SnakePoint(i, SNAKE_ANGLE) = Acos(dy / SnakePoint(i, SNAKE_DIST))
      If (dy < 0) Then
        SnakePoint(i, SNAKE_ANGLE) = (2 * 3.1415927) - SnakePoint(i, SNAKE_ANGLE)
      End If
      Else
      SnakePoint(i, SNAKE_ANGLE) = 0
    End If
     
  Next
   
  For i = 0 To NoOfSnakePoints - 1
  
    If (i < NoOfSnakePoints - 1) Then
      distNext = SnakePoint(i + 1, SNAKE_DIST)
      If (i > 1) Then
        dx = SnakePoint(i + 1, SNAKE_X) - SnakePoint(i - 1, SNAKE_X)
        dy = SnakePoint(i + 1, SNAKE_Y) - SnakePoint(i - 1, SNAKE_Y)
        j = i + 1
        Else
        dx = SnakePoint(i + 1, SNAKE_X) - SnakePoint(NoOfSnakePoints - 1, SNAKE_X)
        dy = SnakePoint(i + 1, SNAKE_Y) - SnakePoint(NoOfSnakePoints - 1, SNAKE_Y)
        j = i + 1
      End If
      Else
      dx = SnakePoint(0, SNAKE_X) - SnakePoint(i - 1, SNAKE_X)
      dy = SnakePoint(0, SNAKE_Y) - SnakePoint(i - 1, SNAKE_Y)
      distNext = SnakePoint(0, SNAKE_DIST)
      j = 0
    End If
    distBase = Sqr((dx * dx) + (dy * dy))
    distPrevious = SnakePoint(i, SNAKE_DIST)
    
    dp = (distPrevious - snakeEnergy) * 0.5
    distPrevious = distPrevious - dp
    distNext = distNext + dp
    mx = SnakePoint(j, SNAKE_X) - (dx * (distPrevious / distNext))
    my = SnakePoint(j, SNAKE_Y) - (dy * (distPrevious / distNext))
    
    dx = ((SnakePoint(i, SNAKE_X) - mx) * elasticity) + ((Rnd - 0.5) * 1)
    dy = ((SnakePoint(i, SNAKE_Y) - my) * elasticity) + ((Rnd - 0.5) * 1)
      
    If (dx > 1) Then
      dx = 1
    End If
    If (dy > 1) Then
      dy = 1
    End If
    If (dx < -1) Then
      dx = -1
    End If
    If (dy < -1) Then
      dy = -1
    End If
    px = SnakePoint(i, SNAKE_X) - dx
    py = SnakePoint(i, SNAKE_Y) - dy
    If (px >= 0) And (px < width) And (py >= 0) And (py < height) Then
      If (image(px, py) = 0) Then
        SnakePoint(i, SNAKE_X) = px
        SnakePoint(i, SNAKE_Y) = py
        Else
        SnakeStationaryPoints = SnakeStationaryPoints + 1
      End If
    End If
  Next
    
  If (snakeEnergy > 0.1) Then
    snakeEnergy = snakeEnergy * 0.99
  End If
  
  If (prevSnakeStationaryPoints = SnakeStationaryPoints) Then
    snakeStationary = snakeStationary + 1
    Else
    snakeStationary = 0
  End If
  If ((SnakeStationaryPoints / NoOfSnakePoints) > 0.2) And (snakeStationary > 2) Then
    SnakeComplete = True
  End If
  prevSnakeStationaryPoints = SnakeStationaryPoints
  
End Sub








Public Sub Diffuse(diffuseConstant As Single, diffuseSteps As Integer)
  Dim x As Integer
  Dim y As Integer
  Dim i As Integer
  Dim index As Integer
  Dim diffValue() As Single
  Dim Value As Single
  Dim dv As Single
  Dim max As Single
  
  ReDim diffValue(width, height, 2)
  For x = 0 To width - 1
    For y = 0 To height - 1
      diffValue(x, y, 0) = image(x, y)
    Next
  Next
  
  index = 1
  max = 1
  For i = 1 To diffuseSteps
    For x = 1 To width - 2
      For y = 1 To height - 2
        If (diffValue(x, y, 0) > 0) Then
          Value = diffValue(x, y + 1, 1 - index) + diffValue(x + 1, y + 1, 1 - index) + diffValue(x + 1, y, 1 - index) + diffValue(x + 1, y - 1, 1 - index)
          Value = Value + diffValue(x, y - 1, 1 - index) + diffValue(x - 1, y - 1, 1 - index) + diffValue(x - 1, y, 1 - index) + diffValue(x - 1, y + 1, 1 - index)
          dv = (Value / 8) - diffValue(x, y, 1 - index)
          diffValue(x, y, index) = diffValue(x, y, 1 - index) + (diffuseConstant * dv)
          If (diffValue(x, y, index) < 0) Then
            diffValue(x, y, index) = 0
          End If
          If (diffValue(x, y, index) > 255) Then
            diffValue(x, y, index) = 255
          End If
          If (i = diffuseSteps) Then
            If (diffValue(x, y, index) > max) Then
              max = diffValue(x, y, index)
            End If
          End If
        End If
      Next
    Next
        
    If (i = diffuseSteps) Then
      For x = 1 To width - 2
        For y = 1 To height - 2
          image(x, y) = CByte(diffValue(x, y, index) / max * 255)
        Next
      Next
    End If
    
    If (index = 1) Then
      index = 0
      Else
      index = 1
    End If
  Next
  
  
  
End Sub


Public Sub getEdges()
  Dim x As Integer
  Dim y As Integer
  Dim edgeFound As Boolean
  Dim newedgeFound As Boolean
  Dim pixel As Integer
  Dim val As Byte
  Dim edgePath(30000, 3)
  Dim NoOfEdgePoints As Integer
  Dim i As Integer
  Dim j As Integer
  Dim dx As Single
  Dim dy As Single
  Dim angle As Single
  Dim dist As Single
  Dim xx As Integer
  Dim yy As Integer
  Dim edgeType As Integer
  Dim intensity As Single
  Dim histMax As Single
  Dim edgeLocated As Boolean
  Dim edgeCount As Integer
  Dim trackLen As Long
  Dim x1 As Single
  Dim y1 As Single
  Dim da As Single
  Dim startEdge As Integer
  Dim max_da As Single
  Dim avAngle As Single
  Dim totAngle As Single
  Dim prevAngle As Single
  Dim angleChange As Single
  Const thresh = 20
  
  For i = 0 To NoOfEdgeAngles - 1
    EdgeHistogram(i) = 0
  Next
  
  For x = 0 To width - 1
    For y = 0 To height - 1
      edgeTraced(x, y) = False
    Next
  Next
  
  noOfEdges = 0
  noOfTracks = 0
  maxEdgeLength = 1
  histMax = 1
  newedgeFound = True
  edgeCount = 0
  While (newedgeFound)
  
    edgeFound = False
    edgeLocated = False
    x = 0
    While (x < width) And (edgeFound = False)
      y = 0
      While (y < height) And (edgeFound = False)
        If (image(x, y) > thresh) And (edgeTraced(x, y) = False) Then
          edgeFound = True
          Else
          y = y + 1
        End If
      Wend
      If (edgeFound = False) Then
        x = x + 1
      End If
    Wend
    newedgeFound = edgeFound
  
    NoOfEdgePoints = 0
    max_da = 0
    x1 = -1
    y1 = -1
    prevAngle = -1
    While (edgeFound)
      edgeTraced(x, y) = True
      pixel = 0
      edgeFound = False
      While (pixel < 24) And (Not edgeFound)
        Select Case pixel
          Case 0
            If (y > 0) Then
              If (image(x, y - 1) > thresh) And (Not edgeTraced(x, y - 1)) Then
                y = y - 1
                edgeFound = True
              End If
            End If
          Case 1
            If (x < width) And (y > 0) Then
              If (image(x + 1, y - 1) > thresh) And (Not edgeTraced(x + 1, y - 1)) Then
                x = x + 1
                y = y - 1
                edgeFound = True
              End If
            End If
          Case 2
            If (x < width) Then
              If (image(x + 1, y) > thresh) And (Not edgeTraced(x + 1, y)) Then
                x = x + 1
                edgeFound = True
              End If
            End If
          Case 3
            If (x < width) And (y < height) Then
              If (image(x + 1, y + 1) > thresh) And (Not edgeTraced(x + 1, y + 1)) Then
                x = x + 1
                y = y + 1
                edgeFound = True
              End If
            End If
          Case 4
            If (y < height) Then
              If (image(x, y + 1) > thresh) And (Not edgeTraced(x, y + 1)) Then
                y = y + 1
                edgeFound = True
              End If
            End If
          Case 5
            If (x > 0) And (y < height) Then
              If (image(x - 1, y + 1) > thresh) And (Not edgeTraced(x - 1, y + 1)) Then
                x = x - 1