📄 main.pas
字号:
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus;
type
TFrmMain = class(TForm)
MainMenu1: TMainMenu;
AviBtn: TMenuItem;
StartBtn: TMenuItem;
StopBtn: TMenuItem;
SaveDialog1: TSaveDialog;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure StartBtnClick(Sender: TObject);
procedure StopBtnClick(Sender: TObject);
function WriteAvi (): boolean;
private
{ Private declarations }
public
{ Public declarations }
end;
var
FrmMain: TFrmMain;
implementation
uses HVAPI,VFW;
{$R *.dfm}
var
m_hhv: HHV; //数字摄像机句柄
m_bStart: Boolean; //启动标志
m_pBmpInfo: PBITMAPINFO; //BITMAPINFO 结构指针，显示图像时使用
m_pRawBuffer: PChar; //采集图像原始数据缓冲区
m_pImageBuffer: PChar; //Bayer转换后缓冲区
m_ImgBufLength: Integer;
m_RawImgBufLength:Integer;
//设置usb摄像机的一些参数
DeviceNum: integer;
Resolution:HV_RESOLUTION;
SnapMode: HV_SNAP_MODE;
Layout:HV_BAYER_LAYOUT;
Gain: longword;
ADCLevel: longword ;
//查值表
m_pLutR:array[0..255] of BYTE;
m_pLutG:array[0..255] of BYTE;
m_pLutB:array[0..255] of BYTE;
//与avi相关变量
m_pFile:PAVIFILE;
m_ps:PAVISTREAM;
m_psCompressed:PAVISTREAM;
m_nTimeFrame:integer;
const
//窗口位置和大小
XStart = 0;
YStart = 0;
HV_Width = 800;
HV_Height = 600;
procedure TFrmMain.FormCreate(Sender: TObject);
var
status:HVSTATUS;
i:integer;
dTint:double;
lExposure:longWord;
begin
DeviceNum:=1;
Resolution:= RES_MODE0;
SnapMode:= CONTINUATION;
Layout:= BAYER_GR;
Gain:= 8;
ADCLevel := ADC_LEVEL1;
//
// 初始化所有成员变量，同时打开数字摄像机
//
status:= STATUS_OK;
m_bStart := FALSE;
StartBtn.Enabled := true;
StopBtn.Enabled := false;
m_pBmpInfo := nil;
m_pRawBuffer := nil;
m_pImageBuffer := nil;
for i := 0 to 255 do
begin
m_pLutR[i] := i;
m_pLutG[i] := i;
m_pLutB[i] := i;
end;
//打开数字摄像机 1
status:= BeginHVDevice(1, m_hhv);
//检验函数执行状态，如果失败，则返回错误状态消息框
HV_VERIFY(status);
//
// 初始化数字摄像机硬件状态，用户也可以在其他位置初始化数字摄像机，
// 但应保证数字摄像机已经打开，建议用户在应用程序初始化时，
// 同时初始化数字摄像机硬件。
//
//设置数字摄像机分辨率
HVSetResolution(m_hhv, Resolution);
// 采集模式，包括 CONTINUATION(连续)、TRIGGER(外触发)
HVSetSnapMode(m_hhv, SnapMode);
// 设置各个分量的增益
for i:= 0 to 3 do
begin
HVAGCControl(m_hhv, RED_CHANNEL + i, Gain);
end;
// 设置曝光时间
// 请参考曝光时间计算公式
dTint := 6.0 / 100.0;
dTint := dTint * 24000000.0 + 180.0;
lExposure := round(dTint);
lExposure := round(lExposure /(HV_Width + 244));
Status := HVAECControl(m_hhv, AEC_EXPOSURE_TIME,lExposure) ;
// 设置ADC的级别
HVADCControl(m_hhv, ADC_BITS, ADCLevel);
//
// 视频输出窗口，即视频输出范围，输出窗口取值范围必须在输入窗口范围以内，
// 视频窗口左上角X坐标和窗口宽度应为4的倍数，左上角Y坐标和窗口高度应为2的倍数
// 输出窗口的起始位置一般设置为(0, 0)即可。
//
HVSetOutputWindow(m_hhv, XStart, YStart, HV_Width, HV_Height);
//用户可以自己分配BTIMAPINFO缓冲区
m_pBmpInfo:= AllocMem(2048);
// 初始化BITMAPINFO 结构，此结构在保存bmp文件、显示采集图像时使用
m_pBmpInfo^.bmiHeader.biSize:= sizeof(BITMAPINFOHEADER);
// 图像宽度，一般为输出窗口宽度
m_pBmpInfo^.bmiHeader.biWidth:= HV_Width;
// 图像宽度，一般为输出窗口高度
m_pBmpInfo^.bmiHeader.biHeight:= HV_Height;
//
// 以下设置一般相同，
// 对于低于8位的位图，还应设置相应的位图调色板
//
m_pBmpInfo^.bmiHeader.biPlanes:= 1;
m_pBmpInfo^.bmiHeader.biBitCount:= 24;
m_pBmpInfo^.bmiHeader.biCompression:= BI_RGB;
m_pBmpInfo^.bmiHeader.biSizeImage:= 0;
m_pBmpInfo^.bmiHeader.biXPelsPerMeter:= 0;
m_pBmpInfo^.bmiHeader.biYPelsPerMeter:= 0;
m_pBmpInfo^.bmiHeader.biClrUsed:= 0;
m_pBmpInfo^.bmiHeader.biClrImportant:= 0;
//
// 分配原始图像缓冲区，一般用来存储采集图像原始数据
// 一般图像缓冲区大小由输出窗口大小和视频格式确定。
//
//rgb 图像数据大小
m_ImgBufLength := HV_Width * HV_Height * 3;
//RAW格式数据大小
m_RawImgBufLength := HV_Width * HV_Height;
//分配缓冲区
m_pRawBuffer := AllocMem(m_RawImgBufLength);
m_pImageBuffer:= AllocMem(m_ImgBufLength);
end;
procedure TFrmMain.FormDestroy(Sender: TObject);
var
status: HVSTATUS;
begin
//
// 用户在没有通过菜单项正常关闭数字摄像机采集，
// 而直接关闭应用程序时，应保证数字摄像机采集被关闭
//
status:= STATUS_OK;
if(m_bStart) then
begin
StopBtnClick(Sender);
end;
// 关闭数字摄像机，释放数字摄像机内部资源
status:= EndHVDevice(m_hhv);
HV_VERIFY(status);
//释放缓冲区
if (m_pBmpInfo <> nil) then
FreeMem(m_pBmpInfo, 2048);
if (m_pRawBuffer <> nil) then
FreeMem(m_pRawBuffer, m_RawImgBufLength);
if (m_pImageBuffer <> nil) then
FreeMem(m_pImageBuffer, m_ImgBufLength);
end;
function TFrmMain.WriteAvi (): boolean;
var
status: HVSTATUS;
hr: HRESULT;
VideoDc:HDC;
plutR:longword; //指向颜色查值表的指针
plutG:longword;
plutB:longword;
begin
VideoDc := GetDc(FrmMain.Handle);
status := STATUS_OK;
plutR := longword(@ m_pLutR);
plutG := longword(@ m_pLutG);
plutB := longword(@ m_pLutB);
// 将原始图像数据进行Bayer转换，转换后为24位。
ConvertBayer2Rgb(m_pImageBuffer, m_pRawBuffer, HV_Width, HV_Height, BAYER2RGB_NEIGHBOUR, plutR, plutG,plutB, True, BAYER_GR);
if ( m_psCompressed <> nil) then
begin
hr := AVIStreamWrite(m_psCompressed, // stream pointer
m_nTimeFrame, // time of this frame
1, // number to write
m_pImageBuffer,
HV_Width * HV_Height * 3, // lpbi->biSizeImage, // size of this frame
AVIIF_KEYFRAME, // flags....
nil,
nil
);
if (hr = AVIERR_OK) then
begin
m_nTimeFrame := m_nTimeFrame +1;
end;
end;
result := true;
end;
function SnapThreadCallback(var info: HV_SNAP_INFO): Integer; stdcall
begin
FrmMain.WriteAvi();
result := 1;
end;
procedure TFrmMain.StartBtnClick(Sender: TObject);
var
status:HVSTATUS;
wVer:WORD;
hr:HRESULT;
bRVal:boolean;
strhdr:PAVISTREAMINFOA ; //AVI文件信息
opts:PAVICOMPRESSOPTIONS ;
ppBuf:Array[1..1] of pChar; //保存图像的缓冲区列表
pPointer:longWord; //指向缓冲区列表的指针
begin
status := STATUS_OK;
hr := S_OK;
bRVal := TRUE;
SaveDialog1.Filter := 'AVI Files(*.avi)|*.avi';
SaveDialog1.Title := 'Save Avi';
if SaveDialog1.Execute then //if 1
begin
wVer := HIWORD(VideoForWindowsVersion());
if ( (wVer >= 266)) then // oops, we are too old, blow out of here // if 2
begin
AVIFileInit();
// For some reason AVIFileOpen will not shrink the file even with OF_CREATE set
DeleteFile(SaveDialog1.FileName);
// 创建AVI文件
hr := AVIFileOpen(m_pFile, // returned file pointer
Pchar(SaveDialog1.fileName), // file name
OF_WRITE or OF_CREATE, // mode to open file with
nil); // use handler determined
// from file extension....
if (hr <> AVIERR_OK) then // if 3
begin
bRVal := FALSE;
end
else
begin
new(strhdr);
strhdr.fccType := streamtypeVIDEO;// stream type
strhdr.fccHandler := 0;
strhdr.dwScale := 1;
strhdr.dwRate := 15; // rate fps
strhdr.dwSuggestedBufferSize := HV_Width * HV_Height * 3;
SetRect(strhdr.rcFrame, 0, 0, HV_Width, HV_Height);// rectangle for stream
// And create the stream;
hr := AVIFileCreateStream(m_pFile, // file pointer
m_ps, // returned stream pointer
strhdr); // stream header
if (hr <> AVIERR_OK) then // if 4
begin
bRVal := FALSE;
end
else
begin
new(opts);
if (not AVISaveOptions(FrmMain.Handle, 0, 1, m_ps, opts)) then // if 5
begin
bRVal := FALSE;
end
else
begin
hr := AVIMakeCompressedStream(m_psCompressed, m_ps, opts, nil);
if (hr <> AVIERR_OK) then // if 6
begin
bRVal := FALSE;
end
else
begin
hr := AVIStreamSetFormat(m_psCompressed,
0,
m_pBmpInfo, // stream format
sizeof(BITMAPINFOHEADER) // format size
);
if (hr <> AVIERR_OK) then
bRVal := FALSE;
end; // end if 6
end; // end if 5
end; // end if 4
end; // end if 3
end; // end if 2
if (bRVal = true) then
begin
// 初始化数字摄像机采集图像到内存的控制，
// 指定回调函数SnapThreadCallbackEx和用户参数
//
status := HVOpenSnap(m_hhv, SnapThreadCallback, nil);
HV_VERIFY(status);
if HV_SUCCESS(status) then
begin //已经打开SnapEx环境
//
// 启动数字摄像机采集图像到内存
ppBuf[1] := m_pRawBuffer;
pPointer := longWord(@ppBuf);
status := HVStartSnap(m_hhv, pPointer,1);
HV_VERIFY(status);
if (HV_SUCCESS(status)) then
begin
m_bStart := TRUE; //标志开始图像的采集和压缩
StartBtn.Enabled := FALSE;
StopBtn.Enabled := TRUE;
end
else
begin
HVCloseSnap(m_hhv);
end;
end;
end;
// 终止AVI文件
if ( not m_bStart) then
begin
if (m_ps <> nil) then
begin
AVIStreamClose(m_ps);
m_ps := nil;
end;
if (m_psCompressed <> nil) then
begin
AVIStreamClose(m_psCompressed);
m_psCompressed := nil;
end;
if (m_pFile <> nil) then
begin
AVIFileClose(m_pFile);
m_pFile := nil;
end;
AVIFileExit();
end ;
end; // end if 1
end;
procedure TFrmMain.StopBtnClick(Sender: TObject);
var
status:HVSTATUS;
begin
status := STATUS_OK;
// 关闭采集图像到内存控制，释放数字摄像机资源
HVCloseSnap(m_hhv);
// 终止AVI文件
if (m_ps <> nil) then
begin
AVIStreamClose(m_ps);
m_ps := nil;
end;
if (m_psCompressed <> nil) then
begin
AVIStreamClose(m_psCompressed);
m_psCompressed := nil;
end;
if (m_pFile <> nil) then
begin
AVIFileClose(m_pFile);
m_pFile := nil;
end;
AVIFileExit();
m_nTimeFrame := 0;
m_bStart := FALSE;
StartBtn.Enabled := TRUE;
StopBtn.Enabled := FALSE;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -