Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Закрытая тема
Ваша тема закрыта, почему это могло произойти? Возможно,
Нет наработок или кода, если нужно готовое решение - создайте тему в разделе Фриланс и оплатите работу.
Название темы включает слова - "Помогите", "Нужна помощь", "Срочно", "Пожалуйста".
Название темы слишком короткое или не отражает сути вашего вопроса.
Тема исчерпала себя, помните, один вопрос - одна тема
Прочитайте правила и заново правильно создайте тему.
 
Опции темы Поиск в этой теме
Старый 15.08.2010, 22:32   #21
DIgorevich
Погулять вышел
Участник клуба
 
Аватар для DIgorevich
 
Регистрация: 17.05.2010
Сообщений: 1,573
По умолчанию

Лови: Project1.rar
надеюсь, так нужно?

Код:
var
  Form1: TForm1;
  Channel: DWORD;
  TempBMP: TBitmap;
implementation

{$R *.dfm}

procedure TForm1.tmrFFTTimer(Sender: TObject);
var
  FFTFata: TFFTData;
begin
  if BASS_ChannelIsActive(Channel) <> BASS_ACTIVE_PLAYING then Exit;
  BASS_ChannelGetData(Channel, @FFTFata, BASS_DATA_FFT1024);
  Spectrum.Draw(boxPaint.Canvas.Handle, FFTFata, 2, -2);
  Spectrum.SetBackground(True,TempBMP);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
if not BASS_Init(1, 44100, BASS_DEVICE_3D, Handle, nil) then
  begin
      exit;
  end;
  BASS_Start;

end;

procedure TForm1.Button1Click(Sender: TObject);
var  Drect,srect:TRect;
begin
  Spectrum:= TSpectrum.Create(boxPaint.Width, boxPaint.Height);
  Spectrum.Height:= boxPaint.Height - 5;
  Spectrum.Mask:= clGray;
  srect:=Bounds(boxPaint.left,boxPaint.top,boxPaint.Width,boxPaint.Height);
  drect:=Bounds(0,0,boxPaint.Width,boxPaint.Height);
  TempBMP:=TBitmap.Create;
  TempBMP.Width:=boxPaint.Width;
  TempBMP.Height:=boxPaint.Height;
  TempBMP.Canvas.CopyRect(Drect, Form1.Canvas, srect);
if opendialog1.Execute then 
 begin
  tmrFFT.Enabled:=true;
   Channel := BASS_StreamCreateFile(FALSE, PChar(opendialog1.FileName), 0, 0, 0 {$IFDEF UNICODE} or BASS_UNICODE {$ENDIF});
      BASS_ChannelPlay(Channel, False);
 end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  TempBMP.Free;
  Spectrum.Free;
  BASS_Free;
end;
Никогда не знаешь, где тебе повезет... (Фрай)

Последний раз редактировалось DIgorevich; 15.08.2010 в 22:42.
DIgorevich вне форума
Старый 15.08.2010, 22:43   #22
phphel
Форумчанин
 
Аватар для phphel
 
Регистрация: 12.07.2010
Сообщений: 249
По умолчанию

У меня в твоем примере если открыть файл форма закрывается..подозреваю что идет переполнение стека
Moonquake
phphel вне форума
Старый 15.08.2010, 22:44   #23
DIgorevich
Погулять вышел
Участник клуба
 
Аватар для DIgorevich
 
Регистрация: 17.05.2010
Сообщений: 1,573
По умолчанию

я переделал пример, не качай. Ты лучше код посмотри, он рабочий, без переполнения уже.
Никогда не знаешь, где тебе повезет... (Фрай)
DIgorevich вне форума
Старый 15.08.2010, 22:54   #24
phphel
Форумчанин
 
Аватар для phphel
 
Регистрация: 12.07.2010
Сообщений: 249
По умолчанию

Что значит не качай?
Moonquake
phphel вне форума
Старый 15.08.2010, 22:55   #25
DIgorevich
Погулять вышел
Участник клуба
 
Аватар для DIgorevich
 
Регистрация: 17.05.2010
Сообщений: 1,573
По умолчанию

там экзешка была старая, от другого кода...
Рабочий код: двумя моими постами выше... Ты просто вставь его и проверь
Никогда не знаешь, где тебе повезет... (Фрай)
DIgorevich вне форума
Старый 15.08.2010, 23:11   #26
phphel
Форумчанин
 
Аватар для phphel
 
Регистрация: 12.07.2010
Сообщений: 249
По умолчанию

В примере работает, а у меня нет. почему то берет фон с формы 1, а мне надо с формы2, + желательно было бы делать отрисовку в OnPaint а не в таймере
Moonquake
phphel вне форума
Старый 15.08.2010, 23:13   #27
DIgorevich
Погулять вышел
Участник клуба
 
Аватар для DIgorevich
 
Регистрация: 17.05.2010
Сообщений: 1,573
По умолчанию

ну делай Copyrect с формы2... а отрисовку ТОЛЬКО при обновлении Spectrum'a
Код:
  srect:=Bounds(boxPaint.left,boxPaint.top,boxPaint.Width,boxPaint.Height);
  drect:=Bounds(0,0,boxPaint.Width,boxPaint.Height);
  TempBMP:=TBitmap.Create;
  TempBMP.Width:=boxPaint.Width;
  TempBMP.Height:=boxPaint.Height;
  TempBMP.Canvas.CopyRect(Drect, Form1.Canvas, srect);
здесь прописываются координаты откуда брать фоновое изображение
Никогда не знаешь, где тебе повезет... (Фрай)
DIgorevich вне форума
Старый 15.08.2010, 23:16   #28
phphel
Форумчанин
 
Аватар для phphel
 
Регистрация: 12.07.2010
Сообщений: 249
По умолчанию

DIgorevich....мда.
Moonquake
phphel вне форума
Старый 15.08.2010, 23:17   #29
DIgorevich
Погулять вышел
Участник клуба
 
Аватар для DIgorevich
 
Регистрация: 17.05.2010
Сообщений: 1,573
По умолчанию

Цитата:
Сообщение от phphel Посмотреть сообщение
DIgorevich....мда.
что значит? не вижу трудностей...
Никогда не знаешь, где тебе повезет... (Фрай)
DIgorevich вне форума
Старый 15.08.2010, 23:19   #30
DomiNick
Студент, не
Старожил
 
Аватар для DomiNick
 
Регистрация: 29.01.2009
Сообщений: 2,067
По умолчанию

Цитата:
варианты типа "Юзай TImage" не катят, по многим причинам.
За что ж немилость-то такая?

Возможно пригодится: http://programmersforum.ru/showthread.php?t=108931
I am the First of Cyber Evolution...
I am the First to Program your Future...
DomiNick вне форума
Закрытая тема


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
PaintBox _-Re@l-_ Общие вопросы Delphi 11 23.06.2010 12:54
текст в PaintBox krikaved Общие вопросы Delphi 5 06.05.2010 19:05
Вопрос по PaintBox rainbow Общие вопросы Delphi 1 07.04.2010 11:21
Paintbox lacost Мультимедиа в Delphi 3 14.01.2009 09:53
paintbox steck Общие вопросы Delphi 5 28.10.2007 16:15