TVideoCapture類的原始碼，繼承TCustomPanel，用於視訊捕獲（用到了SendMessage和SetWindowPos等API）good

阿新 • • 發佈：2021-01-10

unit VideoCapture;  
  
interface  
  
uses  
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,  
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Imaging.jpeg;  
  
type  
  TVideoCapture = class(TCustomPanel)  
  private  
    hWndC: THandle;  
    CapturingAVI: bool;  
     
procedure WMSize(var Message: TWMSize); message WM_SIZE;  
  protected  
    { Protected declarations }  
  public  
    constructor Create(AOwner: TComponent); override;  
    destructor Destroy; override;  
    procedure OpenVideo(handle: THandle);  
    procedure CloseVideo;  
    procedure GrabFrame;  
     
procedure StartVideo;  
    procedure StopVideo;  
    procedure SaveBitMap(filename: TFileName);  
    procedure SaveJpeg(filename: TFileName; compressibility: Integer);  
    procedure SavetoJpegStream(var JpegStream: TMemoryStream; compressibility: Integer);  
    function StartAvi(filename: TFileName): Boolean;  
     
procedure StopAvi;  
    procedure SetVideoFormat;  
    procedure SetSource;  
    procedure SetStretch(TrueorFalse: Boolean = true);  
    procedure SetCompression;  
  published  
    property Align;  
  end;  
  
procedure Register;  
  
implementation  
  
const  
  WM_CAP_START = WM_USER;  
  
  WM_CAP_GET_CAPSTREAMPTR = (WM_CAP_START + 1);  
  WM_CAP_SET_CALLBACK_ERROR = (WM_CAP_START + 2);  
  WM_CAP_SET_CALLBACK_STATUS = (WM_CAP_START + 3);  
  WM_CAP_SET_CALLBACK_YIELD = (WM_CAP_START + 4);  
  WM_CAP_SET_CALLBACK_FRAME = (WM_CAP_START + 5);  
  WM_CAP_SET_CALLBACK_VIDEOSTREAM = (WM_CAP_START + 6);  
  WM_CAP_SET_CALLBACK_WAVESTREAM = (WM_CAP_START + 7);  
  WM_CAP_GET_USER_DATA = (WM_CAP_START + 8);  
  WM_CAP_SET_USER_DATA = (WM_CAP_START + 9);  
  
  WM_CAP_DRIVER_CONNECT = (WM_CAP_START + 10);  
  WM_CAP_DRIVER_DISCONNECT = (WM_CAP_START + 11);  
  WM_CAP_DRIVER_GET_NAME = (WM_CAP_START + 12);  
  WM_CAP_DRIVER_GET_VERSION = (WM_CAP_START + 13);  
  WM_CAP_DRIVER_GET_CAPS = (WM_CAP_START + 14);  
  
  WM_CAP_FILE_SET_CAPTURE_FILE = (WM_CAP_START + 20);  
  WM_CAP_FILE_GET_CAPTURE_FILE = (WM_CAP_START + 21);  
  WM_CAP_FILE_ALLOCATE = (WM_CAP_START + 22);  
  WM_CAP_FILE_SAVEAS = (WM_CAP_START + 23);  
  WM_CAP_FILE_SET_INFOCHUNK = (WM_CAP_START + 24);  
  WM_CAP_FILE_SAVEDIB = (WM_CAP_START + 25);  
  
  WM_CAP_EDIT_COPY = (WM_CAP_START + 30);  
  
  WM_CAP_SET_AUDIOFORMAT = (WM_CAP_START + 35);  
  WM_CAP_GET_AUDIOFORMAT = (WM_CAP_START + 36);  
  
  WM_CAP_DLG_VIDEOFORMAT = (WM_CAP_START + 41);  
  WM_CAP_DLG_VIDEOSOURCE = (WM_CAP_START + 42);  
  WM_CAP_DLG_VIDEODISPLAY = (WM_CAP_START + 43);  
  WM_CAP_GET_VIDEOFORMAT = (WM_CAP_START + 44);  
  WM_CAP_SET_VIDEOFORMAT = (WM_CAP_START + 45);  
  WM_CAP_DLG_VIDEOCOMPRESSION = (WM_CAP_START + 46);  
  
  WM_CAP_SET_PREVIEW = (WM_CAP_START + 50);  
  WM_CAP_SET_OVERLAY = (WM_CAP_START + 51);  
  WM_CAP_SET_PREVIEWRATE = (WM_CAP_START + 52);  
  WM_CAP_SET_SCALE = (WM_CAP_START + 53);  
  WM_CAP_GET_STATUS = (WM_CAP_START + 54);  
  WM_CAP_SET_SCROLL = (WM_CAP_START + 55);  
  
  WM_CAP_GRAB_FRAME = (WM_CAP_START + 60);  
  WM_CAP_GRAB_FRAME_NOSTOP = (WM_CAP_START + 61);  
  
  WM_CAP_SEQUENCE = (WM_CAP_START + 62);  
  WM_CAP_SEQUENCE_NOFILE = (WM_CAP_START + 63);  
  WM_CAP_SET_SEQUENCE_SETUP = (WM_CAP_START + 64);  
  WM_CAP_GET_SEQUENCE_SETUP = (WM_CAP_START + 65);  
  WM_CAP_SET_MCI_DEVICE = (WM_CAP_START + 66);  
  WM_CAP_GET_MCI_DEVICE = (WM_CAP_START + 67);  
  WM_CAP_STOP = (WM_CAP_START + 68);  
  WM_CAP_ABORT = (WM_CAP_START + 69);  
  
  WM_CAP_SINGLE_FRAME_OPEN = (WM_CAP_START + 70);  
  WM_CAP_SINGLE_FRAME_CLOSE = (WM_CAP_START + 71);  
  WM_CAP_SINGLE_FRAME = (WM_CAP_START + 72);  
  
  WM_CAP_PAL_OPEN = (WM_CAP_START + 80);  
  WM_CAP_PAL_SAVE = (WM_CAP_START + 81);  
  WM_CAP_PAL_PASTE = (WM_CAP_START + 82);  
  WM_CAP_PAL_AUTOCREATE = (WM_CAP_START + 83);  
  WM_CAP_PAL_MANUALCREATE = (WM_CAP_START + 84);  
  
  
