pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

Playsound package - more linux play commands

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3560 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
gbamber
2014-09-13 08:55:51 +00:00
parent 04929ac56f
commit 35ee9ccb27
3 changed files with 159 additions and 107 deletions
Download Patch File Download Diff File Expand all files Collapse all files

177
components/playsoundpackage/uplaysound.pas
View File

@ -6,65 +6,69 @@ interface
uses uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs 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 type
TPlayStyle = (psAsync,psSync); TPlayStyle = (psAsync, psSync);
Tplaysound = class(TAboutPlaySound) Tplaysound = class(TAboutPlaySound)
private private
{ Private declarations } { Private declarations }
{$IFDEF LINUX} {$IFDEF LINUX}
SoundPlayerAsyncProcess:Tasyncprocess; SoundPlayerAsyncProcess: Tasyncprocess;
SoundPlayerSyncProcess:Tprocess; SoundPlayerSyncProcess: Tprocess;
{$ENDIF} {$ENDIF}
fPathToSoundFile:String; fPathToSoundFile: string;
fPlayStyle:TPlayStyle; fPlayStyle: TPlayStyle;
protected protected
{ Protected declarations } { Protected declarations }
procedure PlaySound(Const szSoundFilename:String); virtual; procedure PlaySound(const szSoundFilename: string); virtual;
public public
{ Public declarations } { Public declarations }
Constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
Destructor Destroy; reintroduce; destructor Destroy; reintroduce;
procedure Execute; procedure Execute;
published published
{ Published declarations } { Published declarations }
Property SoundFile:String read fPathToSoundFile write fPathToSoundFile; property SoundFile: string read fPathToSoundFile write fPathToSoundFile;
Property PlayStyle:TPlayStyle read fPlayStyle write fPlayStyle default psASync; property PlayStyle: TPlayStyle read fPlayStyle write fPlayStyle default psASync;
end; end;
procedure Register; procedure Register;
implementation implementation
{$IFDEF LINUX} {$IFDEF LINUX}
CONST // Defined in mmsystem const // Defined in mmsystem
SND_SYNC=0; SND_SYNC = 0;
SND_ASYNC=1; SND_ASYNC = 1;
SND_NODEFAULT=2; SND_NODEFAULT = 2;
{$ENDIF} {$ENDIF}
resourcestring resourcestring
C_UnableToPlay = 'Unable to play '; C_UnableToPlay = 'Unable to play ';
Constructor Tplaysound.Create(AOwner: TComponent);
constructor Tplaysound.Create(AOwner: TComponent);
begin begin
inherited Create(AOwner); inherited Create(AOwner);
fPlayStyle:=psASync; fPlayStyle := psASync;
fPathToSoundFile:=ProgramDirectory; fPathToSoundFile := ProgramDirectory;
// About Dialog properties // About Dialog properties
AboutBoxComponentName:='PlaySound'; AboutBoxComponentName := 'PlaySound';
AboutBoxWidth:=400; AboutBoxWidth := 400;
AboutBoxHeight:=400; AboutBoxHeight := 400;
AboutBoxBackgroundColor:=clCream; AboutBoxBackgroundColor := clCream;
//AboutBoxFontName (string) //AboutBoxFontName (string)
//AboutBoxFontSize (integer) //AboutBoxFontSize (integer)
AboutBoxVersion:='0.0.1'; AboutBoxVersion := '0.0.2';
AboutBoxAuthorname:='Gordon Bamber'; AboutBoxAuthorname := 'Gordon Bamber';
AboutBoxOrganisation:='Public Domain'; AboutBoxOrganisation := 'Public Domain';
AboutBoxAuthorEmail:='minesadorada@charcodelvalle.com'; AboutBoxAuthorEmail := 'minesadorada@charcodelvalle.com';
AboutBoxLicenseType:='LGPL'; AboutBoxLicenseType := 'LGPL';
AboutBoxDescription:='Plays WAVE sounds in Windows or Linux'; AboutBoxDescription := 'Plays WAVE sounds in Windows or Linux';
end; end;
Destructor Tplaysound.Destroy;
destructor Tplaysound.Destroy;
begin begin
{$IFDEF LINUX} {$IFDEF LINUX}
FreeAndNil(SoundPlayerSyncProcess); FreeAndNil(SoundPlayerSyncProcess);
@ -72,75 +76,120 @@ begin
{$ENDIF} {$ENDIF}
inherited; inherited;
end; end;
procedure Tplaysound.Execute; procedure Tplaysound.Execute;
begin begin
If Not FileExistsUTF8(fPathToSoundFile) then Exit; if not FileExistsUTF8(fPathToSoundFile) then
Exit;
PlaySound(fPathToSoundFile); PlaySound(fPathToSoundFile);
end; end;
procedure Tplaysound.PlaySound(Const szSoundFilename:String); procedure Tplaysound.PlaySound(const szSoundFilename: string);
Var var
flags:Word; flags: word;
linuxplaycommand:String; szNonWindowsPlayCommand: string;
begin begin
linuxplaycommand:=''; szNonWindowsPlayCommand := '';
{$IFDEF WINDOWS} {$IFDEF WINDOWS}
If fPlayStyle = psASync then flags:=SND_ASYNC OR SND_NODEFAULT if fPlayStyle = psASync then
else flags:=SND_SYNC OR SND_NODEFAULT; flags := SND_ASYNC or SND_NODEFAULT
TRY else
sndPlaySound(PChar(szSoundFilename),flags); flags := SND_SYNC or SND_NODEFAULT;
try
sndPlaySound(PChar(szSoundFilename), flags);
except except
ShowMessage(C_UnableToPlay + szSoundFilename); ShowMessage(C_UnableToPlay + szSoundFilename);
end; end;
{$ELSE} {$ELSE}
// How to play in Linux? Use generic Linux commands // How to play in Linux? Use generic Linux commands
// Use asyncprocess to play sound as SND_ASYNC // Use asyncprocess to play sound as SND_ASYNC
// Try play
// Try play if (FindDefaultExecutablePath('play') <> '') then
If (FindDefaultExecutablePath('play') <> '') then linuxplaycommand:='play'; szNonWindowsPlayCommand := 'play';
// Try aplay // Try aplay
If (linuxplaycommand='') then if (szNonWindowsPlayCommand = '') then
If (FindDefaultExecutablePath('aplay') <> '') Then linuxplaycommand:='aplay'; if (FindDefaultExecutablePath('aplay') <> '') then
// Try paplay szNonWindowsPlayCommand := 'aplay -q ';
If (linuxplaycommand='') then // Try paplay
If (FindDefaultExecutablePath('paplay') <> '') Then linuxplaycommand:='paplay'; if (szNonWindowsPlayCommand = '') then
// proceed if we managed to find a valid command if (FindDefaultExecutablePath('paplay') <> '') then
If (linuxplaycommand <> '') then szNonWindowsPlayCommand := 'paplay';
BEGIN // Try mplayer
If fPlayStyle = psASync then 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 begin
If SoundPlayerAsyncProcess=Nil then SoundPlayerAsyncProcess:=Tasyncprocess.Create(Nil); if fPlayStyle = psASync then
SoundPlayerAsyncProcess.CurrentDirectory:=ExtractFileDir(szSoundFilename); begin
SoundPlayerAsyncProcess.Executable:=FindDefaultExecutablePath(linuxplaycommand); if SoundPlayerAsyncProcess = nil then
SoundPlayerAsyncProcess := Tasyncprocess.Create(nil);
SoundPlayerAsyncProcess.CurrentDirectory := ExtractFileDir(szSoundFilename);
SoundPlayerAsyncProcess.Executable :=
FindDefaultExecutablePath(szNonWindowsPlayCommand);
SoundPlayerAsyncProcess.Parameters.Clear; SoundPlayerAsyncProcess.Parameters.Clear;
SoundPlayerAsyncProcess.Parameters.Add(szSoundFilename); SoundPlayerAsyncProcess.Parameters.Add(szSoundFilename);
TRY try
SoundPlayerAsyncProcess.Execute; SoundPlayerAsyncProcess.Execute;
except except
ShowMessage('Playstyle=paASync: ' + C_UnableToPlay + szSoundFilename); On E: Exception do
E.CreateFmt('Playstyle=paASync: ' + C_UnableToPlay +
'%s Message:%s', [szSoundFilename, E.Message]);
end; end;
end end
else else
begin begin
If SoundPlayerSyncProcess=Nil then SoundPlayerSyncProcess:=Tprocess.Create(Nil); if SoundPlayerSyncProcess = nil then
SoundPlayerSyncProcess.CurrentDirectory:=ExtractFileDir(szSoundFilename); SoundPlayerSyncProcess := Tprocess.Create(nil);
SoundPlayerSyncProcess.Executable:=FindDefaultExecutablePath(linuxplaycommand); SoundPlayerSyncProcess.CurrentDirectory := ExtractFileDir(szSoundFilename);
SoundPlayerSyncProcess.Executable :=
FindDefaultExecutablePath(szNonWindowsPlayCommand);
SoundPlayersyncProcess.Parameters.Clear; SoundPlayersyncProcess.Parameters.Clear;
SoundPlayerSyncProcess.Parameters.Add(szSoundFilename); SoundPlayerSyncProcess.Parameters.Add(szSoundFilename);
TRY try
SoundPlayerSyncProcess.Execute; SoundPlayerSyncProcess.Execute;
SoundPlayersyncProcess.WaitOnExit; SoundPlayersyncProcess.WaitOnExit;
except except
ShowMessage('Playstyle=paSyncSync: ' + C_UnableToPlay + szSoundFilename); On E: Exception do
E.CreateFmt('Playstyle=paSync: ' + C_UnableToPlay +
'%s Message:%s', [szSoundFilename, E.Message]);
end; end;
end; end;
END; end
else
raise Exception.CreateFmt('The play command %s does not work on your system',
[szNonWindowsPlayCommand]);
{$ENDIF} {$ENDIF}
end; end;
procedure Register; procedure Register;
begin begin
RegisterComponents('LazControls',[Tplaysound]); RegisterComponents('LazControls', [Tplaysound]);
{$I playsound_icon.lrs} {$I playsound_icon.lrs}
end; end;

