classimageprocessing.cls

vb做的摄像头程序

  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 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 c As Long
  Dim i As Integer
  Dim g As Single
  Dim patchWidth As Integer
  Dim tx As Integer
  Dim ty As Integer
  Dim bx As Integer
  Dim by As Integer
  
  
  Call show(canvas)
  patchWidth = StereoPatchSize / 2
  canvas.FillStyle = 0
  For i = 0 To NoOfStereoMatches - 1
    'If (stereoMatch(i, 7) > minDistance) And (stereoMatch(i, 7) < maxDistance) Then
    If (stereoMatch(i, 7) < 0.9) Then
      g = Int((1 - stereoMatch(i, 7)) * 255)
      c = RGB(g, g, 0)
      canvas.FillColor = c
  
      x = stereoMatch(i, 0)
      y = stereoMatch(i, 1)
      
      tx = ((x - patchWidth) / width) * canvas.ScaleWidth
      ty = ((y - patchWidth) / height) * canvas.ScaleHeight
      bx = ((x + patchWidth) / width) * canvas.ScaleWidth
      by = ((y + patchWidth) / height) * canvas.ScaleHeight
      canvas.Line (tx, ty)-(bx, by), c, B
      
      'For xx = x - patchWidth To x - patchWidth + StereoPatchSize - 1
      '  For yy = y - patchWidth To y - patchWidth + StereoPatchSize - 1
      '    'g = image(xx, yy) / 255
      '    'c = RGB(Int(g * Red), Int(g * Green), Int(g * Blue))
      '    'canvas.FillColor = c
      '    tx = (xx / width) * canvas.ScaleWidth
      '    ty = (yy / height) * canvas.ScaleHeight
      '    bx = ((xx + 1) / width) * canvas.ScaleWidth
      '    by = ((yy + 1) / height) * canvas.ScaleHeight
      '    canvas.Line (tx, ty)-(bx, by), c, B
      '  Next
      'Next
      
    End If
  Next
End Sub



Public Sub showStereoDepthGraph(canvas As PictureBox)
  Dim xx As Integer
  Dim yy As Integer
  Dim x As Integer
  Dim y As Integer
  Dim prev_x As Integer
  Dim prev_y As Integer
  Dim x2 As Integer
  Dim y2 As Integer
  Dim py As Single
  Dim c As Long
  Dim av As Long
  
  c = RGB(0, 255, 0)
  canvas.ForeColor = c
  canvas.BackColor = 0
  canvas.FillColor = c
  canvas.FillStyle = 0
  canvas.Cls
  For xx = 0 To width - 1
    x = ((xx / width) * canvas.ScaleWidth)
    x2 = (((xx + 1) / width) * canvas.ScaleWidth)
    
    av = 0
    For yy = 0 To height - 1
      av = av + image(xx, yy)
    Next
    py = av / height
    
    'py = py / 255
    'py = (py * py) * 255
    
    'c = RGB(0, py, 0)
    'canvas.FillColor = c
    If (py > 0) Then
      y = ((py / 255) * canvas.ScaleHeight)
      y2 = (((py + 8) / 255) * canvas.ScaleHeight)
      canvas.Line (x, y)-(prev_x, prev_y), c
      prev_x = x
      prev_y = y
    End If
  Next
End Sub


Public Sub saveStereoAsVRML(filename As String, objectName As String)
  On Error GoTo saveStereoAsVRML_err
  
  Dim vrmlStr As String
  Dim i As Integer
  Dim filenumber As Integer
  
  vrmlStr = "#VRML V2.0 utf8" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "DEF " & objectName & " Group" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "  {" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "  children" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "    [" & Chr(13) & Chr(10)

  For i = 0 To NoOfStereoMatches - 1
    vrmlStr = vrmlStr & saveStereoAsVRMLpoint(i)
  Next
  vrmlStr = vrmlStr & "    ]" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "  }" & Chr(13) & Chr(10)
  
  filenumber = FreeFile
  Open filename For Output As #filenumber
  Print #filenumber, vrmlStr
  Close #filenumber

saveStereoAsVRML_exit:
  Exit Sub
saveStereoAsVRML_err:
  MsgBox "classImageProcessing/saveStereoAsVRML/" & Error$(Err) & "/" & Err, , "Error"
  Resume saveStereoAsVRML_exit
End Sub


Private Function saveStereoAsVRMLpoint(pointNo As Integer) As String

  Dim vrmlStr As String
  Dim x As Single
  Dim y As Single
  Dim z As Single
      
  x = stereoMatch(pointNo, 0)
  y = stereoMatch(pointNo, 1)
  z = 50 - (stereoMatch(pointNo, 7) * stereoMatch(pointNo, 7) * 50)
      
  vrmlStr = ""
  vrmlStr = vrmlStr & "    Transform" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "      {" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "      children Shape" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "        {" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "        appearance Appearance" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "          {" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "          material Material" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "            {" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "            diffuseColor " & (1 - stereoMatch(pointNo, 7)) & " 0.1 " & stereoMatch(pointNo, 7) & Chr(13) & Chr(10)
  'vrmlStr = vrmlStr & "            emissiveColor 0.5 0.5 0.5" & Chr(13) & Chr(10)
  'vrmlStr = vrmlStr & "            transparency 0" & Chr(13) & Chr(10)
  'vrmlStr = vrmlStr & "            ambientIntensity 0.5" & Chr(13) & Chr(10)
  'vrmlStr = vrmlStr & "            shininess 1" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "            }" & Chr(13) & Chr(10)
  'vrmlStr = vrmlStr & "          material Material {}" & Chr(13) & Chr(10)
  'vrmlStr = vrmlStr & "          # texture ImageTexture {}" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "          }" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "        geometry Box { size 5 5 5 }" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "        }" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "      translation " & x & " " & y & " " & " " & z & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "      scale 1 1 1" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "      }," & Chr(13) & Chr(10)
  saveStereoAsVRMLpoint = vrmlStr

End Function


Public Sub showGradientField(canvas As PictureBox)
  Dim x As Integer
  Dim y As Integer
  Dim screenX(2) As Single
  Dim screenY(2) As Single
  Dim c As Long
  Dim ax As Single
  Dim ay As Single
  Dim Value As Integer
  
  canvas.Cls
  canvas.FillStyle = 0
  Call showEdges(canvas, False)
  For x = 0 To width - 1 Step 4
    For y = 0 To height - 1 Step 4
      Value = getEdgeGradient(x, y, width, ax, ay) * 255
      c = RGB(0, Value, 0)
      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
      
      screenX(1) = ((x + (ax * 4)) / width) * canvas.ScaleWidth
      screenY(1) = ((y + (ay * 4)) / height) * canvas.ScaleHeight
      canvas.Line (screenX(0), screenY(0))-(screenX(1), screenY(1)), c
    Next
  Next
End Sub



Public Sub showSnake(canvas As PictureBox)
  Dim i As Integer
  Dim screenX(2) As Single
  Dim screenY(2) As Single
  Dim originX As Single
  Dim originY As Single
  Dim c As Long
  
  canvas.Cls
  canvas.FillStyle = 0
  c = RGB(0, 255, 0)
  For i = 0 To NoOfSnakePoints - 1
    screenX(0) = (SnakePoint(i, SNAKE_X) / width) * canvas.ScaleWidth
    screenY(0) = (SnakePoint(i, SNAKE_Y) / height) * canvas.ScaleHeight
    'canvas.Circle (screenX(0), screenY(0)), 1, c
    If (i > 0) Then
      canvas.Line (screenX(0), screenY(0))-(screenX(1), screenY(1)), c
      If (i = NoOfSnakePoints - 1) Then
        canvas.Line (screenX(0), screenY(0))-(originX, originY), c
      End If
      Else
      originX = screenX(0)
      originY = screenY(0)
    End If
    screenX(1) = screenX(0)
    screenY(1) = screenY(0)
  Next
End Sub


Public Sub centreOfEdges(ByRef x As Integer, ByRef y As Integer)
'returns the centre of edges within the image
  Dim i As Integer
  Dim av_x As Single
  Dim av_y As Single