关于在视频捕捉的同时关闭设备的问题，帮忙看看

Question

procedure TVideoPanel.SetActive(value: boolean);
begin
  if FActive <> Value then
  begin
    FActive := Value;
    if Factive = true then
      initVideo;
    if Factive = False then
    begin
       {关闭视频}                   出现问题的地方
      if FCapture = True then
        SetCapture(False);
      CapCaptureAbort(FCapWnd);
      CapDriverDisconnect(FCapWnd);
    end;
  end;
end;
-------------
这是我目前研究写的一个视频捕捉程序，但是在关闭视频的时候出现一个问题
如果我将关闭捕捉，和关闭视频分开写在两个事件中 ，分别按照顺序执行，没有什么问题，但是如果放在一个过程里执行，则出现视频捕捉动作能停止，而视频窗口却不能关闭我把我的程序源码贴上，各位帮忙看看怎么解决这个问题
-----------------------------------程序源码-------------------------------------
unit VideoPanel;interfaceuses
  SysUtils, Classes, Controls, ExtCtrls, VFW, VideoCoDec, YUVConverts, windows,
  Messages, Graphics, Dialogs;type
  TPlayRange = (Rg160x120, Rg176x144, Rg352x288, Rg320x240, Rg640x480);
type
  PFrameData = ^TFrameData;
  TFrameData = packed record
    Size: Cardinal;
    KeyFrame: Boolean;
    Data: Pointer;
  end;
type
  TOnCapture = procedure(Sender: TObject; CaptureFrame: pointer; KeyFrame: boolean; Size: Cardinal) of object; //
  TVideoPanel = class(TCustomControl)
  private
    { Private declarations }
    FActive: Boolean;
    FPlayRange: TPlayRange;
    FFrameOfSecond: integer;
    FCapture: boolean;
    CaptureWidth: integer;
    CaptureHeight: integer;
    FOnCapture: TOnCapture;
    //FColor:TColor;
    //---------视频播放参数-----------
    vsc: TVideoCoDec;
    //    lastBmp: TBitmap;
    Initialized: Boolean;
    lpFrame: PFrameData;    { Private-Deklarationen }
    FCapWnd: HWnd; // AVICapture window handle
    FDriverCaps: TCAPDRIVERCAPS; // Driver caps
    FCapStatus: TCAPSTATUS; // Capture status    FCaptureBIHSize: Integer; // Size of capture bmp format info
    FCaptureBIH: PBitmapInfoHeader; // capture bmp format info
    FStreamBIHSize: Integer; // Size of stream bmp format info
    FStreamBIH: PBitmapInfoHeader; // stream bmp format info
    FFrameStream: TMemoryStream; // stream for read a frame
    FPixelPointer: PByte; // Pointer to pixel data in FFrameStream
    FVideoCodec: TVideoYUVCodec;    FFrameBitmap: TBitmap; // bitmap contain the last frame    FFrameBitmap1: TBitmap; // bitmap contain the last frame
    FFrameStream1: TMemoryStream; // stream for read a frame
    FPixelPointer1: PByte; // Pointer to pixel data in FFrameStream
    procedure Init(hBmp: HBITMAP);
    {capture }
    procedure WMMove(var Message: TWMMove); message WM_MOVE;
    // Status Callbacks
    procedure StatusCallback(nID: Integer; lpsz: PChar);
    procedure ErrorCallback(nID: Integer; lpsz: PChar);
    // Callback for single frame and capture
    procedure FrameCallback(hCapWnd: HWND; lpVHDR: PVideoHdr);
    procedure VideoStreamCallback(hCapWnd: HWND; lpVHDR: PVideoHdr);
    procedure DisplayVideo(AEnable: Boolean);
    procedure GetDriverCaps;
    procedure GetCaptureStatus;
    procedure VideoFormatChanged;
    procedure StartSequence(ToFile: Boolean);
    //-------------------------------------------------------------
    function GetActive: boolean;
    procedure SetActive(value: boolean);
    function GetPlayRange: TPlayRange;
    procedure SetPlayRange(Value: TPlayRange);
    function GetCapture: Boolean;
    procedure SetCapture(value: boolean);
    function GetFrameOfSecond: integer;
    procedure SetFrameOfSecond(value: integer);
  protected
    { Protected declarations }
    procedure InitVideo;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
    property Active: Boolean read GetActive write SetActive; //是否激活设备
    property Color;
    property PlayRange: TplayRange read GetPlayRange write SetPlayRange;
    //播放区域大小
    property FrameOfSecond: integer read GetFrameOfSecond write SetFrameOfSecond;
    //每秒采集帧数
    property Capture: Boolean read GetCapture write SetCapture;
    //是否进行视频捕捉
    property OnCapture: TOnCapture read FOnCapture write FOnCapture;
  end;const
  CaptureColorDepth = 24;
