高手帮忙!如何实现视频截图?

Question

视频截图可不是一个简单的事情,不信你试试看?打开一个视频文件,按下"Prt Scr"键,打开Windows画笔,Ctrl+V把截图粘上
你会发现你只是截到了Media Player的界面,而里面的视频是黑的,截不动!谁能解释这个问题?如何用Delphi实现截视频的图?谢谢大家的帮助!!

Answer 1

Delphi裡面,要使用Image單元與TBitamp以及刷子組合起來抓圖.
全屏幕抓圖:
 //抓取屏幕，並保存到Image控件中
var
  Fullscreen:Tbitmap;
  FullscreenCanvas:TCanvas;
  dc:HDC;
begin
  Fullscreen:=TBitmap.Create;//創建一個BITMAP來存放圖像
  Fullscreen.Width:=screen.width;
  Fullscreen.Height:=screen.Height;
  DC:=GetDC(0);//取得屏幕的DC，參數0指的是屏幕
  FullscreenCanvas:=TCanvas.Create;//創建一個CANVAS對像
  FullscreenCanvas.Handle:=DC;  Fullscreen.Canvas.CopyRect
  (Rect(0,0,screen.Width,screen.Height),fullscreenCanvas,
  Rect(0,0,Screen.Width,Screen.Height));
  //把整個屏幕複製到BITMAP中
  FullscreenCanvas.Free;//釋放CANVAS對像
  ReleaseDC(0,DC);//釋放DC
   //*******************************
  image1.picture.Bitmap:=fullscreen;//拷貝下的圖像賦給IMAGE對像
  image1.Width:=fullscreen.Width;
  image1.Height:=fullscreen.Height;
  fullscreen.free;//釋放bitmap.
//===========================================
//抓取鼠標選取的區域,要復雜些,給出整個代碼(Unit2單元,Unit1請看下面):
unit Unit2;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls;type
  TForm2 = class(TForm)
    Image1: TImage;
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form2: TForm2;
  foldx,x1,y1,x2,y2,oldx,oldy,foldy:integer;
  flag,trace:boolean;
implementationuses Unit1;{$R *.DFM}procedure TForm2.Timer1Timer(Sender: TObject);
var
  Fullscreen:Tbitmap;
  FullscreenCanvas:TCanvas;
  dc:HDC;
begin
  timer1.Enabled:=false;
  Fullscreen:=TBitmap.Create;
  Fullscreen.Width:=screen.width;
  Fullscreen.Height:=screen.Height;
  DC:=GetDC(0);
  FullscreenCanvas:=TCanvas.Create;
  FullscreenCanvas.Handle:=DC;
  Fullscreen.Canvas.CopyRect(Rect(0,0,screen.Width,screen.Height),fullscreenCanvas,
  Rect(0,0,Screen.Width,Screen.Height));
  FullscreenCanvas.Free;
  ReleaseDC(0,DC);
  image1.picture.Bitmap:=fullscreen;
  image1.Width:=fullscreen.Width;
  image1.Height:=fullscreen.Height;
  fullscreen.free;
  form2.WindowState:=wsMaximized;
  form2.show;
  messagebeep(1);
  foldx:=-1;
  foldy:=-1;
  image1.Canvas.Pen.mode:=pmnot; //筆的模式為取反
  image1.canvas.pen.color:=clblack; //筆為黑色
  image1.canvas.brush.Style:=bsclear;//空白刷子
  flag:=true;
end;
procedure TForm2.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if trace=true then//是否在追蹤鼠標？
  begin//是，擦除舊的矩形並畫上新的矩形
    with image1.canvas do
    begin
        rectangle(x1,y1,oldx,oldy);
        Rectangle(x1,y1,x,y);
        oldx:=x;
        oldy:=y;
    end;
  end
  else if flag=true then//在鼠標所在的位置上畫十字
  begin
    with image1.canvas do
        begin
          moveTo(foldx,0);//擦除舊的十字
          LineTo(foldx,screen.height);
          moveto(0,foldy);
          lineto(screen.width,foldy);
          moveTo(x,0);//畫上新的十字
          LineTo(x,screen.height);
          moveto(0,y);
          lineto(screen.width,y);
          foldx:=x;
          foldy:=y;
        end;
  end;
end;procedure TForm2.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  width,height:integer;
  newbitmap:Tbitmap;
begin
  if (trace=false) then//TRACE表示是否在追蹤鼠標
  begin//首次點擊鼠標左鍵，開始追蹤鼠標。
    flag:=false;
    with image1.canvas do
    begin
        moveTo(foldx,0);
        LineTo(foldx,screen.height);
        moveto(0,foldy);
        lineto(screen.width,foldy);
    end;
    x1:=x;
    y1:=y;
    oldx:=x;
    oldy:=y;
    trace:=true;
    image1.Canvas.Pen.mode:=pmnot;//筆的模式為取反
    //這樣再在原處畫一遍矩形，相當於擦除矩形。
    image1.canvas.pen.color:=clblack;//筆為黑色
    image1.canvas.brush.Style:=bsclear;//空白刷子
    end
  else
  begin//第二次點擊，表示已經得到矩形了，把它拷貝到FORM1中的IMAGE部件上。
    x2:=x;
    y2:=y;
    trace:=false;
    image1.canvas.rectangle(x1,y1,oldx,oldy);
    width:=abs(x2-x1);
    height:=abs(y2-y1);
    form1.image1.Width:=Width;
    form1.image1.Height:=Height;    newbitmap:=Tbitmap.create;
    newbitmap.width:=width;
    newbitmap.height:=height;
    newbitmap.Canvas.CopyRect
    (Rect(0,0,width,Height),form2.image1.canvas,
    Rect(x1,y1,x2,y2));//拷貝
    form1.image1.picture.bitmap:=newbitmap;//放到FORM的IMAGE上
    newbitmap.free;
    form2.hide;
    form1.show;
