unit_formmain.pas

Flash播放器源码 Code by [e-mail] 2008-12-10 说明： 1、支持Flash文件播放时拖动进度条定位播放 2、支持屏蔽Flash右键 3、支持

unit Unit_FormMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ToolWin,
  ShockwaveFlashObjects_TLB, ImgList, ExtCtrls, AppEvnts, Menus;

type
  TFormMain = class(TForm)
    toolbar2: TToolBar;
    btn_open: TToolButton;
    dlgOpen1: TOpenDialog;
    imglst1: TImageList;
    btn2: TToolButton;
    btn_back: TToolButton;
    btn_play: TToolButton;
    btn_pause: TToolButton;
    btn8: TToolButton;
    btn_stop: TToolButton;
    btn_next: TToolButton;
    btn_zoomin: TToolButton;
    btn_zoomout: TToolButton;
    btn_fullscreen: TToolButton;
    btn_exit: TToolButton;
    btn12: TToolButton;
    btn4: TToolButton;
    pnl1: TPanel;
    TrackBar1: TTrackBar;
    tmr1: TTimer;
    appevnt1: TApplicationEvents;
    PM_Flash: TPopupMenu;
    N11: TMenuItem;
    btn1: TToolButton;
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure btn_openClick(Sender: TObject);
    procedure btn_exitClick(Sender: TObject);
    procedure btn_pauseClick(Sender: TObject);
    procedure btn_stopClick(Sender: TObject);
    procedure btn_playClick(Sender: TObject);
    procedure btn_nextClick(Sender: TObject);
    procedure btn_backClick(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure tmr1Timer(Sender: TObject);
    procedure btn_fullscreenClick(Sender: TObject);
    procedure appevnt1Message(var Msg: tagMSG; var Handled: Boolean);
    procedure btn_zoominClick(Sender: TObject);
    procedure btn_zoomoutClick(Sender: TObject);
    procedure N11Click(Sender: TObject);
  private
    procedure ReShowPlay;
    { Private declarations }
  public
    m_Player: TShockwaveFlash;
    m_FullScreenShowing: Boolean;
    procedure AcceptFiles(var msg: TMessage); message WM_DROPFILES;
    procedure PlayFile(a_strFileName: string);
    { Public declarations }
  end;

var
  FormMain: TFormMain;

implementation
uses
  ShellAPI;


{$R *.dfm}

procedure TFormMain.FormCreate(Sender: TObject);
var
  l_strCommand: string;
begin
  DragAcceptFiles(Handle, True);
  m_FullScreenShowing := False;
  m_Player := TShockwaveFlash.Create(Self);
  with m_Player do
  begin
    Parent := Self;
    Visible := True;
    Align := alClient;
  end;

  //处理参数
  if ParamCount > 0 then
  begin
    l_strCommand := Trim(Copy(CmdLine, Length(ParamStr(0)) + 4, Length(CmdLine)));
    l_strCommand := StringReplace(l_strCommand, '"', '', [rfReplaceAll]);
    l_strCommand := StringReplace(l_strCommand, '''', '', [rfReplaceAll]);
    PlayFile(l_strCommand);
  end;
end;

procedure TFormMain.FormResize(Sender: TObject);
begin
  ReShowPlay;
end;

procedure TFormMain.ReShowPlay;
begin
  ActiveControl := nil;
  ActiveControl := m_Player;
end;

procedure TFormMain.btn_openClick(Sender: TObject);
begin
  if dlgOpen1.Execute then
  begin
    PlayFile(dlgOpen1.FileName);
  end;
end;

procedure TFormMain.btn_exitClick(Sender: TObject);
begin
  Close;
end;

procedure TFormMain.btn_pauseClick(Sender: TObject);
begin
  m_Player.StopPlay;
end;

procedure TFormMain.btn_stopClick(Sender: TObject);
begin
  m_Player.Stop;
  m_Player.GotoFrame(1);
end;

procedure TFormMain.btn_playClick(Sender: TObject);
begin
  m_Player.Play;
end;

procedure TFormMain.btn_nextClick(Sender: TObject);
begin
  if m_Player.CurrentFrame >= m_Player.TotalFrames then Exit;
  m_Player.GotoFrame(m_Player.CurrentFrame + 10);
end;

procedure TFormMain.btn_backClick(Sender: TObject);
begin
  if m_Player.CurrentFrame <= 1 then Exit;
  m_Player.GotoFrame(m_Player.CurrentFrame - 10);
end;

procedure TFormMain.TrackBar1Change(Sender: TObject);
begin
  if not SameText(Trim(m_Player.Movie), '') then
  begin
    m_Player.GotoFrame(TrackBar1.Position);
  end;
end;

procedure TFormMain.tmr1Timer(Sender: TObject);
begin
  tmr1.Enabled := False;
  TrackBar1.OnChange := nil;
  if (m_Player.ReadyState = 4) then
  begin
    if (m_Player.CurrentFrame >= m_Player.TotalFrames - 1) then
    begin
      m_Player.GotoFrame(1);
    end;
  end;
  TrackBar1.Position := m_Player.CurrentFrame;
  TrackBar1.OnChange := TrackBar1Change;
  tmr1.Enabled := True;
end;

procedure TFormMain.btn_fullscreenClick(Sender: TObject);
begin
  if not m_FullScreenShowing then
  begin
    toolbar2.Visible := False;
    toolbar2.Align := alNone;
    SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) and not WS_CAPTION);
    if WindowState = wsMaximized then WindowState := wsNormal;
    WindowState := wsMaximized;
    BringToFront;
    m_FullScreenShowing := True;
  end
  else
  begin
    SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) or WS_CAPTION);
    WindowState := wsNormal;
    toolbar2.Visible := True;
    toolbar2.Align := alTop;
    m_FullScreenShowing := False;
  end;
  ReShowPlay;
end;

procedure TFormMain.appevnt1Message(var Msg: tagMSG; var Handled: Boolean);
begin
  if Msg.message = WM_RBUTTONDOWN then
  begin
    //显示自定义右键菜单
    PM_Flash.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y);
    Handled := True;
  end
  else if Msg.message = WM_MOUSEMOVE then
  begin
    //显示工具栏
    if (WindowState = wsMaximized) and m_FullScreenShowing then
    begin
      if Mouse.CursorPos.Y < toolbar2.Height + 5 then
      begin
        toolbar2.Visible := True;
        toolbar2.Top := 0;
        toolbar2.Width := m_Player.Width;
        toolbar2.BringToFront;
      end
      else
      begin
        toolbar2.Visible := False;
      end;
    end;
  end
  else if (Msg.message = WM_KEYDOWN) then
  begin
    //全屏处理
    if (msg.wParam = VK_ESCAPE) and m_FullScreenShowing then
    begin
      btn_fullscreen.Click;
    end
    else if (msg.wParam = VK_F11) then
    begin
      btn_fullscreen.Click;
    end
    else if msg.wParam = VK_SPACE then
    begin
      if (m_Player.ReadyState = 4) and (m_Player.IsPlaying) then
      begin
        btn_pause.Click;
      end
      else
      begin
        btn_play.Click;
      end;
    end;
  end;
end;

procedure TFormMain.btn_zoominClick(Sender: TObject);
begin
  m_Player.Zoom(120);
end;

procedure TFormMain.btn_zoomoutClick(Sender: TObject);
begin
  m_Player.Zoom(80);
end;

procedure TFormMain.AcceptFiles(var msg: TMessage);
const
  ct_MaxFileNameLen = 255;
var
  i,
    l_Count: integer;
  l_cFileName: array[0..ct_MaxFileNameLen] of char;
  l_strFileName: string;
begin
  l_Count := DragQueryFile(msg.WParam, $FFFFFFFF, l_cFileName, ct_MaxFileNameLen);
  if l_Count > 0 then
  begin
    DragQueryFile(msg.WParam, l_Count - 1, l_cFileName, ct_MaxFileNameLen);
    l_strFileName := Trim(l_cFileName);
    btn_stop.Click;
    if SameText(ExtractFileExt(l_strFileName), '.swf') then
      PlayFile(l_strFileName);
  end;
  DragFinish(msg.WParam);
end;

procedure TFormMain.PlayFile(a_strFileName: string);
begin
  m_Player.Movie := a_strFileName;
  m_Player.Menu := False; //屏蔽SWF菜单
  m_Player.WMode := 'TransParent'; //使用透明背景
  m_Player.Quality2 := 'Best'; //最高质量播放
  m_Player.Loop := False; //取消循环播放
  TrackBar1.Min := 1;
  TrackBar1.Max := m_Player.TotalFrames;
  TrackBar1.Position := 0;
  m_Player.Play;
end;

procedure TFormMain.N11Click(Sender: TObject);
var
  verNum, majorNum, minorNum, revisionNum: Integer;
begin
  verNum := m_Player.FlashVersion;
  majorNum := verNum div 65536;
  minorNum := (verNum - majorNum * 65536) div 256;
  revisionNum := verNum mod 256;
  ShowMessage('你的 Flash 播放器控件的版本号：' + IntToStr(majorNum)
    + '.' + IntToStr(minorNum) + '.' + IntToStr(revisionNum));
end;

end.