frmhvsnapcontinous.frm

大恒摄像机开发范例程序 有利于大家二次开发

VERSION 5.00
Begin VB.Form FrmHVSnapContinous 
   Caption         =   "HSnapContinous"
   ClientHeight    =   7245
   ClientLeft      =   2535
   ClientTop       =   2400
   ClientWidth     =   10380
   LinkTopic       =   "Form1"
   ScaleHeight     =   7245
   ScaleWidth      =   10380
   Begin VB.Menu MenuSnap 
      Caption         =   "Snap"
      Index           =   0
      Begin VB.Menu MenuStart 
         Caption         =   "Start"
         Index           =   2
      End
      Begin VB.Menu MenuStop 
         Caption         =   "Stop"
         Index           =   3
      End
   End
End
Attribute VB_Name = "FrmHVSnapContinous"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim hhv As Long     '图像卡句柄


Public bStart As Boolean



Dim bminfo As BITMAPINFO    'BMP文件信息

Dim pRawBuffer() As Byte       '原始图像缓冲区
Dim pImageBuffer() As Byte       'rgb图像缓冲区

Dim HV_Width As Long
Dim HV_Height As Long







Private Sub Form_Load()
    Dim Status As HVSTATUS
    
   ' 初始化所有成员变量，同时打开数字摄像机
    Status = STATUS_OK


    bStart = False
   
    HV_Width = 800
    HV_Height = 600
   
    '改变菜单的状态


   


   ' 打开数字摄像机 1
    Status = BeginHVDevice(1, hhv)
   '  //  检验函数执行状态，如果失败，则返回错误状态消息框
    HV_VERIFY (Status)
    
    If (Not HV_SUCCESS(Status)) Then

        MenuStart(2).Enabled = False
        MenuStop(3).Enabled = False
        
   End If
    
    
    Call InitialDevice '初始化图像卡硬件状态，用户也可以在其他位置初始化图像卡，但应保证图像卡已经打开
                    '建议用户在应用程序初始化时，同时初始化图像卡硬件。
                    
   
                    
                    
End Sub


Private Sub Form_Unload(Cancel As Integer)
     Dim Status As HVSTATUS
     Status = STATUS_OK
     
    '先停止卡的采集
    bStart = False
    Sleep (100)
    
    '
    '  关闭数字摄像机，释放数字摄像机内部资源
    Status = EndHVDevice(hhv)
    HV_VERIFY (Status)
       

  
End Sub



Private Sub MenuStart_Click(Index As Integer)
    Dim Status As HVSTATUS
    Dim I As Integer
    
    
    
    Status = STATUS_OK
    

   
    ' 启动数字摄像机采集图像到内存
    

    
    bStart = True
    Dim pLutR(0 To 255) As Byte
    Dim pLutG(0 To 255) As Byte
    Dim pLutB(0 To 255) As Byte

    For I = 0 To 255
        pLutR(I) = I
        pLutG(I) = I
        pLutB(I) = I

    Next I
    

    Dim ppBuf(0 To 0) As Long
    ppBuf(0) = VarPtr(pRawBuffer(0))
    
    '改变菜单的状态
    MenuStart(2).Enabled = False
    MenuStop(3).Enabled = True
        
    Do While bStart
        Status = HVSnapShot(hhv, VarPtr(ppBuf(0)), 1)
    
        HV_VERIFY (Status)
        If (HV_SUCCESS(Status)) Then
             ConvertBayer2Rgb VarPtr(pImageBuffer(0)), VarPtr(pRawBuffer(0)), HV_Width, HV_Height, BAYER2RGB_NEIGHBOUR, VarPtr(pLutR(0)), VarPtr(pLutG(0)), VarPtr(pLutB(0)), True, BAYER_GR
            '在视图客户区显示图像
            StretchDIBits FrmHVSnapContinous.hdc, 0, 0, HV_Width, HV_Height, 0, 0, HV_Width, HV_Height, pImageBuffer(0), bminfo, DIB_RGB_COLORS, SRCCOPY

        End If
        
        DoEvents

   Loop
        

        
End Sub

Private Sub MenuStop_Click(Index As Integer)

    bStart = False
        
    '改变菜单的状态
    MenuStart(2).Enabled = True
    MenuStop(3).Enabled = False
        
