dephi实现屏幕录像

唐志勇825 贡献于2014-10-20

作者 kongtee  创建于2010-06-26 04:43:00   修改者kongtee  修改于2010-06-26 04:46:00字数5921

文档摘要:Dephi实现屏幕录像delphi利用VFW函数实现录制屏幕的功能:1.通过Timer实现抓屏,将屏幕抓图存为BMP格式。2.调用AVIFileInit初始化3.调用AVIFileOpen创建视频文件
关键词:

Dephi实现屏幕录像 delphi利用VFW函数实现录制屏幕的功能: 1.通过Timer实现抓屏,将屏幕抓图存为BMP格式。 2.调用AVIFileInit初始化 3.调用AVIFileOpen创建视频文件 4.调用AVIFileCreateStream创建视频流 5.调用AVIMakeCompressedStream压缩视频流 6.调用AVIStreamSetFormat设置视频流格式 7.调用AVIStreamWrite写入视频 8.调用AVIStreamClose关闭视频流指针,AVIFileRelease释放视频文件,AVIFileExit关闭视频文件。 源码: 1.抓屏存为BMP     //抓屏幕, Flag = SRCCOPY,不抓透明窗口,Flag=SRCCOPY or CAPTUREBLT抓透明窗口    //CAPTUREBLT要自己定义    //const    //{$ifndef CAPTUREBLT}    //   CAPTUREBLT = $40000000;    //{$endif} var   ScreenBmp: TBitmap;   PicIndex: Integer;            //图片序号   RecTransFlag: Cardinal;                    //录制屏幕标志,是否录制透明窗体   AppPath: string;                           //应用程序路径   TempPath: string;                          //临时文件夹路径   BmpFileName: string;                         //BMP文件存储路径   procedure TForm1.FormCreate(Sender: TObject); begin   PicIndex   := 0;   BmpFileName := '';   ScreenBmp := TBitmap.Create;   ScreenBmp.PixelFormat := pf24bit;   ScreenBmp.Width  := Screen.Width;   ScreenBmp.Height := Screen.Height;   ScreenBmp.Canvas.Brush.Style := bsClear;   RecPause := False;   //不录制透明窗体   RecTransFlag := SRCCOPY;   //录制透明窗体   //RecTransFlag := SRCCOPY or CAPTUREBLT;     AppPath := ExtractFilePath(Application.ExeName);   TempPath := AppPath + 'Temp\';   if not DirectoryExists(TempPath) then     CreateDirectory(PAnsiChar(TempPath), nil); end; procedure TForm1.DrawCursorToBmp(var ScrBmp: TBitmap); var   hCur   : HICON;   MousePt: TPoint; begin   if not Assigned(ScrBmp) then     Exit;   hCur := GetCursor();   GetCursorPos(MousePt);   // 画 光 标   DrawIcon(ScrBmp.canvas.handle, MousePt.x, MousePt.y, hCur); end; procedure TForm1.Timer1Timer(Sender: TObject); var   dc: HDC;  begin   DC := GetDC(0);   try     BitBlt(ScreenBmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, dc, 0, 0, Flag);   finally     ReleaseDC(0, dc);   end;   //根据标记判断是否画上光标   DrawCursorToBmp(ScreenBmp);   BmpFileName := TempPath + IntToStr(PicIndex) + '.bmp';   ScreenBmp.SaveToFile(BmpFileName );   end;   try     Inc(PicIndex);   except     on EIntOverflow do   end; procedure TForm1.Button1Click(Sender: TObject); begin     timer1.Enabled := True; end; 2.取保存的bmp图片生成avi并添加声音. uses VFW; var   AviFileName: string;                         //AVI文件存储路径   Tempbmp: TBitmap;                        //生成AVI前读出的BMP function GetBitmapData(bmp: TBitmap): TImageData; begin   bmp.PixelFormat := pf24bit;   Result.Width  := bmp.Width;   Result.Height := bmp.Height;   Result.Stride := Result.Width shl 2;   Result.Scan0  := bmp.ScanLine[Result.Height - 1];   Result.PixelFormat := -1;                  // Windows bitmap format flag   Result.Reserved := 0; end; procedure CreateAVI; var      hr: Integer;   Strhdr: TAVIStreamInfo;         //AVI流信息   Wavehdr: TWaveFormatEx;   Opts: TAVICOMPRESSOPTIONS;      //压缩选项   POpts: PAVICOMPRESSOPTIONS;     //压缩选项指针   Bi: BITMAPINFOHEADER;           //BMP头信息   B: Boolean;   P: Pointer;   i: Integer;   bmpData: TImageData;   nRet   : Integer; begin     if FileExists(AviFileName) then       DeleteFile(AviFileName);     AVIFileInit;     hr := AVIFileOpen(PFile, PChar(AviFileName), OF_CREATE or OF_WRITE, nil);     if (hr <> 0) then       Exit;     //设置AVI流信息     ZeroMemory(@Strhdr, SizeOf(TAVIStreamInfo));     strhdr.fccType := streamTypeVIDEO;     strhdr.fccHandler := mmioFOURCC('D', 'I', 'V', 'X');     strhdr.dwFlags := 0;     strhdr.dwCaps  := 0;     strhdr.wPriority := 0;     strhdr.wLanguage := 0;     strhdr.dwScale := 1;     strhdr.dwRate  := 5;                        //pfs     strhdr.dwStart := 0;     strhdr.dwLength := 0;     strhdr.dwInitialFrames := 0;     strhdr.dwSuggestedBufferSize := ((Screen.Width * 3 + 3) and $FFFC) * screen.Height; //Screen.Height * screen.Width * 3;     strhdr.dwQuality := 0;      strhdr.dwSampleSize := 1;     strhdr.rcFrame := Rect(0, 0, Screen.Width, Screen.Height);     strhdr.dwEditCount := 0;     strhdr.dwFormatChangeCount := 0;     strhdr.szName[0] := #0;     strhdr.szName[1] := #0;     //设置WAV流信息     ZeroMemory(@Wavehdr, SizeOf(TWaveFormatEx));     Wavehdr.cbSize := 0;     Wavehdr.nChannels := 1;     Wavehdr.wFormatTag:= 1;     Wavehdr.wBitsPerSample := 16;     Wavehdr.nSamplesPerSec := 8000;     Wavehdr.nBlockAlign := Wavehdr.wBitsPerSample * Wavehdr.nChannels div 8;     Wavehdr.nAvgBytesPerSec := Wavehdr.nBlockAlign * Wavehdr.nSamplesPerSec;     ZeroMemory(@opts, SizeOf(TAVICOMPRESSOPTIONS));     //设置压缩信息     //Indeo? Video 5.10     opts.fccType := streamTypeVIDEO;           // vids     opts.fccHandler := 808810089;     opts.dwKeyFrameEvery := 0;     opts.dwQuality := 8500;     opts.dwBytesPerSecond := 0;     opts.dwFlags := 8;     opts.lpFormat := nil;     opts.cbFormat := 0;     opts.cbParms  := 48;     opts.dwInterleaveEvery := 0;     //设置BMP头信息     ZeroMemory(@bi, SizeOf(BITMAPINFOHEADER));     bi.biSize   := SizeOf(bi);     bi.biWidth  := Screen.Width;     bi.biHeight := Screen.Height;     bi.biPlanes := 1;     bi.biBitCount := 24;     bi.biCompression := 0;     bi.biSizeImage := ((Screen.Width * 3 + 3) and $FFFC) * screen.Height; //(((bih.biWidth * 3) + 3) & 0xFFFC) * bih.biHeight //Screen.Height * screen.Width * 3; //_stride * _height;     bi.biXPelsPerMeter := 0;     bi.biYPelsPerMeter := 0;     bi.biClrUsed := 0;     bi.biClrImportant := 0;     hr := AVIFileCreateStream(PFile, PSrcStream, @strhdr);     if (hr <> 0) then       Exit;     hr := AVIMakeCompressedStream(PCompStream, PSrcStream, @opts, nil);     if (hr <> 0) then       Abort;     hr := AVIStreamSetFormat(PCompStream, 20, @bi, 40);     if (hr <> 0) then       Abort;     Tempbmp := TBitmap.Create;     Tempbmp.LoadFromFile(bmpFile);     bmpData := GetBitmapData(Tempbmp);     hr := AVIStreamWrite(PCompStream,                            FrameCount,    //存在第几帧                            1,                            bmpData.Scan0,                            ((Screen.Width * 3 + 3) and $FFFC) * screen.Height,                            0,                            nil,                            nil);       if (hr <> 0) then         Abort;       //添加声音       AddAVISound;   end; end; procedure AddAVISound; var   wfx: TWAVEFORMATEX;   buf: array of char;   wav: PWavChunk;   hf: HWND;   size: DWORD;   Strhdr: TAVIStreamInfo;   hr: Cardinal;   numbytes, numsamps: DWORD; begin   ZeroMemory(@wfx, sizeof(TWAVEFORMATEX));   hf := CreateFile(PChar(WavFileName), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);   if (hf = 0) then     Exit;   try     size := GetFileSize(hf, nil);     SetLength(buf, size);     ReadFile(hf, buf[0], size, size, nil);   finally     CloseHandle(hf);   end;   wav := PWavChunk(buf);   wfx.wFormatTag := wav.fmt.wFormatTag;   wfx.cbSize := 0;   wfx.nAvgBytesPerSec := wav.fmt.dwAvgBytesPerSec;   wfx.nBlockAlign := wav.fmt.wBlockAlign;   wfx.nChannels := wav.fmt.wChannels;   wfx.nSamplesPerSec := wav.fmt.dwSamplesPerSec;   wfx.wBitsPerSample := wav.fmt.wBitsPerSample;   ZeroMemory(@Strhdr, SizeOf(TAVIStreamInfo));   Strhdr.fccType := streamtypeAUDIO;   Strhdr.dwScale := wfx.nBlockAlign;   Strhdr.dwRate  := wfx.nSamplesPerSec * wfx.nBlockAlign;   Strhdr.dwSampleSize := wfx.nBlockAlign;   Strhdr.dwQuality := DWORD(-1);   hr := AVIFileCreateStream(PFile, PWavStream, @Strhdr);   if (hr <> 0) then   begin     if (buf <> nil) then       buf := nil;     Exit;   end;   hr := AVIStreamSetFormat(PWavStream, 0, @wfx, SizeOf(TWAVEFORMATEX));   if (hr <> 0) then   begin     if (buf <> nil) then       buf := nil;     Exit;   end;   // now we can write the data   numbytes := wav.dat.size;   if wfx.wBitsPerSample <> 0 then     numsamps := numbytes * 8 div wfx.wBitsPerSample   else     numsamps := 0;   hr := AVIStreamWrite(PWavStream, 0, numsamps, wav, numbytes, 0, nil, nil);   if (buf  <> nil) then     buf := nil;   if (hr <> 0) then     Exit;   WavAddCompleted := True; end;

下载文档到电脑,查找使用更方便

文档的实际排版效果,会与网站的显示效果略有不同!!

需要 3 金币 [ 分享文档获得金币 ] 0 人已下载

下载文档