📄 flashplayer.~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 + -