frmmain.frm

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

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.Form FrmMain 
   Caption         =   "HVStoreBmp"
   ClientHeight    =   1470
   ClientLeft      =   6885
   ClientTop       =   4695
   ClientWidth     =   3075
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1470
   ScaleWidth      =   3075
   Begin MSComDlg.CommonDialog SaveDialog1 
      Left            =   120
      Top             =   0
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      DefaultExt      =   "bmp"
      DialogTitle     =   "Save Bmp"
      Filter          =   "Bitmap Files(*.bmp)|*.bmp"
   End
   Begin VB.CommandButton BtnStoreBmp 
      Caption         =   "StoreBmp"
      Height          =   495
      Left            =   720
      TabIndex        =   0
      Top             =   360
      Width           =   1575
   End
End
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim hhv As Long     '图像卡句柄

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

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




Private Sub BtnStoreBmp_Click()
     Dim Status As HVSTATUS
     Status = STATUS_OK

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

    Dim XStart As Long
    Dim YStart As Long
    Dim Hv_Width As Long
    Dim HV_Height 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
    Hv_Width = 800
    HV_Height = 600
    
    ' 打开数字摄像机 1，返回状态值
    Status = BeginHVDevice(1, hhv)
    '  检验函数执行状态，如果失败，则返回错误状态消息框
    HV_VERIFY (Status)
    
    '设置数字摄像机分辨率
    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
    
    '设置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 pRawBuffer(0 To (Hv_Width * HV_Height - 1))  '设置原始图像缓冲区大小

    '分配Bayer转换后图像数据缓冲
    ReDim pImageBuffer(0 To (Hv_Width * HV_Height * 3 - 1))
    
    '定义一个文件句柄
    Dim hFile As Integer
    

    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))
    
    Status = HVSnapShot(hhv, VarPtr(ppBuf(0)), 1)
    
    HV_VERIFY (Status)
    If (HV_SUCCESS(Status)) Then
        ' 将原始图像数据进行Bayer转换，转换后为24位。
        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

        SaveDialog1.DialogTitle = "Save Bmp"
        SaveDialog1.Filter = "Bitmap Files(*.bmp)|*.bmp"
        
        If HV_SUCCESS(Status) Then
        
           SaveDialog1.ShowSave
           If Len(SaveDialog1.FileName) > 0 Then
            
             '保存一幅BMP图像文件
             '以下设置如没有特别说明，基本相同
             hFile = FreeFile()
             'Open (("D:\Test") & CStr(i + 1) & ".bmp") For Binary As #hFile  '给定文件名
             Open (SaveDialog1.FileName) For Binary As #hFile   '给定文件名
             Put #hFile, , bmiFHeader
             Put #hFile, , bminfo
             Put #hFile, , pImageBuffer
             Close #hFile
            
           End If
           

       End If
        
    End If
            

    '  关闭数字摄像机1
    Status = EndHVDevice(hhv)
    HV_VERIFY (Status)

    
End Sub