请教如何将摄像头的图象能在程序的屏幕上显示呢? (delphi)急急,DELHI中有没有播放的控件啊!

解决方案 »

  1.   

    网上代码,没有试过,试一下吧:
    unit Unit1;interfaceuses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls, ExtCtrls;type
      TForm1 = class(TForm)
        Panel1: TPanel;
        SaveDialog1: TSaveDialog;
        Panel2: TPanel;
        OpenVideo: TButton;
        CloseVideo: TButton;
        SaveBMP: TButton;
        StartAVI: TButton;
        StopAVI: TButton;
        procedure FormCreate(Sender: TObject);
        procedure OpenVideoClick(Sender: TObject);
        procedure CloseVideoClick(Sender: TObject);
        procedure SaveBMPClick(Sender: TObject);
        procedure StartAVIClick(Sender: TObject);
        procedure StopAVIClick(Sender: TObject);
        procedure FormClose(Sender: TObject; var Action: TCloseAction);
      private
      hWndC : THandle;
    CapturingAVI : bool;
        { Private declarations }
      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;
    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 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_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);
    OpenVideo.Enabled :=false;
    end;procedure TForm1.CloseVideoClick(Sender: TObject);
    begin
    if hWndC <> 0 then begin
    SendMessage(hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0);
    hWndC := 0;
    OpenVideo.Enabled :=true;
    end;
    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;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
    begin
    CloseVideoClick(Sender);
    end;end.