unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Buttons, Core,
LCLIntf, Math, Types, LCLtype;
type
{ TForm1 }
TForm1 = class(TForm)
ImageList1: TImageList;
OpenDialog1: TOpenDialog;
LVideoPosition: TPanel;
LVideoDuration: TPanel;
PBottom: TPanel;
SpeedButton1: TSpeedButton;
videoSeekBar: TPanel;
volumeBar: TPanel;
BOpen: TSpeedButton;
BPlay: TSpeedButton;
BPause: TSpeedButton;
BStop: TSpeedButton;
btnPrev: TSpeedButton;
btnNext: TSpeedButton;
btnVolume: TSpeedButton;
btnNextFrame: TSpeedButton;
procedure BOpenClick(Sender: TObject);
procedure BPauseClick(Sender: TObject);
procedure BPlayClick(Sender: TObject);
procedure BStopClick(Sender: TObject);
procedure btnNextFrameClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormDropFiles(Sender: TObject; const FileNames: array of string);
procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
procedure SpeedButton1Click(Sender: TObject);
procedure videoSeekBarMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure videoSeekBarPaint(Sender: TObject);
procedure volumeBarMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure volumeBarPaint(Sender: TObject);
private
procedure UpdateProgress(Sender: TObject);
procedure OpenVideo(FName: String);
procedure SetVolume(FVolume: Integer);
public
FPlayer : TEXPlayer;
FProgress, videoPosition, volumePosition : Integer;
videoDuration : Int64;
OriginalBounds: TRect;
OriginalWindowState: TWindowState;
ScreenBounds: TRect;
end;
var
Form1: TForm1;
seeking: double;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.UpdateProgress(Sender: TObject);
var
FPosition, streamPosition, streamDuration, streamStartTime : Double;
begin
if not FPlayer.Playing then Exit;
streamPosition := FPlayer.StreamPosition;
streamStartTime := FPlayer.StreamStartTime;
streamDuration := FPlayer.StreamDuration;
FPosition := streamPosition - streamStartTime;
if (streamDuration > 0) then
begin
videoDuration := Trunc(streamDuration * FProgress);
videoPosition := 0;
LVideoDuration.Caption := FormatDateTime('hh:nn:ss', streamDuration / 86400);
if FPosition >= 0 then
begin
LVideoPosition.Caption := FormatDateTime('hh:nn:ss', FPosition / 86400);
videoPosition := Trunc(FPosition * FProgress);
videoSeekBar.Invalidate;
end else
begin
LVideoPosition.Caption := '00:00:00';
videoPosition := 0;
end;
end else
begin
videoPosition := 0;
videoDuration := 0;
LVideoPosition.Caption := '';
LVideoDuration.Caption := '';
end;
end;
procedure TForm1.OpenVideo(FName: String);
begin
FPlayer.Stop;
FPlayer.Url := FName;
Form1.Caption := ExtractFileName(FName);
FPlayer.Play;
FPlayer.AudioVolume := volumePosition;
end;
procedure TForm1.SetVolume(FVolume: Integer);
begin
if FVolume < 0 then
volumePosition := 0
else if FVolume > 100 then
volumePosition := 100;
FPlayer.AudioVolume := FVolume;
case (FVolume) of
51..100: btnVolume.ImageIndex := 7;
1..50: btnVolume.ImageIndex := 8;
0: btnVolume.ImageIndex := 9;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
volumePosition := 100;
videoPosition := 0;
videoDuration := 100;
FProgress := 1000;
FPlayer := TEXPlayer.Create(nil);
with FPlayer do
begin
Align := alClient;
OnProgress := @Self.UpdateProgress;
Parent := Self;
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FreeAndNil(FPlayer);
end;
procedure TForm1.FormDropFiles(Sender: TObject; const FileNames: array of string);
begin
OpenVideo(FileNames[0]);
end;
procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
volumePosition := volumePosition + EnsureRange(WheelDelta, -4, 4);
volumeBar.Invalidate;
SetVolume(volumePosition);
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
var
png: TCustomBitmap;
begin
ImageList1.Clear;
ImageList1.Width:= 32;
ImageList1.Height:= 32;
png := TPortableNetworkGraphic.Create;
try
png.LoadFromFile(Application.Location + 'pasek.png');
ImageList1.AddSliced(png, 11, 1);
finally
png.Free;
end;
end;
procedure TForm1.BOpenClick(Sender: TObject);
begin
if not OpenDialog1.Execute then Exit;
OpenVideo(OpenDialog1.FileName);
end;
procedure TForm1.videoSeekBarMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if (ssLeft in Shift) then
begin
FPlayer.Seek((X * videoDuration) div videoSeekBar.Width / FProgress, false);
end;
end;
procedure TForm1.videoSeekBarPaint(Sender: TObject);
var
R : TRect;
begin
with videoSeekBar, Canvas do
begin
Brush.Color := clWhite;
//Pen.Color := RGB(58, 40, 76);
//Rectangle(0, 0, videoSeekBar.Width, videoSeekBar.Height);
R := Rect(0, 0, videoSeekBar.Width * videoPosition div videoDuration, videoSeekBar.Height);
Brush.Color := RGB(48, 48, 48);
FillRect(R);
end;
end;
procedure TForm1.volumeBarMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if (ssLeft in Shift) then
begin
volumePosition := Round(X * 100 / volumeBar.Width);
volumeBar.Invalidate;
SetVolume(volumePosition);
end;
end;
procedure TForm1.volumeBarPaint(Sender: TObject);
var
R : TRect;
begin
with volumeBar, Canvas do
begin
Brush.Color := clWhite;
Pen.Color := RGB(58, 40, 76);
Rectangle(0, 0, volumeBar.Width, volumeBar.Height);
R := Rect(1, 1, volumeBar.Width * volumePosition div 100, volumeBar.Height -1);
Brush.Color := RGB(58, 40, 76);
FillRect(R);
end;
end;
procedure TForm1.BPlayClick(Sender: TObject);
begin
if not FPlayer.Playing then
begin
FPlayer.Play;
end else
begin
FPlayer.Resume;
end;
if not FPlayer.Playing then ShowMessage('Brak pliku do odtworzenia');
Exit;
end;
procedure TForm1.BPauseClick(Sender: TObject);
begin
FPlayer.Pause;
end;
procedure TForm1.BStopClick(Sender: TObject);
begin
FPlayer.Stop;
videoPosition := 0;
videoSeekBar.Invalidate;
end;
procedure TForm1.btnNextFrameClick(Sender: TObject);
begin
if BorderStyle <> bsNone then begin
// To full screen
OriginalWindowState := WindowState;
OriginalBounds := BoundsRect;
BorderStyle := bsNone;
BoundsRect := Screen.MonitorFromWindow(Handle).BoundsRect;
end else begin
// From full screen
BorderStyle := bsSizeable;
if OriginalWindowState = wsMaximized then
WindowState := wsMaximized
else
BoundsRect := OriginalBounds;
end;
end;
end.
Recent
