classimageprocessing.cls

这是一个立体视觉程序

    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
  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)
      RGBval = canvas.Point(screenX, screenY)
      Select Case processType
        Case 0  'greyscale
          Value = (RGBval / maxcol)
        Case 1  'red
          Value = ((RGBval And 255) / 255)
        Case 2  'green
          Value = ((RGBval And 65280) / 65280)
        Case 3  'blue
          Value = ((RGBval And 16711680) / 16711680)
      End Select
      
      image(x, y) = Value
    Next
  Next

End Sub



Public Sub getImageContours(rawImage As classImageProcessing)
'extracts edges from the given image
  Dim x As Integer
  Dim y As Integer
  Dim Value As Single
  Dim scalex As Single
  Dim scaley As Single
  Dim xx As Integer
  Dim yy As Integer
  Dim p1 As Integer
  Dim p2 As Integer
  Dim value2 As Single
  Dim max As Single
  
  scalex = rawImage.width / width
  scaley = rawImage.height / height
  
  max = 1 - EdgeThreshold
  
  For x = 0 To width - 1
    For y = 0 To height - 1
      xx = x * scalex
      yy = y * scaley
      If ((xx >= 1) And (yy >= 1)) Then
        p1 = rawImage.getPoint(xx, yy)
        p2 = rawImage.getPoint(xx - 1, yy)
        Value = Abs(p1 - p2)
        p2 = rawImage.getPoint(xx, yy - 1)
        Value = Value + Abs(p1 - p2)
        Value = Value / (255 * 2)
        value2 = Value - EdgeThreshold
        If (value2 < 0) Then
          Value = 0
          Else
          Value = 255 - (255 * (value2 / max))
        End If
        image(x, y) = Value
      End If
    Next
  Next
    
End Sub

Public Sub getGaussianContours(rawImage As classImageProcessing, Optional GaussianRadius As Variant)
'extracts gaussian contours from the given image
  Dim x As Integer
  Dim y As Integer
  Dim Value As Single
  Dim scalex As Single
  Dim scaley As Single
  Dim p1 As Single
  Dim value2 As Single
  Dim max As Single
  Dim px As Integer
  Dim py As Integer
  Dim patchRadius As Integer
  Dim centreX As Integer
  Dim centreY As Integer
  Dim Dist As Single
  Dim radiusSqr As Single
  Dim pixels As Single
  
  scalex = rawImage.width / width
  scaley = rawImage.height / height
  max = 1
  
  If (IsMissing(GaussianRadius)) Then
    patchRadius = rawImage.width / 40
    Else
    patchRadius = GaussianRadius
  End If
  If (patchRadius < 1) Then
    patchRadius = 1
  End If
  radiusSqr = patchRadius * patchRadius
  pixels = 4 * radiusSqr * 255
  
  For x = patchRadius To width - patchRadius
    For y = patchRadius To height - patchRadius
  'For x = 1 To width - 1
  '  For y = 1 To height - 1
      
      'get the current point in the raw image
      centreX = x * scalex
      centreY = y * scaley
      
      Value = 0
      For px = centreX - patchRadius To centreX + patchRadius
        For py = centreY - patchRadius To centreY + patchRadius
        
          'calculate the squared distance
          Dist = ((px - centreX) * (px - centreX)) + ((py - centreY) * (py - centreY))
        
          If ((px >= 1) And (px < rawImage.width) And (py >= 1) And (py < rawImage.height)) Then
            p1 = rawImage.getPoint(px, py)
            Value = Value + (p1 * function_Gaussian(Dist, radiusSqr))
          End If
                
        Next
      Next
      image(x, y) = CByte((Value / pixels) * 255)

    Next
  Next
  
  Call Normalize
End Sub


Public Sub getDoGContours(rawImage As classImageProcessing, Optional GaussianRadius As Variant)
'extracts double Gaussian (DoG) contours from the given image
  Dim image2() As Byte
  Dim radius1 As Single
  Dim radius2 As Single
  Dim x As Integer
  Dim y As Integer
  Dim p1 As Integer
  Dim p2 As Integer
  Dim dp As Integer
    
  ReDim image2(width, height)
  
  If (IsMissing(GaussianRadius)) Then
    radius1 = rawImage.width / 40
    Else
    radius1 = GaussianRadius
  End If
  radius2 = 1 'radius1 / 2
  
  Call getGaussianContours(rawImage, radius1)
  For x = 0 To width - 1
    For y = 0 To height - 1
      image2(x, y) = image(x, y)
    Next
  Next
  
  If (radius2 > 0) Then
    Call getGaussianContours(rawImage, radius2)
    For x = 0 To width - 1
      For y = 0 To height - 1
        p1 = image(x, y)
        p2 = image2(x, y)
        dp = Abs(p1 - p2)
        image(x, y) = CByte(dp)
      Next
    Next
  End If
  
  Call Normalize
  
End Sub



Public Sub show(canvas As PictureBox, Optional tx As Variant, Optional ty As Variant, Optional subImageWidth As Variant, Optional subImageHeight As Variant)
  Dim x As Integer
  Dim y As Integer
  Dim screenX(2) As Single
  Dim screenY(2) As Single
  Dim Value As Byte
  Dim c As Long
  Dim i As Integer
  Dim showPoint As Boolean
  
  If (processType <> 4) Then
  
  canvas.FillStyle = 0
  For x = 0 To width - 1
    For y = 0 To height - 1
      showPoint = True
      If (IsMissing(tx)) Then
        Value = image(x, y)
        Else
        If (x >= tx) And (x < tx + subImageWidth) And (y >= ty) And (y < ty + subImageHeight) Then
          Value = image(x, y)
          Else
          Value = 0
          showPoint = False
        End If
      End If
      
      If (showPoint) Then
        Select Case processType
          Case 1 'red
            c = RGB(Value, 0, 0)
          Case 2 'green
            c = RGB(0, Value, 0)
          Case 3 'blue
            c = RGB(0, 0, Value)
          Case 4 'edges
            Value = 255 - Value
            c = RGB(Value, Value, Value)
          Case Else
            c = RGB(Value, Value, Value)
        End Select
        canvas.FillColor = c
        screenX(0) = (x / width) * canvas.ScaleWidth
        screenY(0) = (y / height) * canvas.ScaleHeight
        screenX(1) = ((x + 1) / width) * canvas.ScaleWidth
        screenY(1) = ((y + 1) / height) * canvas.ScaleHeight
        canvas.Line (screenX(0), screenY(0))-(screenX(1), screenY(1)), c, B
      End If
    Next
  Next
  
  End If
  
