Delphi FMX メディアプレイヤー miniDPlay ソースコード ― 2022年08月26日 11:46
unit Unit1;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Media,
FMX.StdCtrls, FMX.Controls.Presentation, FMX.Media.Win, FMX.Edit, FMX.ExtCtrls,
FMX.Memo.Types, FMX.ScrollBox, FMX.Memo, FMX.Platform, FMX.Layouts,
FMX.ListBox, FMX.Objects, FMX.Effects,System.IOUtils, FMX.DialogService,
Winapi.Windows;
type
TForm1 = class(TForm)
StatusBar1: TStatusBar;
Panel1: TPanel;
OpenDialog1: TOpenDialog;
MediaPlayer1: TMediaPlayer;
MediaPlayerControl1: TMediaPlayerControl;
Timer1: TTimer;
ListBox1: TListBox;
pnlFile: TPanel;
pnlMain: TPanel;
MediaPlayer2: TMediaPlayer;
pnlPView: TPanel;
MediaPlayerControl2: TMediaPlayerControl;
Panel2: TPanel;
btnFileOpen: TButton;
btnStopPlay: TButton;
Panel3: TPanel;
edNow: TEdit;
edNagasa: TEdit;
pnlSeek: TPanel;
TrackBar1: TTrackBar;
ProgressBar1: TProgressBar;
pnlPie: TPanel;
Pie1: TPie;
Circle1: TCircle;
Circle2: TCircle;
StyleBook1: TStyleBook;
pnlPreMei: TPanel;
lblFilDrop: TLabel;
edPRev: TEdit;
edPRevTime: TEdit;
Timer2: TTimer;
lblPrgFilmei: TLabel;
Splitter2: TSplitter;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
procedure btnStopPlayClick(Sender: TObject);
procedure btnFileOpenClick(Sender: TObject);
function filSetPlay(filmei:string):boolean;
procedure ListBox1DragOver(Sender: TObject; const Data: TDragObject;
const Point: TPointF; var Operation: TDragOperation);
procedure ListBox1DragDrop(Sender: TObject; const Data: TDragObject;
const Point: TPointF);
procedure ListBox1Change(Sender: TObject);
procedure timeKaku(var ed:Tedit; tim:Tmediatime);
procedure ProgressBar1MouseEnter(Sender: TObject);
procedure ProgressBar1MouseLeave(Sender: TObject);
procedure ProgressBar1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Single);
procedure ProgressBar1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Single);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure Pie1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Single);
procedure Pie1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
procedure Pie1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Single);
procedure zeroTank(fom:TForm; stb:TStatusbar; pnl:TPanel; pai:TPie; var zero:single; var tank:single);
procedure listFontSetei(lsb:TListbox);
procedure FormShow(Sender: TObject);
procedure ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Single);
procedure ListBox1MouseEnter(Sender: TObject);
procedure ListBox1MouseLeave(Sender: TObject);
procedure pnlFileResize(Sender: TObject);
procedure Pie1MouseEnter(Sender: TObject);
procedure Pie1MouseLeave(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure ListBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Single);
private
{ private 宣言 }
public
{ public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.fmx}
var
saigo:boolean;
genban:integer;
nagasa:single;
genDir:string;
zeroKak:single;
mauleftOn:boolean;
tankak:single;
lbxGetText:string;
volset:single;{規定ボリュームセット}
//////////////////////////////////////////////////////////////////////////////
//ゼロ角 タン角 変更
//左下45度が0で(右回りで)右下45度が270
procedure TForm1.zeroTank(fom:TForm; stb:TStatusbar; pnl:TPanel; pai:TPie; var zero, tank: single);
begin
var PtScreen,PtForm : TPointF;
var cyusinX,cyusinY : single;
var zureX,zureY : single;
cyusinX := 0;
cyusinY := 0;
PtScreen := Screen.MousePos;
PtForm := fom.ScreenToclient(PtScreen);
zureX := PtForm.x - stb.position.x - pnl.Position.x - pai.Position.x - pai.Width / 2 - cyusinX;
zureY := PtForm.y - stb.position.y - pnl.Position.y - pai.position.y - pai.Height / 2 - cyusinY;
tank := 0;
if (zureX = 0)and(zureY = 0) then begin
//
end else if (zureX = 0)and(zureY > 0) then begin
tank := 90; zero := 0;
end else if (zureX = 0)and(zureY < 0) then begin
tank := 270; zero := 135;
end else if (zureX > 0)and(zureY = 0) then begin
tank := 0; zero := 225;
end else if (zureX < 0)and(zureY = 0) then begin
tank := 180; zero := 45;
end else if (zureX > 0)and(zureY > 0) then begin
tank := arctan(zureY / zureX) * 180 / pi;
zero := 360 + tank - 135;
end else if (zureX < 0)and(zureY > 0) then begin
tank := 90 - arctan(zureX/ zureY) * 180 / pi;
zero := tank - 135;
end else if (zureX < 0)and(zureY < 0) then begin
tank := 180 + arctan(zureY/ zureX) * 180 / pi;
zero := tank - 135;
end else if (zureX > 0)and(zureY < 0) then begin
tank := 270 - arctan(zureX/ zureY) * 180 / pi;
zero := tank - 135;
end;
end;
procedure TForm1.listFontSetei(lsb: TListbox);
begin
var i:integer;
for i:=0 to Lsb.Items.Count-1 do begin
Lsb.ListItems[i].StyledSettings:=[]; // 全部反映される
with Lsb.ListItems[i].Font do begin
Family := 'Meiryo';
Lsb.Listitems[i].TextSettings.FontColor := TAlphaColorRec.white;//TAlphaColorRec.Blue; //$FFDDDDDD;
Size := 11;
end;
end;
end;
procedure TForm1.btnFileOpenClick(Sender: TObject);
begin
if opendialog1.Execute then begin
genDir := extractfilePath(opendialog1.filename);
listbox1.Items.Clear;
listbox1.items.Add(extractfilename(opendialog1.filename));
//listFontSetei(Listbox1);
genban := 0;
lblFilDrop.Visible := false;
timer1.Enabled := false;
timer2.Enabled := false;
listbox1.ItemIndex := genban; {リストボックスチェンジで動画スタート}
end;
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
//
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
TMediaCodecManager.RegisterMediaCodecClass('.mp4', 'mp4 Files', TMediaType.Video, TWindowsMediaCodec);
//TMediaCodecManager.RegisterMediaCodecClass('.mpg', 'mpg Files', TMediaType.Video, TWindowsMediaCodec);
OpenDialog1.Filter := TMediaCodecManager.GetFilterString ;
end;
procedure TForm1.FormResize(Sender: TObject);
begin
//
end;
procedure TForm1.FormShow(Sender: TObject);
begin
lbxGetText := '';
timer1.Enabled := false;
timer2.Enabled := false;
end;
procedure TForm1.ListBox1Change(Sender: TObject);
begin
//if lbxMauOn then begin
genban := listbox1.ItemIndex;
if filSetPlay(genDir + '\' + listbox1.Items[genban]) = false then begin
//TDialogService.ShowMessage('FILE ERROR');
inc(genban);
if genban > listbox1.items.Count - 1 then begin
genban := 0;
listbox1.ItemIndex := 0;
listbox1.ItemIndex := 1;
listbox1.ItemIndex := 0;
end;
end;
listbox1.ItemIndex := genban;
//end;
end;
procedure TForm1.ListBox1DragDrop(Sender: TObject; const Data: TDragObject;
const Point: TPointF);
begin
var U:Tstringlist;
var D:string;
var sdmy:string;
U := Tstringlist.Create;
try
genDir := extractfilePath(data.files[0]);
listbox1.Items.Clear;
for D in data.files do begin
if TPath.hasExtension(D) then begin
U.Add(extractfilename(D)); {フォルダは除外して拡張子のあるファイルのみゲット}
end;
end;
listbox1.items.AddStrings(U);
finally
U.free;
end;
//listFontSetei(Listbox1);
genban := 0;
lblFilDrop.Visible := false;
timer1.Enabled := false;
timer2.Enabled := false;
volset := 0.5;/////////////////////////////////////////////////////////////////
listbox1.ItemIndex := genban; {リストボックスチェンジで動画スタート}
end;
procedure TForm1.ListBox1DragOver(Sender: TObject; const Data: TDragObject;
const Point: TPointF; var Operation: TDragOperation);
begin
Operation := TDragOperation.copy;
end;
procedure TForm1.ListBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Single);
begin
var gIndex:integer;
if listbox1.Items.Count = 0 then exit;
gIndex := listbox1.ItemByPoint(x,y).Index;
if gIndex = genban then begin
TDialogService.ShowMessage('すでに再生されています');
Winapi.Windows.SetCursorPos(round(form1.left+1), round(form1.top+1));
mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
end else begin
//TDialogService.ShowMessage('TIGAU'+inttostr(gIndex)+','+inttostr(genban));
end;
end;
procedure TForm1.ListBox1MouseEnter(Sender: TObject);
begin
lbxGetText := '';
end;
procedure TForm1.ListBox1MouseLeave(Sender: TObject);
begin
mediaplayer2.Clear;
lbxGetText := '';
end;
procedure TForm1.ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
begin
var gText:string;
try
gText := listbox1.ItemByPoint(x,y).Text;
edPrev.text := gText;
//TDialogService.ShowMessage('MOVE');
if gText <> lbxGetText then
mediaplayer2.FileName := genDir + '\' + gText;
mediaplayer2.Volume := 0;
mediaplayer2.play;
timer2.Enabled := true;
lbxGetText := gText;
except
//
end;
end;
//////////////////////////////////////////////////////////////////////////////
//パイ マウス ダウン
procedure TForm1.Pie1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Single);
begin
if button = TMouseButton.mbLeft then begin
zeroTank(Form1,Statusbar1,pnlPie,Pie1,zeroKak,tankak);
mauleftOn := false;
if zerokak <= 0 then begin
mauleftOn := false; {左下45度よりも左下はマウスダウン認識させない}
zerokak := 0;
end else if zerokak >= 270 then begin
mauleftOn := false; {右下45度よりも右下はマウスダウン認識させない}
zerokak := 0; {もしもこの範囲でマウスダウンしたら，安全側の最小値0にする}
end else begin
mauleftOn := true; {左下45度から右回りで右下45度の範囲のみマウスダウン認識}
end;
end;
end;
procedure TForm1.Pie1MouseEnter(Sender: TObject);
begin
with pie1.fill do begin
Kind := TBrushkind.Gradient;
Gradient.Color := Talphacolorrec.Gold; //.Darkgoldenrod;
Gradient.Color1 := $FF555555;
Gradient.Style := TGradientStyle.gsRadial ;
Color := Talphacolorrec.Darkgoldenrod;
end;
end;
procedure TForm1.Pie1MouseLeave(Sender: TObject);
begin
with pie1.fill do begin
Kind := TBrushkind.Solid;
Color := $FF555555;
end;
end;
//////////////////////////////////////////////////////////////////////////////
//パイ マウス ムーブ
procedure TForm1.Pie1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
begin
if mauLeftOn then begin
zeroTank(Form1,Statusbar1,pnlPie,Pie1,zeroKak,tankak);
if zerokak <= 0 then begin
mauleftOn := false;
zerokak := 0;
tankak := 135;
end else if zerokak >= 270 then begin
mauleftOn := false;
zerokak := 270;
tankak := 45;
end;
Pie1.RotationAngle := zerokak; {OK}
try
mediaplayer1.Volume := zerokak / 270; {ボリューム OK}
volset := mediaplayer1.Volume;
except
//
end;
end;
end;
///////////////////////////////////////////////////////////////////////////////
//パイ マウス アップ
procedure TForm1.Pie1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Single);
begin
mauLeftOn := false;
end;
procedure TForm1.pnlFileResize(Sender: TObject);
begin
pnlPView.Height := pnlFile.Width * 0.5625; {16:9}
end;
procedure TForm1.ProgressBar1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Single);
begin
trackbar1.value := progressbar1.max * x / progressbar1.width;
end;
procedure TForm1.ProgressBar1MouseEnter(Sender: TObject);
begin
try
mediaplayer2.FileName := genDir + '\' + listbox1.Selected.Text;
timer2.Enabled :=true;
edPRev.text := listbox1.Selected.Text;
except
//
end;
end;
procedure TForm1.ProgressBar1MouseLeave(Sender: TObject);
begin
mediaplayer2.Clear;
end;
procedure TForm1.ProgressBar1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
begin
try
mediaplayer2.Volume := 0;
mediaplayer2.CurrentTime := round(Progressbar1.max * x / progressbar1.width * mediatimescale);
mediaplayer2.play;
except
//
end;
end;
procedure TForm1.timeKaku(var ed: Tedit; tim: Tmediatime);
begin
var DurationMin, DurationSec: integer;
DurationMin := tim div 10000 div 60000;
DurationSec := tim div 10000 mod 60000 div 1000;
ed.Text := IntToStr(DurationMin) + ':' + IntToStr(DurationSec);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
try
with mediaplayer1 do begin
progressbar1.Value := CurrentTime / mediatimescale;
timeKaku(edNow,CurrentTime);
if Duration = CurrentTime then saigo := true;
end;
except
//
end;
if saigo then begin
saigo := false;
timer1.Enabled := false;
sleep(500);
inc(genban);
if genban > listbox1.Items.Count - 1 then begin
genban := 0;
//mediaplayer1.Stop;
end;
listbox1.ItemIndex := genban; {リストボックスチェンジで動画スタート}
end;
//listFontSetei(listbox1);
end;
procedure TForm1.Timer2Timer(Sender: TObject);
begin
timeKaku(edPRevTime,mediaplayer2.CurrentTime);
end;
procedure TForm1.TrackBar1Change(Sender: TObject);
begin
try
mediaplayer1.CurrentTime := round(trackbar1.Value * mediatimescale);
mediaplayer1.play;
except
//
end;
end;
procedure TForm1.btnStopPlayClick(Sender: TObject);
begin
try
with mediaplayer1 do begin
if State = TmediaState.Unavailable then begin
timer1.Enabled := false;
end else if State = TmediaState.Playing then begin
Stop;
timer1.Enabled := false;
end else if state = TmediaState.Stopped then begin
Play;
timer1.Enabled := true;
end;
end;
except
//
end;
end;
function TForm1.filSetPlay(filmei: string):boolean;
begin
var sdmy:string;
//listFontSetei(listbox1);
result := true;
try
if mediaplayer1.FileName = filmei then exit;
mediaplayer1.FileName := filmei;
sdmy := filmei + ' ('+ FloatToStr(MediaPlayer1.VideoSize.X) + 'x' +
FloatToStr(MediaPlayer1.VideoSize.Y) + ')';
form1.caption := sdmy;
sdmy := extractfilename(filmei);
lblPrgFilmei.Text := sdmy;
mediaplayer1.play;
timer1.Enabled := true;
except
result := false;//ShowMessageFmt('%s', ['メディアファイルを開けませんでした']);
end;
mediaplayer1.Volume := volset;////////////////////////////////////////////////////////////////////
pie1.RotationAngle := 270 * mediaplayer1.Volume;
try
nagasa := mediaplayer1.Duration / mediatimescale;
with trackbar1 do begin Min := 0; Max := nagasa; Value := 0; end;
with ProgressBar1 do begin Min := 0; Max := nagasa; Value := 0; end;
timekaku(edNagasa,mediaplayer1.Duration);
except
//
end;
end;
end.
コメント
トラックバック
このエントリのトラックバックURL: http://tukasa.asablo.jp/blog/2022/08/26/9520868/tb