procedure Register;implementationprocedure Register;
begin
  RegisterComponents('ActiveX', [TVideoPanel]);
end;
//------------------------------------------------------------function WidthBytes(I: LongInt): LongInt;
begin
  Result := ((I + 31) div 32) * 4;
end;procedure CreateBmpHeader(var bmih: TBitmapInfoHeader;
  AWidth, AHeight, ABitsPerPixel: Integer);
begin
  with bmih do
  begin
    biSize := SizeOf(TBitmapInfoHeader);
    biWidth := AWidth;
    biHeight := round(AHeight);
    biPlanes := 1;
    biBitCount := ABitsPerPixel;
    biCompression := BI_RGB;
    biSizeImage := WidthBytes(biWidth * biBitCount) * biHeight * biPlanes;
    biXPelsPerMeter := 0;
    biYPelsPerMeter := 0;
    biClrUsed := 0;
    biClrImportant := 0;
  end;
end;function ErrorCallback(hCapWnd: HWnd; nID: Integer; lpsz: PChar): DWord;
  stdcall;
  far;
var
  OwnerForm: TVideoPanel;
begin
  OwnerForm := TVideoPanel(capGetUserData(hCapWnd));
  if (OwnerForm <> nil) and (OwnerForm is TVideoPanel) then
    OwnerForm.ErrorCallback(nID, lpsz);
  Result := 1;
end;function StatusCallback(hCapWnd: HWnd; nID: Integer; lpsz: PChar): DWord;
  stdcall; far;
var
  OwnerForm: TVideoPanel;
begin
  OwnerForm := TVideoPanel(capGetUserData(hCapWnd));
  if (OwnerForm <> nil) and (OwnerForm is TVideoPanel) then
    OwnerForm.StatusCallback(nID, lpsz);
  Result := 1;
end;function FrameCallback(hCapWnd: HWnd; lpVHDR: PVideoHdr): DWord; stdcall; far;
var
  OwnerForm: TVideoPanel;
begin
  OwnerForm := TVideoPanel(capGetUserData(hCapWnd));
  if (OwnerForm <> nil) and (OwnerForm is TVideoPanel) then
    OwnerForm.FrameCallBack(hCapWnd, lpVHDR);
  Result := 1;
end;function VideoStreamCallback(hCapWnd: HWND; lpVHDR: PVideoHdr): UINT; stdcall;
  far;
var
  OwnerForm: TVideoPanel;
begin
  OwnerForm := TVideoPanel(capGetUserData(hCapWnd));
  if (OwnerForm <> nil) and (OwnerForm is TVideoPanel) then
    OwnerForm.VideoStreamCallBack(hCapWnd, lpVHDR);
  Result := 1;
end;procedure SetCallbacks(ACapWnd: HWnd);
begin
  if ACapWnd = 0 then
    Exit;
  capSetCallbackOnStatus(ACapWnd, @StatusCallback);
  capSetCallbackOnVideoStream(ACapWnd, @VideoStreamCallback);
end;procedure ClearCallbacks(ACapWnd: HWnd);
begin
  if ACapWnd = 0 then
    Exit;
  capSetCallbackOnError(ACapWnd, nil);
  capSetCallbackOnStatus(ACapWnd, nil);
  capSetCallbackOnYield(ACapWnd, nil);
  capSetCallbackOnFrame(ACapWnd, nil);
  capSetCallbackOnVideoStream(ACapWnd, nil);
  capSetCallbackOnWaveStream(ACapWnd, nil);
  capSetCallbackOnCapControl(ACapWnd, nil);
end;function MillisecondsToStr(Value: DWord): string;
var
  hour, min, sec, msec: Integer;
begin
  msec := Value mod 1000;
  Value := Value div 1000;
  sec := Value mod 60;
  Value := Value div 60;
  min := Value mod 60;
  hour := Value div 60;
  Result := Format('%.2d:%.2d:%.2d.%.3d', [hour, min, sec, msec]);
end;procedure StopCapture(HwndC: HWnd);
begin
  if HwndC <> 0 then
    SendMessage(hWndC, WM_CAP_STOP, 0, 0);
end;
////////////////////////////////////////////////////////

