unit1.pas

摄像头视频捕捉程序

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, DSPack,
  Menus, ExtCtrls, ComCtrls, StdCtrls,directshow, OleServer, DSUtil,
  ImgList, ToolWin, shellapi;

type
  TForm1 = class(TForm)
    VideoWindow: TDSVideoWindow;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Open1: TMenuItem;
    Exit1: TMenuItem;
    OpenDialog: TOpenDialog;
    Control1: TMenuItem;
    Play1: TMenuItem;
    Pause1: TMenuItem;
    Stop1: TMenuItem;
    DVDGraph: TDSDVDGraph;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    ToolButton10: TToolButton;
    ToolButton11: TToolButton;
    ImageList1: TImageList;
    StepForward1: TMenuItem;
    Options1: TMenuItem;
    Fullscreen1: TMenuItem;
    Popup: TPopupMenu;
    N1: TMenuItem;
    GoTo1: TMenuItem;
    PlaySpeed1: TMenuItem;
    NextChapter1: TMenuItem;
    PreviousChapter1: TMenuItem;
    FastForward1: TMenuItem;
    Rewind1: TMenuItem;
    N4: TMenuItem;
    MenuRoot1: TMenuItem;
    TitleMenu1: TMenuItem;
    N5: TMenuItem;
    Bookmarks1: TMenuItem;
    Savebookmark1: TMenuItem;
    Restorebookmark1: TMenuItem;
    Play2: TMenuItem;
    Pause2: TMenuItem;
    Stop2: TMenuItem;
    N2: TMenuItem;
    GoTo2: TMenuItem;
    NextChapter2: TMenuItem;
    PreviousChapter2: TMenuItem;
    PlaySpeed2: TMenuItem;
    FastForward2: TMenuItem;
    Rewind2: TMenuItem;
    N3: TMenuItem;
    MenuRoot2: TMenuItem;
    TitleMenu2: TMenuItem;
    Fullscreen2: TMenuItem;
    N6: TMenuItem;
    Bookmarks2: TMenuItem;
    Savebookmark2: TMenuItem;
    Restorebookmark2: TMenuItem;
    StatusBar1: TStatusBar;
    N7: TMenuItem;
    progdigycom1: TMenuItem;
    procedure Exit1Click(Sender: TObject);
    procedure Open1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Play1Click(Sender: TObject);
    procedure Pause1Click(Sender: TObject);
    procedure Stop1Click(Sender: TObject);
    procedure Fullscreen1Click(Sender: TObject);
    procedure VideoWindowVidMouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: Integer);
    procedure VideoWindowVidMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure StepForward1Click(Sender: TObject);
    procedure VideoWindowVidKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure VideoWindowVidDblClick(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure NextChapter1Click(Sender: TObject);
    procedure PreviousChapter1Click(Sender: TObject);
    procedure FastForward1Click(Sender: TObject);
    procedure Rewind1Click(Sender: TObject);
    procedure MenuRoot1Click(Sender: TObject);
    procedure TitleMenu1Click(Sender: TObject);
    procedure Savebookmark1Click(Sender: TObject);
    procedure Restorebookmark1Click(Sender: TObject);
    procedure DVDGraphDVDCurrentHMSFTime(sender: TComponent;
      HMSFTimeCode: TDVD_HMSF_TIMECODE; TimeCode: TDVD_TimeCode);
    procedure DVDGraphDVDTitleChange(sender: TComponent; title: Integer);
    procedure DVDGraphDVDChapterStart(sender: TComponent;
      chapter: Integer);
    procedure progdigycom1Click(Sender: TObject);
  private
    { D閏larations priv閑s }
  public
    { D閏larations publiques }
    procedure RenderTest(hr: HResult);
  end;

var
  Form1: TForm1;
  Status: TAM_DVD_RenderStatus;
  IsFullScreen: boolean = false;
implementation

{$R *.DFM}

procedure TForm1.RenderTest(hr: HResult);
begin
  case hr of
    longint(VFW_E_DVD_DECNOTENOUGH):
      begin
        messagebox(0,'not enough hardware or software decoders to decode all streams.','error',mb_ok);
        DVDGraph.Disconnect;
        application.Terminate;
      end;
    longint(VFW_E_DVD_RENDERFAIL) :
      begin
        messagebox(0,'Some basic error occurred in building the graph.','error',mb_ok);
        DVDGraph.Disconnect;
        application.Terminate;
      end;
  end;

end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
  DVDGraph.Disconnect;
  Application.Terminate;
end;

procedure TForm1.Open1Click(Sender: TObject);
var
  Status : TAM_DVD_RenderStatus;
begin
if OpenDialog.Execute then
  begin
    DVDGraph.Disconnect;
    DVDGraph.Connect;
    RenderTest(DVDGraph.DvdGraphBuilder.RenderDvdVideoVolume(StringToOleStr(OpenDialog.FileName),AM_DVD_HWDEC_PREFER,status));
    DVDGraph.QueryInterfaces;
    DVDGraph.DvdControl2.SetOption(DVD_NotifyParentalLevelChange,false);//not notify us when parental level changes
    DVDGraph.DvdControl2.SetOption(DVD_HMSF_TimeCodeEvents, true); // use new HMSF timecode format
    DVDGraph.MediaControl.Run;
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  DVDGraph.Disconnect;
end;

procedure TForm1.Play1Click(Sender: TObject);
var cmd: IDVDCmd;
begin
  cmd := nil;
  if assigned(DVDGraph.DvdGraphBuilder) then
  begin
    if assigned(DVDGraph.DvdControl2) then
      DVDGraph.DvdControl2.PlayForwards(1.0,DVD_CMD_FLAG_None,cmd);
    if assigned(DVDGraph.MediaControl) then
      DVDGraph.MediaControl.Run;
  end
  else
  begin
    DVDGraph.Disconnect;
    DVDGraph.Connect;
    RenderTest(DVDGraph.DvdGraphBuilder.RenderDvdVideoVolume(nil,AM_DVD_HWDEC_PREFER,status));
    DVDGraph.QueryInterfaces;
    DVDGraph.DvdControl2.SetOption(DVD_NotifyParentalLevelChange,false);//not notify us when parental level changes
    DVDGraph.DvdControl2.SetOption(DVD_HMSF_TimeCodeEvents, true); // use new HMSF timecode format
    DVDGraph.MediaControl.Run;
  end;
end;

procedure TForm1.Pause1Click(Sender: TObject);
begin
  if assigned(DVDGraph.MediaControl) then
    DVDGraph.MediaControl.Pause;
end;

procedure TForm1.Stop1Click(Sender: TObject);
begin
  if assigned(DVDGraph.MediaControl) then
  begin
    DVDGraph.MediaControl.Stop;
    DVDGraph.Disconnect;
  end;
end;

procedure TForm1.Fullscreen1Click(Sender: TObject);
begin
  if VideoWindow.IsFullScreen then
    VideoWindow.StopFullScreen
  else
    VideoWindow.StartFullScreen;

end;

procedure TForm1.VideoWindowVidMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var Point : TPoint;
begin
  if assigned(DVDGraph.DvdControl2) then
  begin
    Point.x := x;
    Point.y := y;
    DVDGraph.DvdControl2.SelectAtPosition(Point);
  end;
end;

procedure TForm1.VideoWindowVidMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var Point : TPoint;
begin
  if assigned(DVDGraph.DvdControl2) then
  begin
    Point.x := x;
    Point.y := y;
    DVDGraph.DvdControl2.ActivateAtPosition(Point);
  end;
end;

procedure TForm1.StepForward1Click(Sender: TObject);
begin
  if (assigned(DVDGraph.MediaControl) and assigned(DVDGraph.VideoFrameStep)) then
  begin
    DVDGraph.MediaControl.Pause;
    DVDGraph.VideoFrameStep.Step(1,nil);
  end;
end;

procedure TForm1.VideoWindowVidKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if ((key = 27) and VideoWindow.IsFullScreen) then VideoWindow.StopFullScreen;
end;

procedure TForm1.VideoWindowVidDblClick(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if VideoWindow.IsFullScreen then
    VideoWindow.StopFullScreen
  else
    VideoWindow.StartFullScreen;
end;

procedure TForm1.NextChapter1Click(Sender: TObject);
var cmd: IDVDCmd;
begin
  cmd := nil;
  if assigned(DVDGraph.DvdControl2) then
    DVDGraph.DvdControl2.PlayNextChapter(DVD_CMD_FLAG_None, cmd);
end;

procedure TForm1.PreviousChapter1Click(Sender: TObject);
var cmd: IDVDCmd;
begin
  cmd := nil;
  if assigned(DVDGraph.DvdControl2) then
    DVDGraph.DvdControl2.PlayPrevChapter(DVD_CMD_FLAG_None, cmd);
end;

procedure TForm1.FastForward1Click(Sender: TObject);
var cmd: IDVDCmd;
begin
  cmd := nil;
  if assigned(DVDGraph.DvdControl2) then
    DVDGraph.DvdControl2.PlayForwards(8.0,DVD_CMD_FLAG_None,cmd);
end;

procedure TForm1.Rewind1Click(Sender: TObject);
var cmd: IDVDCmd;
begin
  cmd := nil;
  if assigned(DVDGraph.DvdControl2) then
    DVDGraph.DvdControl2.PlayBackwards(8.0,DVD_CMD_FLAG_None,cmd);
end;

procedure TForm1.MenuRoot1Click(Sender: TObject);
var cmd: IDVDCmd;
begin
  cmd := nil;
  if assigned(DVDGraph.DvdControl2) then
    DVDGraph.DvdControl2.ShowMenu(DVD_MENU_Root,DVD_CMD_FLAG_None,cmd);
end;

procedure TForm1.TitleMenu1Click(Sender: TObject);
var cmd: IDVDCmd;
begin
  cmd := nil;
  if assigned(DVDGraph.DvdControl2) then
    DVDGraph.DvdControl2.ShowMenu(DVD_MENU_Title,DVD_CMD_FLAG_None,cmd);
end;

procedure TForm1.Savebookmark1Click(Sender: TObject);
begin
  DVDGraph.SaveBookmark(ExtractFilePath(Application.EXEName)+'bookmark.bmk');
end;

procedure TForm1.Restorebookmark1Click(Sender: TObject);
begin
  DVDGraph.RestoreBookmark(ExtractFilePath(Application.EXEName)+'bookmark.bmk');
end;

procedure TForm1.DVDGraphDVDCurrentHMSFTime(sender: TComponent;
  HMSFTimeCode: TDVD_HMSF_TIMECODE; TimeCode: TDVD_TimeCode);
begin
    statusbar1.Panels.Items[0].Text :=
      format('Time %d:%d:%d',[HMSFTimeCode.bHours,HMSFTimeCode.bMinutes,HMSFTimeCode.bSeconds]);
end;

procedure TForm1.DVDGraphDVDTitleChange(sender: TComponent;
  title: Integer);
begin
  statusbar1.Panels.Items[1].Text := 'Title '+inttostr(title);
end;

procedure TForm1.DVDGraphDVDChapterStart(sender: TComponent;
  chapter: Integer);
begin
  statusbar1.Panels.Items[2].Text := 'Chapter '+ inttostr(chapter);
end;

procedure TForm1.progdigycom1Click(Sender: TObject);
begin
  shellexecute(0,nil,'http://www.progdigy.com',nil,nil,SW_SHOW);
end;

end.