显示现场视频: 图形叠加: 可移动坐标准心

这个例子介绍的是如何使用IC Imaging Control在视频上加入可移动坐标准心。

示例程序窗口如图所示：

程序开始后首先调用对话框(.ShowDeviceSettingsDialog)用于选择设备。 在Form_Load()结尾处 .LiveStart将显示设备传来的现场视频。 准备工作有两步：第一，开启叠加模式(.OverlayBitmap.Enable)。第二，将dragging状态设为False， 该变量将被用于指示鼠标左键是否处于按下状态。

Dim dragging As Boolean

Private Sub Form_Load()

    ICImagingControl1.ShowDeviceSettingsDialog

    If Not ICImagingControl1.DeviceValid Then
        Unload Me
        Exit Sub
    End If

    ICImagingControl1.OverlayBitmap.Enable = True
    ICImagingControl1.LiveStart

    dragging = False
End Sub

坐标准心由两条红色线段和一副蓝色坐标值构成。.OverlayBitmap.DrawLine用于划线，.OverlayBitmap.DrawText生成坐标：

Private Sub DisplayCrosshairs(XPos As Integer, YPos As Integer)

    ICImagingControl1.OverlayBitmap.DrawLine vbRed, XPos, YPos - 10, XPos, YPos + 10
    ICImagingControl1.OverlayBitmap.DrawLine vbRed, XPos - 10, YPos, XPos + 10, YPos

    ICImagingControl1.OverlayBitmap.DrawText vbBlue, XPos + 3, YPos + 2, XPos & "," & YPos

End Sub

决定准心位置的有两个因素：鼠标的运动及其按键状态。 用户点击画面，程序将删除旧的坐标点，给叠加层bitmap填入透明色.DropOutColor。DisplayCrosshairs XPos, YPos 将为鼠标画出新的准心：

Private Sub ICImagingControl1_MouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal XPos As Integer, ByVal YPos As Integer)

    If Not Shift And vbShiftMask Then
        ICImagingControl1.OverlayBitmap.Fill ICImagingControl1.OverlayBitmap.DropOutColor
    End If

    DisplayCrosshairs XPos, YPos

    dragging = True

End Sub

用户按住左键移动鼠标时，程序将删除旧的坐标点，给叠加层bitmap填入透明色.DropOutColor. DisplayCrosshairs XPos, YPos将为鼠标画出新的准心：

Private Sub ICImagingControl1_MouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal XPos As Integer, ByVal YPos As Integer)

    If dragging Then

        If Not Shift And vbShiftMask Then
            ICImagingControl1.OverlayBitmap.Fill ICImagingControl1.OverlayBitmap.DropOutColor
        End If

        DisplayCrosshairs XPos, YPos

    End If

End Sub

放开鼠标将把状态变量dragging重设为False:

Private Sub ICImagingControl1_MouseUp(ByVal Button As Long, ByVal Shift As Long, ByVal XPos As Integer, ByVal YPos As Integer)

    dragging = False

End Sub