Answer 1

constructor TVideoPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPlayrange := Rg352x288;
  FrameOfSecond := 15;
  CaptureWidth := 160;
  CaptureHeight := 120;
  self.Color := clblack;
  self.Height := CaptureHeight;
  self.Width := CaptureWidth;
end;destructor TVideoPanel.Destroy;
begin
  inherited Destroy;
  if FCapWnd <> 0 then
  begin
    capCaptureStop(FCapWnd);
    ClearCallbacks(FCapWnd);
    capDriverDisconnect(FCapWnd);
    DestroyWindow(FCapWnd);
    FCapWnd := 0;
  end;
  FPixelPointer := nil;
  FFrameStream.Free;
  FFrameBitmap.Free;
  if (FStreamBIHSize > 0) and (FStreamBIH <> nil) then
    FreeMem(FStreamBIH, FStreamBIHSize);
  if (FCaptureBIHSize > 0) and (FCaptureBIH <> nil) then
    FreeMem(FCaptureBIH, FCaptureBIHSize);
end;function TVideoPanel.GetActive: Boolean;
begin
  Result := FActive;
end;procedure TVideoPanel.SetActive(value: boolean);
begin
  if FActive <> Value then
  begin
    FActive := Value;
    if Factive = true then
      initVideo;
    if Factive = False then
    begin
      if FCapture = True then
        SetCapture(False);
      CapCaptureAbort(FCapWnd);
      CapDriverDisconnect(FCapWnd);
    end;
  end;
end;function TVideoPanel.GetPlayRange: TplayRange;
begin
  Result := FPlayrange;
end;procedure TVideoPanel.SetPlayRange(value: TPlayRange);
var temp: boolean;
begin
  temp := false;
  if FPlayRange <> Value then
    FPlayRange := value;
  case FPlayrange of
    Rg160x120:
      begin
        self.width := 160;
        self.Height := 120;
      end;
    Rg176x144:
      begin
        self.Width := 176;
        self.Height := 144;
      end;
    Rg352x288:
      begin
        self.Width := 352;
        self.Height := 288;
      end;
    Rg320x240:
      begin
        self.Width := 320;
        self.Height := 240;
      end;
    Rg640x480:
      begin
        self.Width := 640;
        self.Height := 480;
      end;
  end;
  if FActive = true then
  begin
    CapCaptureAbort(FCapWnd);
    CapDriverDisconnect(FCapWnd);
    temp := true;
  end;
  CaptureWidth := self.width;
  CaptureHeight := self.height;
  if temp = true then
    initVideo;
end;function TVideoPanel.GetCapture;
begin
  Result := FCapture;
end;procedure TVideoPanel.SetCapture(value: boolean);
begin
  if FCapture <> Value then
    FCapture := Value;
  if FActive = False then
  begin
    FCapture := False;
    exit;
  end;
  if FCapture = true then
    StartSequence(False);
  if FCapture = False then
    StopCapture(FCapWnd);
end;function TVideoPanel.GetFrameOfSecond: integer;
begin
  result := FFrameOfSecond;
end;procedure TVideoPanel.SetFrameOfSecond(value: integer);
begin
  if FFrameOfSecond <> value then
    if Value > 30 then
      FFrameOfSecond := 30
    else if Value < 1 then
      FFrameOfSecond := 1
    else
      FFrameOfSecond := value;
end;
//-----------------------------------------------procedure TVideoPanel.WMMove(var Message: TWMMove);
begin
  inherited;
  // after move of form
  if FCapWnd = 0 then
    Exit;
  ShowWindow(FCapWnd, SW_HIDE);
  ShowWindow(FCapWnd, SW_SHOW);
end;

Answer 2

procedure TVideoPanel.DisplayVideo(AEnable: Boolean);
begin
  if FCapWnd = 0 then
    Exit;
  // CapParms.
  if AEnable then
  begin
    capPreviewRate(FCapWnd, 100 div FFrameOfSecond);
    capOverlay(FCapWnd, true);
    capPreview(FCapWnd, True);
  end
  else
  begin
    capOverlay(FCapWnd, False);
    capPreview(FCapWnd, False);
  end;
  GetCaptureStatus;
end;procedure TVideoPanel.GetDriverCaps;
begin
  if FCapWnd = 0 then
    Exit;
  capDriverGetCaps(FCapWnd, @FDriverCaps, SizeOf(FDriverCaps));
end;procedure TVideoPanel.StatusCallback(nID: Integer; lpsz: PChar);
begin
  GetCaptureStatus;
