unit AvRecorder;

interface

uses
  AnyQBase,
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Videocap, StdCtrls, Buttons, VideoDisp, ACMWaveOut,
  ACMWaveIn, math, vfw;

const
  WM_SIZEOUT = WM_USER + 5377;

type
  TRecordStatus=(rsReady, rsStop, rsRecord, rsPlay);

  TAvRecForm = class(TAnyQBaseForm)
    pnlVideo: TPanel;
    pnlTool: TPanel;
    BitBtnRecord: TBitBtn;
    BitBtnStop: TBitBtn;
    BitBtnPlay: TBitBtn;
    pnlAdvance: TPanel;
    pnlOption: TPanel;
    grpAudio: TGroupBox;
    VideoRecorder: TVideoCap;
    Panel2: TPanel;
    BitBtnOption: TBitBtn;
    BitBtnADD: TBitBtn;
    BitBtnClose: TBitBtn;
    paintStatus: TPaintBox;
    grpVideo: TGroupBox;
    chkAnyQ: TCheckBox;
    chkNormal: TCheckBox;
    chkNoCompress: TCheckBox;
    chkXVID: TCheckBox;
    chkXVID2: TCheckBox;
    chkRaw: TCheckBox;
    ledtFileName: TLabeledEdit;
    BitBtnSaveAS: TBitBtn;
    spbtnAudio: TSpeedButton;
    spbtnVideo: TSpeedButton;
    Image1: TImage;
    ACMRecorder: TACMWaveIn;
    ACMPlayer: TACMWaveOut;
    VideoDisplayer: TVideoDisp;
    TimerPlay: TTimer;
    procedure paintStatusPaint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BitBtnOptionClick(Sender: TObject);
    procedure spbtnVideoClick(Sender: TObject);
    procedure BitBtnRecordClick(Sender: TObject);
    procedure BitBtnStopClick(Sender: TObject);
    procedure BitBtnCloseClick(Sender: TObject);
    procedure BitBtnPlayClick(Sender: TObject);
    procedure chkAudioClick(Sender: TObject);
    procedure ACMRecorderData(data: Pointer; size: Integer);
    procedure ACMPlayerDone(Sender: TObject);
    procedure VideoRecorderVideoStream(sender: TObject; lpVhdr: PVIDEOHDR);
    procedure BitBtnADDClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure chkVideoClick(Sender: TObject);
    procedure TimerPlayTimer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ParentResize(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure spbtnAudioClick(Sender: TObject);
    procedure BitBtnSaveASClick(Sender: TObject);
  private
    { Private declarations }
    Avi: IAVIFile;
    videos: IAVIStream;
    Audios: IAVIStream;
    VPos: Integer;
    APos: Integer;
    VInfo: TAVIStreamInfo;
    AInfo: TAVIStreamInfo;

    StartTick: Cardinal;

    procedure WMSIZEOUT(var msg: TMessage); message WM_SIZEOUT;

  public
    { Public declarations }
    RecordStatus: TRecordStatus;
    RecordTime: Cardinal;
    RecordSize: Integer;
    PlayedTime: Cardinal;
    AfterClose: TNotifyEvent;

    AudioStream: TMemoryStream;
//    VideoStream: TMemoryStream;

    AttachNo: Integer;
    SavedFileName: string;
    VEnd: Boolean;
    AEnd: Boolean;

    procedure StartRecord;
    Procedure StopRecord;
    Procedure PlayRecord;
    Procedure RecordAVI;
    Procedure RecordWAV;
    procedure SaveAVI(filename: string = '');
    procedure SaveWAV(filename: string = '');

    procedure PlayAVI(filename: string = '');
    procedure PlayWAV(filename: string = '');
  end;

var
  AvRecForm: TAvRecForm;

implementation

{$R *.dfm}
uses mmsystem, g729, AnyQv, Jabber1, RiserWindow, Session;

const
  PCMFOMAT : tWAVEFORMATEX =
    ( wFormatTag: WAVE_FORMAT_PCM;
      nChannels: 1;
      nSamplesPerSec: 8000;
      nAvgBytesPerSec: 8000;
      nBlockAlign: 1;
      wBitsPerSample: 8;
      cbSize: 0;
    );

  GSMFOMAT : tWAVEFORMATEX =
    ( wFormatTag: 49;
      nChannels: 1;
      nSamplesPerSec: 8000;
      nAvgBytesPerSec: 1625;
      nBlockAlign: 65;
      wBitsPerSample: 0;
      cbSize: 2;
    );

  AnyQFOMAT : tWAVEFORMATEX =
    ( wFormatTag: 0;
      nChannels: 1;
      nSamplesPerSec: 8000;
      nAvgBytesPerSec: 1000;
      nBlockAlign: 10;
      wBitsPerSample: 16;
      cbSize: 2;
    );
  AnyQPCMFOMAT : tWAVEFORMATEX =
    ( wFormatTag: WAVE_FORMAT_PCM;
      nChannels: 1;
      nSamplesPerSec: 8000;
      nAvgBytesPerSec: 16000;
      nBlockAlign: 2;
      wBitsPerSample: 16;
      cbSize: 0;
    );

procedure TAvRecForm.paintStatusPaint(Sender: TObject);
var
  R: TRect;
  txt: String;
begin
  with paintStatus.Canvas do
  begin
    Lock;
    //画分隔线
    pen.Color := clLtGray;
    pen.Width := 1;
    pen.Style := psSolid;
    MoveTo(0,0);
    LineTo(paintStatus.Width,0);

    //显示当前状态
    R := Rect(2,2, 78, 19);
    case RecordStatus of
      rsReady: DrawText(Handle, '准备就绪', 8, R, DT_LEFT or DT_TOP);
      rsStop: DrawText(Handle, '停止', 4, R, DT_LEFT or DT_TOP);
      rsRecord: DrawText(Handle, '正在录制...', 11, R, DT_LEFT or DT_TOP);
      rsPlay: DrawText(Handle, '正在播放...', 11, R, DT_LEFT or DT_TOP);
    end;

    //显示时间
    R := Rect(80,2, 196, 19);
    case RecordStatus of
      rsPlay:
        txt := '时间:'+formatfloat('0.00', PlayedTime/1000)+
            '/'+formatfloat('0.00', RecordTime/1000)+'秒';
      else
        txt := '时间:'+formatfloat('0.00', RecordTime/1000)+'秒';
    end;
    DrawText(Handle, Pchar(txt), length(txt), R, DT_LEFT or DT_TOP);

    //显示文件大小
    R := Rect(200,2, 316, 19);
    txt := '文件大小:'+formatfloat('0.00', RecordSize/1024)+'KB';
    DrawText(Handle, Pchar(txt), length(txt), R, DT_LEFT or DT_TOP);
    UnLock;
  end;
  if RecordStatus = rsRecord then
    if RecordSize>2048*1024 then
      StopRecord;
//      PostMessage(Handle, WM_SIZEOUT, 0, 0);
end;

procedure TAvRecForm.FormCreate(Sender: TObject);
begin
  ACMRecorder.Visible := false;
  ACMPlayer.Visible := false;
  RecordStatus := rsReady;
  RecordTime := 0;
  RecordSize := 0;
  AttachNo := 1;
  Height := pnlVideo.Height+pnlTool.Height+pnlAdvance.Height;
end;

procedure TAvRecForm.BitBtnOptionClick(Sender: TObject);
begin
  pnlOption.Top := Height;
  pnlOption.Visible := not pnlOption.Visible;
//  if pnlOption.Visible then
//    Height := Height + pnlOption.Height;
end;

procedure TAvRecForm.spbtnVideoClick(Sender: TObject);
begin
  BitBtnRecord.Enabled := spbtnAudio.Down or spbtnVideo.Down;
  pnlVideo.Visible := spbtnVideo.Down;
  if spbtnVideo.Down then
  begin
    chkNormal.Checked := True;
    chkAnyQ.Enabled := False;
    chkNormal.Enabled := False;
    chkNoCompress.Enabled := False;
  end
  else
  begin
    chkAnyQ.Enabled := True;
    chkNormal.Enabled := True;
    chkNoCompress.Enabled := True;
  end
end;

procedure TAvRecForm.BitBtnRecordClick(Sender: TObject);
begin
  StartRecord;
end;

procedure TAvRecForm.StartRecord;
begin
  RecordStatus := rsRecord;
  paintStatus.Invalidate;

  BitBtnRecord.Enabled := false;
  BitBtnStop.Enabled := True;
  BitBtnPlay.Enabled := False;

  chkAnyQ.Enabled := false;
  chkNormal.Enabled := false;
  chkNoCompress.Enabled := false;
  chkXVID.Enabled := False;
  chkXVID2.Enabled := False;
  chkRaw.Enabled := False;
  ledtFileName.Enabled := false;

  spbtnVideo.Enabled := false;
  spbtnAudio.Enabled := false;
  RecordTime := 0;
  if spbtnVideo.Down then
    RecordAVI
  else
    RecordWAV;
end;

procedure TAvRecForm.BitBtnStopClick(Sender: TObject);
begin
  StopRecord;
end;

procedure TAvRecForm.PlayRecord;
begin
  RecordStatus := rsPlay;
  PlayedTime := 0;
  paintStatus.Invalidate;

  BitBtnRecord.Enabled := False;
  BitBtnStop.Enabled := True;
  BitBtnPlay.Enabled := False;

  chkAnyQ.Enabled := false;
  chkNormal.Enabled := false;
  chkNoCompress.Enabled := false;
  chkXVID.Enabled := False;
  chkXVID2.Enabled := False;
  chkRaw.Enabled := False;
  ledtFileName.Enabled := false;
  if spbtnVideo.Down then
    PlayAVI
  else
    PlayWAV;
end;

procedure TAvRecForm.RecordAVI;
type
  PGSMFMT= ^TGSMFMT;
  TGSMFMT = packed record
    org: tWAVEFORMATEX;
    add: word;
  end;
var
  GSM: TGSMFMT;
  VInfo: TAVIStreamInfo;
  AInfo: TAVIStreamInfo;
  vidfmt: TBitmapInfoHeader;

  procedure initVideo;
  var
    bh: tagBITMAPINFOHEADER;
  begin
    try
      VideoRecorder.DriverIndex := MainSession.Prefs.getInt('CamDriver');
      VideoRecorder.VideoPreview := false;
      VideoRecorder.DriverOpen := true;
      bh := VideoRecorder.BitMapInfoHeader;
      bh.biWidth := 160;
      bh.biHeight := 120;
      bh.biCompression := BI_RGB;
      bh.biSizeImage := 160*120*3;
      bh.biBitCount := 24;
      VideoRecorder.BitMapInfoHeader := bh;
      VideoRecorder.VideoPreview := true;
      VideoRecorder.StartCapture;
      VideoRecorder.visible := true;
//      KeyFlag := true;
    except
      UninitCode;
//      ShowRiserWindow(nil,'初始化视频设备失败，设备可能已被占用!',ico_info);
      abort;
    end;
  end;
begin
  initVideo;
  if chkXVID.Checked or chkXVID2.Checked then
    InitCode;
  if FileExists(ExtractFilePath(Application.ExeName)+'~capture.avi') then
    DeleteFile(ExtractFilePath(Application.ExeName)+'~capture.avi');
  Image1.Visible := false;
  VideoRecorder.visible := true;
  VideoDisplayer.visible := False;

  StartTick := GetTickCount;
  AVIFileInit;
  AVIFileOpen(Avi, Pchar(ExtractFilePath(Application.ExeName)+'~capture.avi') , OF_CREATE or OF_WRITE, nil);
//  AVIFileAddRef(Avi);

  FillMemory(@VInfo, sizeof(VInfo), 0);
  VInfo.dwScale := 40000;
  VInfo.dwRate := 1000000;
  VInfo.fccType := streamtypeVIDEO;
  VInfo.rcFrame := Rect(0,0,160,120);
  VInfo.szName := 'AnyQ XVID ENCODER';
  if chkXVID.Checked or chkXVID2.Checked then
    VInfo.fccHandler := mmioStringToFOURCC('xvid',0);
  AVIFileCreateStream(avi, videos, VInfo);

  vidfmt := VideoRecorder.BitMapInfoHeader;
  if chkXVID.Checked or chkXVID2.Checked then
    vidfmt.biCompression := mmioStringToFOURCC('XVID',0);
  AVIStreamSetFormat(videos, 0, @vidfmt, sizeof(vidfmt));
  VPos := 0;
//
  if ledtFileName.Text='' then
    ledtFileName.Text := 'VIDEOEMSG'+inttostr(AttachNo);

  VideoRecorder.StartCapture;
  if spbtnAudio.Down then
  begin
    GSM.org := GSMFOMAT;
    GSM.add := 320;
    FillMemory(@AInfo, sizeof(AInfo), 0);
    AInfo.dwScale := GSMFOMAT.nBlockAlign;
    AInfo.dwRate := GSMFOMAT.nAvgBytesPerSec;
    AInfo.fccType := streamtypeAUDIO;
    AInfo.dwSampleSize := GSMFOMAT.nBlockAlign;
    AVIFileCreateStream(avi, Audios, AInfo);
    AVIStreamSetFormat(Audios,0,@GSM,Sizeof(GSM));
    APos := 0;
    ACMRecorder.Open(@GSM, MainSession.Prefs.getInt('WavInDriver'));
  end;
  SavedFileName := '';
  BitBtnSaveAS.Enabled := False;
  RecordSize := 2048;
end;

procedure TAvRecForm.RecordWAV;
type
  PGSMFMT= ^TGSMFMT;
  TGSMFMT = packed record
    org: tWAVEFORMATEX;
    add: word;
  end;
var
  GSM: TGSMFMT;
begin
  if chkAnyQ.Checked then
    ACMRecorder.Open(@AnyQPCMFOMAT, MainSession.Prefs.getInt('WavInDriver'));

  if chkNormal.Checked then
  begin
    GSM.org := GSMFOMAT;
    GSM.add := 320;
    ACMRecorder.Open(@GSM, MainSession.Prefs.getInt('WavInDriver'));
  end;

  if chkNoCompress.Checked then
    ACMRecorder.Open(@PCMFOMAT, MainSession.Prefs.getInt('WavInDriver'));

  if ledtFileName.Text='' then
    ledtFileName.Text := 'VOICEMSG'+inttostr(AttachNo);

  StartTick := GetTickCount;
  SavedFileName := '';
  BitBtnSaveAS.Enabled := False;
end;

procedure TAvRecForm.StopRecord;
begin
  TimerPlay.Enabled :=false;
  paintStatus.Invalidate;

  BitBtnRecord.Enabled := True;
  BitBtnStop.Enabled := false;
  BitBtnPlay.Enabled := True;

  if not spbtnVideo.Down then
  begin
    chkAnyQ.Enabled := True;
    chkNormal.Enabled := True;
    chkNoCompress.Enabled := True;
  end;

  chkXVID.Enabled := True;
  chkXVID2.Enabled := False;
  chkRaw.Enabled := True;
  ledtFileName.Enabled := True;

  spbtnVideo.Enabled := True;
  spbtnAudio.Enabled := True;

  ACMRecorder.Close;
  if VideoRecorder.DriverOpen then
  begin
    VideoRecorder.StopCapture;
    VideoRecorder.DriverOpen := false;
  end;
  ACMPlayer.Close;

  if RecordStatus <> rsRecord then
  begin
    RecordStatus := rsStop;
    exit;
  end
  else
    RecordStatus := rsStop;

  if spbtnVideo.Down then
    SaveAVI
  else
    SaveWav;

  if videos<> nil then
    videos := nil;
  if Audios<>nil then
    Audios := nil;
  if Avi <> nil then
  begin
    Avi := nil;
    AVIFileExit;
  end;
end;

procedure TAvRecForm.BitBtnCloseClick(Sender: TObject);
begin
  ModalResult := mrCancel;
  close;
end;

procedure TAvRecForm.BitBtnPlayClick(Sender: TObject);
begin
  PlayRecord;
end;

procedure TAvRecForm.chkAudioClick(Sender: TObject);
begin
  chkAnyQ.OnClick := nil;
  chkNormal.OnClick := nil;
  chkNoCompress.OnClick := nil;

  chkAnyQ.Checked := False;
  chkNormal.Checked := False;
  chkNoCompress.Checked := False;
  TCheckBox(Sender).Checked := True;

  chkAnyQ.OnClick := chkAudioClick;
  chkNormal.OnClick := chkAudioClick;
  chkNoCompress.OnClick := chkAudioClick;
end;

procedure TAvRecForm.ACMRecorderData(data: Pointer; size: Integer);
var
  po: array [0..9] of Byte;
begin
  if AudioStream=nil then
    AudioStream := TMemoryStream.Create;

  if not spbtnVideo.Down then
  begin
    RecordTime := ACMRecorder.getsample div 8;
    paintStatusPaint(paintStatus);
    RecordSize := AudioStream.size;
  end;

  if chkAnyQ.Checked then
  begin
    va_g729a_encoder(data, @po);
    AudioStream.Write(po[0],10);
  end
  else
    AudioStream.Write(data^,size);

  if spbtnVideo.Down and (AudioStream.Size>0) {and (VPos=0){} then
  begin
    AVIStreamWrite(Audios, APos, AudioStream.Size div GSMFOMAT.nBlockAlign, AudioStream.Memory, AudioStream.Size,0,0,0);
    APos := APos + AudioStream.Size div GSMFOMAT.nBlockAlign;
    RecordSize :=  RecordSize + AudioStream.Size+8+16;
    AudioStream.Clear;
  end; {}
end;

procedure TAvRecForm.SaveAVI(filename: string);
var
  VinfoW: TAVIStreamInfoW;
  Vsize: Integer;
begin
  if filename='' then
    filename := ExtractFilePath(Application.ExeName)+ledtFileName.Text;
  filename := filename+'.avi';

  if VideoRecorder.DriverOpen then
  begin
    VideoRecorder.StopCapture;
    VideoRecorder.DriverOpen := false;
  end;
  VideoRecorder.visible := false;
  Image1.Visible := true;
  VideoDisplayer.visible := false;
  ACMRecorder.Close;

  if avi<>nil then
  begin
    //按照M$的说明，应该用AVIStreamRelease来释放，但是在这里只能这样用
    videos.Info(VinfoW, Vsize);
    VInfow.dwScale := vinfo.dwScale;
    videos.SetInfo(VinfoW, Vsize);
    videos := nil;
//    AVIStreamRelease(videos);
    if spbtnAudio.Down then
    begin
      Audios := nil;
//      AVIStreamRelease(Audios);
    end;
    try
      avi := nil;
//      AVIFileRelease(avi);     //为什么有这句会出错？该死的微软。
    except
    end;
  end;

  AVIFileExit;
  if FileExists(filename) then
    DeleteFile(filename);
  CopyFile(Pchar(ExtractFilePath(Application.ExeName)+'~capture.avi'),PChar(filename),false);
  SavedFileName := filename;
  BitBtnSaveAS.Enabled := True;
end;

procedure TAvRecForm.SaveWAV(filename: string);
var
  hWAV : HMMIO;
  mmckinfoParent, mmckinfoSubchunk: MMCKINFO;
  size: Integer;
begin
  if filename='' then
    filename := ExtractFilePath(Application.ExeName)+ledtFileName.Text;
  if chkAnyQ.Checked then
    filename := filename+'.sqa'
  else
    filename := filename+'.wav';

  ACMRecorder.Close;
  hWAV := mmioOpen(pchar(Filename), nil, MMIO_CREATE or MMIO_WRITE or MMIO_EXCLUSIVE);
  mmckinfoParent.fccType := mmioStringToFOURCC('WAVE',0);
  mmioCreateChunk(hWAV, @mmckinfoParent, MMIO_CREATERIFF);

  mmckinfoSubchunk.ckid := mmioStringToFOURCC('fmt ',0);
  if chkNoCompress.Checked then
    mmckinfoSubchunk.cksize := sizeof(PCMWAVEFORMAT);
  if chkNormal.Checked then
    mmckinfoSubchunk.cksize := sizeof(tWAVEFORMATEX)+GSMFOMAT.cbSize;
  if chkAnyQ.Checked then
    mmckinfoSubchunk.cksize := sizeof(tWAVEFORMATEX);
  mmioCreateChunk(hWAV, @mmckinfoSubchunk, 0);

  if chkNoCompress.Checked then
    mmioWrite(hWAV, @PCMFOMAT, sizeof(PCMWAVEFORMAT));
  if chkNormal.Checked then
  begin
    mmioWrite(hWAV, @GSMFOMAT, sizeof(tWAVEFORMATEX));
    mmioWrite(hWAV, #64#1, 2);
  end;
  if chkAnyQ.Checked then
  begin
    mmioWrite(hWAV, @AnyQFOMAT, sizeof(tWAVEFORMATEX));
    mmioWrite(hWAV, #160#0, 2);
  end;
  mmioAscend(hWAV, @mmckinfoSubchunk, 0);

  if not chkNoCompress.Checked then
  begin
    mmckinfoSubchunk.ckid := mmioStringToFOURCC('fact',0);
    mmckinfoSubchunk.cksize := 4;
    mmioCreateChunk(hWAV, @mmckinfoSubchunk, 0);
    if chkNormal.Checked then
      Size := Ceil(AudioStream.Size*8000/1625);
    if chkNormal.Checked then
      Size := AudioStream.Size*16;
    mmioWrite(hWAV, @Size, 4);
    mmioAscend(hWAV, @mmckinfoSubchunk, 0);
  end;

  mmckinfoSubchunk.ckid := mmioStringToFOURCC('data',0);
  mmckinfoSubchunk.cksize := AudioStream.Size;
  mmioCreateChunk(hWAV, @mmckinfoSubchunk, 0);
  AudioStream.Seek(0,0);
  mmioWrite(hWAV, AudioStream.Memory, AudioStream.Size);
  mmioAscend(hWAV, @mmckinfoSubchunk, 0);
  mmioAscend(hWAV, @mmckinfoParent, 0);
  mmioClose(hWAV, 0);
  AudioStream.Free;
  AudioStream := nil;
  SavedFileName := filename;
  BitBtnSaveAS.Enabled := True;
end;

procedure TAvRecForm.PlayAVI(filename: string);
var
  Info: TAVIFileInfo;
  size: Integer;
  Bufsize: Integer;
  samples: Integer;
  wavformat: tWAVEFORMATEX;
  Pwavfmt: PWaveFormatEx;
  Pvidfmt: Pointer;
  Pbuf: Pointer;
  Buf: array [0..4095] of byte;
  i,j,a,s: integer;
  tick: cardinal;
  lendTime: Integer;
  lTime: Integer;
  lFrame: Integer;
  vidfmt: TBitmapInfoHeader;
  DFRAM: xvid_dec_frame_t;
  Dimg_t: xvid_image_t;
begin
  if filename='' then
    filename := ExtractFilePath(Application.ExeName)+ledtFileName.Text;
  filename := filename+'.avi';

  VideoDisplayer.visible := true;
  Image1.Visible := False;
  VideoRecorder.visible := false;
  AVIFileInit;
  AVIFileOpen(avi,pchar(filename), OF_READ, nil);
  AVIFileInfo(avi,Info,sizeof(info));

  VideoDisplayer.Width := Info.dwWidth;
  VideoDisplayer.Height := Info.dwHeight;
  VideoDisplayer.Streaming := true;
  VideoDisplayer.StreamRate := Info.dwScale;


  AVIFileGetStream(avi, Audios, streamtypeAUDIO	,0);
  AEnd := Audios=nil;
  if Audios<>nil then
  begin
    AVIStreamInfo(Audios, AInfo, sizeof(Vinfo));
    AVIStreamReadFormat(Audios, AVIStreamStart(Audios), nil, @size);
    Pbuf := GetMemory(size);
    AVIStreamReadFormat(Audios, AVIStreamStart(Audios), Pbuf, @size);
    ACMPlayer.Open(PWaveFormatEx(Pbuf), MainSession.Prefs.getInt('WavOutDriver'));
    wavformat := PWaveFormatEx(Pbuf)^;
    FreeMemory(Pbuf);
  end;

  AVIFileGetStream(avi, videos, streamtypeVIDEO	,0);
  VEnd := videos=nil;
  if videos<> nil then
  begin
    AVIStreamInfo(videos, VInfo, sizeof(Vinfo));
    AVIStreamReadFormat(videos, AVIStreamStart(videos), nil, @size);
    Pvidfmt := GetMemory(Size);
    AVIStreamReadFormat(videos, AVIStreamStart(videos), Pvidfmt, @size);
    vidfmt := PBitmapInfoHeader(Pvidfmt)^;
    vidfmt.biCompression := BI_RGB;
    VideoDisplayer.BitMapInfoHeader := vidfmt;
    FreeMemory(Pvidfmt);
  end;

  aPos := 0;
  s := 0;
  tick := GetTickCount;
  lFrame := 0;
  Bufsize := 0;
  for i:= 0 to VInfo.dwLength do
  begin
    lTime := GetTickCount-tick;
    if Audios<>nil then
      if aPos = 0 then
      begin
        for j:= 1 to 2 do
        begin
          Bufsize := 0;
          while (Bufsize = 0) and (aPos < AInfo.dwLength) do
          begin
            AVIStreamRead(Audios, aPos, AVISTREAMREAD_CONVENIENT, nil,0, @size, @samples);
            AVIStreamRead(Audios, aPos, AVISTREAMREAD_CONVENIENT, @Buf[Bufsize], size, nil, nil);
            Bufsize := Bufsize + size;
            if samples>0 then
              inc(aPos, samples)
            else
              inc(aPos);
          end;
          if Bufsize > 0 then
            ACMPlayer.PlayBack(@buf[0],Bufsize);
        end;
      end;

    while GetTickCount-tick < AVIStreamSampleToTime(videos, i) do
    begin
      Application.ProcessMessages;
      if RecordStatus <> rsplay then
        break;
    end;
    if RecordStatus <> rsplay then
      break;

    AVIStreamRead(videos,i,1, nil,0, @size, nil);
    pbuf := GetMemory(Size);
    AVIStreamRead(videos,i,1, Pbuf, size, nil, nil);
    if VInfo.fccHandler = mmioStringToFOURCC('xvid',0) then
      try
        FillMemory(@Dimg_t, Sizeof(Dimg_t), 0);
        Dimg_t.csp := XVID_CSP_BGR or XVID_CSP_VFLIP;
        Dimg_t.plane[0] := @Decbuf[0];
        Dimg_t.stride[0] := 160*3;

        FillMemory(@DFRAM, sizeof(DFRAM), 0);
        DFRAM.version := XVID_VERSION;
        DFRAM.general := XVID_LOWDELAY or XVID_DEBLOCKY or XVID_DEBLOCKUV;
        DFRAM.bitstream := Pbuf;
        DFRAM.length := size;
        DFRAM.output := Dimg_t;

        if not CodeInited then exit;
        if not assigned(VDecodeproc) then
          exit;
        VDecodeproc(DECodehandle, XVID_DEC_DECODE, @DFRAM, nil);
        VideoDisplayer.DrawStream(@Decbuf[0], false);
      except
      end
    else
      try
        VideoDisplayer.DrawStream(Pbuf, false);
      except
      end;
    FreeMemory(pbuf);
    PlayedTime := AVIStreamSampleToTime(videos, i);
    try
      paintStatusPaint(paintStatus);
    except
    end;
  end;

  VEnd := true;

  if AEnd and VEnd then
  begin
    videos := nil;
    Audios := nil;
    Avi := nil;
    AVIFileExit;
    StopRecord;
  end;
end;

procedure TAvRecForm.PlayWAV(filename: string);
var
  hWAV : HMMIO;
  mmckinfoParent, mmckinfoSubchunk: MMCKINFO;
  size, i: Integer;
  Pformat: array [0..50] of Byte;
  SBuf: array [0..9] of byte;
  buf: array [0..65535] of Byte;
  bufSize: Integer;
begin
  if filename='' then
    filename := ExtractFilePath(Application.ExeName)+ledtFileName.Text;
  if chkAnyQ.Checked then
    filename := filename+'.sqa'
  else
    filename := filename+'.wav';

  hWAV := mmioOpen(pchar(Filename), nil, MMIO_READ or MMIO_EXCLUSIVE);
  mmckinfoParent.fccType := mmioStringToFOURCC('WAVE',0);
  mmioDescend(hWAV, @mmckinfoParent, nil, MMIO_FINDRIFF);

  mmckinfoSubchunk.ckid := mmioStringToFOURCC('fmt ',0);
  mmioDescend(hWAV, @mmckinfoSubchunk, @mmckinfoParent, MMIO_FINDCHUNK);
  mmioRead(hWAV, @Pformat, mmckinfoSubchunk.cksize);
  mmioAscend(hWAV, @mmckinfoSubchunk, 0);

  if PWAVEFORMATEX(@Pformat)^.wFormatTag <> 0 then
    ACMPlayer.Open(@Pformat, MainSession.Prefs.getInt('WavOutDriver'))
  else
    ACMPlayer.Open(@AnyQPCMFOMAT, MainSession.Prefs.getInt('WavOutDriver'));

  if PWAVEFORMATEX(@Pformat)^.wFormatTag <> 0 then
    bufSize := PWAVEFORMATEX(@Pformat)^.nAvgBytesPerSec
  else
    bufSize := 10;
  TimerPlay.Enabled := true;

  mmckinfoSubchunk.ckid := mmioStringToFOURCC('data',0);
  mmioDescend(hWAV, @mmckinfoSubchunk, @mmckinfoParent, MMIO_FINDCHUNK);
  for i:= 0 to mmckinfoSubchunk.cksize div bufSize do
  begin
    if PWAVEFORMATEX(@Pformat)^.wFormatTag = 0 then
    begin
      mmioRead(hWAV, @SBuf, bufSize);
      va_g729a_decoder(@SBuf, @Buf, 0);
      ACMPlayer.PlayBack(@Buf, bufSize*16);
      Continue;
    end;
    if i<mmckinfoSubchunk.cksize div bufSize then
    begin
      mmioRead(hWAV, @Buf, bufSize);
      ACMPlayer.PlayBack(@Buf, bufSize);
    end
    else
    begin
      mmioRead(hWAV, @Buf, mmckinfoSubchunk.cksize mod bufSize);
      ACMPlayer.PlayBack(@Buf, mmckinfoSubchunk.cksize mod bufSize);
    end;
  end;
  mmioAscend(hWAV, @mmckinfoSubchunk, 0);
  mmioAscend(hWAV, @mmckinfoParent, 0);
  mmioClose(hWAV, 0);
end;

procedure TAvRecForm.ACMPlayerDone(Sender: TObject);
var
  i: Integer;
  BufSize, Size: Integer;
  Buf: array [0..4095] of byte;
  samples: Integer;
begin
  if spbtnVideo.Down and (Audios<>nil) then
  begin
    PlayedTime := ACMPlayer.getsample div 8;
    AEnd := PlayedTime+1 >= AVIStreamLengthTime(Audios);
//    Caption := inttostr(PlayedTime)+'/'+inttostr(AVIStreamLengthTime(Audios));

    Bufsize := 0;
    while (Bufsize = 0) and (aPos < AInfo.dwLength) do
    begin
      AVIStreamRead(Audios, aPos, AVISTREAMREAD_CONVENIENT, nil,0, @size, @samples);
      AVIStreamRead(Audios, aPos, AVISTREAMREAD_CONVENIENT, @Buf[Bufsize], size, nil, nil);
      Bufsize := Bufsize + size;
      if samples>0 then
        inc(aPos, samples)
      else
        inc(aPos);
    end;
    if Bufsize > 0 then
      ACMPlayer.PlayBack(@buf[0],Bufsize); {}

    if AEnd and VEnd then
    begin
      videos := nil;
      Audios := nil;
      Avi := nil;
      AVIFileExit;
      StopRecord;
    end;
  end;
end;

procedure TAvRecForm.VideoRecorderVideoStream(sender: TObject;
  lpVhdr: PVIDEOHDR);
var
  FRAME : xvid_enc_frame_t;
  Eimg_t : xvid_image_t;
begin
  if VPos mod 2 <> 0 then
  begin
    Inc(Vpos);
    Exit;
  end;

  if chkXVID.Checked or chkXVID2.Checked then
  begin
    FillMemory(@Eimg_t, Sizeof(Eimg_t), 0);
    Eimg_t.csp := XVID_CSP_BGR or XVID_CSP_VFLIP;
    Eimg_t.plane[0] := lpVhdr^.lpData;
    Eimg_t.stride[0] := 160*3;

    FillMemory(@FRAME, sizeof(FRAME), 0);
    FRAME.version := XVID_VERSION;
    FRAME.vol_flags := XVID_VOL_QUARTERPEL;
    FRAME.quant_intra_matrix := nil;
    FRAME.quant_inter_matrix := nil;
    FRAME.vop_flags := XVID_VOP_HALFPEL or XVID_VOP_CHROMAOPT or XVID_VOP_TRELLISQUANT; //or XVID_VOP_DEBUG;
    FRAME.motion := XVID_ME_QUARTERPELREFINE16 or XVID_ME_CHROMA_BVOP;
    FRAME.input := Eimg_t;
    FRAME._type := XVID_TYPE_AUTO;
    FRAME.bitstream := @outbuf[0];

    if VPos < 3 then
      FRAME._type := 1;

    if chkXVID.Checked then
      FRAME.quant := 8;
    if chkXVID2.Checked then
      FRAME.quant := 4;

    FRAME.length := 0;
    if not assigned(Vencodeproc) then exit;
    FRAME.length := Vencodeproc(ENCodehandle, XVID_ENC_ENCODE, @FRAME, nil);

    AVIStreamWrite(videos, VPos div 2, 1, @outbuf[0], FRAME.length,0,0,0);
    VPos := VPos + 1;
    RecordSize :=  RecordSize + FRAME.length+8+16;
  end;

  if chkRaw.Checked then
  begin
    AVIStreamWrite(videos, VPos div 2, 1, lpVhdr.lpData, lpVhdr.dwBytesUsed,0,0,0);
    VPos := VPos + 1;
    Caption := inttostr(VPos);
    RecordSize :=  RecordSize + lpVhdr.dwBytesUsed+8;
  end;

  RecordTime := lpVhdr.dwTimeCaptured;
  if Vpos>1 then
  VInfo.dwScale := (lpVhdr.dwTimeCaptured * 1000) div ((Vpos+1) div 2);

  try
    paintStatusPaint(paintStatus);
  except
  end;
end;

procedure TAvRecForm.BitBtnADDClick(Sender: TObject);
begin
  ModalResult := mrOK;
  close;
end;

procedure TAvRecForm.FormDestroy(Sender: TObject);
begin
  if assigned(AudioStream) then
    FreeAndNil(AudioStream);
end;

procedure TAvRecForm.chkVideoClick(Sender: TObject);
begin
  chkXVID.OnClick := nil;
  chkXVID2.OnClick := nil;

  chkXVID.Checked := False;
  chkXVID2.Checked := False;
  TCheckBox(Sender).Checked := True;

  chkXVID.OnClick := chkVideoClick;
  chkXVID2.OnClick := chkVideoClick;
end;

procedure TAvRecForm.TimerPlayTimer(Sender: TObject);
begin
  if not spbtnVideo.Down then
  begin
    PlayedTime := ACMPlayer.getsample div 8;
    paintStatusPaint(paintStatus);
    if PlayedTime>=RecordTime-1 then
      StopRecord;
  end;
end;

procedure TAvRecForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  StopRecord;
  if assigned(AfterClose) then
    AfterClose(Sender);
end;

procedure TAvRecForm.ParentResize(Sender: TObject);
begin
  Left := (Twincontrol(Sender).Width-Width) div 2;
  Top := Max((Twincontrol(Sender).Height-386) div 2, 0);
end;

procedure TAvRecForm.FormShow(Sender: TObject);
begin
  if frmAnyQ.SkinData1.Active then
    frmAnyQ.SkinData1.SkinForm(self.Handle);
end;

procedure TAvRecForm.FormResize(Sender: TObject);
begin
  if Twincontrol(Sender).Parent=nil then exit;
  if Twincontrol(Sender).Parent.Parent<>nil then
  begin
    if Twincontrol(Sender).Parent.Parent is TForm then
    begin
      if Twincontrol(Sender).Parent.Height<Height then
      begin
        TForm(Twincontrol(Sender).Parent.Parent).Height :=
            TForm(Twincontrol(Sender).Parent.Parent).Height+Height-
            Twincontrol(Sender).Parent.Height;
        TForm(Twincontrol(Sender).Parent.Parent).Constraints.MinHeight :=
            TForm(Twincontrol(Sender).Parent.Parent).Height;
      end
      else
        TForm(Twincontrol(Sender).Parent.Parent).Constraints.MinHeight := 386;
    end;    
  end;
  Twincontrol(Sender).Parent.Constraints.MinHeight := Height;
end;

procedure TAvRecForm.WMSIZEOUT(var msg: TMessage);
begin
//  StopRecord;
//  ShowRiserWindow(nil,'不能录制超过2M的音频或视频',ico_info);
end;

procedure TAvRecForm.spbtnAudioClick(Sender: TObject);
begin
  BitBtnRecord.Enabled := spbtnAudio.Down or spbtnVideo.Down;
end;

procedure TAvRecForm.BitBtnSaveASClick(Sender: TObject);
var
  newfilename: string;
begin
  if SavedFileName<>'' then
  begin
    newfilename := ledtFileName.Text+ExtractFileExt(SavedFileName);
    if CopyFile(Pchar(SavedFileName), Pchar(newfilename), False) then
      SavedFileName := newfilename
    else
      ShowRiserWindow(nil, '保存文件失败！', 22);
  end;
end;

end.
