📄 mainform.frm
字号:
VERSION 5.00
Begin VB.Form Form1
BackColor = &H00404000&
Caption = "Microview专业卡演示程序"
ClientHeight = 8655
ClientLeft = 615
ClientTop = 2655
ClientWidth = 11550
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
LinkTopic = "Form1"
ScaleHeight = 577
ScaleMode = 3 'Pixel
ScaleWidth = 770
StartUpPosition = 2 'CenterScreen
Begin VB.CommandButton HideInfo
Caption = "隐藏"
Height = 495
Left = 13680
TabIndex = 2
Top = 6840
Width = 855
End
Begin VB.CommandButton RefreshInfo
Caption = "刷新"
Height = 495
Left = 12720
TabIndex = 1
Top = 6840
Width = 855
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 40
Left = 9960
Top = 7920
End
Begin VB.PictureBox DispArea
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H00808000&
BorderStyle = 0 'None
Height = 3255
Left = 0
ScaleHeight = 3255
ScaleMode = 0 'User
ScaleWidth = 5895
TabIndex = 9
Top = 0
Width = 5895
Begin VB.Label lblMICROVIEWIMAGE
BackColor = &H00808000&
Caption = "MICROVIEW IMAGE"
ForeColor = &H00FFFF00&
Height = 255
Left = 0
TabIndex = 10
Top = 0
Width = 1815
End
End
Begin VB.Line Line1
BorderColor = &H00FFFFFF&
Index = 1
X1 = 832
X2 = 968
Y1 = 176
Y2 = 176
End
Begin VB.Label lblMousePosition
BackColor = &H00404000&
Caption = "鼠标位置："
ForeColor = &H00FFFFFF&
Height = 255
Left = 12480
TabIndex = 8
Top = 240
Width = 1095
End
Begin VB.Line Line1
BorderColor = &H00FFFFFF&
Index = 0
X1 = 832
X2 = 968
Y1 = 40
Y2 = 40
End
Begin VB.Label MouseY
BackColor = &H00FFFFFF&
ForeColor = &H00000000&
Height = 255
Left = 13800
TabIndex = 7
Top = 720
Width = 735
End
Begin VB.Label MouseX
BackColor = &H00FFFFFF&
ForeColor = &H00000000&
Height = 255
Left = 12720
TabIndex = 6
Top = 720
Width = 735
End
Begin VB.Label lblY
BackColor = &H00404000&
Caption = "Y:"
ForeColor = &H00FFFFFF&
Height = 255
Left = 13560
TabIndex = 5
Top = 720
Width = 255
End
Begin VB.Label lblX
BackColor = &H00404000&
Caption = "X:"
ForeColor = &H00FFFFFF&
Height = 255
Left = 12480
TabIndex = 4
Top = 720
Width = 255
End
Begin VB.Label lblLabel2
BackColor = &H00404000&
Caption = "视频信息："
ForeColor = &H00FFFFFF&
Height = 255
Left = 12480
TabIndex = 3
Top = 2280
Width = 1095
End
Begin VB.Label Hint
BackColor = &H00404000&
Caption = "请刷新！"
ForeColor = &H00FFFFFF&
Height = 3735
Left = 12480
TabIndex = 0
Top = 2880
Width = 1935
End
Begin VB.Menu Display
Caption = "暂停显示(&A)"
End
Begin VB.Menu Captrue
Caption = "采集图像(&B)"
End
Begin VB.Menu SetPar
Caption = "参数设置(&C)"
End
Begin VB.Menu Reset
Caption = "恢复默认参数(&D)"
End
Begin VB.Menu test
Caption = "视频信号测试(&E)"
Visible = 0 'False
End
Begin VB.Menu FullScreen
Caption = "全屏显示(&F)"
End
Begin VB.Menu SyncSet
Caption = "同步源设置(&G)"
Visible = 0 'False
Begin VB.Menu RSync
Caption = "同步在红路"
End
Begin VB.Menu GSync
Caption = "同步在绿路"
End
Begin VB.Menu BSync
Caption = "同步在蓝路"
End
Begin VB.Menu CSync
Caption = "复合外同步"
End
Begin VB.Menu SSync
Caption = "行场同步分离"
End
End
Begin VB.Menu OSDSet
Caption = "OSD功能(&H)"
Visible = 0 'False
End
Begin VB.Menu CapFormat
Caption = "采集格式(&I)"
Begin VB.Menu now
Caption = "当前格式："
End
Begin VB.Menu line
Caption = "-----------------"
End
Begin VB.Menu MONOCHOY8
Caption = "MONOCHOY8"
End
Begin VB.Menu RGB1555
Caption = "RGB1555"
End
Begin VB.Menu CO_RGB24
Caption = "CO_RGB24"
End
Begin VB.Menu aRGB8888
Caption = "aRGB8888"
End
Begin VB.Menu RGB8332
Caption = "RGB8332"
End
Begin VB.Menu CO_RGB565
Caption = "CO_RGB565"
End
Begin VB.Menu RGB5515
Caption = "RGB5515"
End
Begin VB.Menu CO_YUV444
Caption = "CO_YUV444"
End
Begin VB.Menu CO_YUV422
Caption = "CO_YUV422"
End
Begin VB.Menu YUV411
Caption = "YUV411"
End
End
Begin VB.Menu TenBitMode
Caption = "10bit模式(&J)"
Visible = 0 'False
Begin VB.Menu HighBits
Caption = "高8位"
End
Begin VB.Menu MiddleBits
Caption = "中8位"
End
Begin VB.Menu LowBits
Caption = "低8位"
End
Begin VB.Menu TenBits
Caption = "10bit方式"
End
End
Begin VB.Menu FilterSet
Caption = "滤波器设置(&K)"
Visible = 0 'False
End
Begin VB.Menu menuRealTimeInfo
Caption = "右边栏信息(&L)"
End
Begin VB.Menu about
Caption = "关于(&M)"
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub about_Click()
frmAbout.Show 1
End Sub
Private Sub aRGB8888_Click()
MV_SetDeviceParameter hDevice, GARB_BITDESCRIBE, 3 '设置图像采集格式为RGB8888
now.Caption = "当前格式：aRGB8888"
End Sub
Private Sub BSYNC_Click()
RSync.Checked = False
GSync.Checked = False
BSync.Checked = True
CSync.Checked = False '复合外同步
SSync.Checked = False '行场同步分离
MV_SetDeviceParameter hDevice, WORK_SYNC, 2 '设置同步方式为同步在蓝路
End Sub
Private Sub Captrue_Click()
MV_SetDeviceParameter hDevice, SET_GARBIMAGEINFO, VarPtr(info) '得到当前的图像的信息
Timer1.Enabled = True
End Sub
Private Sub CO_RGB24_Click()
MV_SetDeviceParameter hDevice, GARB_BITDESCRIBE, 2 '设置图像采集格式为CO_RGB24
now.Caption = "当前格式：CO_RGB24"
End Sub
Private Sub CO_RGB565_Click()
MV_SetDeviceParameter hDevice, GARB_BITDESCRIBE, 5 '设置图像采集格式为CO_RGB565
now.Caption = "当前格式：CO_RGB565"
End Sub
Private Sub CO_YUV422_Click()
MV_SetDeviceParameter hDevice, GARB_BITDESCRIBE, 8 '设置图像采集格式为CO_YUV422
now.Caption = "当前格式：CO_YUV422"
End Sub
Private Sub CO_YUV444_Click()
MV_SetDeviceParameter hDevice, GARB_BITDESCRIBE, 7 '设置图像采集格式为CO_YUV444
now.Caption = "当前格式：CO_YUV444"
End Sub
Private Sub CSYNC_Click()
RSync.Checked = False
GSync.Checked = False
BSync.Checked = False
CSync.Checked = True
SSync.Checked = False
MV_SetDeviceParameter hDevice, WORK_SYNC, 3 '设置同步方式为复合外同步
End Sub
Private Sub DispArea_Click()
Dim worstatu As RUNOPER
If bIsReadData = True Then
workstatu = MV_OperateDevice(hDevice, MVQUERYSTATU)
temp = MV_GetLastError(False)
If Not (workstatu = MVRUN) Then
strDotData = "读取每点信息之前，请先运行设备！"
DotData.Show 1
Exit Sub
End If
GetCursorPos Pnt '取得鼠标位置
ScreenToClient DispArea.hWnd, Pnt
'逐点读取视频
Dim rect1 As RECT
Dim i As Long
Dim cutlen As Long, xoff As Long, yoff As Long, Width As Long, height As Long
Dim pdest() As Byte
Dim buffer() As Byte
Dim str1 As String, str2 As String, str3 As String
Dim pt As PointAPI
xoff = MV_GetDeviceParameter(hDevice, DISP_LEFT)
yoff = MV_GetDeviceParameter(hDevice, DISP_TOP)
Width = MV_GetDeviceParameter(hDevice, GARB_WIDTH)
height = MV_GetDeviceParameter(hDevice, GARB_HEIGHT)
pt.X = Pnt.X - xoff
pt.Y = Pnt.Y - yoff
If pt.X < Width And pt.Y < height Then
MV_SetDeviceParameter hDevice, SET_GARBIMAGEINFO, VarPtr(info) '得到当前的图像的信息
ReDim buffer(info.Length) As Byte '分配内存
For i = 0 To info.Length - 1
buffer(i) = 0
Next i
MV_CaptureSingle hDevice, False, VarPtr(buffer(0)), info.Length, info '采集一幅图像
If info.nColor = 32 Then
ReDim pdest(4) As Byte '分配内存
cutlen = MV_ReadPixel(VarPtr(info), VarPtr(buffer(0)), pt, VarPtr(pdest(0))) '取出该点数据
If pdest(2) = 0 Then
str1 = "该点数据红色分量为：0"
Else: str1 = Format$(pdest(2), "该点数据红色分量为：####")
End If
If pdest(1) = 0 Then
str2 = ",绿色分量为0："
Else
str2 = Format$(pdest(1), ",绿色分量为：####")
End If
If pdest(0) = 0 Then
str3 = ",蓝色分量为：0"
Else
str3 = Format$(pdest(0), ",蓝色分量为：####")
End If
str3 = str1 & str2 & str3
ElseIf info.nColor = 24 Then
ReDim pdest(3) As Byte
cutlen = MV_ReadPixel(VarPtr(info), VarPtr(buffer(0)), pt, VarPtr(pdest(0))) '取出该点数据
If pdest(2) = 0 Then
str1 = "该点数据红色分量为：0"
Else: str1 = Format$(pdest(2), "该点数据红色分量为：####")
End If
If pdest(1) = 0 Then
str2 = ",绿色分量为0："
Else
str2 = Format$(pdest(1), ",绿色分量为：####")
End If
If pdest(0) = 0 Then
str3 = ",蓝色分量为：0"
Else
str3 = Format$(pdest(0), ",蓝色分量为：####")
End If
str3 = str1 & str2 & str3
Else
str3 = "请在24位或32位采集模式下使用此功能！"
End If
strDotData = str3
DotData.Show 1
Else
Debug.Print "out of range"
End If
End If
End Sub
Private Sub DispArea_MouseMove(Button As Integer, _
Shift As Integer, _
X As Single, _
Y As Single)
'取得鼠标位置
GetCursorPos Pnt
ScreenToClient DispArea.hWnd, Pnt
'逐点读取视频
MouseX.Caption = Pnt.X
MouseY.Caption = Pnt.Y
End Sub
Private Sub Display_Click()
If Display.Caption = "显示图像(&D)" Then
Display.Caption = "暂停显示(&D)"
MV_OperateDevice hDevice, MVRUN '设置采集卡采集并显示图像
Else
Display.Caption = "显示图像(&D)"
MV_OperateDevice hDevice, MVPAUSE '暂停采集卡采集显示图像
End If
DispArea.Refresh
End Sub
Private Sub FilterSet_Click()
FilterForm.Show 1
End Sub
Private Sub Form_Load()
' 变量定义
Dim val As Long
Dim str As String
Dim nCardCount As Integer
Dim strName As String
Dim tmphDevice As Long
hDevice = 0
bOnField = False
nFileFmt = False
bIsColor = True
nQuality = 50
nFrmNo = 1
bIsReadData = False
'得到板卡数量和每块卡的名称,储存到一字符串数组
nAmount = MV_GetDeviceNumber()
If Not (nAmount > 0) Then
ERROR.Show 1
Exit Sub
End If
For nCardCount = 0 To nAmount - 1
hDevice = MV_OpenDevice(nCardCount, True)
MV_CloseDevice (tmphDevice)
tmphDevice = hDevice
nBoardType = MV_GetDeviceParameter(hDevice, GET_BOARD_TYPE) '得到当前采集卡类型
Select Case nBoardType
Case LEVIN_M10: strName = "LEVIN_M10"
Case LEVIN_RGB10: strName = "LEVIN_RGB10"
Case LEVIN_M20: strName = "LEVIN_M20"
Case LEVIN_RGB20: strName = "LEVIN_RGB20"
Case LEVIN_VGA100: strName = "LEVIN_VGA100"
Case LEVIN_VGA170: strName = "LEVIN_VGA170"
Case V520: strName = "MVPCI V520/Moka-C50"
Case V510: strName = "MVPCI V510/Moka-C51"
Case V500: strName = "MVPCI V500"
Case V410: strName = "MVPCI V410"
Case V400: strName = "MVPCI V400"
Case V3A: strName = "MVPCI V3A"
Case V300: strName = "MVPCI V300"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -