unit1.~pa

详细介绍了用delphi如何编写一个视频播放器

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, ToolWin, ImgList, ExtCtrls, Menus, MPlayer,MMSystem;
const
  MCI_SETAUDIO = $0873;
  MCI_DGV_SETAUDIO_VOLUME = $4002; 
  MCI_DGV_SETAUDIO_ITEM = $00800000; 
  MCI_DGV_SETAUDIO_VALUE = $01000000; 
  MCI_DGV_STATUS_VOLUME = $4019;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    View1: TMenuItem;
    Control1: TMenuItem;
    Help1: TMenuItem;
    pnlBacking: TPanel;
    pnlView: TPanel;
    ImageList1: TImageList;
    OpenDialog1: TOpenDialog;
    StatusBar1: TStatusBar;
    ToolBar1: TToolBar;
    Panel2: TPanel;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    TrackBar1: TTrackBar;
    Timer1: TTimer;
    MediaPlayer1: TMediaPlayer;
    Open1: TMenuItem;
    Close1: TMenuItem;
    Exit1: TMenuItem;
    N1: TMenuItem;
    Toolbar2: TMenuItem;
    Trackbar2: TMenuItem;
    Statusbar2: TMenuItem;
    N2: TMenuItem;
    Fullscreen1: TMenuItem;
    ZoomIn1: TMenuItem;
    ZoomOut1: TMenuItem;
    N3: TMenuItem;
    Play1: TMenuItem;
    Pause1: TMenuItem;
    Stop1: TMenuItem;
    N4: TMenuItem;
    Mute1: TMenuItem;
    N5: TMenuItem;
    Loop1: TMenuItem;
    About1: TMenuItem;
    ProgressBar1: TProgressBar;
    Progressbar2: TMenuItem;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    ToolButton10: TToolButton;
    ToolButton11: TToolButton;
    OriginalSize1: TMenuItem;
    ToolButton12: TToolButton;
    procedure FormResize(Sender: TObject);
    procedure Play1Click(Sender: TObject);
    procedure Pause1Click(Sender: TObject);
    procedure Stop1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure Close1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure Open1Click(Sender: TObject);
    procedure Mute1Click(Sender: TObject);
    procedure Loop1Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Toolbar2Click(Sender: TObject);
    procedure Trackbar2Click(Sender: TObject);
    procedure Statusbar2Click(Sender: TObject);
    procedure Progressbar2Click(Sender: TObject);
    procedure Fullscreen1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ZoomIn1Click(Sender: TObject);
    procedure ZoomOut1Click(Sender: TObject);
    procedure OriginalSize1Click(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure pnlViewClick(Sender: TObject);
    procedure pnlBackingClick(Sender: TObject);
    procedure About1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    sFilename: String;
    OrginalRec: TRect;
    LastPos: Integer;
    LastVol: Integer;
    ZoomLevel: Integer;
    bFullScreen: Boolean;
    procedure CloseMedia;
    procedure OpenMedia(sFile: String);
    procedure FixDisplay;
    procedure SetZoom(Incr: Integer;Zoomin: Boolean);
    procedure SetMPVolume(MP: TMediaPlayer; Volume: Integer);
    procedure EndFullScreen;
    function GetMPVolume(MP: TMediaPlayer): Integer;
    procedure ShowTaskbar(Visible: boolean);
    procedure EnableTaskBar(Enable : boolean); 
  end;

type 
  MCI_DGV_SETAUDIO_PARMS = record 
    dwCallback: DWORD; 
    dwItem: DWORD; 
    dwValue: DWORD; 
    dwOver: DWORD; 
    lpstrAlgorithm: PChar; 
    lpstrQuality: PChar; 
  end; 

type 
  MCI_STATUS_PARMS = record 
    dwCallback: DWORD; 
    dwReturn: DWORD; 
    dwItem: DWORD; 
    dwTrack: DWORD;
  end; 

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.ShowTaskbar(Visible: boolean);
var
  hTaskBarWindow : HWnd; 
begin 
  hTaskBarWindow:=FindWindow('Shell_TrayWnd',nil); 
  if hTaskBarWindow<>0 then 
    if Visible then 
      ShowWindow(hTaskBarWindow, SW_SHOW) 
    else 
      ShowWindow(hTaskBarWindow, SW_HIDE) 
end;
procedure TForm1.EnableTaskBar(Enable : boolean);
var 
  hTaskBarWindow : HWnd; 
begin 
  hTaskBarWindow:=FindWindow('Shell_TrayWnd',nil); 
  if hTaskBarWindow<>0 then 
    EnableWindow(hTaskBarWindow,Enable); 
end; 


procedure TForm1.SetMPVolume(MP: TMediaPlayer; Volume: Integer);
  { Volume: 0 - 1000 }
var
  p: MCI_DGV_SETAUDIO_PARMS;
begin
  { Volume: 0 - 1000 }
  p.dwCallback := 0;
  p.dwItem := MCI_DGV_SETAUDIO_VOLUME;
  p.dwValue := Volume;
  p.dwOver := 0;
  p.lpstrAlgorithm := nil;
  p.lpstrQuality := nil;
  mciSendCommand(MP.DeviceID, MCI_SETAUDIO,
    MCI_DGV_SETAUDIO_VALUE or MCI_DGV_SETAUDIO_ITEM, Cardinal(@p));
end;

function TForm1.GetMPVolume(MP: TMediaPlayer): Integer;
var
  p: MCI_STATUS_PARMS;
begin
  p.dwCallback := 0;
  p.dwItem := MCI_DGV_STATUS_VOLUME;
  mciSendCommand(MP.DeviceID, MCI_STATUS, MCI_STATUS_ITEM, Cardinal(@p));
  Result := p.dwReturn;
  { Volume: 0 - 1000 }
end;

procedure TForm1.FormResize(Sender: TObject);
begin
try
FixDisplay;
except
  // do nothing
end;

end;

procedure TForm1.CloseMedia;
begin
try
if sFilename <> '' then
begin
statusbar1.SimpleText := '';
progressbar1.Position :=  progressbar1.Min;
trackbar1.Position := progressbar1.Min;
   MediaPlayer1.Stop;
   MediaPlayer1.Close;
   Timer1.Enabled := false;
   sFilename := '';
end;
except
   on E: Exception do showmessage('Could not Close Media:' + #10 + #13 + E.Message);
end;

end;

procedure TForm1.OpenMedia(sFile: String);
begin
try
CloseMedia;
ZoomLevel := 0;
sFilename := sFile;
statusbar1.SimpleText := sfile;
MediaPlayer1.display := pnlView;
MediaPlayer1.FileName := sfile;
MediaPlayer1.TimeFormat := tfMilliseconds;
TrackBar1.Frequency := 5000;
MediaPlayer1.Open;
OrginalRec := MediaPlayer1.DisplayRect;
FixDisplay;
TrackBar1.Max := MediaPlayer1.Length;
progressbar1.Max := MediaPlayer1.Length;
Timer1.Enabled := true;

MediaPlayer1.Play;
except
   on E: Exception do showmessage('Could not Open Media:' + #10 + #13 + E.Message);
end;
end;

procedure TForm1.FixDisplay;
Var
Rect: TRect;
begin
Rect := MediaPlayer1.DisplayRect;
pnlView.SetBounds(0,0,1,1);
  pnlView.Width :=  Rect.Right;
  pnlView.Height := Rect.bottom;
  pnlView.Left := (pnlBacking.width - pnlView.Width) div 2;
  pnlView.top := (pnlBacking.height - pnlView.height) div 2;
end;

procedure TForm1.Play1Click(Sender: TObject);
begin
try
  MediaPlayer1.Play;
except
   on E: Exception do showmessage('Could not Play Media:' + #10 + #13 + E.Message);
end;
end;

procedure TForm1.Pause1Click(Sender: TObject);
begin
try
  MediaPlayer1.Pause;
except
   on E: Exception do showmessage('Could not Pause Media:' + #10 + #13 + E.Message);
end;
end;

procedure TForm1.Stop1Click(Sender: TObject);
begin
try
  MediaPlayer1.Stop;
except
   on E: Exception do showmessage('Could not Stop Media:' + #10 + #13 + E.Message);
end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
try
TrackBar1.OnChange := nil; // this is to prevent the checkbox from becoming unchecked
TrackBar1.Position := MediaPlayer1.Position;
TrackBar1.OnChange := TrackBar1Change;
progressbar1.Position := MediaPlayer1.Position;
if (Loop1.Checked = true) and (progressbar1.Position = progressbar1.Max) then
begin
  TrackBar1.Position := TrackBar1.Min;
  TrackBar1Change(Sender);
end;
except
   on E: Exception do showmessage('Could not Track Media:' + #10 + #13 + E.Message);
end;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
try
MediaPlayer1.Stop;
MediaPlayer1.Position := TrackBar1.Position;
MediaPlayer1.Play;
except
   on E: Exception do showmessage('Could not Move Media:' + #10 + #13 + E.Message);
end;

end;

procedure TForm1.Close1Click(Sender: TObject);
begin
closemedia;
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
closemedia;
close;
end;

procedure TForm1.Open1Click(Sender: TObject);
begin
if opendialog1.Execute = true then
begin
     OpenMedia(opendialog1.filename);
end;
end;

procedure TForm1.Mute1Click(Sender: TObject);
begin
  Mute1.Checked := not Mute1.Checked;
if Mute1.Checked = true then
begin
  //muting
  LastVol := GetMPVolume(MediaPlayer1);
  SetMPVolume(MediaPlayer1,0);
  toolbutton4.ImageIndex := 4;
end
else
begin
  //un muting
  toolbutton4.ImageIndex := 3;
  SetMPVolume(MediaPlayer1,LastVol);
end;

end;

procedure TForm1.Loop1Click(Sender: TObject);
begin
  Loop1.Checked := not Loop1.Checked;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
closemedia;
end;

procedure TForm1.Toolbar2Click(Sender: TObject);
begin
Toolbar2.Checked := not Toolbar2.Checked;
Toolbar1.Visible := Toolbar2.Checked;
end;

procedure TForm1.Trackbar2Click(Sender: TObject);
begin
Trackbar2.Checked := not Trackbar2.Checked;
panel2.Visible := TrackBar2.Checked;
end;

procedure TForm1.Statusbar2Click(Sender: TObject);
begin
Statusbar2.Checked := not Statusbar2.Checked;
Statusbar1.Visible := Statusbar2.Checked;
end;

procedure TForm1.Progressbar2Click(Sender: TObject);
begin
Progressbar2.Checked := not Progressbar2.Checked;
Progressbar1.Visible := Progressbar2.Checked;
end;

procedure TForm1.Fullscreen1Click(Sender: TObject);
var
Rect: TRect;
ImageRect: TRect;
iHeight: Integer;
iWidth: Integer;
begin
try
//full screen code here
if sFilename = '' then exit;
//ShowTaskbar(false);
//EnableTaskBar(false);
MediaPlayer1.Stop;
form1.WindowState := wsmaximized;
bFullScreen := true;
file1.Visible := false;
view1.Visible := false;
control1.Visible := false;
help1.Visible := false;
progressbar1.Visible := false;
toolbar1.Visible := false;
panel2.Visible := false;
statusbar1.Visible := false;
//form1.BorderStyle := bsnone;
//resize the video as needed
    rect.Left := 0;
    rect.Top := 0;
    rect.Bottom := screen.height;
    rect.Right := screen.width;
    ImageRect := OrginalRec;

    iheight := rect.Bottom div ImageRect.Bottom;
    iwidth := rect.right div ImageRect.right;
ImageRect.Left := 0;
ImageRect.Top := 0;
ImageRect.Right := OrginalRec.Right * iwidth;
ImageRect.bottom := OrginalRec.bottom * iheight;
pnlView.Left := 0;
pnlView.Top := 0;
pnlView.Width := ImageRect.right;
pnlView.Height := ImageRect.bottom;
pnlView.Visible := true;
MediaPlayer1.display := pnlView;
MediaPlayer1.DisplayRect := ImageRect;
FixDisplay;
MediaPlayer1.Play;

except
   on E: Exception do showmessage('Could display full screen:' + #10 + #13 + E.Message);
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
pnlView.Color := clblack;
end;

procedure TForm1.ZoomIn1Click(Sender: TObject);
begin
//zoom in
SetZoom(100,true);
end;

procedure TForm1.ZoomOut1Click(Sender: TObject);
begin
//zoom out
SetZoom(100,false);
end;

procedure TForm1.OriginalSize1Click(Sender: TObject);
begin
//original size
if sFilename = '' then exit;
pnlView.Left := 0;
pnlView.Top := 0;
pnlView.Width := OrginalRec.Right;
pnlView.Height := OrginalRec.Bottom;
MediaPlayer1.DisplayRect := OrginalRec;
FixDisplay;
end;

procedure TForm1.SetZoom(Incr: Integer;Zoomin: Boolean);
Var
Rect: TRect;
begin
if sFilename = '' then exit;

rect := MediaPlayer1.DisplayRect;
if Zoomin = true then
begin
     ZoomLevel := ZoomLevel + 1;
     Rect.Right := Rect.Right + Incr;
     Rect.Bottom := Rect.Bottom + Incr;
end
else
begin
     ZoomLevel := ZoomLevel - 1;
     Rect.Right := Rect.Right - Incr;
     Rect.Bottom := Rect.Bottom - Incr;
end;
MediaPlayer1.DisplayRect := Rect;
FixDisplay;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
if bFullScreen = true then
begin
   EndFullScreen;
end;
end;

procedure TForm1.pnlViewClick(Sender: TObject);
begin
if bFullScreen = true then
begin
   EndFullScreen;
end;
end;

procedure TForm1.pnlBackingClick(Sender: TObject);
begin
if bFullScreen = true then
begin
   EndFullScreen;
end;
end;

procedure TForm1.EndFullScreen;
begin
   //end the full screen
try
//ShowTaskbar(true);
//EnableTaskBar(true);
form1.WindowState := wsnormal;
MediaPlayer1.Stop;
bFullScreen := false;
file1.Visible := true;
view1.Visible := true;
control1.Visible := true;
help1.Visible := true;
if progressbar2.Checked then
begin
progressbar1.Visible := true;
end;
if Toolbar2.Checked then
begin
toolbar1.Visible := true;
end;
if Trackbar2.Checked then
begin
panel2.Visible := true;
end;
if Statusbar2.Checked then
begin
statusbar1.Visible := true;
end;
MediaPlayer1.Stop;
pnlView.Left := 0;
pnlView.Top := 0;
pnlView.Width := OrginalRec.Right;
pnlView.Height := OrginalRec.Bottom;
MediaPlayer1.DisplayRect := OrginalRec;
FixDisplay;
MediaPlayer1.Play;
except
   on E: Exception do showmessage('Could end full screen:' + #10 + #13 + E.Message);
end;
end;

procedure TForm1.About1Click(Sender: TObject);
begin
AboutBox.showmodal;
end;

end.