Показать сообщение отдельно
  #19  
Старый 14.01.2015, 07:51
BlackMonsta BlackMonsta вне форума
Новичок
 
Регистрация: 22.12.2013
Сообщения: 67
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию

Код:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, ExtCtrls, Buttons, sSpeedButton, sColorSelect, bass,
  Spin, JPeg;

type
  TFFTData  = array [0..512] of Single;
  TForm1 = class(TForm)
    Label1: TLabel;
    PopupMenu1: TPopupMenu;
    ext1: TMenuItem;
    Panel1: TPanel;
    Panel2: TPanel;
    sColorSelect1: TsColorSelect;
    OpenSong1: TMenuItem;
    OpenDialog1: TOpenDialog;
    Timer1: TTimer;
    Button1: TButton;
    Button2: TButton;
    Timer2: TTimer;
    Timer3: TTimer;
    SpinEdit1: TSpinEdit;
    pb1: TImage;
    Timer4: TTimer;
    Panel3: TPanel;
    procedure ext1Click(Sender: TObject);
    procedure OpenSong1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Button3Click(Sender: TObject);
    procedure Draw(HWND : THandle; FFTData : TFFTData; X, Y : Integer);
    procedure Timer4Timer(Sender: TObject);
    procedure Panel1Click(Sender: TObject);
    procedure Panel2Click(Sender: TObject);
    procedure Panel3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  s1: HSTREAM;
  s2: HSTREAM;
  FFTPeacks  : array [0..128] of Integer;
  FFTFallOff : array [0..128] of Integer;

implementation

{$R *.dfm}

procedure TForm1.Draw(HWND : THandle; FFTData : TFFTData; X, Y : Integer);
        var i, YPos : LongInt; YVal : Single;
       begin
       //î÷èñòêà îáëàñòè âèçóàëèçàöèè
          pb1.Canvas.Pen.Color := clBlack;
          pb1.Canvas.Brush.Color := clBlack;
          pb1.Canvas.Rectangle(0, 0, pb1.Width, pb1.Height);
       //âèçóàëèçàöèÿ
       // pb1.Canvas.Pen.Color := clRed;
         for i := 0 to 127 do begin // êîëè÷åñòâî ñòîëáèêîâ
           YVal := Abs(FFTData[i]);
           YPos := trunc((YVal) * 500);
           if YPos > pb1.Height then YPos := pb1.Height;

           if YPos >= FFTPeacks[i] then FFTPeacks[i] := YPos
             else FFTPeacks[i] := FFTPeacks[i] - 1;

           if YPos >= FFTFallOff[i] then FFTFallOff[i] := YPos
              else FFTFallOff[i] := FFTFallOff[i] - 3;
                     //ðèñîâàíèå ïèêà
                     pb1.Canvas.Pen.Color := clYellow;
                     pb1.Canvas.MoveTo(X + i*(3+1) , Y + pb1.Height - FFTPeacks[i]);
                     pb1.Canvas.LineTo(X + i*(3+1) + 3, Y + pb1.Height - FFTPeacks[i]);
                     //ðèñîâàíèå ñòîëáèêà
                     pb1.Canvas.Pen.Color := clRed;
                     pb1.Canvas.Brush.Color := clRed;
                     pb1.Canvas.Rectangle(X + i*(3+1) , Y + pb1.Height - FFTFallOff[i], X + i*(3+1) + 3, Y + pb1.Height);

              end;

        end;
        

procedure TForm1.ext1Click(Sender: TObject);
begin
if PopupMenu1.PopupComponent is TPanel then
TPanel(PopupMenu1.PopupComponent).Color:= sColorSelect1.ColorValue;
end;

procedure TForm1.OpenSong1Click(Sender: TObject);
begin
If OpenDialog1.Execute then
begin
if PopupMenu1.PopupComponent is TPanel then
TPanel(PopupMenu1.PopupComponent).Caption:= OpenDialog1.FileName;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
If OpenDialog1.Execute then
begin
panel1.Caption:= OpenDialog1.FileName;         
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
If OpenDialog1.Execute then
begin
panel2.Caption:= OpenDialog1.FileName;
end;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
if Key = VK_UP then
begin
Panel1.Color:= clWindow;
s1 := BASS_StreamCreateFile(False, PChar(Panel1.Caption), 0, 0, 0);
BASS_ChannelPlay(s1, true);
BASS_ChannelPause(s1);
end;
if Key = VK_DOWN then
begin
Panel2.Color:= clWindow;
s2 := BASS_StreamCreateFile(False, PChar(Panel2.Caption), 0, 0, 0);
BASS_ChannelPlay(s2, true);
BASS_ChannelPause(s2);
end;
end;

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
If Key = VK_UP then
begin
BASS_ChannelStop(s1);
end;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
s: integer;
begin
Timer2.Interval:= Round(60000/(spinedit1.Value));
Timer2.Enabled:= true;
end;

procedure TForm1.Timer4Timer(Sender: TObject);
var
  FFTFata : TFFTData;
begin
BASS_ChannelGetData(s1, @FFTFata, BASS_DATA_FFT1024);
BASS_ChannelGetData(s2, @FFTFata, BASS_DATA_FFT1024);
Draw (pb1.Canvas.Handle, FFTFata, 0,-5);
end;

procedure TForm1.Panel1Click(Sender: TObject);
begin
s1 := BASS_StreamCreateFile(False, PChar(Panel1.Caption), 0, 0, 0);
BASS_ChannelPlay(s1, true);
end;

procedure TForm1.Panel2Click(Sender: TObject);
begin
s2 := BASS_StreamCreateFile(False, PChar(Panel2.Caption), 0, 0, 0);
BASS_ChannelPlay(s2, true);
end;

procedure TForm1.Panel3Click(Sender: TObject);
begin
Timer4.Enabled:= True;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
BASS_Init(-1, 44100, 0, Handle, nil);
end;

end.
Админ: учимся корректно оформлять код.

Вот код. Button1 и Button2 они открывают OpenDialog и с ними выбираю mp3 файлы. При нажатии Button1 появляется OD и при выборе файла, путь к файлу сохраняется в Panel1.Caption, с Button2 тоже самое только он сохраняет второй путь к файлу в Panel2.Caption. При нажатии на эти две понельки то воспроизводятся те звуки которые я выбрал. При нажатии на Panel3 включается Timer4. И вот получается сначала у меня получилось сделать чтобы в одном Paintbox отображались 2 потока сразу. Но, когда два этих потока заканчиваются(сам звук уже заканчивается) то выходит ошибка. Ошибка скорее всего из за того что Timer4 отображает в Paintbox не понятно что потому что два этих потока не проигрываются или закончили проигрываться.
Ответить с цитированием