unit SRWave;
interface
uses
{$IFDEF WIN32} Windows, {$else
} WinTypes, WinProcs, SysUtils, {$ENDIF}
Classes, Graphics, Controls, Forms, MMSystem, Dialogs, DsgnIntf;
type
TWaveLocation = (wlFile, wlResource, wlRAM);
TAboutProperty = class(TPropertyEditor)
public
procedure Edit;
override;
function GetAttributes: TPropertyAttributes;
override;
function GetValue: string;
override;
end;
TSRWavePlayer = class(TComponent)
private
{ Private declarations }
FAbout :TAboutProperty;
FAsync,
FLoop : boolean;
FWaveName : string;
FWavePointer : pointer;
FWaveLocation : TWaveLocation;
FBeforePlay,
FAfterPlay : TNotifyEvent;
procedure SetAfterPlay(Value: TNotifyEvent);
procedure SetAsync(Value: boolean);
procedure SetBeforePlay(Value: TNotifyEvent);
procedure SetLoop(Value: boolean);
protected
{ Protected declarations }
public
{ Public declarations }
property WavePointer: pointer read fWavePointer write fWavePointer;
function Play: boolean;
procedure Stop;
published
{ Published declarations }
property About: TAboutProperty read FAbout write FAbout;
property Async: boolean read FAsync write SetAsync;
property Loop: boolean read FLoop write SetLoop;
{$IFDEF WIN32}
property WaveLocation: TWaveLocation read FWaveLocation write fWaveLocation default wlFile;
{$ENDIF}
property WaveName: string read FWaveName write FWaveName;
property BeforePlay: TNotifyEvent read FBeforePlay write SetBeforePlay;
property AfterPlay: TNotifyEvent read FAfterPlay write SetAfterPlay;
end;
procedure Register;
implementation
procedure TAboutProperty.Edit;
const
CarriageReturn = chr(13);
var Msg: string;
begin
Msg := 'SRWavePlayer Komponente v1.0';
Msg:=Msg+CarriageReturn+CarriageReturn;
Msg:=Msg+'Copyright ?1998 Simon Reinhardt, alle Rechte vorbehalten.';
Msg:=Msg+CarriageReturn+CarriageReturn;
Msg:=Msg+' eMail: S.Reinhardt@WTal.de'+CarriageReturn+CarriageReturn;
Msg:=Msg+' Homepage: http://sr-soft.wtal.de'+CarriageReturn;
ShowMessage(Msg);
end;
function TAboutProperty.GetAttributes: TPropertyAttributes;
begin
Result := [paMultiSelect, paDialog, paReadOnly];
end;
function TAboutProperty.GetValue: string;
begin
Result := 'Komponenten-Infos';
end;
procedure TSRWavePlayer.SetAfterPlay(Value: TNotifyEvent);
begin
FAfterPlay := Value;
end;
procedure TSRWavePlayer.SetAsync(Value: boolean);
begin
{ if FAsync<>Value then
begin
}
FAsync:=Value;
if not FAsync then
FLoop:=false;
{ end;
}
end;
procedure TSRWavePlayer.SetBeforePlay(Value: TNotifyEvent);
begin
FBeforePlay := Value;
end;
procedure TSRWavePlayer.SetLoop(Value: boolean);
begin
if (FLoop<>Value) and FAsync then
FLoop:=Value;
end;
function TSRWavePlayer.Play;
{$IFDEF WIN32}
var Flags : DWORD;
{$else
}
var Flags : WORD;
PWaveName : PChar;
{$ENDIF}
begin
if Assigned(FBeforePlay) then
FBeforePlay(Self);
{$IFDEF WIN32}
case FWaveLocation of
wlFile : Flags := SND_FILENAME;
wlResource : Flags := SND_RESOURCE;
else
Flags := SND_MEMORY;
end;
{$else
}
{ Flags := SND_MEMORY;}
Flags := 0;
{$ENDIF}
if FLoop then
Flags := Flags or SND_LOOP;
if FAsync then
Flags := Flags or SND_ASYNC
else
Flags := Flags or SND_SYNC;
{$IFDEF WIN32}
if FWaveLocation = wlRAM then
Result := PlaySound(FWavePointer, 0, Flags)
else
Result := PlaySound(PChar(FWaveName), 0, Flags);
{$else
}
PWaveName:=StrAlloc(255);
StrPCopy(PWaveName, FWaveName);
Result := sndPlaySound(PWaveName, Flags);
StrDispose(PWaveName);
{$ENDIF}
if Assigned(FAfterPlay) then
FAfterPlay(Self);
end;
procedure TSRWavePlayer.Stop;
{$IFDEF WIN32}
var Flags : DWORD;
{$else
}
var Flags : WORD;
{$ENDIF}
begin
{$IFDEF WIN32}
case FWaveLocation of
wlFile : Flags:=SND_FILENAME;
wlResource : Flags:=SND_RESOURCE;
else
Flags:=SND_MEMORY;
end;
PlaySound(nil, 0, Flags);
{$else
}
sndPlaySound(nil, 0);
{$ENDIF}
end;
procedure Register;
begin
RegisterComponents('Simon', [TSRWavePlayer]);
RegisterPropertyEditor(TypeInfo(TAboutProperty), TSRWavePlayer, 'ABOUT', TAboutProperty);
end;
end.
