From a06674e8c098f5cade46c6f4bdad6d03793edf53 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Tue, 19 Jul 2016 23:24:09 +0000 Subject: [PATCH] tvplanit: Add unit "sound.pas" for playing sound on non-Windows systems. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5007 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../tvplanit/examples/fulldemo/demo.lpi | 6 +- .../tvplanit/examples/fulldemo/demomain.lfm | 1 + .../tvplanit/examples/fulldemo/demomain.pas | 13 +- .../tvplanit/examples/fulldemo/sound.pas | 181 ++++++++++++++++++ components/tvplanit/source/vpevnteditdlg.lfm | 4 +- 5 files changed, 200 insertions(+), 5 deletions(-) create mode 100644 components/tvplanit/examples/fulldemo/sound.pas diff --git a/components/tvplanit/examples/fulldemo/demo.lpi b/components/tvplanit/examples/fulldemo/demo.lpi index 3dbb99432..9f96f2434 100644 --- a/components/tvplanit/examples/fulldemo/demo.lpi +++ b/components/tvplanit/examples/fulldemo/demo.lpi @@ -42,7 +42,7 @@ - + @@ -55,6 +55,10 @@ + + + + diff --git a/components/tvplanit/examples/fulldemo/demomain.lfm b/components/tvplanit/examples/fulldemo/demomain.lfm index 34fd3acfa..4c53af80e 100644 --- a/components/tvplanit/examples/fulldemo/demomain.lfm +++ b/components/tvplanit/examples/fulldemo/demomain.lfm @@ -784,6 +784,7 @@ object MainForm: TMainForm CategoryColorMap.Category9.Description = 'Category 9' EnableEventTimer = True PlayEventSounds = True + OnPlaySound = VpBufDSDataStore1PlaySound AutoConnect = True AutoCreate = True Directory = 'data' diff --git a/components/tvplanit/examples/fulldemo/demomain.pas b/components/tvplanit/examples/fulldemo/demomain.pas index e0553c541..f1fa94628 100644 --- a/components/tvplanit/examples/fulldemo/demomain.pas +++ b/components/tvplanit/examples/fulldemo/demomain.pas @@ -8,7 +8,7 @@ uses Classes, SysUtils, FileUtil, PrintersDlgs, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, ComCtrls, LCLTranslator, Menus, VpBaseDS, VpDayView, VpWeekView, VpTaskList, VpAbout, VpContactGrid, VpMonthView, VpResEditDlg, - VpContactButtons, VpBufDS, VpNavBar, VpData, VpPrtPrvDlg, VpPrtFmtDlg, Types; + VpContactButtons, VpBufDS, VpNavBar, VpData, VpPrtPrvDlg, VpPrtFmtDlg, Types, VpBase; type @@ -100,6 +100,8 @@ type procedure MnuSettingsClick(Sender: TObject); procedure RbAllTasksChange(Sender: TObject); procedure RbHideCompletedTasksChange(Sender: TObject); + procedure VpBufDSDataStore1PlaySound(Sender: TObject; + const AWavFile: String; AMode: TVpPlaySoundMode); procedure VpNavBar1ItemClick(Sender: TObject; Button: TMouseButton; Shift: TShiftState; Index: Integer); private @@ -140,7 +142,8 @@ uses {$ENDIF} LCLVersion, LResources, LazFileUtils, LazUTF8, StrUtils, DateUtils, Translations, IniFiles, Math, Printers, - VpMisc, VpBase, VpPrtFmt; + VpMisc, VpPrtFmt, + sound; {$UNDEF UTF8_CALLS} {$IFDEF LCL} @@ -872,6 +875,12 @@ begin ImageList1.GetBitmap(1, Img.Picture.Bitmap); end; +procedure TMainForm.VpBufDSDataStore1PlaySound(Sender: TObject; + const AWavFile: String; AMode: TVpPlaySoundMode); +begin + sound.PlaySound(AWavFile, AMode); +end; + procedure TMainForm.ShowContacts; begin Notebook.PageIndex := 2; diff --git a/components/tvplanit/examples/fulldemo/sound.pas b/components/tvplanit/examples/fulldemo/sound.pas new file mode 100644 index 000000000..28d27c365 --- /dev/null +++ b/components/tvplanit/examples/fulldemo/sound.pas @@ -0,0 +1,181 @@ +{ This unit enables playing of sound for + - all versions of Windows + - most versions of Linux + - maybe Macintosh OSX + Adapted from PlayWavePackage by Gordon Bamber. + https://sourceforge.net/p/lazarus-ccr/svn/HEAD/tree/components/playsoundpackage/ +} + +unit sound; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, VpBase; + +procedure PlaySound(const ASoundFilename: string; APlaySoundMode: TVpPlaySoundMode); + + +implementation + +uses +{$IFDEF WINDOWS} + mmsystem, +{$ELSE} + process, asyncprocess, +{$ENDIF} + FileUtil; + +CONST + C_UnableToPlay = 'Unable to play '; + +{$IFNDEF WINDOWS} +var + SoundPlayerAsyncProcess: TAsyncProcess = nil; + SoundPlayerSyncProcess: TProcess = nil; +{$ENDIF} + +procedure PlaySound(const ASoundFilename: string; APlaySoundMode: TVpPlaySoundMode); +{$IFNDEF WINDOWS} + var + playCommand: string; + L: TStrings; + i: Integer; +{$ENDIF} +begin +{$IFDEF WINDOWS} + try + case APlaySoundMode of + psmAsync : sndPlaySound(PChar(ASoundFilename), SND_ASYNC or SND_NODEFAULT); + psmSync : sndPlaySound(PChar(ASoundFilename), SND_SYNC or SND_NODEFAULT); + psmStop : sndPlaySound(nil, 0); + end; + except + On E: Exception do + E.CreateFmt(C_UnableToPlay + + '%s Message:%s', [ASoundFilename, E.Message]); + end; +{$ELSE} + if (APlaySoundMode = psmStop) then begin + if SoundPlayerAsyncProcess <> nil then + SoundPlayerAsyncProcess.Terminate(1); + exit; + end; + + // How to play in Linux? Use generic Linux commands + // Use asyncprocess to play sound as SND_ASYNC + // Try play + playCommand := ''; + if (FindDefaultExecutablePath('play') <> '') then + playCommand := 'play'; + // Try aplay + if (playCommand = '') then + if (FindDefaultExecutablePath('aplay') <> '') then + playCommand := 'aplay -q '; + // Try paplay + if (playCommand = '') then + if (FindDefaultExecutablePath('paplay') <> '') then + playCommand := 'paplay'; + // Try mplayer + if (playCommand = '') then + if (FindDefaultExecutablePath('mplayer') <> '') then + playCommand := 'mplayer -really-quiet '; + // Try CMus + if (playCommand = '') then + if (FindDefaultExecutablePath('CMus') <> '') then + playCommand := 'CMus '; + // Try pacat + if (playCommand = '') then + if (FindDefaultExecutablePath('pacat') <> '') then + playCommand := 'pacat -p '; + // Try ffplay + if (playCommand = '') then + if (FindDefaultExecutablePath('ffplay') <> '') then + playCommand := 'ffplay -autoexit -nodisp '; + // Try cvlc + if (playCommand = '') then + if (FindDefaultExecutablePath('cvlc') <> '') then + playCommand := 'cvlc -q --play-and-exit '; + // Try canberra-gtk-play + if (playCommand = '') then + if (FindDefaultExecutablePath('canberra-gtk-play') <> '') then + playCommand := 'canberra-gtk-play -c never -f '; + // Try Macintosh command? + if (playCommand = '') then + if (FindDefaultExecutablePath('afplay') <> '') then + playCommand := 'afplay'; + + // proceed if we managed to find a valid command + if (playCommand <> '') then + begin + // Since the playcommand found above can contain parameters we must + // separate executable and parameters. + L := TStringList.Create; + try + L.Delimiter := ' ';; + L.DelimitedText := playCommand; + if APlaySoundMode = psmAsync then + begin + if SoundPlayerAsyncProcess = nil then + SoundPlayerAsyncProcess := TAsyncProcess.Create(nil); + SoundPlayerAsyncProcess.CurrentDirectory := ExtractFileDir(ASoundFilename); + SoundPlayerAsyncProcess.Executable := FindDefaultExecutablePath(L[0]); + SoundPlayerAsyncProcess.Parameters.Clear; + for i:=1 to L.Count-1 do + SoundPlayerAsyncProcess.Parameters.Add(L[i]); + SoundPlayerAsyncProcess.Parameters.Add(ASoundFilename); + + WriteLn; + WriteLn(SoundPlayerAsyncProcess.Executable);; + for i:=0 to SoundPlayerAsyncProcess.Parameters.Count-1 do + WriteLn(i, ': ', SoundPlayerAsyncProcess.Parameters[i]); + try + SoundPlayerAsyncProcess.Execute; + except + on E: Exception do + E.CreateFmt('PlaySoundMode = psmAsync: ' + C_UnableToPlay + + '%s Message:%s', [ASoundFilename, E.Message]); + end; + end + else + begin + if SoundPlayerSyncProcess = nil then + SoundPlayerSyncProcess := TProcess.Create(nil); + SoundPlayerSyncProcess.CurrentDirectory := ExtractFileDir(ASoundFilename); + SoundPlayerSyncProcess.Executable := FindDefaultExecutablePath(L[0]); + SoundPlayersyncProcess.Parameters.Clear; + for i:=1 to L.Count-1 do + SoundPlayerSyncProcess.Parameters.Add(L[i]); + SoundPlayerSyncProcess.Parameters.Add(ASoundFilename); + try + SoundPlayerSyncProcess.Execute; + SoundPlayersyncProcess.WaitOnExit; + except + On E: Exception do + E.CreateFmt('PlaySoundMode = psmSync: ' + C_UnableToPlay + + '%s Message:%s', [ASoundFilename, E.Message]); + end; + end; + + finally + L.Free; + end; + end + else + raise Exception.Create('No sound support found on this system.'); +{$ENDIF} +end; + + +{$IFNDEF WINDOWS} +initialization + +finalization + FreeAndNil(SoundPlayerSyncProcess); + FreeAndNil(SoundPlayerAsyncProcess); +{$ENDIF} + +end. + diff --git a/components/tvplanit/source/vpevnteditdlg.lfm b/components/tvplanit/source/vpevnteditdlg.lfm index d2a543a80..6d3248724 100644 --- a/components/tvplanit/source/vpevnteditdlg.lfm +++ b/components/tvplanit/source/vpevnteditdlg.lfm @@ -1,7 +1,7 @@ object DlgEventEdit: TDlgEventEdit - Left = 417 + Left = 512 Height = 433 - Top = 211 + Top = 221 Width = 697 BorderStyle = bsToolWindow Caption = 'Add / Edit Events'