You've already forked lazarus-ccr
Bugfix: Linux implementation fixed
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3668 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
gbamber
@ -1,4 +1,4 @@
|
|||||||
<?xml version="1.0" encoding="UTF-8"?>
|
<?xml version="1.0"?>
|
||||||
<CONFIG>
|
<CONFIG>
|
||||||
<Package Version="4">
|
<Package Version="4">
|
||||||
<Name Value="playwavepackage"/>
|
<Name Value="playwavepackage"/>
|
||||||
@ -51,6 +51,7 @@
|
|||||||
</UsageOptions>
|
</UsageOptions>
|
||||||
<PublishOptions>
|
<PublishOptions>
|
||||||
<Version Value="2"/>
|
<Version Value="2"/>
|
||||||
|
<DestinationDirectory Value="/home/gordon/Lazarusprojects/playsoundpackage/published"/>
|
||||||
</PublishOptions>
|
</PublishOptions>
|
||||||
</Package>
|
</Package>
|
||||||
</CONFIG>
|
</CONFIG>
|
||||||
|
|||||||
@ -1,210 +1,212 @@
|
|||||||
unit uplaysound;
|
unit uplaysound;
|
||||||
|
|
||||||
{$mode objfpc}{$H+}
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
interface
|
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 }
|
||||||
{$IFNDEF WINDOWS}
|
{$IFNDEF WINDOWS}
|
||||||
SoundPlayerAsyncProcess: Tasyncprocess;
|
SoundPlayerAsyncProcess: Tasyncprocess;
|
||||||
SoundPlayerSyncProcess: Tprocess;
|
SoundPlayerSyncProcess: Tprocess;
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
fPlayCommand:String;
|
fPlayCommand:String;
|
||||||
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;
|
// This is the default method
|
||||||
published
|
procedure Execute;
|
||||||
{ Published declarations }
|
published
|
||||||
property SoundFile: string read fPathToSoundFile write fPathToSoundFile;
|
{ Published declarations }
|
||||||
property PlayStyle: TPlayStyle read fPlayStyle write fPlayStyle default psASync;
|
// This is normally set at runtime
|
||||||
Property PlayCommand:String read fPlayCommand write fPlayCommand;
|
property SoundFile: string read fPathToSoundFile write fPathToSoundFile;
|
||||||
end;
|
// Default is Async
|
||||||
|
property PlayStyle: TPlayStyle read fPlayStyle write fPlayStyle default psASync;
|
||||||
procedure Register;
|
// This is automatically determined when the component loads
|
||||||
|
property PlayCommand:String read fPlayCommand write fPlayCommand;
|
||||||
implementation
|
end;
|
||||||
|
|
||||||
{$IFNDEF WINDOWS}
|
procedure Register;
|
||||||
const // Defined in mmsystem
|
|
||||||
SND_SYNC = 0;
|
implementation
|
||||||
SND_ASYNC = 1;
|
|
||||||
SND_NODEFAULT = 2;
|
{$IFNDEF WINDOWS}
|
||||||
{$ENDIF}
|
const // Defined in mmsystem
|
||||||
resourcestring
|
SND_SYNC = 0;
|
||||||
C_UnableToPlay = 'Unable to play ';
|
SND_ASYNC = 1;
|
||||||
|
SND_NODEFAULT = 2;
|
||||||
function GetNonWindowsPlayCommand:String;
|
{$ENDIF}
|
||||||
Var szNonWindowsPlayCommand: string;
|
resourcestring
|
||||||
begin
|
C_UnableToPlay = 'Unable to play ';
|
||||||
szNonWindowsPlayCommand:='';
|
|
||||||
{$IFNDEF WINDOWS}
|
function GetNonWindowsPlayCommand:String;
|
||||||
// Try play
|
Var szNonWindowsPlayCommand: string;
|
||||||
if (FindDefaultExecutablePath('play') <> '') then
|
begin
|
||||||
szNonWindowsPlayCommand := 'play';
|
szNonWindowsPlayCommand:='';
|
||||||
// Try aplay
|
// Try play
|
||||||
if (szNonWindowsPlayCommand = '') then
|
if (FindDefaultExecutablePath('play') <> '') then
|
||||||
if (FindDefaultExecutablePath('aplay') <> '') then
|
szNonWindowsPlayCommand := 'play';
|
||||||
szNonWindowsPlayCommand := 'aplay -q';
|
// Try aplay
|
||||||
// Try paplay
|
if (szNonWindowsPlayCommand = '') then
|
||||||
if (szNonWindowsPlayCommand = '') then
|
if (FindDefaultExecutablePath('aplay') <> '') then
|
||||||
if (FindDefaultExecutablePath('paplay') <> '') then
|
szNonWindowsPlayCommand := 'aplay -q';
|
||||||
szNonWindowsPlayCommand := 'paplay';
|
// Try paplay
|
||||||
// Try mplayer
|
if (szNonWindowsPlayCommand = '') then
|
||||||
if (szNonWindowsPlayCommand = '') then
|
if (FindDefaultExecutablePath('paplay') <> '') then
|
||||||
if (FindDefaultExecutablePath('mplayer') <> '') then
|
szNonWindowsPlayCommand := 'paplay';
|
||||||
szNonWindowsPlayCommand := 'mplayer -really-quiet';
|
// Try mplayer
|
||||||
// Try CMus
|
if (szNonWindowsPlayCommand = '') then
|
||||||
if (szNonWindowsPlayCommand = '') then
|
if (FindDefaultExecutablePath('mplayer') <> '') then
|
||||||
if (FindDefaultExecutablePath('CMus') <> '') then
|
szNonWindowsPlayCommand := 'mplayer -really-quiet';
|
||||||
szNonWindowsPlayCommand := 'CMus';
|
// Try CMus
|
||||||
// Try pacat
|
if (szNonWindowsPlayCommand = '') then
|
||||||
if (szNonWindowsPlayCommand = '') then
|
if (FindDefaultExecutablePath('CMus') <> '') then
|
||||||
if (FindDefaultExecutablePath('pacat') <> '') then
|
szNonWindowsPlayCommand := 'CMus';
|
||||||
szNonWindowsPlayCommand := 'pacat -p';
|
// Try pacat
|
||||||
// Try ffplay
|
if (szNonWindowsPlayCommand = '') then
|
||||||
if (szNonWindowsPlayCommand = '') then
|
if (FindDefaultExecutablePath('pacat') <> '') then
|
||||||
if (FindDefaultExecutablePath('ffplay') <> '') then
|
szNonWindowsPlayCommand := 'pacat -p';
|
||||||
szNonWindowsPlayCommand := 'ffplay -autoexit -nodisp';
|
// Try ffplay
|
||||||
// Try cvlc
|
if (szNonWindowsPlayCommand = '') then
|
||||||
if (szNonWindowsPlayCommand = '') then
|
if (FindDefaultExecutablePath('ffplay') <> '') then
|
||||||
if (FindDefaultExecutablePath('cvlc') <> '') then
|
szNonWindowsPlayCommand := 'ffplay -autoexit -nodisp';
|
||||||
szNonWindowsPlayCommand := 'cvlc -q --play-and-exit';
|
// Try cvlc
|
||||||
// Try canberra-gtk-play
|
if (szNonWindowsPlayCommand = '') then
|
||||||
if (szNonWindowsPlayCommand = '') then
|
if (FindDefaultExecutablePath('cvlc') <> '') then
|
||||||
if (FindDefaultExecutablePath('canberra-gtk-play') <> '') then
|
szNonWindowsPlayCommand := 'cvlc -q --play-and-exit';
|
||||||
szNonWindowsPlayCommand := 'canberra-gtk-play -c never -f';
|
// Try canberra-gtk-play
|
||||||
// Try Macintosh command?
|
if (szNonWindowsPlayCommand = '') then
|
||||||
if (szNonWindowsPlayCommand = '') then
|
if (FindDefaultExecutablePath('canberra-gtk-play') <> '') then
|
||||||
if (FindDefaultExecutablePath('afplay') <> '') then
|
szNonWindowsPlayCommand := 'canberra-gtk-play -c never -f';
|
||||||
szNonWindowsPlayCommand := 'afplay';
|
// Try Macintosh command?
|
||||||
{$ENDIF}
|
if (szNonWindowsPlayCommand = '') then
|
||||||
Result:=szNonWindowsPlayCommand;
|
if (FindDefaultExecutablePath('afplay') <> '') then
|
||||||
end;
|
szNonWindowsPlayCommand := 'afplay';
|
||||||
|
Result:=szNonWindowsPlayCommand;
|
||||||
|
end;
|
||||||
constructor Tplaysound.Create(AOwner: TComponent);
|
|
||||||
begin
|
|
||||||
inherited Create(AOwner);
|
constructor Tplaysound.Create(AOwner: TComponent);
|
||||||
fPlayStyle := psASync;
|
begin
|
||||||
fPathToSoundFile := ProgramDirectory;
|
inherited Create(AOwner);
|
||||||
{$IFDEF WINDOWS}
|
fPlayStyle := psASync;
|
||||||
fPlayCommand:='sndPlaySnd';
|
fPathToSoundFile := ProgramDirectory;
|
||||||
{$ELSE}
|
{$IFDEF WINDOWS}
|
||||||
fPlayCommand:=GetNonWindowsPlayCommand;
|
fPlayCommand:='sndPlaySnd';
|
||||||
{$ENDIF}
|
{$ELSE}
|
||||||
// About Dialog properties
|
fPlayCommand:=GetNonWindowsPlayCommand; // Linux, Mac etc.
|
||||||
AboutBoxComponentName := 'PlaySound';
|
{$ENDIF}
|
||||||
AboutBoxWidth := 400;
|
// About Dialog properties
|
||||||
AboutBoxHeight := 400;
|
AboutBoxComponentName := 'PlaySound';
|
||||||
AboutBoxBackgroundColor := clCream;
|
AboutBoxWidth := 400;
|
||||||
//AboutBoxFontName (string)
|
AboutBoxHeight := 400;
|
||||||
//AboutBoxFontSize (integer)
|
AboutBoxBackgroundColor := clCream;
|
||||||
AboutBoxVersion := '0.0.3';
|
//AboutBoxFontName (string)
|
||||||
AboutBoxAuthorname := 'Gordon Bamber';
|
//AboutBoxFontSize (integer)
|
||||||
AboutBoxOrganisation := 'Public Domain';
|
AboutBoxVersion := '0.0.3';
|
||||||
AboutBoxAuthorEmail := 'minesadorada@charcodelvalle.com';
|
AboutBoxAuthorname := 'Gordon Bamber';
|
||||||
AboutBoxLicenseType := 'LGPL';
|
AboutBoxOrganisation := 'Public Domain';
|
||||||
AboutBoxDescription := 'Plays WAVE sounds in Windows or Linux';
|
AboutBoxAuthorEmail := 'minesadorada@charcodelvalle.com';
|
||||||
end;
|
AboutBoxLicenseType := 'LGPL';
|
||||||
|
AboutBoxDescription := 'Plays WAVE sounds in Windows or Linux';
|
||||||
destructor Tplaysound.Destroy;
|
end;
|
||||||
begin
|
|
||||||
{$IFNDEF WINDOWS}
|
destructor Tplaysound.Destroy;
|
||||||
FreeAndNil(SoundPlayerSyncProcess);
|
begin
|
||||||
FreeAndNil(SoundPlayerAsyncProcess);
|
{$IFNDEF WINDOWS}
|
||||||
{$ENDIF}
|
FreeAndNil(SoundPlayerSyncProcess);
|
||||||
inherited;
|
FreeAndNil(SoundPlayerAsyncProcess);
|
||||||
end;
|
{$ENDIF}
|
||||||
|
inherited;
|
||||||
procedure Tplaysound.Execute;
|
end;
|
||||||
begin
|
|
||||||
if not FileExistsUTF8(fPathToSoundFile) then
|
procedure Tplaysound.Execute;
|
||||||
Exit;
|
begin
|
||||||
PlaySound(fPathToSoundFile);
|
if not FileExistsUTF8(fPathToSoundFile) then
|
||||||
end;
|
Exit;
|
||||||
|
PlaySound(fPathToSoundFile);
|
||||||
procedure Tplaysound.PlaySound(const szSoundFilename: string);
|
end;
|
||||||
var
|
|
||||||
flags: word;
|
procedure Tplaysound.PlaySound(const szSoundFilename: string);
|
||||||
begin
|
var
|
||||||
{$IFDEF WINDOWS}
|
flags: word;
|
||||||
if fPlayStyle = psASync then
|
begin
|
||||||
flags := SND_ASYNC or SND_NODEFAULT
|
{$IFDEF WINDOWS}
|
||||||
else
|
if fPlayStyle = psASync then
|
||||||
flags := SND_SYNC or SND_NODEFAULT;
|
flags := SND_ASYNC or SND_NODEFAULT
|
||||||
try
|
else
|
||||||
sndPlaySound(PChar(szSoundFilename), flags);
|
flags := SND_SYNC or SND_NODEFAULT;
|
||||||
except
|
try
|
||||||
ShowMessage(C_UnableToPlay + szSoundFilename);
|
sndPlaySound(PChar(szSoundFilename), flags);
|
||||||
end;
|
except
|
||||||
{$ELSE}
|
ShowMessage(C_UnableToPlay + szSoundFilename);
|
||||||
// How to play in Linux? Use generic Linux commands
|
end;
|
||||||
// Use asyncprocess to play sound as SND_ASYNC
|
{$ELSE}
|
||||||
// proceed if we managed to find a valid command
|
// How to play in Linux? Use generic Linux commands
|
||||||
if (fNonWindowsPlayCommand <> '') then
|
// Use asyncprocess to play sound as SND_ASYNC
|
||||||
begin
|
// proceed if we managed to find a valid command
|
||||||
if fPlayStyle = psASync then
|
if (fPlayCommand <> '') then
|
||||||
begin
|
begin
|
||||||
if SoundPlayerAsyncProcess = nil then
|
if fPlayStyle = psASync then
|
||||||
SoundPlayerAsyncProcess := Tasyncprocess.Create(nil);
|
begin
|
||||||
SoundPlayerAsyncProcess.CurrentDirectory := ExtractFileDir(szSoundFilename);
|
if SoundPlayerAsyncProcess = nil then
|
||||||
SoundPlayerAsyncProcess.Executable :=
|
SoundPlayerAsyncProcess := Tasyncprocess.Create(nil);
|
||||||
FindDefaultExecutablePath(fNonWindowsPlayCommand);
|
SoundPlayerAsyncProcess.CurrentDirectory := ExtractFileDir(szSoundFilename);
|
||||||
SoundPlayerAsyncProcess.Parameters.Clear;
|
SoundPlayerAsyncProcess.Executable :=
|
||||||
SoundPlayerAsyncProcess.Parameters.Add(szSoundFilename);
|
FindDefaultExecutablePath(fPlayCommand);
|
||||||
try
|
SoundPlayerAsyncProcess.Parameters.Clear;
|
||||||
SoundPlayerAsyncProcess.Execute;
|
SoundPlayerAsyncProcess.Parameters.Add(szSoundFilename);
|
||||||
except
|
try
|
||||||
On E: Exception do
|
SoundPlayerAsyncProcess.Execute;
|
||||||
E.CreateFmt('Playstyle=paASync: ' + C_UnableToPlay +
|
except
|
||||||
'%s Message:%s', [szSoundFilename, E.Message]);
|
On E: Exception do
|
||||||
end;
|
E.CreateFmt('Playstyle=paASync: ' + C_UnableToPlay +
|
||||||
end
|
'%s Message:%s', [szSoundFilename, E.Message]);
|
||||||
else
|
end;
|
||||||
begin
|
end
|
||||||
if SoundPlayerSyncProcess = nil then
|
else
|
||||||
SoundPlayerSyncProcess := Tprocess.Create(nil);
|
begin
|
||||||
SoundPlayerSyncProcess.CurrentDirectory := ExtractFileDir(szSoundFilename);
|
if SoundPlayerSyncProcess = nil then
|
||||||
SoundPlayerSyncProcess.Executable :=
|
SoundPlayerSyncProcess := Tprocess.Create(nil);
|
||||||
FindDefaultExecutablePath(fNonWindowsPlayCommand);
|
SoundPlayerSyncProcess.CurrentDirectory := ExtractFileDir(szSoundFilename);
|
||||||
SoundPlayersyncProcess.Parameters.Clear;
|
SoundPlayerSyncProcess.Executable :=
|
||||||
SoundPlayerSyncProcess.Parameters.Add(szSoundFilename);
|
FindDefaultExecutablePath(fPlayCommand);
|
||||||
try
|
SoundPlayersyncProcess.Parameters.Clear;
|
||||||
SoundPlayerSyncProcess.Execute;
|
SoundPlayerSyncProcess.Parameters.Add(szSoundFilename);
|
||||||
SoundPlayersyncProcess.WaitOnExit;
|
try
|
||||||
except
|
SoundPlayerSyncProcess.Execute;
|
||||||
On E: Exception do
|
SoundPlayersyncProcess.WaitOnExit;
|
||||||
E.CreateFmt('Playstyle=paSync: ' + C_UnableToPlay +
|
except
|
||||||
'%s Message:%s', [szSoundFilename, E.Message]);
|
On E: Exception do
|
||||||
end;
|
E.CreateFmt('Playstyle=paSync: ' + C_UnableToPlay +
|
||||||
end;
|
'%s Message:%s', [szSoundFilename, E.Message]);
|
||||||
end
|
end;
|
||||||
else
|
end;
|
||||||
raise Exception.CreateFmt('The play command %s does not work on your system',
|
end
|
||||||
[fNonWindowsPlayCommand]);
|
else
|
||||||
{$ENDIF}
|
raise Exception.CreateFmt('The play command %s does not work on your system',
|
||||||
end;
|
[fPlayCommand]);
|
||||||
|
{$ENDIF}
|
||||||
procedure Register;
|
end;
|
||||||
begin
|
|
||||||
RegisterComponents('LazControls', [Tplaysound]);
|
procedure Register;
|
||||||
{$I playsound_icon.lrs}
|
begin
|
||||||
end;
|
RegisterComponents('LazControls', [Tplaysound]);
|
||||||
|
{$I playsound_icon.lrs}
|
||||||
end.
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
Reference in New Issue
Block a user