end;procedure TVideoPanel.ErrorCallback(nID: Integer; lpsz: PChar);
begin
end;procedure TVideoPanel.StartSequence(ToFile: Boolean);
var
  CaptureParms: TCaptureParms;
begin
  if FCapWnd = 0 then
    Exit;
  capCaptureGetSetup(FCapWnd, @CaptureParms, SizeOf(CaptureParms));
  with CaptureParms do
  begin
      // frame rate
    dwRequestMicroSecPerFrame := 1000000 div FFrameOfSecond;
      // *Micro* seconds!
    // background capture
    fYield := true;
      // abort by mouse click
    fAbortLeftMouse := false; //True;
    fAbortRightMouse := false; //True;
    fLimitEnabled := false
  end;
  capCaptureSetSetup(FCapWnd, @CaptureParms, SizeOf(CaptureParms));
  if ToFile then
    capCaptureSequence(FCapWnd)
  else
    capCaptureSequenceNoFile(FCapWnd);
  GetCaptureStatus;
end;procedure TVideoPanel.FrameCallback(hCapWnd: HWND; lpVHDR: PVideoHdr);
begin
  GetCaptureStatus;
end;procedure TVideoPanel.VideoStreamCallback(hCapWnd: HWND; lpVHDR: PVideoHdr);
var
  NewFrame: Pointer;
begin
  case FVideoCodec of
    vcUnknown: Exit; //图像数据，关键帧(T/F)，大小； newFrame：压缩后数据
    vcRGB: newFrame := vsc.PackFrame(lpVHDR^.lpData, lpFrame^.KeyFrame,
        lpFrame^.Size); // 14侦/s
  else
    begin
      MYYUV12toRGB(lpVHDR^.lpData, FPixelPointer, FCaptureBIH^.biWidth,
        FCaptureBIH^.biHeight); // I420, IYUV
      newFrame := vsc.PackFrame(FPixelPointer, lpFrame^.KeyFrame,
        lpFrame^.Size);
    end;
  end;
  //返回 newFrame,newFrame^.KeyFrame, newFrame^.Size  if Assigned(FOnCapture) then
    FOncapture(self, Newframe, lpFrame^.Keyframe, lpFrame^.size);end;
{===============================================}procedure TVideoPanel.Init(hBmp: HBITMAP);
var
  fccHandler: TFourCC;
  DIB: TDibSection;
  bmiIn: TbitmapInfo;
  bmiOut: TBitmapInfo;
begin  fccHandler.AsString := 'divx';  GetObject(hBmp, SizeOf(DIB), @DIB);
  FillChar(bmiIn, SizeOf(TBitmapInfo), 0);
  FillChar(bmiOut, SizeOf(TBitmapInfo), 0);  bmiIn.bmiHeader := DIB.dsBmih;
  bmiOut.bmiHeader := DIB.dsBmih;
  if fccHandler.AsString = 'divx' then
    bmiOut.bmiHeader.biCompression := fccHandler.AsCardinal
  else
    bmiOut.bmiHeader.biCompression := 861292868;  // 以后改为设置 Quality=50 * 100, KeyRate=10
  Initialized := vsc.Init(bmiIn, bmiOut, 5000, 10); //  含义??????????????
  if not Initialized then
    exit;
  vsc.SetDataRate(30, 100 * 1000, 1); //  含义??????????????
  vsc.Start;
  Initialized := true;
end;procedure TVideoPanel.GetCaptureStatus;
begin
  if FCapWnd = 0 then
    Exit;
  capGetStatus(FCapWnd, @FCapStatus, SizeOf(FCapStatus));
end;procedure TVideoPanel.VideoFormatChanged;
const
  BITexts: array[BI_RGB..BI_BITFIELDS] of string =
  ('RGB', 'RLE8', 'RLE4', 'BITFIELDS');
var
  s: string;
  BmpFileHeader: TBitmapFileHeader;
