⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 flashplayer.~pas

📁 关于DEPHI7.0的播放器管理系统源代码
💻 ~PAS
字号:
unit Flashplayer;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ComCtrls, ToolWin, OleCtrls, ShockwaveFlashObjects_TLB,
  StdCtrls, Menus, ActnList;

type
  TFormFlashPlayer = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Splitter1: TSplitter;
    BTNPause: TButton;
    BTNPlay: TButton;
    BTNAdd: TButton;
    BTNClear: TButton;
    BTNHide: TButton;
    BTNFulldisplay: TButton;
    PopupMenu1: TPopupMenu;
    ShockwaveFlash1: TShockwaveFlash;
    PopAbout: TMenuItem;
    N1: TMenuItem;
    PopList: TMenuItem;
    PopAdd: TMenuItem;
    N3: TMenuItem;
    PopClear: TMenuItem;
    N4: TMenuItem;
    Popexit: TMenuItem;
    PopPlay: TMenuItem;
    PopStop: TMenuItem;
    ListBox1: TListBox;
    ActionList1: TActionList;
    ActionAdd: TAction;
    ActionClear: TAction;
    ActionPlay: TAction;
    ActionStop: TAction;
    OpenDialog1: TOpenDialog;
    CoolBar4: TCoolBar;
    ToolBar4: TToolBar;
    Label1: TLabel;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    BTNSave: TButton;
    SaveDialog1: TSaveDialog;
    BTNOpen: TButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    BTNClose: TButton;
    ActionOpen: TAction;
    ActionSave: TAction;
    Button1: TButton;
    ListBox2: TListBox;
    ActionClose: TAction;
    procedure ActionAddExecute(Sender: TObject);
    procedure BTNHideClick(Sender: TObject);
    procedure BTNFulldisplayClick(Sender: TObject);
    procedure ActionClearExecute(Sender: TObject);
    procedure ActionSaveExecute(Sender: TObject);
    procedure ActionOpenExecute(Sender: TObject);
    procedure ListBoxScrollar(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ActionPlayExecute(Sender: TObject);
    procedure ActionStopExecute(Sender: TObject);
    procedure ActionCloseExecute(Sender: TObject);
    procedure PopAboutClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormFlashPlayer: TFormFlashPlayer;
  JlrFIle : Textfile;
  FlashFrames : Integer;

implementation
uses about;
{$R *.dfm}

procedure TFormFlashPlayer.ListBoxScrollar(Sender: TObject);
var
i, MaxWidth: integer; 
begin 
  MaxWidth := 0;
  for i := 0 to ListBox1.Items.Count - 1 do
    if MaxWidth < ListBox1.Canvas.TextWidth(ListBox1.Items.Strings[i]) then
       MaxWidth := ListBox1.Canvas.TextWidth(ListBox1.Items.Strings[i]);
  SendMessage(ListBox1.Handle, LB_SETHORIZONTALEXTENT, MaxWidth+20, 0);
end;


procedure TFormFlashPlayer.ActionAddExecute(Sender: TObject);
var i : Integer;
FileTemp : String;
begin
  OpenDialog1.Title := '请选取Flash(*.swf)文件,一次可选择多个文件';
  OpenDialog1.Filter := 'Flash文件(*.swf)|*.swf';
  if OpenDialog1.Execute then
     begin
       for i:= 0 to OpenDialog1.Files.Count -1 do
          begin
            FileTemp := OpenDialog1.Files.Strings[i];
            ListBox1.Items.Add(FileTemp);
          end;
     end;
ListBoxScrollar(Sender);
end;

procedure TFormFlashPlayer.BTNHideClick(Sender: TObject);
begin
Panel1.Visible := not Panel1.Visible;
end;

procedure TFormFlashPlayer.BTNFulldisplayClick(Sender: TObject);
begin
FormFlashPlayer.WindowState := wsMaximized;
FormFlashPlayer.Refresh;
Panel1.Visible := False;
Panel2.Repaint;
ShockwaveFlash1.Repaint;
end;

procedure TFormFlashPlayer.ActionClearExecute(Sender: TObject);
begin
if ShockwaveFlash1.Playing and (ListBox1.Items[ListBox1.ItemIndex] = ShockwaveFlash1.Movie)then
     begin
       ShockwaveFlash1.Stop;
       ShockwaveFlash1.FreeOnRelease;
       FormFlashPlayer.Refresh;
     end;
ListBox1.Clear;
end;

procedure TFormFlashPlayer.ActionSaveExecute(Sender: TObject);
var i: Integer;
FileTemp : String;
begin
   if ListBox1.Items.Count <= 0 then exit;
   SaveDialog1.Title := '请输入要保存的文件名,以.jlr结束';
   if SaveDialog1.Execute then
   try
     begin
       assignFile(JlrFile, SaveDialog1.FileName);
       rewrite(JlrFile);
         try
           for i :=0 to ListBox1.Items.Count -1 do
              begin
                FileTemp := ListBox1.Items.Strings[i];
                writeln(JlrFile, FileTemp);
              end;
         finally
           CloseFile(JlrFile);
         end;
     end;
   except
     showmessage('无法保存此文件!');
   end;
end;

procedure TFormFlashPlayer.ActionOpenExecute(Sender: TObject);
var
FileTemp : String;
begin
  OpenDialog1.Title := '请选取Flash列表(*.jlr)文件';
  OpenDialog1.Filter := 'Flash列表(*.jlr)|*.jlr';
  if OpenDialog1.Execute then
     if OpenDialog1.FileName <> '' then
     try
       assignFile(JlrFile, OpenDialog1.FileName);
       reset(JlrFile);
         try
           while not Eof(JlrFile) do
            begin
             readln(JlrFile, FileTemp);
             ListBox1.Items.Add(FileTemp);
            end;
         finally
           CloseFile(JlrFile);
         end;
    except
     showmessage('无法打开此文件!');
    end;
ListBoxScrollar(Sender);
end;

procedure TFormFlashPlayer.Button1Click(Sender: TObject);
var i : Integer;
begin
if ShockwaveFlash1.Playing and (ListBox1.Items[ListBox1.ItemIndex] = ShockwaveFlash1.Movie)then
     begin
       ShockwaveFlash1.Stop;
       ShockwaveFlash1.FreeOnRelease;
       FormFlashPlayer.Refresh;
     end;
if ListBox1.ItemIndex <> -1 then
  begin
  for i := Listbox1.Items.Count - 1 downto 0 do
     if Listbox1.selected[i] then
      begin
       Listbox2.items.add(Listbox1.items[i]);
       Listbox1.items.delete(i);
      end;
  ListBoxScrollar(Sender);
  end;
end;

procedure TFormFlashPlayer.ActionPlayExecute(Sender: TObject);
Var i: Integer;
FileTemp : String;
begin
  if ListBox1.Items.Count > 0 then
    begin
       i := ListBox1.ItemIndex;
       FileTemp := ListBox1.Items[i];
       if ShockwaveFlash1.Playing and (FileTemp = ShockwaveFlash1.Movie)
            then exit;
       ShockwaveFlash1.StopPlay;
       ShockwaveFlash1.Movie := FileTemp;
       ShockwaveFlash1.Play;
         while shockwaveFlash1.CurrentFrame = shockwaveFlash1.TotalFrames do
             begin
               i := ListBox1.ItemIndex;
               ShockwaveFlash1.Stop;
               if i <= (ListBox1.Items.Count - 1) then
                  begin
                    i := i+1;
                   end
               else
                  begin
                   i := 0;
                  end;
               ListBox1.ItemIndex := i;
               FileTemp := ListBox1.Items[i];
               ShockwaveFlash1.Movie := FileTemp;
               ShockwaveFlash1.Play;
             end;

   end;
end;

procedure TFormFlashPlayer.ActionStopExecute(Sender: TObject);
begin
   if ShockwaveFlash1.Playing then
      begin
        ShockwaveFlash1.Stop;
        FlashFrames := ShockwaveFlash1.CurrentFrame;
      end;
end;

procedure TFormFlashPlayer.ActionCloseExecute(Sender: TObject);
begin
  if ShockwaveFlash1.Playing then
     begin
       ShockwaveFlash1.Stop;
       ShockwaveFlash1.FreeOnRelease;
       FormFlashPlayer.Refresh;
     end;
  close;
end;

procedure TFormFlashPlayer.PopAboutClick(Sender: TObject);
begin
  FormAbout.Show;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -