Playsound package - more linux play commands
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3560 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
gbamber
parent
04929ac56f
commit
35ee9ccb27
@ -6,65 +6,69 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs
|
||||
,FileUtil{$IFDEF WINDOWS},mmsystem{$ELSE},asyncprocess,process{$ENDIF},aboutplaysound;
|
||||
, FileUtil{$IFDEF WINDOWS}, mmsystem{$ELSE}, asyncprocess, process{$ENDIF}, aboutplaysound;
|
||||
|
||||
type
|
||||
TPlayStyle = (psAsync,psSync);
|
||||
TPlayStyle = (psAsync, psSync);
|
||||
|
||||
Tplaysound = class(TAboutPlaySound)
|
||||
private
|
||||
{ Private declarations }
|
||||
{$IFDEF LINUX}
|
||||
SoundPlayerAsyncProcess:Tasyncprocess;
|
||||
SoundPlayerSyncProcess:Tprocess;
|
||||
SoundPlayerAsyncProcess: Tasyncprocess;
|
||||
SoundPlayerSyncProcess: Tprocess;
|
||||
{$ENDIF}
|
||||
fPathToSoundFile:String;
|
||||
fPlayStyle:TPlayStyle;
|
||||
fPathToSoundFile: string;
|
||||
fPlayStyle: TPlayStyle;
|
||||
protected
|
||||
{ Protected declarations }
|
||||
procedure PlaySound(Const szSoundFilename:String); virtual;
|
||||
procedure PlaySound(const szSoundFilename: string); virtual;
|
||||
public
|
||||
{ Public declarations }
|
||||
Constructor Create(AOwner: TComponent); override;
|
||||
Destructor Destroy; reintroduce;
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; reintroduce;
|
||||
procedure Execute;
|
||||
published
|
||||
{ Published declarations }
|
||||
Property SoundFile:String read fPathToSoundFile write fPathToSoundFile;
|
||||
Property PlayStyle:TPlayStyle read fPlayStyle write fPlayStyle default psASync;
|
||||
property SoundFile: string read fPathToSoundFile write fPathToSoundFile;
|
||||
property PlayStyle: TPlayStyle read fPlayStyle write fPlayStyle default psASync;
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
|
||||
implementation
|
||||
|
||||
{$IFDEF LINUX}
|
||||
CONST // Defined in mmsystem
|
||||
SND_SYNC=0;
|
||||
SND_ASYNC=1;
|
||||
SND_NODEFAULT=2;
|
||||
const // Defined in mmsystem
|
||||
SND_SYNC = 0;
|
||||
SND_ASYNC = 1;
|
||||
SND_NODEFAULT = 2;
|
||||
{$ENDIF}
|
||||
resourcestring
|
||||
C_UnableToPlay = 'Unable to play ';
|
||||
Constructor Tplaysound.Create(AOwner: TComponent);
|
||||
|
||||
constructor Tplaysound.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
fPlayStyle:=psASync;
|
||||
fPathToSoundFile:=ProgramDirectory;
|
||||
fPlayStyle := psASync;
|
||||
fPathToSoundFile := ProgramDirectory;
|
||||
|
||||
// About Dialog properties
|
||||
AboutBoxComponentName:='PlaySound';
|
||||
AboutBoxWidth:=400;
|
||||
AboutBoxHeight:=400;
|
||||
AboutBoxBackgroundColor:=clCream;
|
||||
AboutBoxComponentName := 'PlaySound';
|
||||
AboutBoxWidth := 400;
|
||||
AboutBoxHeight := 400;
|
||||
AboutBoxBackgroundColor := clCream;
|
||||
//AboutBoxFontName (string)
|
||||
//AboutBoxFontSize (integer)
|
||||
AboutBoxVersion:='0.0.1';
|
||||
AboutBoxAuthorname:='Gordon Bamber';
|
||||
AboutBoxOrganisation:='Public Domain';
|
||||
AboutBoxAuthorEmail:='minesadorada@charcodelvalle.com';
|
||||
AboutBoxLicenseType:='LGPL';
|
||||
AboutBoxDescription:='Plays WAVE sounds in Windows or Linux';
|
||||
AboutBoxVersion := '0.0.2';
|
||||
AboutBoxAuthorname := 'Gordon Bamber';
|
||||
AboutBoxOrganisation := 'Public Domain';
|
||||
AboutBoxAuthorEmail := 'minesadorada@charcodelvalle.com';
|
||||
AboutBoxLicenseType := 'LGPL';
|
||||
AboutBoxDescription := 'Plays WAVE sounds in Windows or Linux';
|
||||
end;
|
||||
Destructor Tplaysound.Destroy;
|
||||
|
||||
destructor Tplaysound.Destroy;
|
||||
begin
|
||||
{$IFDEF LINUX}
|
||||
FreeAndNil(SoundPlayerSyncProcess);
|
||||
@ -72,75 +76,120 @@ begin
|
||||
{$ENDIF}
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure Tplaysound.Execute;
|
||||
begin
|
||||
If Not FileExistsUTF8(fPathToSoundFile) then Exit;
|
||||
if not FileExistsUTF8(fPathToSoundFile) then
|
||||
Exit;
|
||||
PlaySound(fPathToSoundFile);
|
||||
end;
|
||||
|
||||
procedure Tplaysound.PlaySound(Const szSoundFilename:String);
|
||||
Var
|
||||
flags:Word;
|
||||
linuxplaycommand:String;
|
||||
procedure Tplaysound.PlaySound(const szSoundFilename: string);
|
||||
var
|
||||
flags: word;
|
||||
szNonWindowsPlayCommand: string;
|
||||
begin
|
||||
linuxplaycommand:='';
|
||||
szNonWindowsPlayCommand := '';
|
||||
{$IFDEF WINDOWS}
|
||||
If fPlayStyle = psASync then flags:=SND_ASYNC OR SND_NODEFAULT
|
||||
else flags:=SND_SYNC OR SND_NODEFAULT;
|
||||
TRY
|
||||
sndPlaySound(PChar(szSoundFilename),flags);
|
||||
except
|
||||
ShowMessage(C_UnableToPlay + szSoundFilename);
|
||||
end;
|
||||
if fPlayStyle = psASync then
|
||||
flags := SND_ASYNC or SND_NODEFAULT
|
||||
else
|
||||
flags := SND_SYNC or SND_NODEFAULT;
|
||||
try
|
||||
sndPlaySound(PChar(szSoundFilename), flags);
|
||||
except
|
||||
ShowMessage(C_UnableToPlay + szSoundFilename);
|
||||
end;
|
||||
{$ELSE}
|
||||
// How to play in Linux? Use generic Linux commands
|
||||
// Use asyncprocess to play sound as SND_ASYNC
|
||||
|
||||
// Try play
|
||||
If (FindDefaultExecutablePath('play') <> '') then linuxplaycommand:='play';
|
||||
// Try aplay
|
||||
If (linuxplaycommand='') then
|
||||
If (FindDefaultExecutablePath('aplay') <> '') Then linuxplaycommand:='aplay';
|
||||
// Try paplay
|
||||
If (linuxplaycommand='') then
|
||||
If (FindDefaultExecutablePath('paplay') <> '') Then linuxplaycommand:='paplay';
|
||||
// proceed if we managed to find a valid command
|
||||
If (linuxplaycommand <> '') then
|
||||
BEGIN
|
||||
If fPlayStyle = psASync then
|
||||
begin
|
||||
If SoundPlayerAsyncProcess=Nil then SoundPlayerAsyncProcess:=Tasyncprocess.Create(Nil);
|
||||
SoundPlayerAsyncProcess.CurrentDirectory:=ExtractFileDir(szSoundFilename);
|
||||
SoundPlayerAsyncProcess.Executable:=FindDefaultExecutablePath(linuxplaycommand);
|
||||
SoundPlayerAsyncProcess.Parameters.Clear;
|
||||
SoundPlayerAsyncProcess.Parameters.Add(szSoundFilename);
|
||||
TRY
|
||||
SoundPlayerAsyncProcess.Execute;
|
||||
except
|
||||
ShowMessage('Playstyle=paASync: ' + C_UnableToPlay + szSoundFilename);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
If SoundPlayerSyncProcess=Nil then SoundPlayerSyncProcess:=Tprocess.Create(Nil);
|
||||
SoundPlayerSyncProcess.CurrentDirectory:=ExtractFileDir(szSoundFilename);
|
||||
SoundPlayerSyncProcess.Executable:=FindDefaultExecutablePath(linuxplaycommand);
|
||||
SoundPlayersyncProcess.Parameters.Clear;
|
||||
SoundPlayerSyncProcess.Parameters.Add(szSoundFilename);
|
||||
TRY
|
||||
SoundPlayerSyncProcess.Execute;
|
||||
SoundPlayersyncProcess.WaitOnExit;
|
||||
except
|
||||
ShowMessage('Playstyle=paSyncSync: ' + C_UnableToPlay + szSoundFilename);
|
||||
end;
|
||||
end;
|
||||
END;
|
||||
// How to play in Linux? Use generic Linux commands
|
||||
// Use asyncprocess to play sound as SND_ASYNC
|
||||
// Try play
|
||||
if (FindDefaultExecutablePath('play') <> '') then
|
||||
szNonWindowsPlayCommand := 'play';
|
||||
// Try aplay
|
||||
if (szNonWindowsPlayCommand = '') then
|
||||
if (FindDefaultExecutablePath('aplay') <> '') then
|
||||
szNonWindowsPlayCommand := 'aplay -q ';
|
||||
// Try paplay
|
||||
if (szNonWindowsPlayCommand = '') then
|
||||
if (FindDefaultExecutablePath('paplay') <> '') then
|
||||
szNonWindowsPlayCommand := 'paplay';
|
||||
// Try mplayer
|
||||
if (szNonWindowsPlayCommand = '') then
|
||||
if (FindDefaultExecutablePath('mplayer') <> '') then
|
||||
szNonWindowsPlayCommand := 'mplayer -really-quiet ';
|
||||
// Try CMus
|
||||
if (szNonWindowsPlayCommand = '') then
|
||||
if (FindDefaultExecutablePath('CMus') <> '') then
|
||||
szNonWindowsPlayCommand := 'CMus ';
|
||||
// Try pacat
|
||||
if (szNonWindowsPlayCommand = '') then
|
||||
if (FindDefaultExecutablePath('pacat') <> '') then
|
||||
szNonWindowsPlayCommand := 'pacat -p ';
|
||||
// Try ffplay
|
||||
if (szNonWindowsPlayCommand = '') then
|
||||
if (FindDefaultExecutablePath('ffplay') <> '') then
|
||||
szNonWindowsPlayCommand := 'ffplay -autoexit -nodisp ';
|
||||
// Try cvlc
|
||||
if (szNonWindowsPlayCommand = '') then
|
||||
if (FindDefaultExecutablePath('cvlc') <> '') then
|
||||
szNonWindowsPlayCommand := 'cvlc -q --play-and-exit ';
|
||||
// Try canberra-gtk-play
|
||||
if (szNonWindowsPlayCommand = '') then
|
||||
if (FindDefaultExecutablePath('canberra-gtk-play') <> '') then
|
||||
szNonWindowsPlayCommand := 'canberra-gtk-play -c never -f ';
|
||||
// Try Macintosh command?
|
||||
if (szNonWindowsPlayCommand = '') then
|
||||
if (FindDefaultExecutablePath('afplay') <> '') then
|
||||
szNonWindowsPlayCommand := 'afplay';
|
||||
// proceed if we managed to find a valid command
|
||||
if (szNonWindowsPlayCommand <> '') then
|
||||
begin
|
||||
if fPlayStyle = psASync then
|
||||
begin
|
||||
if SoundPlayerAsyncProcess = nil then
|
||||
SoundPlayerAsyncProcess := Tasyncprocess.Create(nil);
|
||||
SoundPlayerAsyncProcess.CurrentDirectory := ExtractFileDir(szSoundFilename);
|
||||
SoundPlayerAsyncProcess.Executable :=
|
||||
FindDefaultExecutablePath(szNonWindowsPlayCommand);
|
||||
SoundPlayerAsyncProcess.Parameters.Clear;
|
||||
SoundPlayerAsyncProcess.Parameters.Add(szSoundFilename);
|
||||
try
|
||||
SoundPlayerAsyncProcess.Execute;
|
||||
except
|
||||
On E: Exception do
|
||||
E.CreateFmt('Playstyle=paASync: ' + C_UnableToPlay +
|
||||
'%s Message:%s', [szSoundFilename, E.Message]);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if SoundPlayerSyncProcess = nil then
|
||||
SoundPlayerSyncProcess := Tprocess.Create(nil);
|
||||
SoundPlayerSyncProcess.CurrentDirectory := ExtractFileDir(szSoundFilename);
|
||||
SoundPlayerSyncProcess.Executable :=
|
||||
FindDefaultExecutablePath(szNonWindowsPlayCommand);
|
||||
SoundPlayersyncProcess.Parameters.Clear;
|
||||
SoundPlayerSyncProcess.Parameters.Add(szSoundFilename);
|
||||
try
|
||||
SoundPlayerSyncProcess.Execute;
|
||||
SoundPlayersyncProcess.WaitOnExit;
|
||||
except
|
||||
On E: Exception do
|
||||
E.CreateFmt('Playstyle=paSync: ' + C_UnableToPlay +
|
||||
'%s Message:%s', [szSoundFilename, E.Message]);
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else
|
||||
raise Exception.CreateFmt('The play command %s does not work on your system',
|
||||
[szNonWindowsPlayCommand]);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterComponents('LazControls',[Tplaysound]);
|
||||
RegisterComponents('LazControls', [Tplaysound]);
|
||||
{$I playsound_icon.lrs}
|
||||
end;
|
||||
|
||||
|
||||
@ -4,7 +4,7 @@
|
||||
<PathDelim Value="\"/>
|
||||
<Version Value="9"/>
|
||||
<BuildModes Active="Default"/>
|
||||
<Units Count="12">
|
||||
<Units Count="13">
|
||||
<Unit0>
|
||||
<Filename Value="project1.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
@ -66,31 +66,26 @@
|
||||
<Unit6>
|
||||
<Filename Value="..\..\aboutdialog\aboutboxunit.pas"/>
|
||||
<UnitName Value="AboutboxUnit"/>
|
||||
<EditorIndex Value="4"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="269"/>
|
||||
<CursorPos X="39" Y="292"/>
|
||||
<UsageCount Value="12"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit6>
|
||||
<Unit7>
|
||||
<Filename Value="..\..\..\lcl\lresources.pp"/>
|
||||
<UnitName Value="LResources"/>
|
||||
<EditorIndex Value="3"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="439"/>
|
||||
<CursorPos X="35" Y="466"/>
|
||||
<UsageCount Value="12"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit7>
|
||||
<Unit8>
|
||||
<Filename Value="..\scrollingtext.pas"/>
|
||||
<UnitName Value="ScrollingText"/>
|
||||
<IsVisibleTab Value="True"/>
|
||||
<EditorIndex Value="2"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="112"/>
|
||||
<CursorPos X="49" Y="129"/>
|
||||
<CursorPos X="45" Y="139"/>
|
||||
<UsageCount Value="12"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit8>
|
||||
@ -118,11 +113,22 @@
|
||||
<CursorPos X="1" Y="1"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit11>
|
||||
<Unit12>
|
||||
<Filename Value="..\..\multithreadprocs\mtprocs.pas"/>
|
||||
<UnitName Value="MTProcs"/>
|
||||
<IsVisibleTab Value="True"/>
|
||||
<EditorIndex Value="3"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="163"/>
|
||||
<CursorPos X="1" Y="1"/>
|
||||
<UsageCount Value="10"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit12>
|
||||
</Units>
|
||||
<General>
|
||||
<ActiveWindowIndexAtStart Value="0"/>
|
||||
</General>
|
||||
<JumpHistory Count="11" HistoryIndex="10">
|
||||
<JumpHistory Count="10" HistoryIndex="9">
|
||||
<Position1>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="33" Column="16" TopLine="1"/>
|
||||
@ -136,37 +142,33 @@
|
||||
<Caret Line="28" Column="32" TopLine="1"/>
|
||||
</Position3>
|
||||
<Position4>
|
||||
<Filename Value="..\..\..\lcl\lresources.pp"/>
|
||||
<Caret Line="2" Column="16" TopLine="1"/>
|
||||
<Filename Value="..\scrollingtext.pas"/>
|
||||
<Caret Line="166" Column="68" TopLine="140"/>
|
||||
</Position4>
|
||||
<Position5>
|
||||
<Filename Value="..\scrollingtext.pas"/>
|
||||
<Caret Line="166" Column="68" TopLine="140"/>
|
||||
<Caret Line="167" Column="1" TopLine="146"/>
|
||||
</Position5>
|
||||
<Position6>
|
||||
<Filename Value="..\scrollingtext.pas"/>
|
||||
<Caret Line="167" Column="1" TopLine="146"/>
|
||||
<Caret Line="162" Column="65" TopLine="146"/>
|
||||
</Position6>
|
||||
<Position7>
|
||||
<Filename Value="..\scrollingtext.pas"/>
|
||||
<Caret Line="162" Column="65" TopLine="146"/>
|
||||
<Caret Line="166" Column="40" TopLine="146"/>
|
||||
</Position7>
|
||||
<Position8>
|
||||
<Filename Value="..\scrollingtext.pas"/>
|
||||
<Caret Line="166" Column="40" TopLine="146"/>
|
||||
<Caret Line="156" Column="92" TopLine="146"/>
|
||||
</Position8>
|
||||
<Position9>
|
||||
<Filename Value="..\scrollingtext.pas"/>
|
||||
<Caret Line="156" Column="92" TopLine="146"/>
|
||||
<Caret Line="167" Column="1" TopLine="147"/>
|
||||
</Position9>
|
||||
<Position10>
|
||||
<Filename Value="..\scrollingtext.pas"/>
|
||||
<Caret Line="167" Column="1" TopLine="147"/>
|
||||
</Position10>
|
||||
<Position11>
|
||||
<Filename Value="..\scrollingtext.pas"/>
|
||||
<Caret Line="132" Column="1" TopLine="104"/>
|
||||
</Position11>
|
||||
</Position10>
|
||||
</JumpHistory>
|
||||
</ProjectSession>
|
||||
<EditorMacros Count="0"/>
|
||||
|
||||
@ -8,7 +8,7 @@ object Form1: TForm1
|
||||
ClientHeight = 363
|
||||
ClientWidth = 552
|
||||
Position = poDesktopCenter
|
||||
LCLVersion = '1.2.2.0'
|
||||
LCLVersion = '1.2.4.0'
|
||||
object ScrollingText1: TScrollingText
|
||||
Left = 0
|
||||
Height = 363
|
||||
@ -17,7 +17,7 @@ object Form1: TForm1
|
||||
About.Description.Strings = (
|
||||
'Component that shows a scrolling window.'#13#10'Use Lines property to set text and Active=True'#13#10'to use the component'
|
||||
)
|
||||
About.Title = 'About About ScrollingText component'
|
||||
About.Title = 'About About About ScrollingText component'
|
||||
About.Height = 280
|
||||
About.Width = 400
|
||||
About.Font.Color = clNavy
|
||||
@ -55,6 +55,7 @@ object Form1: TForm1
|
||||
'June 2014'
|
||||
)
|
||||
Font.Height = -13
|
||||
TextSource = stResource
|
||||
end
|
||||
object BitBtn1: TBitBtn
|
||||
Left = 239
|
||||
|
||||
Loading…
Reference in New Issue
Block a user