begin
  if FCapWnd = 0 then
    Exit;  // read the really capture format
  FCaptureBIHSize := capGetVideoFormatSize(FCapWnd);
  GetMem(FCaptureBIH, FCaptureBIHSize);
  capGetVideoFormat(FCapWnd, FCaptureBIH, FCaptureBIHSize);  FVideoCodec := BICompressionToVideoCodec(FCaptureBIH^.biCompression);  case FVideoCodec of
    vcRGB:
      begin // RGB format
        // Copy header
        if FStreamBIHSize <> FCaptureBIHSize then
        begin
          FStreamBIHSize := FCaptureBIHSize;
          ReAllocMem(FStreamBIH, FStreamBIHSize);
        end;
        Move(FCaptureBIH^, FStreamBIH^, FStreamBIHSize);
      end;
    vcYUY2..High(TVideoYUVCodec):
      begin
        // 32 Bit!
        CreateBmpHeader(FStreamBIH^, FCaptureBIH^.biWidth,
          FCaptureBIH^.biHeight, 32);
      end;
  end;  // prepare Stream for Frame
  FFrameStream.Size := SizeOf(BmpFileHeader) + FStreamBIHSize +
    Integer(FStreamBIH^.biSizeImage);
  // Fill the Header
  FillChar(BmpFileHeader, SizeOf(BmpFileHeader), 0);
  with BmpFileHeader do
  begin
    bfType := $4D42; // 'BM'
    bfSize := FFrameStream.Size;
    bfOffBits := SizeOf(BmpFileHeader) + FStreamBIHSize;
  end;
  FFrameStream.Position := 0;
  FFrameStream.WriteBuffer(BmpFileHeader, SizeOf(BmpFileHeader));
  FFrameStream.WriteBuffer(FStreamBIH^, FStreamBIHSize);
  FPixelPointer := FFrameStream.Memory;
  Inc(FPixelPointer, BmpFileHeader.bfOffBits);  FFrameStream1.Size := SizeOf(BmpFileHeader) + FStreamBIHSize +
    Integer(FStreamBIH^.biSizeImage);
  // Fill the Header
  FillChar(BmpFileHeader, SizeOf(BmpFileHeader), 0);
  with BmpFileHeader do
  begin
    bfType := $4D42; // 'BM'
    bfSize := FFrameStream.Size;
    bfOffBits := SizeOf(BmpFileHeader) + FStreamBIHSize;
  end;
  FFrameStream1.Position := 0;
  FFrameStream1.WriteBuffer(BmpFileHeader, SizeOf(BmpFileHeader));
  FFrameStream1.WriteBuffer(FStreamBIH^, FStreamBIHSize);
  FPixelPointer1 := FFrameStream1.Memory;
  Inc(FPixelPointer1, BmpFileHeader.bfOffBits);  // 初始化bitmap 和 Vsc
  FFrameStream.Position := 0;
  FFrameBitmap.LoadFromStream(FFrameStream);
  Init(FFrameBitmap.Handle);  FFrameBitmap1.LoadFromStream(FFrameStream);  // Display
  if FCaptureBIH^.biCompression in [BI_RGB..BI_BITFIELDS] then
    s := BITexts[FCaptureBIH^.biCompression]
  else
    SetString(s, PChar(@FCaptureBIH^.biCompression), 4);
end;procedure TVideoPanel.InitVideo;
begin
  // create frame bitmap
  FFrameBitmap := TBitmap.Create;
  FFrameBitmap1 := TBitmap.Create;  // compressor
  vsc := TVideoCodec.Create;
  New(lpFrame);
  FFrameStream := TMemoryStream.Create;
  FFrameStream1 := TMemoryStream.Create;  FCaptureBIHSize := 0;
  FCaptureBIH := nil;  // bitmap info header for frame grab
  FStreamBIHSize := SizeOf(TBitmapInfoHeader);
  GetMem(FStreamBIH, FStreamBIHSize);
  // create capture window
  FCapWnd := capCreateCaptureWindow('Capture Window', WS_CHILD or WS_VISIBLE,
    0, 0, CaptureWidth, CaptureHeight, Handle, 0);
  if FCapWnd <> 0 then
  begin
      // the second parameter is the driver index
    if capDriverConnect(FCapWnd, 0) then
    begin
      GetDriverCaps;
          // create header for half size pal with true color
      CreateBmpHeader(FStreamBIH^, CaptureWidth, CaptureHeight,
        CaptureColorDepth);
      capSetVideoFormat(FCapWnd, FStreamBIH, FStreamBIHSize);
      VideoFormatChanged;
      DisplayVideo(True);
          // set callback
      if capSetUserData(FCapWnd, LongInt(Self)) then
        SetCallbacks(FCapWnd);
    end
    else
    begin // no connect to driver
      DestroyWindow(FCapWnd);
      FCapWnd := 0;
    end;
  end;
  GetCaptureStatus;
end;end.

Answer 3

程序太长只好分开贴了 ，如果您觉得这样看不方便 ，可以留下mail给我，我可以发送源码和demo 过去希望高手不吝赐教