frmtesting.frm

来自「这是一个立体视觉程序」· FRM 代码 · 共 277 行

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Object = "{65E121D4-0C60-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCHRT20.OCX"
Begin VB.Form frmTesting 
   BackColor       =   &H00000000&
   Caption         =   "Sentience"
   ClientHeight    =   7335
   ClientLeft      =   165
   ClientTop       =   450
   ClientWidth     =   7800
   Icon            =   "frmTesting.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   7335
   ScaleWidth      =   7800
   StartUpPosition =   2  'CenterScreen
   Begin MSChart20Lib.MSChart MSChart 
      Height          =   2895
      Left            =   4080
      OleObjectBlob   =   "frmTesting.frx":0442
      TabIndex        =   4
      Top             =   3960
      Width           =   3255
   End
   Begin VB.PictureBox picResult 
      BackColor       =   &H00000000&
      Height          =   3375
      Left            =   120
      ScaleHeight     =   200
      ScaleMode       =   0  'User
      ScaleWidth      =   200
      TabIndex        =   3
      Top             =   3840
      Width           =   3735
   End
   Begin VB.Frame Frame1 
      BackColor       =   &H00C0C0C0&
      ForeColor       =   &H00000000&
      Height          =   3735
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   7815
      Begin VB.PictureBox picStereo2 
         BackColor       =   &H00000000&
         Height          =   3375
         Left            =   3960
         ScaleHeight     =   1000
         ScaleMode       =   0  'User
         ScaleWidth      =   1000
         TabIndex        =   2
         Top             =   240
         Width           =   3735
      End
      Begin VB.PictureBox picStereo1 
         BackColor       =   &H00000000&
         Height          =   3375
         Left            =   120
         ScaleHeight     =   200
         ScaleMode       =   0  'User
         ScaleWidth      =   200
         TabIndex        =   1
         Top             =   240
         Width           =   3735
      End
   End
   Begin MSComDlg.CommonDialog Dialog 
      Left            =   0
      Top             =   5040
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      DialogTitle     =   "Open a new Test Image"
   End
   Begin VB.Menu mnuFile 
      Caption         =   "&File"
      Begin VB.Menu mnuOpenRight 
         Caption         =   "Open Right Image"
      End
      Begin VB.Menu mnuOpen 
         Caption         =   "&Open Left Image"
      End
      Begin VB.Menu mnuSavePoints 
         Caption         =   "Save 3D Points"
      End
      Begin VB.Menu mnuExportVRML 
         Caption         =   "Export as VRML"
      End
      Begin VB.Menu mnuExit 
         Caption         =   "&Exit"
      End
   End
   Begin VB.Menu mnuShow 
      Caption         =   "&Show"
      Begin VB.Menu mnuStereo 
         Caption         =   "Stereo"
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "&Help"
      Begin VB.Menu mnuAbout 
         Caption         =   "&About"
      End
   End
End
Attribute VB_Name = "frmTesting"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim finish As Boolean

Const image_Width = 50
Const image_height = 50

Dim stereoimg1 As New classImageProcessing
Dim stereoimg2 As New classImageProcessing
Const smoothness = 0.0001
Const matchThreshold = 0.03
Const patchsize = image_Width / 10
Const searchHorizontal = image_Width / 2
Const searchVertical = image_height / 20



Private Sub showEdges(px As Integer, py As Integer, showHistogram As Boolean, showTracks As Boolean)
  Dim image_raw As New classImageProcessing
  Dim image_gaussian As New classImageProcessing
  Dim edges As New classImageProcessing
  
  Me.MousePointer = 11
  
  picStereo1.ScaleWidth = 200
  picStereo1.ScaleHeight = 200
  picStereo2.ScaleWidth = 200
  picStereo2.ScaleHeight = 200
  
  If (px < 0) Then
    px = 0
  End If
  If (px > picStereo1.ScaleWidth - 50) Then
    px = picStereo1.ScaleWidth - 50
  End If
  If (py < 0) Then
    py = 0
  End If
  If (py > picStereo1.ScaleHeight - 50) Then
    py = picStereo1.ScaleHeight - 50
  End If
  
  px = 0
  py = 0
    
  Call image_raw.init(150, 150)
  Call image_raw.update(picStereo1) ', px, py, px + 100, py + 100)
  Call image_gaussian.init(150, 150)
  Call image_gaussian.getGaussianContours(image_raw, 1)
  Call edges.init(150, 150)
  edges.EdgeThreshold = 0.05
  'edges.EdgeThreshold = 0.03
  Call edges.getImageContours(image_gaussian)
  Call edges.getEdges
  
  If (Not showHistogram) Then
    Call edges.showEdges(picStereo2, showTracks)
    Else
    Call edges.showEdgeHistogram(picStereo2)
  End If

  Set edges = Nothing
  Set image_raw = Nothing
  Set image_gaussian = Nothing
  
  Me.MousePointer = 0
End Sub



Private Sub Form_Load()
  Call stereoimg1.init(image_Width, image_height)
  Call stereoimg2.init(image_Width, image_height)
End Sub


Private Sub mnuAbout_Click()
  frmAbout.show 1
End Sub



Private Sub mnuExit_Click()
  End
End Sub


Private Sub mnuExportVRML_Click()
  Dialog.Filter = "VRML Files|*.WRL"
  Dialog.InitDir = App.Path
  Dialog.FilterIndex = 1
  Dialog.ShowSave
  If (Dialog.filename <> "") Then
    Call stereoimg1.saveStereoAsVRML(Dialog.filename, "stereoObject")
    MsgBox "VRML file created", , ""
  End If
End Sub

Private Sub mnuOpen_Click()
  Dialog.Filter = "JPEG Files|*.JPG|GIF Files|*.GIF|Bitmaps|*.BMP"
  Dialog.InitDir = "E:\gfx\FaceRec" 'App.Path
  Dialog.FilterIndex = 1
  Dialog.ShowOpen
  If (Dialog.filename <> "") Then
    picStereo1.Picture = LoadPicture(Dialog.filename)
  End If
End Sub




Private Sub mnuOpenRight_Click()
  Dialog.Filter = "JPEG Files|*.JPG|GIF Files|*.GIF|Bitmaps|*.BMP"
  Dialog.InitDir = "E:\gfx\FaceRec" 'App.Path
  Dialog.FilterIndex = 1
  Dialog.ShowOpen
  If (Dialog.filename <> "") Then
    picStereo2.Picture = LoadPicture(Dialog.filename)
  End If
End Sub

Private Sub mnuSavePoints_Click()
  Dialog.Filter = "Text Files|*.TXT"
  Dialog.InitDir = App.Path
  Dialog.FilterIndex = 1
  Dialog.ShowSave
  If (Dialog.filename <> "") Then
    Call stereoimg1.saveStereo(Dialog.filename)
    MsgBox "3D Points Saved", , ""
  End If
End Sub


Private Sub mnuStereo_Click()
  Me.MousePointer = 11
  
  picStereo1.ScaleWidth = image_Width
  picStereo1.ScaleHeight = image_height
  picStereo2.ScaleWidth = image_Width
  picStereo2.ScaleHeight = image_height
  picResult.ScaleWidth = image_Width
  picResult.ScaleHeight = image_height
  
  Call stereoimg1.update(picStereo1)
  Call stereoimg2.update(picStereo2)
  
  Call stereoimg1.stereoCompare(stereoimg2, patchsize, smoothness, matchThreshold, searchHorizontal, searchVertical)
  'Call stereoimg1.showStereoMatches(picstereo2, 1)
  Call stereoimg1.showStereoDepth(picResult, 0.8, 1, 0, 0, 255)
  Call stereoimg1.showStereoDepth(picResult, 0.7, 0.8, 0, 255, 0)
  Call stereoimg1.showStereoDepth(picResult, 0, 0.7, 255, 0, 0)
  
  Call stereoimg1.showStereoChart(MSChart)
  
  Me.MousePointer = 0
End Sub



Private Sub MSChart_OLEStartDrag(Data As MSChart20Lib.DataObject, AllowedEffects As Long)

End Sub

Private Sub picstereo1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  Call showEdges(Int(x), Int(y), False, False)
End Sub