42
components/scrolltext/exampleapp/project1.lps
View File

@ -4,7 +4,7 @@
<PathDelim Value="\"/> <PathDelim Value="\"/>
<Version Value="9"/> <Version Value="9"/>
<BuildModes Active="Default"/> <BuildModes Active="Default"/>
<Units Count="12"> <Units Count="13">
<Unit0> <Unit0>
<Filename Value="project1.lpr"/> <Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
@ -66,31 +66,26 @@
<Unit6> <Unit6>
<Filename Value="..\..\aboutdialog\aboutboxunit.pas"/> <Filename Value="..\..\aboutdialog\aboutboxunit.pas"/>
<UnitName Value="AboutboxUnit"/> <UnitName Value="AboutboxUnit"/>
<EditorIndex Value="4"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="269"/> <TopLine Value="269"/>
<CursorPos X="39" Y="292"/> <CursorPos X="39" Y="292"/>
<UsageCount Value="12"/> <UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit6> </Unit6>
<Unit7> <Unit7>
<Filename Value="..\..\..\lcl\lresources.pp"/> <Filename Value="..\..\..\lcl\lresources.pp"/>
<UnitName Value="LResources"/> <UnitName Value="LResources"/>
<EditorIndex Value="3"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="439"/> <TopLine Value="439"/>
<CursorPos X="35" Y="466"/> <CursorPos X="35" Y="466"/>
<UsageCount Value="12"/> <UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit7> </Unit7>
<Unit8> <Unit8>
<Filename Value="..\scrollingtext.pas"/> <Filename Value="..\scrollingtext.pas"/>
<UnitName Value="ScrollingText"/> <UnitName Value="ScrollingText"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="2"/> <EditorIndex Value="2"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="112"/> <TopLine Value="112"/>
<CursorPos X="49" Y="129"/> <CursorPos X="45" Y="139"/>
<UsageCount Value="12"/> <UsageCount Value="12"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit8> </Unit8>
@ -118,11 +113,22 @@
<CursorPos X="1" Y="1"/> <CursorPos X="1" Y="1"/>
<UsageCount Value="10"/> <UsageCount Value="10"/>
</Unit11> </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> </Units>
<General> <General>
<ActiveWindowIndexAtStart Value="0"/> <ActiveWindowIndexAtStart Value="0"/>
</General> </General>
<JumpHistory Count="11" HistoryIndex="10"> <JumpHistory Count="10" HistoryIndex="9">
<Position1> <Position1>
<Filename Value="unit1.pas"/> <Filename Value="unit1.pas"/>
<Caret Line="33" Column="16" TopLine="1"/> <Caret Line="33" Column="16" TopLine="1"/>
@ -136,37 +142,33 @@
<Caret Line="28" Column="32" TopLine="1"/> <Caret Line="28" Column="32" TopLine="1"/>
</Position3> </Position3>
<Position4> <Position4>
<Filename Value="..\..\..\lcl\lresources.pp"/> <Filename Value="..\scrollingtext.pas"/>
<Caret Line="2" Column="16" TopLine="1"/> <Caret Line="166" Column="68" TopLine="140"/>
</Position4> </Position4>
<Position5> <Position5>
<Filename Value="..\scrollingtext.pas"/> <Filename Value="..\scrollingtext.pas"/>
<Caret Line="166" Column="68" TopLine="140"/> <Caret Line="167" Column="1" TopLine="146"/>
</Position5> </Position5>
<Position6> <Position6>
<Filename Value="..\scrollingtext.pas"/> <Filename Value="..\scrollingtext.pas"/>
<Caret Line="167" Column="1" TopLine="146"/> <Caret Line="162" Column="65" TopLine="146"/>
</Position6> </Position6>
<Position7> <Position7>
<Filename Value="..\scrollingtext.pas"/> <Filename Value="..\scrollingtext.pas"/>
<Caret Line="162" Column="65" TopLine="146"/> <Caret Line="166" Column="40" TopLine="146"/>
</Position7> </Position7>
<Position8> <Position8>
<Filename Value="..\scrollingtext.pas"/> <Filename Value="..\scrollingtext.pas"/>
<Caret Line="166" Column="40" TopLine="146"/> <Caret Line="156" Column="92" TopLine="146"/>
</Position8> </Position8>
<Position9> <Position9>
<Filename Value="..\scrollingtext.pas"/> <Filename Value="..\scrollingtext.pas"/>
<Caret Line="156" Column="92" TopLine="146"/> <Caret Line="167" Column="1" TopLine="147"/>
</Position9> </Position9>
<Position10> <Position10>
<Filename Value="..\scrollingtext.pas"/>
<Caret Line="167" Column="1" TopLine="147"/>
</Position10>
<Position11>
<Filename Value="..\scrollingtext.pas"/> <Filename Value="..\scrollingtext.pas"/>
<Caret Line="132" Column="1" TopLine="104"/> <Caret Line="132" Column="1" TopLine="104"/>
</Position11> </Position10>
</JumpHistory> </JumpHistory>
</ProjectSession> </ProjectSession>
<EditorMacros Count="0"/> <EditorMacros Count="0"/>

5
components/scrolltext/exampleapp/unit1.lfm
View File

@ -8,7 +8,7 @@ object Form1: TForm1
ClientHeight = 363 ClientHeight = 363
ClientWidth = 552 ClientWidth = 552
Position = poDesktopCenter Position = poDesktopCenter
LCLVersion = '1.2.2.0' LCLVersion = '1.2.4.0'
object ScrollingText1: TScrollingText object ScrollingText1: TScrollingText
Left = 0 Left = 0
Height = 363 Height = 363
@ -17,7 +17,7 @@ object Form1: TForm1
About.Description.Strings = ( 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' '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.Height = 280
About.Width = 400 About.Width = 400
About.Font.Color = clNavy About.Font.Color = clNavy
@ -55,6 +55,7 @@ object Form1: TForm1
'June 2014' 'June 2014'
) )
Font.Height = -13 Font.Height = -13
TextSource = stResource
end end
object BitBtn1: TBitBtn object BitBtn1: TBitBtn
Left = 239 Left = 239