⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 videocap.pas

📁 基于DELPHI的图片浏览系统设计与实现
💻 PAS
字号:
unit videocap;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
  ExtCtrls, StdCtrls, Dialogs;

type
Tvideo = class
procedure openVideo(hnd:Thandle; image:TImage; btn: Tbutton);
procedure CloseVideo(btn: Tbutton);
procedure SaveBMP(Aowner: TComponent);
procedure StartAVI(Aowner: TComponent);
procedure StopAVI;
end;

implementation
var
CapturingAVI : boolean;
hWndC : THandle;

const WM_CAP_START = WM_USER;
const WM_CAP_STOP = WM_CAP_START + 68;
const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;
const WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11;
const WM_CAP_SAVEDIB = WM_CAP_START + 25;
const WM_CAP_GRAB_FRAME = WM_CAP_START + 60;
const WM_CAP_SEQUENCE = WM_CAP_START + 62;
const WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START + 20;
const WM_CAP_SEQUENCE_NOFILE =WM_CAP_START+  63 ;
const WM_CAP_SET_OVERLAY =WM_CAP_START+  51 ;
const WM_CAP_SET_PREVIEW =WM_CAP_START+  50 ;
const WM_CAP_SET_CALLBACK_VIDEOSTREAM = WM_CAP_START +6;
const WM_CAP_SET_CALLBACK_ERROR=WM_CAP_START +2;
const WM_CAP_SET_CALLBACK_STATUSA= WM_CAP_START +3;
const WM_CAP_SET_CALLBACK_FRAME= WM_CAP_START +5;
const WM_CAP_SET_SCALE=WM_CAP_START+  53 ;
const WM_CAP_SET_PREVIEWRATE=WM_CAP_START+  52 ;
function capCreateCaptureWindowA(lpszWindowName : PCHAR;
dwStyle : longint;
x : integer;
y : integer;
nWidth : integer;
nHeight : integer;
ParentWin : HWND;
nId : integer): HWND;
STDCALL EXTERNAL 'AVICAP32.DLL';

procedure Tvideo.openVideo(hnd:Thandle; image:TImage; btn: Tbutton);
begin
hWndC := capCreateCaptureWindowA('My Own Capture Window',
WS_CHILD or WS_VISIBLE ,
image.Left,
image.Top,
image.Width,
image.Height,
hnd,
0);
if hWndC <> 0 then
SendMessage(hWndC, WM_CAP_SET_CALLBACK_VIDEOSTREAM, 0, 0);
SendMessage(hWndC, WM_CAP_SET_CALLBACK_ERROR, 0, 0);
SendMessage(hWndC, WM_CAP_SET_CALLBACK_STATUSA, 0, 0);
SendMessage(hWndC, WM_CAP_DRIVER_CONNECT, 0, 0);
SendMessage(hWndC, WM_CAP_SET_SCALE, 1, 0);
SendMessage(hWndC, WM_CAP_SET_PREVIEWRATE, 66, 0);
//SendMessage(hWndC, WM_CAP_SEQUENCE_NOFILE, 1, 0);
SendMessage(hWndC, WM_CAP_SET_OVERLAY, 1, 0);
SendMessage(hWndC, WM_CAP_SET_PREVIEW, 1, 0);
btn.Enabled :=false;
end;


{ Tvideo }

procedure Tvideo.CloseVideo(btn: Tbutton);
begin
if hWndC <> 0 then begin
SendMessage(hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0);
hWndC := 0;
btn.Enabled :=true;
end;
end;

procedure Tvideo.SaveBMP(Aowner: TComponent);
var
SaveDialog1:TSaveDialog;
begin
  if hWndC <> 0 then
  begin
  SaveDialog1 := TSaveDialog.Create(Aowner);
  SaveDialog1.DefaultExt := 'bmp';
  SaveDialog1.Filter := 'Bitmap files (*.bmp)|*.bmp';
  if SaveDialog1.Execute then
  SendMessage(hWndC,
  WM_CAP_SAVEDIB,
  0,
  longint(pchar(SaveDialog1.FileName)));
  end;
  SaveDialog1.Free;
end;

procedure Tvideo.StartAVI(Aowner: TComponent);
var
SaveDialog1:TSaveDialog;
begin
if hWndC <> 0 then begin
SaveDialog1 := TSaveDialog.Create(Aowner);
SaveDialog1.DefaultExt := 'avi';
SaveDialog1.Filter := 'AVI files (*.avi)|*.avi';
if SaveDialog1.Execute then begin
CapturingAVI := true;
SendMessage(hWndC,
WM_CAP_FILE_SET_CAPTURE_FILEA,
0,
Longint(pchar(SaveDialog1.FileName)));
SendMessage(hWndC, WM_CAP_SEQUENCE, 0, 0);
end;
end;
SaveDialog1.Free;
end;

procedure Tvideo.StopAVI;
begin
  if hWndC <> 0 then begin
  SendMessage(hWndC, WM_CAP_STOP, 0, 0);
  CapturingAVI := false;
  end;
end;

initialization
CapturingAVI := false;
hWndC := 0;



end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -