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'