TVideoCapture类的源码,继承TCustomPanel,用于视频捕获(用到了SendMessage和SetWindowPos等API)good
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.
好的代码像粥一样,都是用时间熬出来的
分类:
Delphi
· 浏览器原生「磁吸」效果!Anchor Positioning 锚点定位神器解析
· 没有源码,如何修改代码逻辑?
· 一个奇形怪状的面试题:Bean中的CHM要不要加volatile?
· [.NET]调用本地 Deepseek 模型
· 一个费力不讨好的项目,让我损失了近一半的绩效!
· 全网最简单!3分钟用满血DeepSeek R1开发一款AI智能客服,零代码轻松接入微信、公众号、小程
· .NET 10 首个预览版发布,跨平台开发与性能全面提升
· 《HelloGitHub》第 107 期
· 全程使用 AI 从 0 到 1 写了个小工具
· 从文本到图像:SSE 如何助力 AI 内容实时呈现?(Typescript篇)
2019-01-10 DELPHI 常用虚拟键:VK_
2019-01-10 DBGRID控件里可以实现SHIFT复选吗?怎么设置?
2019-01-10 在dbgrid中如何多行选中记录(ctl与shift均可用)
2019-01-10 如何在DBGrid里实现Shift+“选择行”区间多选的功能!
2019-01-10 按着shift键对dbgrid进行多条记录选择的问题(50分)
2019-01-10 Delphi实现DBGrid Shift+鼠标左键单击 多选
2019-01-10 Delphi定位TDataSet数据集最后一条记录