- Delphiartiklar, tips, forum, länksamling - 

      

START | DELPHI | LÄNKARGÄSTBOK 




 Forum

Grundkurs
  »Introduktion
  »Snabbguide
  »Komponenter
  »Händelser
  »Strängar
  »Räkna med Delphi   »Egna typer
  »Selektion
  »Iteration
  »Menyer
  »Funktioner
  »Arraystrukturer

Tips & Tricks
  »Nya tips
  »Blandat
  »Databaser
  »Filer
  »Forms
  »Grafik
  »Internet
  »Komponenter
  »Matematik
  »Multimedia
  »Objekt/ActiveX
  »Skrivare
  »Strängar
  »System
  »Mest lästa tips

Artiklar
  »Delphi och ADO
  »Bygga en DLL
  »Skapa en enkel rapport
  »Hantera registret
  »Enheter, units
  »Klassen TCanvas
  »Använd LookUp Controls

 Nya tips
 Lägg till tips
 Delphilänkar
 Gästbok

 

Fånga en bild från en videokälla Kategori: Multimedia
Inlagt: 2006-07-22
Läst: 1323
Inlagt av: Staffan Berg
Beskrivning
Ett komplett exempel för att fånga en bild från en videokälla. För att exemplet skall fungera krävs att Microsoft Video for Windows SDK finns installerat på din dator. Exemplet visar hur du först öppnar standard videoenheten, fångar en "frame", sparar densamma på disk som en BMP-fil, spelar in en AVI-fil och därefter stänger enheten.
Kod
unit Unit1; 
 
interface 
 
uses 
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, 
  Dialogs, ExtCtrls, StdCtrls; 
 
type 
 TForm1 = class(TForm) 
  Panel1: TPanel; 
  OpenVideo: TButton; 
  CloseVideo: TButton; 
  GrabFrame: TButton; 
  SaveBMP: TButton; 
  StartAVI: TButton; 
  StopAVI: TButton; 
  SaveDialog1: TSaveDialog; 
  procedure FormCreate(Sender: TObject); 
  procedure OpenVideoClick(Sender: TObject); 
  procedure CloseVideoClick(Sender: TObject); 
  procedure GrabFrameClick(Sender: TObject); 
  procedure SaveBMPClick(Sender: TObject); 
  procedure StartAVIClick(Sender: TObject); 
  procedure StopAVIClick(Sender: TObject); 
 private 
  { Private declarations } 
  hWndC : THandle; 
  CapturingAVI : bool; 
 public 
  { Public declarations } 
 end; 
 
var 
 Form1: TForm1; 
 
implementation 
 
{$R *.DFM} 
 
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; 
 
function capCreateCaptureWindowA(lpszWindowName : PCHAR; 
                 dwStyle : longint; 
                 x : integer; 
                 y : integer; 
                 nWidth : integer; 
                 nHeight : integer; 
                 ParentWin : HWND; 
                 nId : integer): HWND; 
                 STDCALL EXTERNAL 'AVICAP32.DLL'; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
 CapturingAVI := false; 
 hWndC := 0; 
 SaveDialog1.Options := 
  [ofHideReadOnly, ofNoChangeDir, ofPathMustExist] 
end; 
 
procedure TForm1.OpenVideoClick(Sender: TObject); 
begin 
 hWndC := capCreateCaptureWindowA('My Own Capture Window', 
                  WS_CHILD or WS_VISIBLE , 
                  Panel1.Left, 
                  Panel1.Top, 
                  Panel1.Width, 
                  Panel1.Height, 
                  Form1.Handle, 
                  0); 
 if hWndC <> 0 then 
  SendMessage(hWndC, WM_CAP_DRIVER_CONNECT, 0, 0); 
end; 
 
procedure TForm1.CloseVideoClick(Sender: TObject); 
begin 
 if hWndC <> 0 then begin 
  SendMessage(hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0); 
  hWndC := 0; 
  end; 
end; 
 
procedure TForm1.GrabFrameClick(Sender: TObject); 
begin 
 if hWndC <> 0 then 
  SendMessage(hWndC, WM_CAP_GRAB_FRAME, 0, 0); 
end; 
 
procedure TForm1.SaveBMPClick(Sender: TObject); 
begin 
 if hWndC <> 0 then begin 
  SaveDialog1.DefaultExt := 'bmp'; 
  SaveDialog1.Filter := 'Bitmap files (*.bmp)|*.bmp'; 
  if SaveDialog1.Execute then 
   SendMessage(hWndC, 
         WM_CAP_SAVEDIB, 
         0, 
         longint(pchar(SaveDialog1.FileName))); 
 end; 
end; 
 
procedure TForm1.StartAVIClick(Sender: TObject); 
begin 
 if hWndC <> 0 then begin 
  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; 
end; 
 
procedure TForm1.StopAVIClick(Sender: TObject); 
begin 
 if hWndC <> 0 then begin 
  SendMessage(hWndC, WM_CAP_STOP, 0, 0); 
  CapturingAVI := false; 
 end; 
end; 
 
end.

 
 
© Copyright 2005 - Staffan Berg
- Alla rättigheter förbehålles -