diff --git a/components/playsoundpackage/TPlaysound.png b/components/playsoundpackage/TPlaysound.png new file mode 100644 index 000000000..7b437d25f Binary files /dev/null and b/components/playsoundpackage/TPlaysound.png differ diff --git a/components/playsoundpackage/aboutplaysound.pas b/components/playsoundpackage/aboutplaysound.pas new file mode 100644 index 000000000..b3cd6bf37 --- /dev/null +++ b/components/playsoundpackage/aboutplaysound.pas @@ -0,0 +1,624 @@ +{ TAboutPlaySound and TAboutBox Component License + + Copyright (C) 2014 Gordon Bamber minesadorada@charcodelvalle.com + + This library is free software; you can redistribute it and/or modify it + under the terms of the GNU Library General Public License as published by + the Free Software Foundation; either version 2 of the License, or (at your + option) any later version. + + This program is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License + for more details. + + You should have received a copy of the GNU Library General Public License + along with this library; if not, write to the Free Software Foundation, + Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +} + +// Change the name of this unit and its PAS file to be unique to your component +// Unit Aboutunit +unit aboutplaysound; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, Controls, Dialogs, Forms, Graphics, LResources, SysUtils, + ExtCtrls, StdCtrls, StrUtils,Buttons,PropEdits; +const + C_DEFAULTLICENSEFORMWIDTH = 500; + C_DEFAULTLICENSEFORMWIDTH_LINUX = C_DEFAULTLICENSEFORMWIDTH + 100; + C_DEFAULTLICENSEFORMHEIGHT = 400; + C_DEFAULTLICENSEFORMHEIGHT_LINUX = C_DEFAULTLICENSEFORMHEIGHT + 50; + +type + TLicenseType = (abNone, abGPL, abLGPL, abMIT, abModifiedGPL, abProprietry); + tAboutBox=Class; // Forward declaration + // Do Search/Replace to change all instances of TAboutComonent + // to TAbout + TAboutPlaySound = class(TComponent) + // This class can descend from any component class (TGraphicControl etc + private + { Private declarations } + fAboutBox: tAboutBox; + procedure SetMyComponentName(Const Avalue:String); + procedure SetAboutBoxWidth(Const AValue:Integer); + procedure SetAboutBoxHeight(Const AValue:Integer); + procedure SetAboutBoxDescription(Const AValue:String); + procedure SetAboutBoxFontName(Const AValue:String); + procedure SetAboutBoxFontSize(Const AValue:Integer); + procedure SetAboutBoxBitmap(Const AValue:TBitmap); + procedure SetAboutBoxBackgroundColor(Const AValue:TColor); + procedure SetAboutBoxTitle(Const AValue:String); + + procedure SetAboutBoxVersion(Const AValue:String); + procedure SetAboutBoxAuthorname(Const AValue:String); + procedure SetAboutBoxOrganisation(Const AValue:String); + procedure SetAboutBoxAuthorEmail(Const AValue:String); + procedure SetAboutBoxBackgroundResourceName(Const AValue:String); + procedure SetAboutBoxLicenseType(Const AValue:String); + procedure SetAboutBoxStretchBackgroundImage(Const AValue:Boolean); + protected + { Protected declarations } + public + { Public declarations } + constructor Create(AOwner: TComponent); override; // Constructor must be public + destructor Destroy; override; // Destructor must be public + + // Set these (hidden) properties in your inherited component's Create procedure + property AboutBoxComponentName:String write SetMyComponentName; + property AboutBoxWidth:Integer write SetAboutBoxWidth; + property AboutBoxHeight:Integer write SetAboutBoxHeight; + property AboutBoxDescription:String write SetAboutBoxDescription; + property AboutBoxFontName:String write SetAboutBoxFontName; + property AboutBoxFontSize:Integer write SetAboutBoxFontSize; + property AboutBoxBackgroundColor:TColor write SetAboutBoxBackgroundColor; + property AboutBoxTitle:String write SetAboutBoxTitle; + + property AboutBoxVersion:String write SetAboutBoxVersion; + property AboutBoxAuthorname:String write SetAboutBoxAuthorname; + property AboutBoxOrganisation:String write SetAboutBoxOrganisation; + property AboutBoxAuthorEmail:String write SetAboutBoxAuthorEmail; + property AboutBoxLicenseType:String write SetAboutBoxLicenseType; + property AboutBoxBackgroundResourceName:String write SetAboutBoxBackgroundResourceName; + property AboutBoxStretchBackgroundImage:Boolean write SetAboutBoxStretchBackgroundImage; + published + // The clickable 'About' property will automaticcally appear in any component + // descended from TAboutPlaySound + + // About this component... + property About: tAboutBox read fAboutBox write fAboutBox; + end; + TAboutbox = class(TComponent) + private + { Private declarations } + fDialog: TForm; + fBackgroundbitmap: TBitMap; + fBackgroundResourceName:String; + fDescription: TStrings; + fDialogTitle, fVersion, fAuthorname, fAuthorEmail, fOrganisation, + fComponentName: string; + fDialogHeight, fDialogWidth: integer; + fStretchBackground: boolean; + fFont: TFont; + fColor: TColor; + fLicenseType: TLicenseType; + procedure SetBackgroundBitmap(const AValue: TBitMap); + procedure SetDescriptionStrings(const AValue: TStrings); + procedure SetFont(const AValue: TFont); + procedure ShowLicense(Sender: TObject); + procedure SetDialogTitle(Const AValue:String); + protected + { Protected declarations } + public + { Public declarations } + procedure ShowDialog; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + { Published declarations } + // Set these properties in your component Constructor method + property BackGround: TBitMap read fBackgroundbitmap write SetBackgroundBitmap; + property BackgroundResourceName:String read fBackgroundResourceName write fBackgroundResourceName; + property Description: TStrings read fDescription write SetDescriptionStrings; + property Title: string read fDialogTitle write SetDialogTitle; + property Height: integer read fDialogHeight write fDialogHeight; + property Width: integer read fDialogWidth write fDialogWidth; + property Font: TFont read fFont write SetFont; + property BackGroundColor: TColor read fColor write fColor; + property StretchBackground: boolean read fStretchBackground + write fStretchBackground default False; + property Version: string read fVersion write fVersion; + property Authorname: string read fAuthorname write fAuthorname; + property Organisation: string read fOrganisation write fOrganisation; + property AuthorEmail: string read fAuthorEmail write fAuthorEmail; + property ComponentName: string read fComponentName write fComponentName; + property LicenseType: TLicenseType read fLicenseType write fLicenseType; + end; + + // Declaration for the 'About' property editor + TAboutPropertyEditor = class(TClassPropertyEditor) + public + procedure Edit; override; + function GetAttributes: TPropertyAttributes; override; + end; + +procedure Register; + +{For i8n if required} +resourcestring + rs_Componentname='Component name'; + rs_About='About'; + rs_License='License'; + rs_By='By'; + rs_For='For'; + rs_DatafileMissing='Resource datafile license.lrs is missing'; + rs_LicenseTextError='There is something wrong with the Licence text'; + rs_AboutBoxError = 'Subcomponent TAboutBox Error'; + + +implementation + +{ TABoutBox} + +constructor TAboutbox.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + fBackgroundbitmap := TBitMap.Create; + fDescription := TStringList.Create; + fFont := TFont.Create; + fColor := clDefault; + fLicenseType := abNone; + fComponentName:=rs_Componentname; + fDialogTitle:=rs_About + ' ' + fComponentName; + + fDialogWidth:=320; + fDialogHeight:=280; + fVersion:='1.0.0.0'; + fLicenseType:=abNone; +end; + +destructor TAboutbox.Destroy; +begin + FreeAndNil(fFont); + FreeAndNil(fDescription); + FreeAndNil(fBackgroundbitmap); + inherited Destroy; +end; +procedure TAboutbox.SetDialogTitle(Const AValue:String); +begin + if AnsiContainsText(fDialogTitle, rs_About) then + fDialogTitle := AValue + else + fDialogTitle := rs_About + ' ' + Avalue; +end; + +procedure TAboutbox.ShowDialog; +var + OKbutton, LicenseButton: TBitBtn; + lbl_Description: TLabel; + img_BackGround: TImage; + sz: string; + iCount: integer; + r:TLResource; +begin + fDialog := TForm.CreateNew(nil); + try //.. finally FreeAndNil everything + with fDialog do + begin + // Set Dialog properties + position := poScreenCenter; + borderstyle := bsToolWindow; + Caption := fDialogTitle; + formstyle := fsSystemStayOnTop; + color := fColor; + font := fFont; + if (fDialogHeight > 0) then + Height := fDialogHeight + else + Height := 240; + if (fDialogWidth > 0) then + Width := fDialogWidth + else + Width := 320; + + // Create a background image + img_BackGround := Timage.Create(fDialog); + with img_BackGround do + // Set img_BackGround properties + begin + Align := alClient; + Stretch := fStretchBackground; + // Bitmap assigned? + if Assigned(fBackgroundbitmap) then + Picture.Assign(fBackgroundbitmap); + // Resource file? + r := LazarusResources.Find(fBackgroundResourceName); + if r <> nil then + img_BackGround.Picture.LoadFromLazarusResource(fBackgroundResourceName); + SendToBack; + parent := fDialog; + end; + + // Create a BitBtn button + okbutton := TBitBtn.Create(fDialog); + // Set BitBtn properties + with okButton do + begin + Kind := bkClose; + left := (fDialog.Width div 2) - Width div 2; + top := fDialog.Height - Height - 10; + ParentFont:=False; + parent := fDialog; + end; + + // Create a License Button + LicenseButton := TBitBtn.Create(fDialog); + if (fLicenseType <> abNone) then + // Put it on the right + begin + LicenseButton.Top := OKButton.Top; + LicenseButton.Caption := rs_License + '...'; + LicenseButton.left := Width - LicenseButton.Width - 10; + LicenseButton.OnClick := @ShowLicense; + LicenseButton.ParentFont:=False; + LicenseButton.Parent := fDialog; + end; + + + // Create a label control + lbl_Description := Tlabel.Create(fDialog); + // Set label properties + with lbl_Description do + begin + left := 8; + Top := 30; + Width := fDialog.Width - 8; + Height := fDialog.Height - 30; + Autosize := False; + ParentFont := True; + Alignment := taCenter; + end; + + // Build up Label text + sz := ''; + // Component name + if fComponentName <> '' then + sz += fComponentName + LineEnding; + // Author name (+Email) + if fAuthorname <> '' then + sz += rs_By + ': ' + fAuthorname + LineEnding; + if fAuthorEmail <> '' then + sz += ' (' + fAuthorEmail + ')' + LineEnding + else + sz += LineEnding; + + sz += LineEnding; + + // Version + if fVersion <> '' then + sz += 'Version: ' + fVersion + LineEnding; + // License + case fLicenseType of + abGPL: sz += rs_License + ': GPL' + LineEnding; + abLGPL: sz += rs_License + ': LGPL' + LineEnding; + abMIT: sz += rs_License + ': M.I.T.' + LineEnding; + abModifiedGPL: sz += rs_License + ': Modified GPL' + LineEnding; + abProprietry: sz += rs_License + ': Proprietry' + LineEnding; + end; + if fOrganisation <> '' then + sz += rs_For + ': ' + fOrganisation + LineEnding; + if fDescription.Count > 0 then + begin + sz += LineEnding; + for iCount := 1 to fDescription.Count do + sz += fDescription[iCount - 1] + LineEnding; + end; + + lbl_Description.Caption := sz; + lbl_Description.parent := fDialog; + // Display the dialog modally + ShowModal; + end; + finally + // Free all resources + FreeAndNil(img_BackGround); + FreeAndNil(lbl_Description); + FreeAndNil(LicenseButton); + FreeAndNil(okbutton); + end; +end; + +procedure TAboutbox.ShowLicense(Sender: TObject); +// Triggered by License button Click +var + sLicenseString: string; + theList: TStringList; + f: integer; + LicenceForm: TForm; + lblText: TLabel; + closebuttton: TBitBtn; + r: TLResource; + szLicenseFile: string; +begin + // Quit early? + if fLicenseType = abNone then + Exit; + + // Set to resource name in license.lrs + case fLicenseType of + abNone: szLicenseFile := ''; + abGPL: szLicenseFile := 'gpl.txt'; + abLGPL: szLicenseFile := 'lgpl.txt'; + abMIT: szLicenseFile := 'mit.txt'; + abModifiedgpl: szLicenseFile := 'modifiedgpl.txt'; + end; + + + // Use a string list to split the text file into lines + theList := TStringList.Create; + // Create a window, label and close button on-the-fly + LicenceForm := TForm.Create(nil); + lblText := TLabel.Create(LicenceForm); + closebuttton := TBitBtn.Create(LicenceForm); + // Load up the text into variable 'sLicenseString' + sLicenseString := LineEnding + LineEnding + fComponentName + LineEnding; + try + try + begin + // Load license text from resource string + r := LazarusResources.Find(szLicenseFile); + if r = nil then + raise Exception.Create(rs_DatafileMissing); + thelist.Add(r.Value); + for f := 0 to TheList.Count - 1 do + sLicenseString += TheList[f] + LineEnding; + end; + except + On e: Exception do + MessageDlg(rs_AboutBoxError, + rs_LicenseTextError, mtError, [mbOK], 0); + end; + + // Replace boilerplate text if possible + sLicenseString := AnsiReplaceText(sLicenseString, '', +{$I %DATE%} + ); + sLicenseString := AnsiReplaceText(sLicenseString, '', fAuthorname); + sLicenseString := AnsiReplaceText(sLicenseString, '', + '(' + fAuthorEmail + ')'); + sLicenseString := AnsiReplaceText(sLicenseString, '', + fOrganisation); + + // Make up the form window and controls + with LicenceForm do + begin + // Form + {$IFDEF WINDOWS} + // More compact GUI? + Width := C_DEFAULTLICENSEFORMWIDTH; + Height := C_DEFAULTLICENSEFORMHEIGHT; + {$ELSE WINDOWS} + Width := C_DEFAULTLICENSEFORMWIDTH_LINUX; + Height := C_DEFAULTLICENSEFORMHEIGHT_LINUX; + {$ENDIF} + // autosize:=true; + // If you enable autosize, the button placement goes awry! + + // The Modified GPL has an extra clause + if (szLicenseFile = 'modifiedgpl.txt') or + (Pos('As a special exception', sLicenseString) > 0) then + Height := Height + 100; + position := poScreenCenter; + borderstyle := bsToolWindow; + Caption := fComponentName + ': Licensing'; + formstyle := fsSystemStayOnTop; + + // Label + lblText.Align := alClient; + lblText.Alignment := taCenter; + lblText.Caption := sLicenseString; + lblText.Parent := LicenceForm; + + // Close Button + closebuttton.Kind := bkClose; + closebuttton.left := (Width div 2) - closebuttton.Width div 2; + closebuttton.top := Height - closebuttton.Height - 10; + closebuttton.parent := LicenceForm; + // Show modally over the existing modal form + PopupParent := TForm(Sender); + ShowModal; + end; + finally + // Free up all component created resources from memory + FreeAndNil(theList); + FreeAndNil(lblText); + FreeAndNil(closebuttton); + FreeAndNil(LicenceForm); + end; +end; + +procedure TAboutbox.SetBackgroundBitmap(const AValue: TBitMap); +begin + if Assigned(AValue) then + fBackgroundbitmap.Assign(AValue); +end; + +procedure TAboutbox.SetDescriptionStrings(const AValue: TStrings); +begin + if Assigned(AValue) then + fDescription.Assign(Avalue); +end; + +procedure TAboutbox.SetFont(const AValue: TFont); +begin + if Assigned(AValue) then + fFont.Assign(AValue); +end; + +{ TAboutPlaySound } + +procedure Register; +begin + RegisterPropertyEditor(TypeInfo(TAboutbox), + TAboutPlaySound, 'About', TAboutPropertyEditor); +end; + +procedure TAboutPropertyEditor.Edit; +// Communicate with the component properties +Var + AAboutBox:TAboutBox; +begin + AAboutBox:=TAboutBox(GetObjectValue(TAboutBox)); + AABoutBox.ShowDialog; +end; + +function TAboutPropertyEditor.GetAttributes: TPropertyAttributes; + // Show the ellipsis +begin + Result := [paDialog, paReadOnly]; +end; + +// Sets for AboutBox dialog properties +procedure TAboutPlaySound.SetMyComponentName(Const Avalue:String); +begin + fAboutBox.ComponentName:=AValue; + fAboutBox.Title:=AValue; +end; +procedure TAboutPlaySound.SetAboutBoxWidth(Const AValue:Integer); +begin + fAboutBox.Width:=Avalue; +end; +procedure TAboutPlaySound.SetAboutBoxHeight(Const AValue:Integer); +begin + fAboutBox.Height:=Avalue; +end; +procedure TAboutPlaySound.SetAboutBoxDescription(Const AValue:String); +begin + fAboutBox.Description.Clear; + fAboutBox.Description.Add(AValue); +end; +procedure TAboutPlaySound.SetAboutBoxFontName(Const AValue:String); +begin + fAboutBox.Font.Name:=AValue; +end; +procedure TAboutPlaySound.SetAboutBoxFontSize(Const AValue:Integer); +begin + if (AValue > 6) then fAboutBox.Font.Size:=AValue; +end; +procedure TAboutPlaySound.SetAboutBoxTitle(Const AValue:String); +begin + fAboutBox.Title:=AValue; +end; +procedure TAboutPlaySound.SetAboutBoxBitmap(Const AValue:TBitmap); +begin + If Assigned(Avalue) then fAboutBox.Assign(AValue); +end; +procedure TAboutPlaySound.SetAboutBoxBackgroundColor(Const AValue:TColor); +begin + fAboutBox.BackGroundColor:=AValue;; +end; +procedure TAboutPlaySound.SetAboutBoxVersion(Const AValue:String); +begin + fAboutBox.Version:=AValue; +end; +procedure TAboutPlaySound.SetAboutBoxAuthorname(Const AValue:String); +begin + fAboutBox.Authorname:=AValue; +end; +procedure TAboutPlaySound.SetAboutBoxOrganisation(Const AValue:String); +begin + fAboutBox.Organisation:=AValue; +end; +procedure TAboutPlaySound.SetAboutBoxAuthorEmail(Const AValue:String); +begin + fAboutBox.AuthorEmail:=AValue; +end; +procedure TAboutPlaySound.SetAboutBoxBackgroundResourceName(Const AValue:String); +begin + fAboutBox.BackgroundResourceName:=AValue; +end; +procedure TAboutPlaySound.SetAboutBoxLicenseType(Const AValue:string); +begin + Case Upcase(AValue) of + 'GPL':fAboutBox.LicenseType:=abGPL; + 'LGPL':fAboutBox.LicenseType:=abLGPL; + 'MIT':fAboutBox.LicenseType:=abMIT; + 'MODIFIEDGPL':fAboutBox.LicenseType:=abModifiedGPL; + 'PROPRIETRY':fAboutBox.LicenseType:=abProprietry; + else + fAboutBox.LicenseType:=abNone; + end; +end; +procedure TAboutPlaySound.SetAboutBoxStretchBackgroundImage(Const AValue:Boolean); +begin + fAboutBox.StretchBackground:=AValue; +end; + +// End Sets + +constructor TAboutPlaySound.Create(AOwner: TComponent); +var + TempImage: TPicture; + r:TLResource; +begin + // Inherit default properties + inherited Create(AOwner); + // Use tAboutBox as a subcomponent + fAboutBox := tAboutBox.Create(nil); + with fAboutBox do + begin + SetSubComponent(True); // Tell the IDE to store the modified properties + // Default of TAboutPlaySound values override TAbouBox.Create defaults + ComponentName := 'TAboutPlaySound'; + Description.Add('This is to demonstrate'); //TStrings + Description.Add('the use of TAboutPlaySound'); //TStrings + Description.Add('Set its properties in your Constructor'); //TStrings + Width := 320; //Integer + Height := 280; //Integer + // Set any Font properties or subproperties here + // Font.Name := 'Arial'; + Font.Color := clNavy; + Font.Size:=10; + // BackGroundColor shows if no BackGround image is set + BackGroundColor := clWindow; + Version := '1.0.0.0'; + AuthorName := 'Gordon Bamber'; + AuthorEmail := 'minesadorada@charcodelvalle.com'; + Organisation := 'Public Domain'; + + //Types available: abNone, abGPL, abLGPL, abMIT, abModifiedGPL, abProprietry + LicenseType := abLGPL; + + // BackGround image is optional + // It must be in a resouce file in the initialization section + + //== How to set a background image to your About dialog -- + // The BackGround property is a TBitmap + // Use a Temporary TPicture to load a JPG. + // NOTE a PNG file will create an error when your component is used in an application! + r := LazarusResources.Find(fAboutBox.BackgroundResourceName); + if r <> nil then + begin + TempImage := TPicture.Create; + // .lrs file is in the initialization section + TempImage.LoadFromLazarusResource(fAboutBox.BackgroundResourceName); + BackGround.Assign(TempImage.Bitmap); + TempImage.Free; + StretchBackground := fAboutBox.StretchBackground; //Boolean + end; +end; +end; + +destructor TAboutPlaySound.Destroy; +begin + FreeAndNil(fAboutBox); + inherited Destroy; +end; +initialization +{$I license.lrs} + +end. diff --git a/components/playsoundpackage/demo/demo.ico b/components/playsoundpackage/demo/demo.ico new file mode 100644 index 000000000..b623bcdbb Binary files /dev/null and b/components/playsoundpackage/demo/demo.ico differ diff --git a/components/playsoundpackage/demo/demo.lpi b/components/playsoundpackage/demo/demo.lpi new file mode 100644 index 000000000..90263511b --- /dev/null +++ b/components/playsoundpackage/demo/demo.lpi @@ -0,0 +1,98 @@ + + + + + + + + + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <Icon Value="0"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <VersionInfo> + <UseVersionInfo Value="True"/> + <RevisionNr Value="1"/> + <StringTable ProductVersion=""/> + </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <RequiredPackages Count="3"> + <Item1> + <PackageName Value="poweredby"/> + </Item1> + <Item2> + <PackageName Value="playwavepackage"/> + <MaxVersion Release="1"/> + </Item2> + <Item3> + <PackageName Value="LCL"/> + </Item3> + </RequiredPackages> + <Units Count="2"> + <Unit0> + <Filename Value="demo.lpr"/> + <IsPartOfProject Value="True"/> + <UnitName Value="demo"/> + </Unit0> + <Unit1> + <Filename Value="umainform.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="mainform"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="umainform"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <Target> + <Filename Value="demo"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + <Other> + <CompilerMessages> + <MsgFileName Value=""/> + </CompilerMessages> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/components/playsoundpackage/demo/demo.lpr b/components/playsoundpackage/demo/demo.lpr new file mode 100644 index 000000000..df9c32372 --- /dev/null +++ b/components/playsoundpackage/demo/demo.lpr @@ -0,0 +1,22 @@ +program demo; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms, poweredby, umainform + { you can add units after this }; + +{$R *.res} + +begin + Application.Title:='PlaySound component demo'; + RequireDerivedFormResource := True; + Application.Initialize; + Application.CreateForm(Tmainform, mainform); + Application.Run; +end. + diff --git a/components/playsoundpackage/demo/demo.res b/components/playsoundpackage/demo/demo.res new file mode 100644 index 000000000..d90777abd Binary files /dev/null and b/components/playsoundpackage/demo/demo.res differ diff --git a/components/playsoundpackage/demo/doorbell.wav b/components/playsoundpackage/demo/doorbell.wav new file mode 100644 index 000000000..f1c8c90ee Binary files /dev/null and b/components/playsoundpackage/demo/doorbell.wav differ diff --git a/components/playsoundpackage/demo/telephone.wav b/components/playsoundpackage/demo/telephone.wav new file mode 100644 index 000000000..41e86c86d Binary files /dev/null and b/components/playsoundpackage/demo/telephone.wav differ diff --git a/components/playsoundpackage/demo/umainform.lfm b/components/playsoundpackage/demo/umainform.lfm new file mode 100644 index 000000000..f549908cb --- /dev/null +++ b/components/playsoundpackage/demo/umainform.lfm @@ -0,0 +1,62 @@ +object mainform: Tmainform + Left = 415 + Height = 129 + Top = 305 + Width = 241 + BorderIcons = [biSystemMenu] + Caption = 'mainform' + ClientHeight = 129 + ClientWidth = 241 + DefaultMonitor = dmPrimary + OnCreate = FormCreate + Position = poScreenCenter + LCLVersion = '1.1' + object cmd_Async: TButton + Left = 16 + Height = 25 + Top = 16 + Width = 75 + Caption = 'Play Async' + OnClick = cmd_AsyncClick + TabOrder = 0 + end + object BitBtn1: TBitBtn + Left = 152 + Height = 30 + Top = 88 + Width = 75 + DefaultCaption = True + Kind = bkClose + ModalResult = 11 + TabOrder = 1 + end + object cmd_Sync: TButton + Left = 152 + Height = 25 + Top = 16 + Width = 75 + Caption = 'Play Sync' + OnClick = cmd_SyncClick + TabOrder = 2 + end + object playsound1: Tplaysound + About.Description.Strings = ( + 'Plays WAVE sounds in Windows or Linux' + ) + About.Title = 'About PlaySound' + About.Height = 400 + About.Width = 400 + About.Font.Color = clNavy + About.Font.Height = -13 + About.BackGroundColor = clCream + About.Version = '0.0.1' + About.Authorname = 'Gordon Bamber' + About.Organisation = 'Public Domain' + About.AuthorEmail = 'minesadorada@charcodelvalle.com' + About.ComponentName = 'PlaySound' + About.LicenseType = abLGPL + SoundFile = '/home/gordon/development/lazarus/' + left = 91 + top = 53 + end +end diff --git a/components/playsoundpackage/demo/umainform.pas b/components/playsoundpackage/demo/umainform.pas new file mode 100644 index 000000000..c57ae88ea --- /dev/null +++ b/components/playsoundpackage/demo/umainform.pas @@ -0,0 +1,65 @@ +unit umainform; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, uplaysound; + +type + + { Tmainform } + + Tmainform = class(TForm) + BitBtn1: TBitBtn; + cmd_Async: TButton; + cmd_Sync: TButton; + playsound1: Tplaysound; + procedure cmd_AsyncClick(Sender: TObject); + procedure cmd_SyncClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + private + { private declarations } + public + { public declarations } + end; + +var + mainform: Tmainform; + +implementation + +{$R *.lfm} + +{ Tmainform } + +procedure Tmainform.cmd_AsyncClick(Sender: TObject); +// No gap between sounds. App remains responsive +begin + playsound1.PlayStyle:=psASync; + playsound1.SoundFile:='doorbell.wav'; + playsound1.Execute; + playsound1.SoundFile:='telephone.wav'; + playsound1.Execute; +end; + +procedure Tmainform.cmd_SyncClick(Sender: TObject); +begin + playsound1.PlayStyle:=psSync; + playsound1.SoundFile:='doorbell.wav'; + playsound1.Execute; + playsound1.SoundFile:='telephone.wav'; + playsound1.Execute; + +end; + +procedure Tmainform.FormCreate(Sender: TObject); +begin + Caption:=Application.Title; + Icon:=Application.Icon; +end; + +end. + diff --git a/components/playsoundpackage/license.lrs b/components/playsoundpackage/license.lrs new file mode 100644 index 000000000..50194e647 --- /dev/null +++ b/components/playsoundpackage/license.lrs @@ -0,0 +1,72 @@ +LazarusResources.Add('gpl.txt','TXT',[ + ' Copyright (C) <year> <name of author> <contact>'#13#10#13#10' This source' + +' is free software; you can redistribute it and/or modify it under'#13#10' ' + +'the terms of the GNU General Public License as published by the Free'#13#10 + +' Software Foundation; either version 2 of the License, or (at your option)' + +#13#10' any later version.'#13#10#13#10' This code is distributed in the h' + +'ope that it will be useful, but WITHOUT ANY'#13#10' WARRANTY; without even' + +' the implied warranty of MERCHANTABILITY or FITNESS'#13#10' FOR A PARTICUL' + +'AR PURPOSE. See the GNU General Public License for more'#13#10' details.' + +#13#10#13#10' A copy of the GNU General Public License is available on the ' + +'World Wide Web'#13#10' at <http://www.gnu.org/copyleft/gpl.html>. You can ' + +'also obtain it by writing'#13#10' to the Free Software Foundation, Inc., 5' + +'9 Temple Place - Suite 330, Boston,'#13#10' MA 02111-1307, USA.' +]); +LazarusResources.Add('lgpl.txt','TXT',[ + ' Copyright (C) <year> <name of author> <contact>'#13#10#13#10' This librar' + +'y is free software; you can redistribute it and/or modify it'#13#10' under' + +' the terms of the GNU Library General Public License as published by'#13#10 + +' the Free Software Foundation; either version 2 of the License, or (at you' + +'r'#13#10' option) any later version.'#13#10#13#10' This program is distri' + +'buted in the hope that it will be useful, but WITHOUT'#13#10' ANY WARRANTY' + +'; without even the implied warranty of MERCHANTABILITY or'#13#10' FITNESS ' + +'FOR A PARTICULAR PURPOSE. See the GNU Library General Public License'#13#10 + +' for more details.'#13#10#13#10' You should have received a copy of the G' + +'NU Library General Public License'#13#10' along with this library; if not,' + +' write to the Free Software Foundation,'#13#10' Inc., 59 Temple Place - Su' + +'ite 330, Boston, MA 02111-1307, USA.' +]); +LazarusResources.Add('mit.txt','TXT',[ + ' Copyright (c) <year> <copyright holders>'#13#10#13#10' Permission is here' + +'by granted, free of charge, to any person obtaining a copy'#13#10' of this' + +' software and associated documentation files (the "Software"), to'#13#10' ' + +'deal in the Software without restriction, including without limitation the' + +#13#10' rights to use, copy, modify, merge, publish, distribute, sublicense' + +', and/or'#13#10' sell copies of the Software, and to permit persons to who' + +'m the Software is'#13#10' furnished to do so, subject to the following con' + +'ditions:'#13#10#13#10' The above copyright notice and this permission noti' + +'ce shall be included in'#13#10' all copies or substantial portions of the ' + +'Software.'#13#10#13#10' THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY' + +' OF ANY KIND, EXPRESS OR'#13#10' IMPLIED, INCLUDING BUT NOT LIMITED TO THE' + +' WARRANTIES OF MERCHANTABILITY,'#13#10' FITNESS FOR A PARTICULAR PURPOSE A' + +'ND NONINFRINGEMENT. IN NO EVENT SHALL THE'#13#10' AUTHORS OR COPYRIGHT HOL' + +'DERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER'#13#10' LIABILITY, WHETHER ' + +'IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING'#13#10' FROM, OUT OF ' + +'OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS'#13#10' IN' + +' THE SOFTWARE.' +]); +LazarusResources.Add('modifiedgpl.txt','TXT',[ + ' Copyright (C) <year> <name of author> <contact>'#13#10#13#10' This librar' + +'y is free software; you can redistribute it and/or modify it'#13#10' under' + +' the terms of the GNU Library General Public License as published by'#13#10 + +' the Free Software Foundation; either version 2 of the License, or (at you' + +'r'#13#10' option) any later version with the following modification:'#13#10 + +#13#10' As a special exception, the copyright holders of this library give ' + +'you'#13#10' permission to link this library with independent modules to pr' + +'oduce an'#13#10' executable, regardless of the license terms of these inde' + +'pendent modules,and'#13#10' to copy and distribute the resulting executabl' + +'e under terms of your choice,'#13#10' provided that you also meet, for eac' + +'h linked independent module, the terms'#13#10' and conditions of the licen' + +'se of that module. An independent module is a'#13#10' module which is not ' + +'derived from or based on this library. If you modify'#13#10' this library,' + +' you may extend this exception to your version of the library,'#13#10' but' + +' you are not obligated to do so. If you do not wish to do so, delete this' + +#13#10' exception statement from your version.'#13#10#13#10' This program ' + +'is distributed in the hope that it will be useful, but WITHOUT'#13#10' ANY' + +' WARRANTY; without even the implied warranty of MERCHANTABILITY or'#13#10' ' + +' FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public Licen' + +'se'#13#10' for more details.'#13#10#13#10' You should have received a cop' + +'y of the GNU Library General Public License'#13#10' along with this librar' + +'y; if not, write to the Free Software Foundation,'#13#10' Inc., 59 Temple ' + +'Place - Suite 330, Boston, MA 02111-1307, USA.' +]); diff --git a/components/playsoundpackage/locale/aboutplaysound.po b/components/playsoundpackage/locale/aboutplaysound.po new file mode 100644 index 000000000..af5247aa1 --- /dev/null +++ b/components/playsoundpackage/locale/aboutplaysound.po @@ -0,0 +1,35 @@ +msgid "" +msgstr "Content-Type: text/plain; charset=UTF-8" + +#: aboutplaysound.rs_about +msgid "About" +msgstr "" + +#: aboutplaysound.rs_aboutboxerror +msgid "Subcomponent TAboutBox Error" +msgstr "" + +#: aboutplaysound.rs_by +msgid "By" +msgstr "" + +#: aboutplaysound.rs_componentname +msgid "Component name" +msgstr "" + +#: aboutplaysound.rs_datafilemissing +msgid "Resource datafile license.lrs is missing" +msgstr "" + +#: aboutplaysound.rs_for +msgid "For" +msgstr "" + +#: aboutplaysound.rs_license +msgid "License" +msgstr "" + +#: aboutplaysound.rs_licensetexterror +msgid "There is something wrong with the Licence text" +msgstr "" + diff --git a/components/playsoundpackage/locale/uplaysound.po b/components/playsoundpackage/locale/uplaysound.po new file mode 100644 index 000000000..6c2391cb3 --- /dev/null +++ b/components/playsoundpackage/locale/uplaysound.po @@ -0,0 +1,7 @@ +msgid "" +msgstr "Content-Type: text/plain; charset=UTF-8" + +#: uplaysound.c_unabletoplay +msgid "Unable to play " +msgstr "" + diff --git a/components/playsoundpackage/playsound_icon.lrs b/components/playsoundpackage/playsound_icon.lrs new file mode 100644 index 000000000..73673b1ea --- /dev/null +++ b/components/playsoundpackage/playsound_icon.lrs @@ -0,0 +1,42 @@ +LazarusResources.Add('TPlaysound','PNG',[ + #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0 + +#0#0#6'bKGD'#0#255#0#255#0#255#160#189#167#147#0#0#0#9'pHYs'#0#0#14#206#0#0 + +#14#206#1#206'_'#197#247#0#0#0#7'tIME'#7#222#9#11#14'*'#1','#3#227';'#0#0#3 + +'_IDATH'#199#141#214'K'#136#215'U'#20#7#240#207#252'G'#29'M'#19#173#204#154 + +'$,5ln'#164'EI'#15#194'$k'#213#131#178'E'#166'a'#148'``-'#10#178#240#1#161 + +#182#201'V'#138#149'-'#162'E'#134#4#9'eX'#248'"'#8#172' '#218#232#25'1M2)' + +#209#202#183'&'#234#204#180#248#157#255#204'_'#249#167#222#205'9'#191's'#238 + +#189#231#253#189'?@Hz/'#241'b'#159#172'.'#191#212#234'='#255#18#241#244#249 + +#178'>'#229'hbK'#242#195#137'v'#151#189'b<q}'#242#31#17'#'#235#154'Z'#195#174 + +'W'#240'$1'#0#203'1'#225#2'O.'#226#185#137'XA'#244#199'R'#188'['#215#215'(' + +#136'I8J9'#138'7'#177#131#242'5'#241'X'#165#255#191'U'#16#247'S'#214#224#251 + +#234'l'#217#131#159#137#135#27'='#217'D'#12'"'#134#16'kS'#182#144'x'#234'2' + +#162'x'#136#152#147#252#15'D'#7#209'J,'#205#20#197#141#216'H'#249#23#31#226 + +'=b('#6'R'#214#18#195#154'G'#17'-'#196#21#216#130')'#196'8'#204#192'|JWu'#190 + +#170#193'M'#248#172#186#200'='#148'Mx'#31#171#136'k*za'#20#1#173#248#20'C1' + +#29#203'('#191#226#28'Q'#195'w'#196#180#26#198#227'0'#238#195#219#196#8#180 + +'Q'#246'aqU'#252'x'#16#3#250#12#244#180'b&f'#227'sJ'#15'6'#167#147#219'0'#26 + +#27#240'|'#13'cq'#2#29#213'f'#211'0'#175'j='#253#209#142#231#232'8'#155'a' + +#183'q['#23#238'H'#221'j'#226#22#252#136'qI'#167'g'#202#219'k'#24'I9'#135#17 + +'8'#158#223'{'#240#2#222#168'r:f'#14'-W'#166#193'6jm'#156'y'#21'O`'#29'n'#197 + +#239#152'Zu'#160#201#25#234#142'Z'#195','#12'B'#15#206#230#247'P'#202'!'#236 + +'f'#224#185#212#29#199'1'#186#7'2'#177';#8'#156#6#14'V'#180#252#147#145#192 + +#254'Z'#30#172#23'M'#195#247#201#28#186'?'#251#190'{W7-'#178'V]'#24'F'#233 + +#198#144#212#215#233#233#198#8#186#146#182#244'ET'#206#164#151'0'#184#193'@' + +#141#158#22#156#174'z'#222#177#164'GS_'#167#131#251'5'#164#228'TFQ7x'#166#26 + +'>'#183'W'#151#181#212'pm:p'#132#206'!'#216#155#181#235#172'jg{'#226#208#206 + +#188'cT'#13#251#19'C'#254#202#158'>'#152']'#241#9#22#224'-:'#151#211's*'#243 + +'|'#128'?Z0'#23#235#179#176#219'qs'#14']G'#213#178'`l'#13#191'd'#206#182#225 + +#153'l'#213'%'#148#159#178#159'wU'#30'v'#142#236#203#208#145#146#145#30#194 + +#163#148#221'x '#239#154'T'#221#17'Wag'#221'@;'#182#226#181#236#130#3#196#24 + +',Ld'#253#178#146#245#174#29'X'#153#200#185#136#24'UEPN'#226'.'#202'^<'#142 + +#21#181#170#13#205#166#156#192'W'#21#130'Z'#156#200#248'['#194#198'h'#202#217 + +'>'#184'('#167'2'#247#31'Pv'#165#177#249#196#228#6'G:(['#235#216#178#190#10 + +')'#6#16#223#164#236'Y'#226#227#228#251'5'#1#187'l'#134'XVAs'#180#18#251#136 + +#171'S'#190#164'q'#243'u'#196#202#228#23#16#139#146#159'EL'#185#8'T'#207'%^N' + +'~'#30'1#'#249'w'#136#187'3'#226#222'''sqB7'#226'[bf'#147#151'KsY'#204'"6$?' + +#129'X'#211'ds'#220'@'#172#174#222'c'#136'u'#137#162#151'z'#232#239'$'#190 + +#200#247'a8'#177'*'#135#238#188#169#173'o'#158#154#0#246'z'#5#3'FQ.'#241'k' + +#17#237#248';''})'#214'R6W'#14#148#166#30'=R'#165#235'b'#233'i'#154#166#153 + +#233#224'y'#235'?'#247')('#135#205' '#216'A'#0#0#0#0'IEND'#174'B`'#130 +]); diff --git a/components/playsoundpackage/playsound_icon.png b/components/playsoundpackage/playsound_icon.png new file mode 100644 index 000000000..7b437d25f Binary files /dev/null and b/components/playsoundpackage/playsound_icon.png differ diff --git a/components/playsoundpackage/playsoundackage.pas b/components/playsoundpackage/playsoundackage.pas new file mode 100644 index 000000000..6c8eca8ee --- /dev/null +++ b/components/playsoundpackage/playsoundackage.pas @@ -0,0 +1,22 @@ +{ This file was automatically created by Lazarus. Do not edit! + This source is only used to compile and install the package. + } + +unit playsoundackage; + +interface + +uses + uplaysound, aboutplaysound, LazarusPackageIntf; + +implementation + +procedure Register; +begin + RegisterUnit('uplaysound', @uplaysound.Register); + RegisterUnit('aboutplaysound', @aboutplaysound.Register); +end; + +initialization + RegisterPackage('playsoundackage', @Register); +end. diff --git a/components/playsoundpackage/playwavepackage.lpk b/components/playsoundpackage/playwavepackage.lpk new file mode 100644 index 000000000..42b833d02 --- /dev/null +++ b/components/playsoundpackage/playwavepackage.lpk @@ -0,0 +1,56 @@ +<?xml version="1.0"?> +<CONFIG> + <Package Version="4"> + <Name Value="playwavepackage"/> + <Author Value="minesadorada"/> + <CompilerOptions> + <Version Value="11"/> + <SearchPaths> + <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Debugging> + <GenerateDebugInfo Value="False"/> + </Debugging> + </Linking> + <Other> + <CompilerMessages> + <MsgFileName Value=""/> + </CompilerMessages> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> + <Description Value="Simple component to play wave files under Windows or Linux"/> + <License Value="LGPLv2"/> + <Version Release="1"/> + <Files Count="2"> + <Item1> + <Filename Value="uplaysound.pas"/> + <HasRegisterProc Value="True"/> + <UnitName Value="uplaysound"/> + </Item1> + <Item2> + <Filename Value="aboutplaysound.pas"/> + <HasRegisterProc Value="True"/> + <UnitName Value="aboutplaysound"/> + </Item2> + </Files> + <i18n> + <EnableI18N Value="True"/> + <OutDir Value="locale"/> + <EnableI18NForLFM Value="True"/> + </i18n> + <Type Value="RunAndDesignTime"/> + <RequiredPkgs Count="1"> + <Item1> + <PackageName Value="IDEIntf"/> + </Item1> + </RequiredPkgs> + <UsageOptions> + <UnitPath Value="$(PkgOutDir)"/> + </UsageOptions> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + </Package> +</CONFIG> diff --git a/components/playsoundpackage/playwavepackage.pas b/components/playsoundpackage/playwavepackage.pas new file mode 100644 index 000000000..8b7b77ce6 --- /dev/null +++ b/components/playsoundpackage/playwavepackage.pas @@ -0,0 +1,22 @@ +{ This file was automatically created by Lazarus. Do not edit! + This source is only used to compile and install the package. + } + +unit playwavepackage; + +interface + +uses + uplaysound, aboutplaysound, LazarusPackageIntf; + +implementation + +procedure Register; +begin + RegisterUnit('uplaysound', @uplaysound.Register); + RegisterUnit('aboutplaysound', @aboutplaysound.Register); +end; + +initialization + RegisterPackage('playwavepackage', @Register); +end. diff --git a/components/playsoundpackage/readme.txt b/components/playsoundpackage/readme.txt new file mode 100644 index 000000000..8396069e6 --- /dev/null +++ b/components/playsoundpackage/readme.txt @@ -0,0 +1,25 @@ +PlayWavePackage +=============== + +A simple visual component to play WAVe files in Windows or Linux + +Licence +======= +LGPLv2 + +Author +====== +minesadorada + +Compatibility +============= +Tested in: +Windows Vista 32-bit +Linux Mint 64-bit + +Should work with: +All versions of Windows +Most versions of Linux +Maybe Macintosh OSX + +:Gordon Bamber September 2014 \ No newline at end of file diff --git a/components/playsoundpackage/uplaysound.pas b/components/playsoundpackage/uplaysound.pas new file mode 100644 index 000000000..af6ab66ae --- /dev/null +++ b/components/playsoundpackage/uplaysound.pas @@ -0,0 +1,147 @@ +unit uplaysound; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs + ,FileUtil{$IFDEF WINDOWS},mmsystem{$ELSE},asyncprocess,process{$ENDIF},aboutplaysound; + +type + TPlayStyle = (psAsync,psSync); + Tplaysound = class(TAboutPlaySound) + private + { Private declarations } + {$IFDEF LINUX} + SoundPlayerAsyncProcess:Tasyncprocess; + SoundPlayerSyncProcess:Tprocess; + {$ENDIF} + fPathToSoundFile:String; + fPlayStyle:TPlayStyle; + protected + { Protected declarations } + procedure PlaySound(Const szSoundFilename:String); virtual; + public + { Public declarations } + 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; + end; + +procedure Register; + +implementation +{$IFDEF LINUX} +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); +begin + inherited Create(AOwner); + fPlayStyle:=psASync; + fPathToSoundFile:=ProgramDirectory; + + // About Dialog properties + 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'; +end; +Destructor Tplaysound.Destroy; +begin + {$IFDEF LINUX} + FreeAndNil(SoundPlayerSyncProcess); + FreeAndNil(SoundPlayerAsyncProcess); + {$ENDIF} + inherited; +end; +procedure Tplaysound.Execute; +begin + If Not FileExistsUTF8(fPathToSoundFile) then Exit; + PlaySound(fPathToSoundFile); +end; + +procedure Tplaysound.PlaySound(Const szSoundFilename:String); +Var + flags:Word; + linuxplaycommand:String; +begin +linuxplaycommand:=''; +{$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; +{$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; +{$ENDIF} +end; + +procedure Register; +begin + RegisterComponents('LazControls',[Tplaysound]); + {$I playsound_icon.lrs} +end; + +end.