End Sub


Public Sub showStereoMatches(canvas As PictureBox, ImageNo As Integer)
  Dim x As Integer
  Dim y As Integer
  Dim screenX(2) As Single
  Dim screenY(2) As Single
  Dim c As Long
  Dim i As Integer
  Dim r As Integer
  Dim g As Integer
  Dim b As Integer
  
  canvas.FillStyle = 0
  For i = 0 To NoOfStereoMatches - 1
    r = Int(Rnd * 255)
    g = Int(Rnd * 255)
    b = Int(Rnd * 255)
    c = RGB(r, g, b)
    canvas.FillColor = c
  
    x = stereoMatch(i, 0)
    y = stereoMatch(i, 1)
    screenX(0) = (x / width) * canvas.ScaleWidth
    screenY(0) = (y / height) * canvas.ScaleHeight
    screenX(1) = ((x + StereoPatchSize) / width) * canvas.ScaleWidth
    screenY(1) = ((y + StereoPatchSize) / height) * canvas.ScaleHeight
    canvas.Line (screenX(0), screenY(0))-(screenX(1), screenY(1)), c, B
  
    x = stereoMatch(i, 2)
    y = stereoMatch(i, 3)
    screenX(0) = (x / width) * canvas.ScaleWidth
    screenY(0) = (y / height) * canvas.ScaleHeight
    screenX(1) = ((x + StereoPatchSize) / width) * canvas.ScaleWidth
    screenY(1) = ((y + StereoPatchSize) / height) * canvas.ScaleHeight
    canvas.Line (screenX(0), screenY(0))-(screenX(1), screenY(1)), c, B
  
  Next
End Sub


Public Sub saveStereo(filename As String)
  On Error GoTo saveStereo_err
  
  Dim x As Single
  Dim y As Single
  Dim z As Single
  Dim i As Integer
  Dim filenumber As Integer
  
  filenumber = FreeFile
  Open filename For Output As #filenumber
    Print #filenumber, NoOfStereoMatches
    For i = 0 To NoOfStereoMatches - 1
      x = stereoMatch(i, 0)
      y = stereoMatch(i, 1)
      z = stereoMatch(i, 7)
      Print #filenumber, x & ", " & y & ", " & z
    Next
  Close #filenumber
  
saveStereo_exit:
  Exit Sub
saveStereo_err:
  MsgBox "classImageProcessing/saveStereo/" & Error$(Err) & "/" & Err, , "Error"
  Resume saveStereo_exit
End Sub


Public Sub loadStereo(filename As String)
  On Error GoTo loadStereo_err
  
  Dim x As Single
  Dim y As Single
  Dim z As Single
  Dim i As Integer
  Dim filenumber As Integer
  
  filenumber = FreeFile
  Open filename For Input As #filenumber
    Input #filenumber, NoOfStereoMatches
    For i = 0 To NoOfStereoMatches - 1
      Input #filenumber, x
      stereoMatch(i, 0) = x
      Input #filenumber, y
      stereoMatch(i, 1) = y
      Input #filenumber, z
      stereoMatch(i, 7) = z
    Next
  Close #filenumber
  
loadStereo_exit:
  Exit Sub
loadStereo_err:
  MsgBox "classImageProcessing/loadStereo/" & Error$(Err) & "/" & Err, , "Error"
  Resume loadStereo_exit
End Sub


Public Sub showStereoDepth(canvas As PictureBox, minDistance As Single, maxDistance As Single, Red As Integer, Green As Integer, Blue As Integer)
  Dim x As Integer
  Dim y As Integer
  Dim xx As Integer
  Dim yy As Integer
  Dim screenX(2) As Single
  Dim screenY(2) As Single
  Dim c As Long
  Dim i As Integer
  Dim g As Single
  
  canvas.FillStyle = 0
  For i = 0 To NoOfStereoMatches - 1
    If (stereoMatch(i, 7) > minDistance) And (stereoMatch(i, 7) < maxDistance) Then
    
      'g = Int((1 - stereoMatch(i, 7)) * 255)
      'c = RGB(0, g, 0)
      'canvas.FillColor = c
  
      'x = stereoMatch(i, 5)
      'y = stereoMatch(i, 6)
      x = stereoMatch(i, 0)
      y = stereoMatch(i, 1)
      
      For xx = x To x + StereoPatchSize - 1
        For yy = y To y + StereoPatchSize - 1
          g = image(xx, yy) / 255
          c = RGB(Int(g * Red), Int(g * Green), Int(g * Blue))
          canvas.FillColor = c
          screenX(0) = (xx / width) * canvas.ScaleWidth
          screenY(0) = (yy / height) * canvas.ScaleHeight
          screenX(1) = ((xx + 1) / width) * canvas.ScaleWidth
          screenY(1) = ((yy + 1) / height) * canvas.ScaleHeight
          canvas.Line (screenX(0), screenY(0))-(screenX(1), screenY(1)), c, B
        Next