waveplay.pas

一个好的多媒体控件twaveplayer

unit WavePlay;

{

 TWavePlayer v1.0
 by Kambiz R. Khojasteh

 mail: [e-mail]
 web: http://www.crosswinds.net/~khojasteh/

 This component is freeware and may be used in any software product.

}

interface

uses
  Windows, Messages, SysUtils, Classes, Dialogs, Forms;

const
  DefaultResType = 'WAVE';

type

  TWave = TMemoryStream;

  TWavePlayer = class(TComponent)
  private
    FSound: TWave;
    FActive: Boolean;
    FLoop: Boolean;
    FStopOthers: Boolean;
    FWaitToStop: Boolean;
    procedure SetActive(Value: Boolean);
    procedure ReadData(Stream: TStream);
    procedure WriteData(Stream: TStream);
  protected
    procedure DefineProperties(Filer: TFiler); override;
  public
    ResType: PChar;
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
    function Empty: Boolean;
    procedure Clear;
    procedure Play;
    procedure Stop;
    procedure LoadFromResourceName(Instance: THandle; const ResName: String);
    procedure LoadFromResourceID(Instance: THandle; const ResID: Integer);
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToStream(Stream: TStream);
    procedure LoadFromFile(FileName: String);
    procedure SaveToFile(FileName: String);
  published
    property Active: Boolean read FActive write SetActive default False;
    property StopOthers: Boolean read FStopOthers write FStopOthers default False;
    property WaitToStop: Boolean read FWaitToStop write FWaitToStop default False;
    property Loop: Boolean read FLoop write FLoop default False;
    property Sound: TWave read FSound write FSound;
  end;

procedure Register;

implementation

uses
  DsgnIntf, MMSystem;

type

{ TWaveComponentEditor }

  TWaveComponentEditor = class(TComponentEditor)
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

{ TWavePropertyEditor }

  TWavePropertyEditor = class(TStringProperty)
  public
    procedure Edit; override;
    function GetValue: string; override;
    procedure SetValue (const Value: string); override;
    function GetAttributes: TPropertyAttributes; override;
  end;

{ TWavePlayer }

constructor TWavePlayer.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  ResType := DefaultResType;
  Sound := TMemoryStream.Create;
  FStopOthers := False;
  FWaitToStop := False;
  FLoop := False;
  FActive := False;
end;

destructor TWavePlayer.Destroy;
begin
  Stop;
  Sound.Free;
  inherited Destroy;
end;

function TWavePlayer.Empty: Boolean;
begin
  Result := (Sound.Size = 0);
end;

procedure TWavePlayer.Clear;
begin
  if Sound.Size > 0 then
  begin
    Stop;
    Sound.Clear;
  end;
end;

procedure TWavePlayer.LoadFromResourceName(Instance: THandle;
  const ResName: String);
var
  Stream: TResourceStream;
begin
  Clear;
  Stream := TResourceStream.Create(Instance, PChar(ResName), ResType);
  try
    if (Stream <> nil) and (Stream.Memory <> nil) then
      Sound.CopyFrom(Stream, Stream.Size);
  finally
    Stream.Free;
  end;
end;

procedure TWavePlayer.LoadFromResourceID(Instance: THandle;
  const ResID: Integer);
var
  Stream: TResourceStream;
begin
  Clear;
  Stream := TResourceStream.CreateFromID(Instance, ResID, ResType);
  try
    if (Stream <> nil) and (Stream.Memory <> nil) then
      Sound.CopyFrom(Stream, Stream.Size);
  finally
    Stream.Free;
  end;
end;

procedure TWavePlayer.LoadFromStream(Stream: TStream);
begin
  Clear;
  Sound.CopyFrom(Stream, 0);
end;

procedure TWavePlayer.SaveToStream(Stream: TStream);
begin
  Stream.CopyFrom(Sound, 0);
end;

procedure TWavePlayer.LoadFromFile(FileName: String);
begin
  Clear;
  Sound.LoadFromFile(FileName);
end;

procedure TWavePlayer.SaveToFile(FileName: String);
begin
  Sound.SaveToFile(FileName);
end;

procedure TWavePlayer.Play;
const
  OthersFlag: array [Boolean] of Word = (SND_NOSTOP, 0);
  WaitFlag: array [Boolean] of Word = (SND_ASYNC, 0);
  LoopFlag: array [Boolean] of Word = (0, SND_LOOP);
begin
  Stop;
  if Sound.Size > 0 then
    FActive := sndPlaySound(Sound.Memory, OthersFlag[StopOthers] or
      WaitFlag[WaitToStop] or LoopFlag[Loop] or SND_MEMORY) and Loop;
end;

procedure TWavePlayer.Stop;
begin
  FActive := False;
  sndPlaySound(nil, SND_MEMORY);
end;

procedure TWavePlayer.SetActive(Value: Boolean);
begin
  if Active <> Value then
    if Value then
      Play
    else
      Stop;
end;

procedure TWavePlayer.ReadData(Stream: TStream);
begin
  Sound.LoadFromStream(Stream);
end;

procedure TWavePlayer.WriteData(Stream: TStream);
begin
  Sound.SaveToStream(Stream);
end;

procedure TWavePlayer.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineBinaryProperty('Data', ReadData, WriteData, Sound.Size > 0);
end;

{ TWaveComponentEditor }

procedure TWaveComponentEditor.ExecuteVerb(Index: Integer);
var
  WavePlayer: TWavePlayer;
begin
  WavePlayer := Component as TWavePlayer;
  if Index = 0 then
    with TOpenDialog.Create(Application) do
      try
        Filter := 'Wave files (*.wav;*.wave)|*.wav;*.wave|Any file (*.*)|*.*';
        Options := Options + [ofPathMustExist, ofFileMustExist];
        if Execute then
        begin
          WavePlayer.LoadFromFile(FileName);
          Designer.Modified;
        end;
      finally
        Free;
      end
  else if Index = 1 then
  begin
    WavePlayer.Clear;
    Designer.Modified;
  end
  else
    inherited ExecuteVerb(Index);
end;

function TWaveComponentEditor.GetVerb(Index: Integer): string;
begin
  case Index of
    0: Result := 'Load from file...';
    1: Result := 'Clear sound data';
  else
    Result := '';
  end;
end;

function TWaveComponentEditor.GetVerbCount: Integer;
begin
  Result := 2;
end;

{ TWavePropertyEditor }

function TWavePropertyEditor.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog];
end;

function TWavePropertyEditor.GetValue: string;
var
  Sound: TWave;
begin
  Sound := TWave(GetOrdValue);
  if Sound.Size > 0 then
    Result := '(TWave)'
  else
    Result := '(None)';
end;

procedure TWavePropertyEditor.SetValue(const Value: string);
begin
  if Value = EmptyStr then SetOrdValue(0);
end;

procedure TWavePropertyEditor.Edit;
var
  WavePlayer: TWavePlayer;
begin
  with TOpenDialog.Create(Application) do
    try
      WavePlayer := GetComponent(0) as TWavePlayer;
      Filter := 'Wave files (*.wav;*.wave)|*.wav;*.wave|Any file (*.*)|*.*';
      Options := Options + [ofPathMustExist, ofFileMustExist];
      if Execute then
      begin
        WavePlayer.LoadFromFile(FileName);
        Modified;
      end;
    finally
      Free;
    end;
end;

procedure Register;
begin
  RegisterComponents('Samples', [TWavePlayer]);
  RegisterComponentEditor(TWavePlayer, TWaveComponentEditor);
  RegisterPropertyEditor(TypeInfo(TWave), TWavePlayer, 'Sound', TWavePropertyEditor);
end;

end.