function capCreateCaptureWindowA(lpszWindowName: PCHAR;  
  dwStyle: longint;  
  x: integer;  
  y: integer;  
  nWidth: integer;  
  nHeight: integer;  
  ParentWin: HWND;  
  nId: integer): HWND; stdcall; external 'avicap32.dll';  
  
procedure Register;  
begin  
  RegisterComponents('FstiCtl', [TVideoCapture]);  
end;  
  
{ TVideoCapture }  
  
constructor TVideoCapture.Create(AOwner: TComponent);  
begin  
  inherited Create(AOwner);  
  CapturingAVI := false;  
  Color := clBlack;  
  BevelOuter := bvNone;  
  Width := 320;  
  Height := 240;  
  hWndC := 0;  
end;  
  
destructor TVideoCapture.Destroy;  
begin  
  if CapturingAVI then StopAvi;  
  if hWndC <> 0 then CloseVideo;  
  hWndC := 0;  
  inherited;  
end;  
  
procedure TVideoCapture.OpenVideo(handle: THandle);  
begin  
  hWndC := capCreateCaptureWindowA('Video Capture Window',  
    WS_CHILD or WS_VISIBLE,  
    Left,  
    Top,  
    Width,  
    Height,  
    Handle,  
    0);  
  if hWndC <> 0 then  
    SendMessage(hWndC, WM_CAP_DRIVER_CONNECT, 0, 0);  
end;  
  
procedure TVideoCapture.CloseVideo;  
begin  
  if hWndC <> 0 then begin  
    SendMessage(hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0);  
    SendMessage(hWndC, WM_CLOSE, 0, 0);  
    hWndC := 0;  
  end;  
