Проиграть звук из таблицы
Автор: Xavier Pacheco
unit Main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, DBCtrls, DB, DBTables, StdCtrls, Mask, Buttons, ComCtrls;
type
TMainForm = class(TForm)
tblSounds: TTable;
dsSounds: TDataSource;
tblSoundsWaveTitle: TStringField;
tblSoundsWave: TBlobField;
edTitle: TDBEdit;
edFileName: TDBEdit;
Label1: TLabel;
Label2: TLabel;
OpenDialog: TOpenDialog;
tblSoundsFileName: TStringField;
SaveDialog: TSaveDialog;
pnlToobar: TPanel;
sbPlay: TSpeedButton;
sbAdd: TSpeedButton;
sbSave: TSpeedButton;
sbExit: TSpeedButton;
Bevel1: TBevel;
dbnNavigator: TDBNavigator;
stbStatus: TStatusBar;
procedure sbPlayClick(Sender: TObject);
procedure sbAddClick(Sender: TObject);
procedure sbSaveClick(Sender: TObject);
procedure sbExitClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
procedure OnAppHint(Sender: TObject);
end;
var
MainForm: TMainForm;
implementation
{$R *.DFM}
uses MMSystem;
procedure TMainForm.sbPlayClick(Sender: TObject);
var
B: TBlobStream;
M: TMemoryStream;
begin
B := TBlobStream.Create(tblSoundsWave, bmRead); // create blob stream
Screen.Cursor := crHourGlass; // wait hourglass
try
M := TMemoryStream.Create; // create memory stream
try
M.CopyFrom(B, B.Size); // copy from blob to memory stream
// Attempt to play sound. Raise exception if something goes wrong
Win32Check(PlaySound(M.Memory, 0, SND_SYNC or SND_MEMORY));
finally
M.Free;
end;
finally
Screen.Cursor := crDefault;
B.Free; // clean up
end;
end;
procedure TMainForm.sbAddClick(Sender: TObject);
begin
if OpenDialog.Execute then
begin
tblSounds.Append;
tblSounds['FileName'] := ExtractFileName(OpenDialog.FileName);
tblSoundsWave.LoadFromFile(OpenDialog.FileName);
edTitle.SetFocus;
end;
end;
procedure TMainForm.sbSaveClick(Sender: TObject);
begin
with SaveDialog do
begin
FileName := tblSounds['FileName']; // initialize file name
if Execute then // execute dialog
tblSoundsWave.SaveToFile(FileName); // save blob to file
end;
end;
procedure TMainForm.sbExitClick(Sender: TObject);
begin
Close;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
Application.OnHint := OnAppHint;
end;
procedure TMainForm.OnAppHint(Sender: TObject);
begin
stbStatus.SimpleText := Application.Hint;
end;
end.
|