End Sub

'/*
'过程:
'        InitialDevice
'输入参数:
'        无
'输出参数:
'        无
'说明:
'        初始化数字摄像机硬件，初始化BITMAPINFO 结构
' */

Public Sub InitialDevice()
     Dim Status As HVSTATUS
     Status = STATUS_OK

    '
    '初始化数字摄像机硬件状态，用户也可以在其他位置初始化数字摄像机，
    '但应保证数字摄像机已经打开，建议用户在应用程序初始化时，
    '同时初始化数字摄像机硬件。
    '

    Dim XStart As Long
    Dim YStart As Long
    Dim lExposure As Long
    Dim dTint As Double
    
    Dim lSize As Long
    Dim hvType As hvType
    Dim lClockFreq As Long
    Dim lTb As Long
    
    
    
    
    XStart = 0
    YStart = 0
    
    '设置数字摄像机分辨率
    Status = HVSetResolution(hhv, RES_MODE0)
    
    '采集模式，包括 CONTINUATION(连续)、TRIGGER(外触发)
    Status = HVSetSnapMode(hhv, CONTINUATION)
    
    '设置各个分量的增益
    Dim I As Integer
    For I = 0 To 3
        Status = HVAGCControl(hhv, RED_CHANNEL + I, 8)
    Next I
    

    lExposure = 0
    dTint = 60 / 1000
      
    lSize = Len(hvType)
    HVGetDeviceInfo hhv, DESC_DEVICE_TYPE, VarPtr(hvType), VarPtr(lSize)
    'When outputwindow changes, change the exposure
    '//请参考曝光系数转换公式
    lClockFreq = 24000000
    If (hvType = HV1300UCTYPE Or hvType = HV1301UCTYPE) Then
       lTb = 0
       lExposure = (dTint * lClockFreq + 180) \ (HV_Width + 244 + lTb)
    Else
        lTb = 0
        lExposure = (dTint * lClockFreq + 180) \ (HV_Width + 305 + lTb) + 1
    End If
        
    If (lExposure > 16383) Then
        lExposure = 16383
    End If
    
    Status = HVAECControl(hhv, AEC_EXPOSURE_TIME, lExposure)
    
    ' 设置ADC的级别
    Status = HVADCControl(hhv, ADC_BITS, ADC_LEVEL2)
    
    '
    '   视频输出窗口，即视频输出范围，输出窗口取值范围必须在输入窗口范围以内，
    '  视频窗口左上角X坐标和窗口宽度应为4的倍数，左上角Y坐标和窗口高度应为2的倍数
    '   输出窗口的起始位置一般设置为(0, 0)即可。
    '
    
    Status = HVSetOutputWindow(hhv, XStart, YStart, HV_Width, HV_Height)
    

    ' 初始化BITMAPINFO 结构，此结构在保存bmp文件、显示采集图像时使用
    bminfo.header.biSize = Len(bminfo.header)
    '  图像宽度，一般为输出窗口宽度
    bminfo.header.biWidth = HV_Width
    ' 图像宽度，一般为输出窗口高度
    bminfo.header.biHeight = HV_Height
    
    '
    '   以下设置一般相同，
    '   对于低于8位的位图，还应设置相应的位图调色板
    '
    bminfo.header.biPlanes = 1
    bminfo.header.biBitCount = 24
    bminfo.header.biCompression = BI_RGB
    bminfo.header.biSizeImage = 0
    bminfo.header.biXPelsPerMeter = 0
    bminfo.header.biYPelsPerMeter = 0
    bminfo.header.biClrUsed = 0
    bminfo.header.biClrImportant = 0
    
    '
    '   分配原始图像缓冲区，一般用来存储采集图像原始数据
    '  一般图像缓冲区大小由输出窗口大小和视频格式确定。
    '
    Dim ntemp As Long
    ntemp = HV_Width * HV_Height - 1
    ReDim pRawBuffer(0 To ntemp)  '设置原始图像缓冲区大小


    '分配Bayer转换后图像数据缓冲
    ReDim pImageBuffer(0 To (HV_Width * HV_Height * 3 - 1))



End Sub