end;
end;end.

Answer 2

//這個是MainForm,也是Unit1單元;
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, ExtDlgs;type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Timer1: TTimer;
    Image1: TImage;
    SaveDialog1: TSavePictureDialog;
    procedure Button4Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementationuses Unit2;{$R *.DFM}procedure TForm1.Button4Click(Sender: TObject);// 關閉程序
begin
  close;
end;procedure TForm1.Timer1Timer(Sender: TObject); //抓取屏幕，並保存到Image控件中
var
  Fullscreen:Tbitmap;
  FullscreenCanvas:TCanvas;
  dc:HDC;
begin
  timer1.Enabled:=false;//取消時鐘
  Fullscreen:=TBitmap.Create;//創建一個BITMAP來存放圖像
  Fullscreen.Width:=screen.width;
  Fullscreen.Height:=screen.Height;
  DC:=GetDC(0);//取得屏幕的DC，參數0指的是屏幕
  FullscreenCanvas:=TCanvas.Create;//創建一個CANVAS對像
  FullscreenCanvas.Handle:=DC;  Fullscreen.Canvas.CopyRect
  (Rect(0,0,screen.Width,screen.Height),fullscreenCanvas,
  Rect(0,0,Screen.Width,Screen.Height));
  //把整個屏幕複製到BITMAP中
  FullscreenCanvas.Free;//釋放CANVAS對像
  ReleaseDC(0,DC);//釋放DC
   //*******************************
  image1.picture.Bitmap:=fullscreen;//拷貝下的圖像賦給IMAGE對像
  image1.Width:=fullscreen.Width;
  image1.Height:=fullscreen.Height;
  fullscreen.free;//釋放bitmap
  form1.WindowState:=wsNormal;//復原窗口狀態
  form1.show;//顯示窗口
  messagebeep(1);//BEEP叫一聲，報告圖像已經截取好了。
end;procedure TForm1.Button1Click(Sender: TObject); //全屏抓圖
begin
  form1.WindowState:=wsMinimized;//最小化程序窗口
  form1.hide;//把程序藏起來
  timer1.enabled:=true;//打開記時器
end;procedure TForm1.Button3Click(Sender: TObject); //保存圖片
begin
if savedialog1.Execute then
begin
form1.Image1.Picture.SaveToFile(savedialog1.filename)
end;
end;procedure TForm1.Button2Click(Sender: TObject); //區域抓圖
begin
form1.Hide;
form2.hide;
form2.Timer1.Enabled:=true;end;end.

Answer 3

//使用mediaPlay截視頻的例子;
unit Unit1; interface uses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs, MPlayer, ExtCtrls, StdCtrls, Menus; type  TForm1 = class(TForm)    MainMenu1: TMainMenu;    filw1: TMenuItem;    open1: TMenuItem;    close1: TMenuItem;    Button1: TButton;    OpenDialog1: TOpenDialog;    PaintBox1: TPaintBox;    MediaPlayer1: TMediaPlayer;    procedure FormCreate(Sender: TObject);    procedure FormClose(Sender: TObject; var Action: TCloseAction);    procedure PaintBox1Paint(Sender: TObject);    procedure open1Click(Sender: TObject);    procedure Button1Click(Sender: TObject);  private  imgbitmap:TBitmap;    { Private declarations }  public    { Public declarations }  end; var  Form1: TForm1; implementation {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject);begin   imgbitmap:=TBitmap.Create;   imgbitmap.Height:=200;   imgbitmap.Width:=200;   imgbitmap.Canvas.Rectangle(0,0,200,200);end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);beginimgbitmap.Free;end; procedure TForm1.PaintBox1Paint(Sender: TObject);beginPaintBox1.Canvas.CopyRect(Rect(0,0,200,200),imgbitmap.Canvas,Rect(0,0,200,200));end; procedure TForm1.open1Click(Sender: TObject);beginif OpenDialog1.Execute thenbeginMediaPlayer1.FileName:=OpenDialog1.FileName;MediaPlayer1.Open;MediaPlayer1.Display:=Form1;MediaPlayer1.DisplayRect:=Rect(10,10,200,200);end;end; procedure TForm1.Button1Click(Sender: TObject);beginimgbitmap.Canvas.CopyRect(Rect(0,0,200,200),form1.Canvas,Rect(10,10,200,200));PaintBox1.Invalidate;imgbitmap.SaveToFile('d:\1234567.bmp');end; end.//test环境win2000+dephi6.0