You've already forked lazarus-ccr
Initial commit.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3553 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
BIN
components/playsoundpackage/TPlaysound.png
Normal file
BIN
components/playsoundpackage/TPlaysound.png
Normal file
Binary file not shown.
After Width: | Height: | Size: 978 B |
624
components/playsoundpackage/aboutplaysound.pas
Normal file
624
components/playsoundpackage/aboutplaysound.pas
Normal file
@ -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 About<yourcomponentname>unit
|
||||
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<yourcomponentname>
|
||||
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, '<year>',
|
||||
{$I %DATE%}
|
||||
);
|
||||
sLicenseString := AnsiReplaceText(sLicenseString, '<name of author>', fAuthorname);
|
||||
sLicenseString := AnsiReplaceText(sLicenseString, '<contact>',
|
||||
'(' + fAuthorEmail + ')');
|
||||
sLicenseString := AnsiReplaceText(sLicenseString, '<copyright holders>',
|
||||
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.
|
BIN
components/playsoundpackage/demo/demo.ico
Normal file
BIN
components/playsoundpackage/demo/demo.ico
Normal file
Binary file not shown.
After Width: | Height: | Size: 134 KiB |
98
components/playsoundpackage/demo/demo.lpi
Normal file
98
components/playsoundpackage/demo/demo.lpi
Normal file
@ -0,0 +1,98 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<General>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="PlaySound component demo"/>
|
||||
<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>
|
22
components/playsoundpackage/demo/demo.lpr
Normal file
22
components/playsoundpackage/demo/demo.lpr
Normal file
@ -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.
|
||||
|
BIN
components/playsoundpackage/demo/demo.res
Normal file
BIN
components/playsoundpackage/demo/demo.res
Normal file
Binary file not shown.
BIN
components/playsoundpackage/demo/doorbell.wav
Normal file
BIN
components/playsoundpackage/demo/doorbell.wav
Normal file
Binary file not shown.
BIN
components/playsoundpackage/demo/telephone.wav
Normal file
BIN
components/playsoundpackage/demo/telephone.wav
Normal file
Binary file not shown.
62
components/playsoundpackage/demo/umainform.lfm
Normal file
62
components/playsoundpackage/demo/umainform.lfm
Normal file
@ -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
|
65
components/playsoundpackage/demo/umainform.pas
Normal file
65
components/playsoundpackage/demo/umainform.pas
Normal file
@ -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.
|
||||
|
72
components/playsoundpackage/license.lrs
Normal file
72
components/playsoundpackage/license.lrs
Normal file
@ -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.'
|
||||
]);
|
35
components/playsoundpackage/locale/aboutplaysound.po
Normal file
35
components/playsoundpackage/locale/aboutplaysound.po
Normal file
@ -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 ""
|
||||
|
7
components/playsoundpackage/locale/uplaysound.po
Normal file
7
components/playsoundpackage/locale/uplaysound.po
Normal file
@ -0,0 +1,7 @@
|
||||
msgid ""
|
||||
msgstr "Content-Type: text/plain; charset=UTF-8"
|
||||
|
||||
#: uplaysound.c_unabletoplay
|
||||
msgid "Unable to play "
|
||||
msgstr ""
|
||||
|
42
components/playsoundpackage/playsound_icon.lrs
Normal file
42
components/playsoundpackage/playsound_icon.lrs
Normal file
@ -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
|
||||
]);
|
BIN
components/playsoundpackage/playsound_icon.png
Normal file
BIN
components/playsoundpackage/playsound_icon.png
Normal file
Binary file not shown.
After Width: | Height: | Size: 978 B |
22
components/playsoundpackage/playsoundackage.pas
Normal file
22
components/playsoundpackage/playsoundackage.pas
Normal file
@ -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.
|
56
components/playsoundpackage/playwavepackage.lpk
Normal file
56
components/playsoundpackage/playwavepackage.lpk
Normal file
@ -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>
|
22
components/playsoundpackage/playwavepackage.pas
Normal file
22
components/playsoundpackage/playwavepackage.pas
Normal file
@ -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.
|
25
components/playsoundpackage/readme.txt
Normal file
25
components/playsoundpackage/readme.txt
Normal file
@ -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
|
147
components/playsoundpackage/uplaysound.pas
Normal file
147
components/playsoundpackage/uplaysound.pas
Normal file
@ -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.
|
Reference in New Issue
Block a user