classimageprocessing.cls

vb做的摄像头程序

  Next
  
  'normalize
  If (max > 0.01) Then
    For index = 0 To Histogram_levels - 1
      Hist(index) = Hist(index) / max
    Next
  End If
  
  'compare
  similarity = 0
  i = 0
  For index = 0 To Histogram_levels - 1
    If (ColourHistogram(index) > 0) And (Hist(index) > 0) Then
      dc = Abs(Hist(index) - ColourHistogram(index))
      similarity = similarity + (1 - (dc * dc))
      i = i + 1
    End If
  Next
  If (i > 0) Then
    similarity = similarity / i
  End If
  
  colourSimilarity = similarity
End Function


Public Sub Clear()
  ReDim image(width, height)
End Sub






Public Sub showColourHistogram(pic As PictureBox)
  Dim i As Integer
  Dim x As Integer
  Dim y As Integer
  Dim prev_x As Integer
  Dim prev_y As Integer
  Dim c As Long
  
  pic.Cls
  c = RGB(255, 255, 255)
  pic.DrawWidth = 1
  For i = 0 To Histogram_levels
    If (ColourHistogram(i) <= 1) And (ColourHistogram(i) >= 0) Then
      x = (pic.ScaleWidth / Histogram_levels) * i
      y = pic.ScaleHeight - (pic.ScaleHeight * ColourHistogram(i))
      If (i > 0) Then
        pic.Line (prev_x, prev_y)-(x, y), c
      End If
      prev_x = x
      prev_y = y
    End If
  Next
  
End Sub


Public Function getEdgeHistogramValue(index As Integer) As Single
  getEdgeHistogramValue = EdgeHistogram(index)
End Function


Public Sub applyThreshold(Value As Byte)
'applies a threshold to the image
  Dim x As Integer
  Dim y As Integer
  
  For x = 0 To width - 1
    For y = 0 To height - 1
      If (image(x, y) < Value) Then
        image(x, y) = 0
      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 getEdge(index As Integer, ByRef x As Integer, ByRef y As Integer, ByRef angle As Integer, ByRef edgeLength As Integer, ByRef probability As Integer, ByRef TrackNumber As Integer)
  If (index < noOfEdges) Then
    x = edges(index, EDGE_X)
    y = edges(index, EDGE_Y)
    angle = edges(index, EDGE_ANGLE) * (180 / NoOfEdgeAngles)
    edgeLength = edges(index, EDGE_LENGTH)
    probability = edges(index, EDGE_PROBABILITY)
    TrackNumber = edges(index, EDGE_TRACK)
  End If
End Sub



Public Sub init(imageWidth As Integer, imageHeight As Integer)
  width = imageWidth
  height = imageHeight
  ReDim image(width, height)
  ReDim edgeTraced(width, height)
  
  NoOfEdgeAngles = 18
  ReDim EdgeHistogram(NoOfEdgeAngles)
  minEdgeLength = 6
  
  scanInterval = 2
  
  EdgeThreshold = 0
  processType = 0
  averageContrast = 1
  Histogram_levels = 40
  ReDim ColourHistogram(Histogram_levels)
  ReDim Hist(Histogram_levels)
  mergeEdgesRadius = 3
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 Sub Normalize()
'normalizes the image
  Dim max As Integer
  Dim x As Integer
  Dim y As Integer
  Dim p As Integer
  
  max = 0
  For x = 0 To width - 1
    For y = 0 To height - 1
      If (image(x, y) > max) Then
        max = image(x, y)
      End If
    Next
  Next
  
  If (max > 0) Then
    For x = 0 To width - 1
      For y = 0 To height - 1
        p = image(x, y)
        p = p / max * 255
        image(x, y) = p
      Next
    Next
  End If
  
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 subtractImage(img1 As classImageProcessing, img2 As classImageProcessing)
  Dim x As Integer
  Dim y As Integer
  Dim p1 As Integer
  Dim p2 As Integer
  Dim dp As Integer
  
  For x = 0 To width - 1
    For y = 0 To height - 1
      p1 = img1.getPoint(x, y)
      p2 = img2.getPoint(x, y)
      dp = Abs(p1 - p2)
      image(x, y) = CByte(dp)
    Next
  Next
End Sub



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)

  Dim x As Integer
  Dim y As Integer
  Dim RGBval As Long
  Dim maxcol As Long
  Dim screenWidth As Single
  Dim screenHeight As Single
  Dim screenLeft As Single
  Dim screenTop As Single
  Dim index As Integer
  Dim max As Long
  Dim redValue As Byte
  Dim greenValue As Byte
  Dim blueValue As Byte
  
  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
  
  'clear the histogram
  For index = 0 To Histogram_levels - 1
    ColourHistogram(index) = 0
  Next
  max = 0
  
  'get the histogram
  maxcol = RGB(255, 255, 255)
  For x = 0 To screenWidth - 1
    For y = 0 To screenHeight - 1
      RGBval = canvas.Point(screenLeft + x, screenTop + y)
      
      redValue = getRGBvalue(RGBval, 0)
      greenValue = getRGBvalue(RGBval, 1)
      blueValue = getRGBvalue(RGBval, 2)
      index = Int(getSpectrumValue(redValue, greenValue, blueValue) * Histogram_levels)
      
      ColourHistogram(index) = ColourHistogram(index) + 1
      If (ColourHistogram(index) > max) Then
        max = ColourHistogram(index)
      End If
    Next
  Next
  
  'normalize the histogram
  If (max > 0) Then
    For index = 0 To Histogram_levels - 1
      ColourHistogram(index) = ColourHistogram(index) / max
    Next
  End If
  
End Sub


Public Sub saveColourHistogram(filenumber As Integer)
  Dim i As Integer
  
  Print #filenumber, Histogram_levels
  For i = 0 To Histogram_levels - 1
    Print #filenumber, ColourHistogram(i)
  Next
End Sub


Public Sub loadColourHistogram(filenumber As Integer)
  Dim i As Integer
  Dim col As Single
  
  Input #filenumber, Histogram_levels
  ReDim ColourHistogram(Histogram_levels)
  ReDim Hist(Histogram_levels)
  For i = 0 To Histogram_levels - 1
    Input #filenumber, col
    ColourHistogram(i) = col
  Next
End Sub


Public Sub updateDirect(canvas As PictureBox, Optional left As Variant, Optional top As Variant, Optional wdth As Variant, Optional hght As Variant)
'import a picture pixel-for-pixel without any scaling
'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 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
  
  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