freepascal.ru

Доброго времени суток! Имеется программа на Лазарусе для записи и обработки звука с линейного входа, конвертированная из Delphi 6. Запись происходит с помощью WinApi функций из Winmm.dll (используется модуль MMSystem). Проблема заключается в том, что прога не получает сообщения от винды об открытии/заполнении буфера/закрытии устройства записи, однако функции для работы со звуком ошибок не возвращают. Проект нормально компилится в обоих IDE, но корректно работает только в дельфи 6. Пробовал на Лазарусах 0.9.29 (FPC 2.2.4) и 0.9.31 (FPC 2.5.1). Возможно я не учел какую-нибуть особенность FPC? Помогите пожалуйста разобраться.
Код следующий:

Код: Выделить всё

..........
uses
  LCLIntf, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, MMSystem, FuncUnit, Ap, ComCtrls, LResources, Math,
  Windows;

  TFTuner = class(TForm)
.........
  private
    hwi:HWAVEIN;
    wh:  TWaveHdr;
    WaveData1:PChar;
    stop:boolean;
    n:integer;
    procedure MMProcOpen(var Message: TMessage); message MM_WIM_OPEN;
    procedure MMProcClose(var Message: TMessage); message MM_WIM_CLOSE;
    procedure MMProcData(var Message: TMessage); message MM_WIM_DATA;   
    procedure
    { Private declarations }
  public;
    { Public declarations }
  end;

var
  FTuner: TFTuner;

implementation   

procedure TFTuner.MMProcOpen(var Message: TMessage);
begin
  ShowMessage('Opened');
end;

procedure TFTuner.MMProcClose(var Message: TMessage);
begin
  GlobalFree(integer(WaveData1));
end;

procedure TFTuner.MMProcData(var Message: TMessage);
begin
/// что то делаем
end;

// Запись инициируется по нажатию кнопки
procedure TFTuner.Button1Click(Sender: TObject);
var Device:integer;
Result:MMResult;
begin
// выбор устройства из списка. список генерится правильно
  Device:=cbDev.ItemIndex;
  wfx:=GetWaveFormat(Device);

  if waveInOpen(@hwi,Device,@wfx,self.Handle, 0,CALLBACK_WINDOW)<>0 then exit;
  if Result<>MMSYSERR_NOERROR then Exit;
 
  wh.lpData:=WaveData1;
  wh.dwBufferLength:=WaveDataLength*sizeof(byte);
  wh.dwUser:=0;
  wh.dwFlags:=0;

  Result:=waveInPrepareHeader(hwi,@wh,sizeof(TWaveHdr));
  if Result<>MMSYSERR_NOERROR then Exit;

  Result:=waveInAddBuffer(hwi,@wh,sizeof(TWaveHdr));
  if Result<>MMSYSERR_NOERROR then Exit;

  Result:=waveInStart(hwi);
  if Result<>MMSYSERR_NOERROR then Exit;
end;
................


Дело не в FPC, а в Lazarus, точнее в LCL. Начиная с версии 0.9.26 она не пропускает в программу некоторые сообщения от WinAPI (например, WM_HOTKEY, WM_SYSCOMMAND). Возможно, MM_WIM_XXX попадают в эту же категорию. Чтобы их получать, нужно переустановить WindowProc с помощью SetWindowLong, в новом WindowProc ловить нужное сообщение или вызывать старый WindowProc. Подробнее см. тут:
http://wiki.lazarus.freepascal.org/Laza ... .2F_Events
http://wiki.lazarus.freepascal.org/Win3 ... our_window
http://forum.lazarus.freepascal.org/ind ... pic=6062.0

Большое спасибо! все получилось