VPF::осцилограмма wav - Форум программистов

dddim

Дата 23.11.2005, 15:52 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 12
Регистрация: 13.7.2005

Репутация: нет
Всего: нет

подскажите где найти компоненту, с помощью которой можно было бы представить звуковой файл в виде осцилограммы(как в sound forge)?мож, у кого хотя бы есть догадки, как такой сделать? smile

welt

Дата 30.11.2005, 15:12 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 89
Регистрация: 21.5.2005
Где: UnderGround

Репутация: нет
Всего: нет

Вот пример. На форме две кнопки (Open, Exit).
PaintBox и ScrollBar

Код


unit Waveshow;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    ScrollBar1: TScrollBar;
    OpenDialog1: TOpenDialog;
    cmdOpen: TButton;
    cmdExit: TButton;
    Panel1: TPanel;
    PaintBox1: TPaintBox;
    procedure cmdOpenClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure cmdExitClick(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure ScrollBar1Change(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    FileIsOpen : Boolean;
    TheFileName : String[79];
    WaveFile : File;
    WaveBytes : LongInt;
    BytesPerSBPosition : Integer;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

{ We're spoofing here.  The header is *usually* 44 bytes long.  It }
{ would be better to just read the doggone thing and make sure. }
const
    WaveHdrSize = 44;

{ if you make the PaintBox wider than 1024, you will really need to }
{ make this larger!  It will be GPF city if you don't. }
var
    ReadBuffer : Array[0..1023] of Byte;

procedure TForm1.FormCreate(Sender: TObject);
begin
    FileIsOpen := False;
    OpenDialog1.DefaultExt := 'wav';
    OpenDialog1.FileName := '*.wav';
    OpenDialog1.Filter := 'Wave files (*.wav)|*.wav';
    Form1.Caption := 'Pete C.''s Wave Displayer';
end;

procedure TForm1.cmdOpenClick(Sender: TObject);
begin
    if OpenDialog1.Execute then
    begin
        if FileIsOpen then CloseFile (WaveFile);
        try
            TheFileName := OpenDialog1.Filename;
            AssignFile (WaveFile, TheFileName);
            Reset (WaveFile, 1);
            FileIsOpen := True;
            Form1.Caption := TheFileName;
            WaveBytes := FileSize (WaveFile) - WaveHdrSize;
            BytesPerSBPosition := 1;
            while (WaveBytes div BytesPerSBPosition) > 32767 do
                inc(BytesPerSBPosition);
            if WaveBytes div BytesPerSBPosition > PaintBox1.Width then
            begin
                ScrollBar1.Visible := True;
                ScrollBar1.Max := WaveBytes div BytesPerSBPosition
                                - PaintBox1.Width;
            end
            else
                ScrollBar1.Visible := False;
            if ScrollBar1.Position <> 0 then
                ScrollBar1.Position := 0
            else
                PaintBox1.Refresh;
        except
            on E: EInOutError do
                MessageDlg ('Unable to open ' + TheFileName + #10 + #13
                            + 'Error was ' + E.Message, mtError, [mbOK], 0);
        end;
    end;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
var
    X, NumRead : Integer;
    CurrPos : LongInt;
begin
    if FileIsOpen then
    begin
        CurrPos := (ScrollBar1.Position * BytesPerSBPosition) + WaveHdrSize;
        Seek (WaveFile, CurrPos);
        with PaintBox1.Canvas do
        begin
         FillChar (ReadBuffer, SizeOf(ReadBuffer), $80);
            BlockRead (WaveFile, ReadBuffer, ClipRect.Right, NumRead);
            Pen.Color := clLime;
            MoveTo (0, ReadBuffer[0] shr 1);  { 128 bit high picture }
            for X := 1 to NumRead - 1 do
                LineTo (X, ReadBuffer[X] shr 1);
        end;
    end;
end;

procedure TForm1.ScrollBar1Change(Sender: TObject);
begin
    PaintBox1.Refresh;
end;

procedure TForm1.cmdExitClick(Sender: TObject);
begin
    Application.Terminate;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
    if FileIsOpen then CloseFile (WaveFile);
end;

end.

Gigabyte

Дата 8.12.2005, 17:29 (ссылка)

(нет голосов)

Загрузка ...

Студент-халявщик

Профиль
Группа: Участник
Сообщений: 305
Регистрация: 1.11.2004
Где: ПЫтер

Репутация: нет
Всего: 3

welt не мог ли ты немного поясьнить код?

--------------------

Alexeis

Дата 9.12.2005, 11:42 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459

интересно что делает строка :

while (WaveBytes div BytesPerSBPosition) > 32767 do
inc(BytesPerSBPosition);

--------------------

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Звук, графика и видео \| Следующая тема »