video.pas

delphi2007写的播放器源码。效果类似于千千静听。

unit Video;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,Bass,BassVideo,ComVariable, Menus, ExtCtrls, AppEvnts;

type
  TfrmVideo = class(TForm)
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N431: TMenuItem;
    N1691: TMenuItem;
    N2: TMenuItem;
    Filter1: TMenuItem;
    N3: TMenuItem;
    Timer_Hide_Mouse: TTimer;
    ApplicationEvents1: TApplicationEvents;
    Timer_Show_Text: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDblClick(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N1691Click(Sender: TObject);
    procedure N431Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ApplicationEvents1Message(var Msg: tagMSG;
      var Handled: Boolean);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure Timer_Hide_MouseTimer(Sender: TObject);
    procedure Timer_Show_TextTimer(Sender: TObject);
  private
    { Private declarations }
  public
    procedure WndProc(var Msg : TMessage); override;
    procedure ActiveSomeStuff;
    procedure WhenFormResize;
  end;

var
  frmVideo: TfrmVideo;
  isFullScreen : Boolean;
  OldRect : TRect;
  OldStyle : Longint;
  hText:integer;
  VEffect:boolean;

implementation

{$R *.dfm}


function FilterProc(Handle : DWORD; FilterName : PChar; Filter : Pointer; User : Pointer): BOOL; stdcall;
var mt : TMenuItem;
begin
 result := TRUE;
 mt := TMenuItem.Create(frmVideo);
 mt.Caption := FilterName;
 mt.Enabled := BassVideo.BassVideo_HasFilterPropertyPage(Handle, Filter, 0); //
 frmVideo.Filter1.Insert(0, mt);
end;

procedure TfrmVideo.ActiveSomeStuff;
var
  i : integer;
begin
 // Enum all filter in the graph and show it for user
 for i := 0 to Filter1.Count - 1 do
  Filter1.Delete(0);
 BassVideo.BassVideo_EnumFilter(chan, @FilterProc, nil);
end;

procedure TfrmVideo.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
  var id, i : integer;
begin
 if Msg.message = WM_COMMAND  then
 begin
  id := Msg.WParam;
  for i := 0 to Filter1.Count - 1 do
  begin
    if Filter1.Items[i].Command = id then
      if Filter1.Items[i].Enabled then
      begin
        BassVideo.BassVideo_ShowFilterPropertyPage(chan, PChar(Filter1.Items[i].Caption), Handle, BASSVIDEO_FILTERNAME);
        exit;
      end;
    end;
  end;
end;

procedure TfrmVideo.WndProc(var Msg: TMessage);
var dc : HDC;
    ps : TPaintStruct;
begin
  if chan <> 0 then
  case Msg.Msg of
   WM_MOVE  : begin
                // apply for Windowed Renderer
                BassVideo_WindowMove(chan, Msg.Msg, Msg.WParam, Msg.LParam, 0);
              end;

   WM_SIZE  : begin
               WhenFormResize;
              end;

   WM_PAINT : begin
                 // this apply for application that use VMR9-Windowless
                 dc := BeginPaint(Handle, ps);
                 BASSVideo_Repaint(chan, Handle, DC, 0);
                 EndPaint(Handle, ps);
              end;
  end;
   inherited;
end;

procedure TfrmVideo.WhenFormResize;
var R : TRect;
begin
  R := frmVideo.ClientRect;
  R.Left := 0; R.Top := 0;
  R.Bottom := R.Bottom;
  BassVideo_WindowResize(chan, R, 0);
end;

procedure TfrmVideo.FormCreate(Sender: TObject);
var
  R:TRect;
begin
//
self.Hide;
  R:=frmVideo.ClientRect;
  BassVideo_SetVideoWindow(0, frmVideo.Handle,  R, 0);
end;

procedure TfrmVideo.FormDblClick(Sender: TObject);
begin
  isFullScreen := not isFullScreen;
 if isFullScreen then
  begin
    OldRect.Left := Left;
    OldRect.Top := Top;
    OldRect.Right := Width;
    OldRect.Bottom := Height;
    OldStyle := GetWindowLong(Handle, GWL_STYLE);
    SetWindowLong(Handle, GWL_STYLE, integer(WS_POPUPWINDOW or WS_VISIBLE));
    Left := 0;
    Top := 0;
    Height := Screen.Height;
    Width := Screen.Width;
    Timer_Hide_Mouse.Enabled := TRUE;
  end
 else
  begin
   SetWindowLong(Handle, GWL_STYLE, OldStyle);
   SetWindowPos(Handle, 0, OldRect.Left , OldRect.Top, OldRect.Right, OldRect.Bottom , 0);
  end;
end;

procedure TfrmVideo.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Shift = [ssLeft] then
  begin
    ReleaseCapture;
    Perform(WM_SYSCOMMAND, $f012, 0);
  end;
end;

procedure TfrmVideo.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  frmVideo.Cursor := crDefault;
 Timer_Hide_Mouse.Enabled := FALSE;
 if not isFullScreen then exit;
 Timer_Hide_Mouse.Enabled := TRUE;
end;

procedure TfrmVideo.N1691Click(Sender: TObject);
begin
  BassVideo_SetRatio(chan, R169, 0, 0);
  WhenFormResize;
end;

procedure TfrmVideo.N1Click(Sender: TObject);
begin
  BassVideo_SetRatio(chan, RSource, 0, 0);
  WhenFormResize;
end;

procedure TfrmVideo.N2Click(Sender: TObject);
begin
  BassVideo_SetRatio(chan, RFree, 0, 0);
  WhenFormResize;
end;

procedure TfrmVideo.N431Click(Sender: TObject);
begin
  BassVideo_SetRatio(chan, R43, 0, 0);
  WhenFormResize;
end;

procedure TfrmVideo.Timer_Hide_MouseTimer(Sender: TObject);
begin
  frmVideo.Cursor := crNone;
  Timer_Hide_Mouse.Enabled := FALSE;
end;

procedure TfrmVideo.Timer_Show_TextTimer(Sender: TObject);
begin
  //if Timer_Buffering.Enabled then exit;
 if chan = 0 then exit;
 if VEffect then
  BassVideo_RemoveText(chan, hText)
 else
  hText := BassVideo_AddText(chan, 'myPlayer', 10, 10, 'Arial', 24, 0, RGB(255, 255, 255), 0100); // bold
 VEffect := not VEffect;
end;

end.