Проиграть звук из таблицы

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: 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.

{/codecitation}

Добавить комментарий