end;  
  
procedure TVideoCapture.GrabFrame;  
begin  
  if hWndC <> 0 then  
    SendMessage(hWndC, WM_CAP_GRAB_FRAME, 0, 0);  
end;  
  
procedure TVideoCapture.SaveBitMap(filename: TFileName);  
begin  
  SendMessage(hWndC, WM_CAP_FILE_SAVEDIB, 0, longint(pchar(FileName)));  
end;  
  
function TVideoCapture.StartAvi(filename: TFileName): Boolean;  
begin  
  if hWndC <> 0 then begin  
    CapturingAVI := true;  
    SendMessage(hWndC,  
      WM_CAP_FILE_SET_CAPTURE_FILE,  
      0,  
      Longint(pchar(FileName)));  
    SendMessage(hWndC, WM_CAP_SEQUENCE, 0, 0);  
  end;  
end;  
  
procedure TVideoCapture.StopAvi;  
begin  
  if hWndC <> 0 then begin  
    SendMessage(hWndC, WM_CAP_STOP, 0, 0);  
    CapturingAVI := false;  
  end;  
end;  
  
procedure TVideoCapture.SaveJpeg(filename: TFileName;  
  compressibility: Integer);  
var  
  bmp: TBitMap;  
  jpg: TJpegimage;  
begin  
  try  
    SaveBitMap('tmp.bmp');  
    bmp := TBitmap.Create;  
    jpg := TJpegImage.Create;  
    bmp.LoadFromFile('tmp.bmp');  
    jpg.Assign(bmp);  
    jpg.CompressionQuality := compressibility;  
    jpg.Compress;  
    jpg.SaveToFile(filename);  
    DeleteFile('tmp.bmp');  
  except  
  end;  
  
  bmp.free;  
  jpg.free;  
end;  
  
procedure TVideoCapture.SetVideoFormat;  
begin  
  SendMessage(hWndC, WM_CAP_DLG_VIDEOFORMAT, 0, 0);  
end;  
  
procedure TVideoCapture.SetSource;  
begin  
  SendMessage(hWndC, WM_CAP_DLG_VIDEOSOURCE, 0, 0);  
end;  
  
procedure TVideoCapture.StartVideo;  
begin  
  SendMessage(hWndC, WM_CAP_SET_PREVIEW, -1, 0);  
  SendMessage(hWndC, WM_CAP_SET_PREVIEWRATE, 100, 0);  
  SendMessage(hWndC, WM_CAP_SET_SCALE, -1, 0);  
end;  
  
procedure TVideoCapture.StopVideo;  
begin  
  SendMessage(hWndC, WM_CAP_SET_PREVIEW, 0, 0);  
end;  
  
procedure TVideoCapture.WMSize(var Message: TWMSize);  
begin  
  SetWindowPos(hWndC, HWND_BOTTOM, 0, 0, Width, Height, SWP_NOMOVE or SWP_NOACTIVATE);  
end;  
  
procedure TVideoCapture.SetStretch(TrueorFalse: Boolean);  
begin  
  
end;  
  
procedure TVideoCapture.SetCompression;  
begin  
  SendMessage(hWndC, WM_CAP_DLG_VIDEOCOMPRESSION, 0, 0)  
end;  
  
procedure TVideoCapture.SavetoJpegStream(var JpegStream: TMemoryStream; compressibility: Integer);  
var  
  bmp: TBitMap;  
  jpg: TJpegimage;  
begin  
  try  
    SaveBitMap('tmp.bmp');  
    bmp := TBitmap.Create;  
    jpg := TJpegImage.Create;  
    bmp.LoadFromFile('tmp.bmp');  
    jpg.Assign(bmp);  
    jpg.CompressionQuality := compressibility;  
    jpg.Compress;  
    jpg.SaveToStream(JpegStream);  
    DeleteFile('tmp.bmp');  
  except  
  end;  
  
  bmp.free;  
  jpg.free;  
end;  
  
end.