cgcardmodule.bas

内窥镜图案工作站有说明 有文档 有应用程序

Attribute VB_Name = "CGCardModule"
Public hcg As Long     '图像卡句柄
Public CaputureAdjust As CHECK_PARAM    '记录图像卡参数
Public CaputureSource As VIDEO_SOURCE    '记录当前图像卡的源
Public bSnap As Boolean  '采集状态标志

Public bminfo As BITMAPINFO    'BMP文件信息
Public bmiFHeader As BITMAPFILEHEADER  'BMP文件头

Public pBuffer() As Byte       '图像缓冲区

Public Sub InitCGCard(ByVal format As VIDEO_FORMAT, ByVal scan_mode As VIDEO_SCAN, ByVal SourceType As VIDEO_SOURCE_TYPE, ByVal SourceIndex As Integer, ByVal standard As VIDEO_STANDARD, ByVal osc As CRY_OSC)

    Dim status As CGSTATUS
    
    Dim Source As VIDEO_SOURCE       '视频源路，包括视频类型和序号，各种图像卡支持的视频源路不尽相同，请参看相应硬件说明

    status = CGSetVideoFormat(hcg, format)      '在采集图像到屏幕时，需要保证视频格式和当前系统屏幕位深度一致，而采集到内存没有此限制

    status = CGSetScanMode(hcg, scan_mode)    '设置视频信号的扫描方式,帧方式或场方式
    
    Source.source_type = SourceType        '视频类型为复合视频
    Source.nIndex = SourceIndex                           '序号为0
    status = CGSetVideoSource(hcg, Source.source_type, Source.nIndex)   '视频源路VIDEO_SOURCE包括视频类型和序号
    
    status = CGSetVideoStandard(hcg, standard)
    
    status = CGSelectCryOSC(hcg, osc)
    
    '设置视频输入窗口，根据视频制式而有所不同
    If standard = PAL Then      '对于视频制式为PAL制
        status = CGSetInputWindow(hcg, 0, 0, 768, 576)  '水平方向为0-768，垂直方向为0-576
    ElseIf standard = NTSC Then '对于视频制式为NTSC制
        status = CGSetInputWindow(hcg, 0, 0, 640, 480)  '水平方向为0-640，垂直方向为0-480
    End If
    
    Dim rect As TRect
    Dim nMode As Integer
    Dim nWidth As Long
    Dim nHeight As Long
    
    GetClientRect MainForm.FrameIn4PlayWnd.hWnd, rect    '获得主窗体影像采集模块FrameIn4PlayWnd视图状态
    
    nWidth = rect.right - rect.left     '视频输出窗口宽度为当前FrameIn4PlayWnd宽度
    nHeight = rect.bottom - rect.top    '视频输出窗口高度为当前FrameIn4PlayWnd高度
    
    nMode = nWidth Mod 4
    nWidth = nWidth - nMode     '视频输出窗口宽满足4的倍数
    
    nMode = nHeight Mod 2
    nHeight = nHeight - nMode   '视频输出窗口高满足2的倍数
    
    status = CGSetOutputWindow(hcg, 0, 0, nWidth, nHeight)  '设置视频输出窗口
    
    '设置BMP文件信息，在保存bmp文件、显示采集图像时使用
    '以下设置如没有特别说明，基本相同
    bminfo.header.biBitCount = 24       '图像位深度，由视频格式确定，如果使用CGDateTransfrom函数，则将15，16，32位数据转换为24位
    bminfo.header.biClrImportant = 0
    bminfo.header.biClrUsed = 0
    bminfo.header.biCompression = BI_RGB
    bminfo.header.biHeight = nHeight    '图像高度，根据扫描模式(FRAME/FIELD)的不同
    bminfo.header.biPlanes = 1
    bminfo.header.biSize = Len(bminfo.header)
    bminfo.header.biSizeImage = nWidth * nHeight * 3    '图像大小，由视频输出窗口和视频格式确定
    bminfo.header.biWidth = nWidth      '图像宽度，一般为输出窗口宽度
    bminfo.header.biXPelsPerMeter = 0
    bminfo.header.biYPelsPerMeter = 0
    
    '设置BMP文件头
    '以下设置如没有特别说明，基本相同
    bmiFHeader.bfOffBits = Len(bmiFHeader) + Len(bminfo)
    bmiFHeader.bfReserved1 = 0
    bmiFHeader.bfReserved2 = 0
    bmiFHeader.bfType = BMP_MAGIC_COOKIE
    bmiFHeader.bfSize = bmiFHeader.bfOffBits + bminfo.header.biSizeImage
    
    ReDim pBuffer(0 To (nWidth * nHeight * 3 - 1))  '设置图像缓冲区大小

End Sub

Public Sub Snap(ByVal bEnable As Boolean)
    Dim status As CGSTATUS
    
    Dim nNum As Long            '采集的总数
    Dim nStatusNum As Long      '当前正在采集的图像状态
    Dim nLastStatusNum As Long  '上一时刻采集的图像状态
    
    Dim handle As Long          '锁定内存句柄
    Dim pLineAddr As Long       '内存线性地址
    
    Dim hDC As Long             '显示设备句柄
    
    If (Not bEnable) Then       '正在采集图像到内存
        status = CGStopSnap(hcg)    '停止采集图像到内存
        If CG_SUCCESS(status) Then
            bSnap = False
        End If
    Else        '否则
        '开始图像卡采集图像到内存
        '指定图像卡将图像采集到静态内存偏移为0的位置，采集缓冲区大小为2幅图像大小
        status = CGStartSnap(hcg, 0, True, 2)    '启动图像卡采集若干帧/场图像数据到内存功能
        If CG_SUCCESS(status) Then    '采集卡正常
            bSnap = True    '设置采集卡采集标识为True
            nStatusNum = -1
            nLastStatusNum = -1
            
            hDC = GetDC(MainForm.FrameIn4PlayWnd.hWnd)       '得到FrameIn4PlayWnd的DC,得到显示屏的场景
            
            '锁定指定位置的静态内存，静态内存偏移为0，锁定大小为两幅图像大小
            status = CGStaticMemLock(0, 2 * bminfo.header.biSizeImage, handle, pLineAddr)    '锁定指定位置和大小的静态内存,锁定成功后就可以使用指针ppLineAddr访问内存数据
            
            If CG_SUCCESS(status) Then    '如果锁定成功,循环采集并显示图像
                Do
                    '获得当前采集图像的状态，指向正在采集的某场图像
                    '状态字以场为单位，从0开始
                    status = CGGetSnappingNumber(hcg, nStatusNum)    '获取当前采集图像的状态,这个采集状态是指执行函数CGStartSnap后.
                    If CG_SUCCESS(status) Then    '如果采集了图像,获取了图像数
                        If nStatusNum <> nLastStatusNum Then    '如果当前采集的图像不是上一时刻采集的图像
                            nLastStatusNum = nStatusNum
                            
                            nNum = -1
                            '注意,此时是按场计算,一帧算两场,由于内存设置为两幅图像,那么计数值为0,1,2,3
                            If nStatusNum = 3 Then  '第1帧采集完成，正在采集第2帧
                                nNum = 1
                            End If
                            
                            If nStatusNum = 1 Then  '第2帧采集完成，正在采集第1帧
                                nNum = 2
                            End If
                            
                            If nNum > 0 Then
                                
                                '将静态内存中的图像传递到用户缓冲区，同时进行格式转换，如果静态内存中图像为15、16、32位，则转换为24位
                                '由于图像卡采集到静态内存的图像数据是正向存放，而Windows中处理的位图数据需要倒置，因此一般还要将图像倒置
                                status = CGDataTransform(pBuffer(0), pLineAddr + (nNum - 1) * bminfo.header.biSizeImage, bminfo.header.biWidth, bminfo.header.biHeight, bminfo.header.biBitCount, True)
                                
                                If CG_SUCCESS(status) Then
                                    '将图像缓冲区中的数据送至屏幕FrameIn4PlayWnd区域显示
                                    SetDIBitsToDevice hDC, 0, 0, bminfo.header.biWidth, bminfo.header.biHeight, 0, 0, 0, bminfo.header.biHeight, pBuffer(0), bminfo, DIB_RGB_COLORS
                                End If
                                
                            End If
                            
                        End If
                    End If
                    
                    DoEvents
                    
                Loop While bSnap
                
                status = CGStaticMemUnlock(handle)  '解除静态内存锁定
                
            End If
            
            ReleaseDC MainForm.FrameIn4PlayWnd.hWnd, hDC '释放显示句柄
            
        End If
        
    End If
    
End Sub