' メインフォーム Public Class frmSample Private m_oEng As CaoEngine Private m_oCtrl As CaoController Private m_oHobj As CaoVariable Private m_oHtpl As CaoVariable Private m_AcqHndl Private m_WinHndl Private m_Width Private m_Height Private Sub frmSample_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load ' CAOオブジェクトの生成 m_oEng = New CaoEngine End Sub Private Sub cmdConnect_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdConnect.Click Dim I Dim GrabID = CInt(txtID.Text) Try m_oCtrl = m_oEng.Workspaces.Item(0).AddController("Sample", "CaoProv.HALCON") ' システム変数生成 m_oHobj = m_oCtrl.AddVariable("@HOBJ") m_oHtpl = m_oCtrl.AddVariable("@HTPL") ' フレームグラバーの初期化 m_oCtrl.Execute("close_all_framegrabbers", New Object(3) {"", "", "", ""}) ' フレームグラバーのオープン m_oHtpl.ID = 1 m_oHtpl.Value = "DirectShow" m_oHtpl.ID = 2 m_oHtpl.Value = 1 m_oHtpl.ID = 3 m_oHtpl.Value = 1 m_oHtpl.ID = 4 m_oHtpl.Value = 0 m_oHtpl.ID = 5 m_oHtpl.Value = 0 m_oHtpl.ID = 6 m_oHtpl.Value = 0 m_oHtpl.ID = 7 m_oHtpl.Value = 0 m_oHtpl.ID = 8 m_oHtpl.Value = "default" m_oHtpl.ID = 9 m_oHtpl.Value = -1 m_oHtpl.ID = 10 m_oHtpl.Value = "default" m_oHtpl.ID = 11 m_oHtpl.Value = -1 m_oHtpl.ID = 12 m_oHtpl.Value = "false" m_oHtpl.ID = 13 m_oHtpl.Value = "default" m_oHtpl.ID = 14 m_oHtpl.Value = "0" m_oHtpl.ID = 15 m_oHtpl.Value = 0 m_oHtpl.ID = 16 m_oHtpl.Value = -1 m_AcqHndl = 17 m_oCtrl.Execute("open_framegrabber", New Object(3) {"", "", New Object(15) {1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16}, m_AcqHndl}) ' 最初の数枚はゴミが取れるので捨てる For I = 0 To 5 ' 画像撮影 m_oCtrl.Execute("grab_image", New Object(3) {"", GrabID, m_AcqHndl, ""}) Next ' 画像サイズ取得 m_Width = 18 m_Height = 19 m_oCtrl.Execute("get_image_pointer3", New Object(3) {GrabID, "", "", New Object(5) {"", "", "", "", m_Width, m_Height}}) ' HALCONオブジェクト(region, xld)描画用の仮想ウィンドウの生成（実際にウィンドウは開きません） m_oHtpl.ID = 1 m_oHtpl.Value = 0 m_oHtpl.ID = 2 m_oHtpl.Value = 0 m_oHtpl.ID = 3 m_oHtpl.Value = 0 m_oHtpl.ID = 4 m_oHtpl.Value = "buffer" m_oHtpl.ID = 5 m_oHtpl.Value = "" m_WinHndl = 20 m_oCtrl.Execute("open_window", New Object(3) {"", "", New Object(6) {1, 2, 18, 19, 3, 4, 5}, m_WinHndl}) timRefresh.Enabled = True cmdConnect.Enabled = False cmdDisconnect.Enabled = True Catch err As Exception MsgBox(err.Message) cmdDisconnect_Click(sender, e) End Try End Sub Private Sub cmdDisconnect_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdDisconnect.Click timRefresh.Enabled = False cmdConnect.Enabled = True cmdDisconnect.Enabled = False If Not m_oCtrl Is Nothing Then m_oHtpl.ID = m_WinHndl If Not m_oHtpl.Value Is Nothing Then ' 仮想ウィンドウのクローズ m_oCtrl.Execute("close_window", New Object(3) {"", "", m_WinHndl, ""}) End If m_oHtpl.ID = m_AcqHndl If Not m_oHtpl.Value Is Nothing Then ' フレームグラバーのクローズ m_oCtrl.Execute("close_framegrabber", New Object(3) {"", "", m_AcqHndl, ""}) End If End If ' CAOオブジェクトの破棄 If Not m_oCtrl Is Nothing Then m_oCtrl.Variables.Clear() System.Runtime.InteropServices.Marshal.ReleaseComObject(m_oHobj) System.Runtime.InteropServices.Marshal.ReleaseComObject(m_oHtpl) m_oHobj = Nothing m_oHtpl = Nothing m_oEng.Workspaces.Item(0).Controllers.Remove(m_oCtrl.Index) System.Runtime.InteropServices.Marshal.ReleaseComObject(m_oCtrl) m_oCtrl = Nothing End If End Sub Private Sub timRefresh_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles timRefresh.Tick Dim bArray() As Byte Dim GrabID = CInt(txtID.Text) Try If (rdoLive.Checked) Then ' 画像撮影 m_oCtrl.Execute("grab_image", New Object(3) {"", GrabID, m_AcqHndl, ""}) ' 描画用画像データ取得 m_oHobj.ID = GrabID bArray = m_oHobj.Value ElseIf (rdoGray.Checked) Then ' 画像撮影 m_oCtrl.Execute("grab_image", New Object(3) {"", GrabID, m_AcqHndl, ""}) ' グレースケール化 m_oCtrl.Execute("rgb1_to_gray", New Object(3) {GrabID, GrabID + 1, "", ""}) ' 描画用画像データ取得 m_oHobj.ID = GrabID + 1 bArray = m_oHobj.Value ElseIf (rdoThreshold.Checked) Then ' 画像撮影 m_oCtrl.Execute("grab_image", New Object(3) {"", GrabID, m_AcqHndl, ""}) ' 2値化(region) m_oHtpl.ID = 1 m_oHtpl.Value = 0 m_oHtpl.ID = 2 m_oHtpl.Value = 126 m_oCtrl.Execute("threshold", New Object(3) {GrabID, GrabID + 1, New Object(1) {1, 2}, ""}) ' 仮想ウィンドウへの描画色変更 m_oHtpl.ID = 1 m_oHtpl.Value = "white" m_oCtrl.Execute("set_color", New Object(3) {"", "", New Object(1) {m_WinHndl, 1}, ""}) ' 仮想ウィンドウへの描画範囲設定 m_oHtpl.ID = 1 m_oHtpl.Value = 0 m_oHtpl.ID = 2 m_oHtpl.Value = 0 m_oCtrl.Execute("set_part", New Object(3) {"", "", New Object(4) {m_WinHndl, 1, 2, m_Height, m_Width}, ""}) ' HALCONオブジェクト(region, xld)はそのまま表示できないので,仮想ウィンドウに仮描画してから画像オブジェクトにダンプする m_oCtrl.Execute("clear_window", New Object(3) {"", "", m_WinHndl, ""}) m_oCtrl.Execute("disp_obj", New Object(3) {GrabID + 1, "", m_WinHndl, ""}) m_oCtrl.Execute("dump_window_image", New Object(3) {"", GrabID + 1, m_WinHndl, ""}) ' 描画用画像の表示 m_oHobj.ID = GrabID + 1 bArray = m_oHobj.Value ElseIf (rdoCanny.Checked) Then ' 画像撮影 m_oCtrl.Execute("grab_image", New Object(3) {"", GrabID, m_AcqHndl, ""}) ' Canny エッジフィルタ m_oHtpl.ID = 1 m_oHtpl.Value = "canny" m_oHtpl.ID = 2 m_oHtpl.Value = 1.0 m_oHtpl.ID = 3 m_oHtpl.Value = "nms" m_oHtpl.ID = 4 m_oHtpl.Value = 1 m_oHtpl.ID = 5 m_oHtpl.Value = 50 m_oCtrl.Execute("edges_image", New Object(3) {GrabID, New Object(1) {GrabID + 1, GrabID + 2}, New Object(4) {1, 2, 3, 4, 5}, ""}) ' 描画用画像の表示 m_oHobj.ID = GrabID + 1 bArray = m_oHobj.Value Else Exit Sub End If ' 描画用画像の表示 If Not bArray Is Nothing Then picImage.Image = Image.FromStream(New MemoryStream(bArray)) End If Catch err As Exception MsgBox(err.Message) cmdDisconnect_Click(sender, e) End Try End Sub End Class