jvavicapture.pas

East make Tray Icon in delphi

  // create the AviCap window
  FHWnd := capCreateCaptureWindow(
    PChar(Title),        // use the user defined title
    WS_VISIBLE or        // window is visible
      WS_CHILD and       // it is a child window
      not WS_CAPTION and // it has no caption
      not WS_BORDER,     // it has no border
    0,                   // 0 left coordinate
    0,                   // 0 top coordinate
    320,                 // width defaults to 320
    240,                 // height defaults to 240
    inherited Handle,    // child of the TWinControl
    0);                  // window identifier

  // place the Pointer to Self in the user data
  SetWindowLong(FHWnd, GWL_USERDATA, Integer(Self));
  // replace the WndProc to be ours
  FPreviousWndProc := Pointer(GetWindowLong(FHWnd, GWL_WNDPROC));
  SetWindowLong(FHWnd, GWL_WNDPROC, Integer(@CustomWndProc));
  // updates the FHWnd member of audio format, capture settings, palette and video format
  // yes, they are private members, but they can still be accessed by a foreign class
  // because the access is done in the same pas file !
  FAudioFormat.FHWnd := FHWnd;
  FCaptureSettings.FHWnd := FHWnd;
  FPalette.FHWnd := FHWnd;
  FVideoFormat.FHWnd := FHWnd;
  // sets the callbacks
  UsedEvents := FUsedEvents;
end;

procedure TJvAVICapture.DestroyWindowHandle;
begin
  // restore the window proc
  SetWindowLong(FHWnd, GWL_WNDPROC, Integer(FPreviousWndProc));
  // destroy the AviCap Window
  DestroyWindow(FHWnd);
  // let the TWinControl window be destroyed
  inherited DestroyWindowHandle;
end;

procedure TJvAVICapture.SetTitle(nTitle: string);
begin
  if FHWnd <> 0 then
  begin
    FTitle := nTitle;
    SetWindowText(FHWnd, PChar(FTitle));
  end;
end;

procedure TJvAVICapture.SetPreviewFrameDelay(nPreviewFrameDelay: Cardinal);
begin
  FPreviewFrameDelay := nPreviewFrameDelay;
  if Previewing then
  begin
    StopPreview;
    StartPreview;
  end;
end;

procedure TJvAVICapture.SetPreviewFPS(nPreviewFPS: Double);
begin
  SetPreviewFrameDelay(Round(1.0E3 * 1.0 / nPreviewFPS));
end;

function TJvAVICapture.GetPreviewFPS: Double;
begin
  Result := 1.0E3 * 1.0 / FPreviewFrameDelay;
end;

procedure TJvAVICapture.SetPreviewing(nPreviewing: Boolean);
begin
  if (not nPreviewing) and Previewing then
    StopPreview;
  if nPreviewing and (not Previewing) then
    StartPreview;
end;

procedure TJvAVICapture.SetFileName(nFileName: TFileName);
begin
  if FHWnd <> 0 then
  begin
    FFileName := nFileName;
    // change the filename
    capFileSetCaptureFile(FHWnd, PChar(nFileName));
  end;
end;

function TJvAVICapture.GetFileName: TFileName;
var
  Name: array [0..MAX_PATH] of Char;
begin
  if FHWnd <> 0 then
  begin
    // get the filename from the window
    capFileGetCaptureFile(FHWnd, Name, SizeOf(Name));
    FFileName := Name;
  end;
  Result := FFileName;
end;

function TJvAVICapture.GetDrivers: TStrings;
begin
  Result := FDrivers;
end;

procedure TJvAVICapture.SetFileSizeAlloc(nFileSizeAlloc: Cardinal);
begin
  if FHWnd <> 0 then
  begin
    FFileSizeAlloc := nFileSizeAlloc;
    capFileAlloc(FHWnd, FFileSizeAlloc);
  end;
end;

procedure TJvAVICapture.SetUsedEvents(nUsedEvents: TJvUsedEvents);
begin
  FUsedEvents := nUsedEvents;

  if FHWnd <> 0 then
  begin
    if ueError in FUsedEvents then
      capSetCallbackOnError(FHWnd, @ErrorCallback)
    else
      capSetCallbackOnError(FHWnd, nil);

    if ueStatus in FUsedEvents then
      capSetCallbackOnStatus(FHWnd, @StatusCallback)
    else
      capSetCallbackOnStatus(FHWnd, nil);

    if ueYield in FUsedEvents then
      capSetCallbackOnYield(FHWnd, @YieldCallback)
    else
      capSetCallbackOnYield(FHWnd, nil);

    if ueFrame in FUsedEvents then
      capSetCallbackOnFrame(FHWnd, @FrameCallback)
    else
      capSetCallbackOnFrame(FHWnd, nil);

    if ueVideoStream in FUsedEvents then
      capSetCallbackOnVideoStream(FHWnd, @VideoStreamCallback)
    else
      capSetCallbackOnVideoStream(FHWnd, nil);

    if ueWaveStream in FUsedEvents then
      capSetCallbackOnWaveStream(FHWnd, @WaveStreamCallback)
    else
      capSetCallbackOnWaveStream(FHWnd, nil);

    if ueCapControl in FUsedEvents then
      capSetCallbackOnCapControl(FHWnd, @CapControlCallback)
    else
      capSetCallbackOnCapControl(FHWnd, nil);
  end;
end;

procedure TJvAVICapture.SetOverlaying(nOverlaying: Boolean);
begin
  if not nOverlaying then
  begin
    if Overlaying then
      StopOverlay;
  end
  else
  if not Overlaying then
    StartOverlay;
end;

function TJvAVICapture.GetDriverName: string;
var
  Name: array [0..MAX_PATH] of Char;
begin
  if FHWnd <> 0 then
  begin
    capDriverGetName(FHWnd, Name, SizeOf(Name));
    Result := Name;
  end
  else
    Result := RsNotConnected;
end;

function TJvAVICapture.GetDriverVersion: string;
var
  Version: array [0..MAX_PATH] of Char;
begin
  if FHWnd <> 0 then
  begin
    capDriverGetVersion(FHWnd, Version, SizeOf(Version));
    Result := Version;
  end
  else
    Result := RsNotConnected;
end;

procedure TJvAVICapture.SetScrollPos(nScrollPos: TJvScrollPos);
var
  TmpPoint: TPoint;
begin
  if FHWnd <> 0 then
  begin
    FScrollPos := nScrollPos;
    TmpPoint.X := FScrollPos.Left;
    TmpPoint.Y := FScrollPos.Top;
    capSetScrollPos(FHWnd, @TmpPoint);
  end;
end;

procedure TJvAVICapture.SetMCIDevice(nMCIDevice: string);
begin
  if FHWnd <> 0 then
    capSetMCIDeviceName(FHWnd, PChar(nMCIDevice));
end;

function TJvAVICapture.GetMCIDevice: string;
var
  Name: array [0..MAX_PATH] of Char;
begin
  if FHWnd <> 0 then
  begin
    capGetMCIDeviceName(FHWnd, Name, SizeOf(Name));
    Result := Name;
  end
  else
    Result := RsNotConnected;
end;

procedure TJvAVICapture.SetDriverIndex(nIndex: TJvDriverIndex);
begin
  if Connect(nIndex) then
    FDriverIndex := nIndex;
end;

procedure TJvAVICapture.SetCapturing(nCapturing: Boolean);
begin
  if FCapturing then
  begin
    if not nCapturing then
      StopCapture;
  end
  else
  if nCapturing then
    if FNoFile then
      StartCaptureNoFile
    else
      StartCapture;
end;

procedure TJvAVICapture.SetNoFile(nNoFile: Boolean);
begin
  // only allow to change if not capturing
  if not FCapturing then
    FNoFile := nNoFile;
end;

procedure TJvAVICapture.UpdateCaps;
var
  Caps: TCAPDRIVERCAPS;
begin
  if FHWnd <> 0 then
  begin
    // get value from the window
    capDriverGetCaps(FHWnd, @Caps, SizeOf(Caps));
    // update internal value
    FDriverCaps := [];
    if Caps.fHasOverlay then
      FDriverCaps := FDriverCaps + [dcOverlay];
    if Caps.fHasDlgVideoSource then
      FDriverCaps := FDriverCaps + [dcDlgVideoSource];
    if Caps.fHasDlgVideoFormat then
      FDriverCaps := FDriverCaps + [dcDlgVideoFormat];
    if Caps.fHasDlgVideoDisplay then
      FDriverCaps := FDriverCaps + [dcDlgVideoDisplay];
    if Caps.fCaptureInitialized then
      FDriverCaps := FDriverCaps + [dcCaptureInitialized];
    if Caps.fDriverSuppliesPalettes then
      FDriverCaps := FDriverCaps + [dcSuppliesPalettes];
  end;
end;

procedure TJvAVICapture.UpdateCaptureStatus;
begin
  if FHWnd <> 0 then
  begin
    capGetStatus(FHWnd, @FCaptureStatus, SizeOf(FCaptureStatus));
    FCapturing := FCaptureStatus.fCapturingNow;
    FPreviewing := FCaptureStatus.fLiveWindow;
    FOverlaying := FCaptureStatus.fOverlayWindow;
  end;
end;

procedure TJvAVICapture.StopCallbacks;
begin
  if FHWnd <> 0 then
  begin
    if not (csDesigning in ComponentState) then
      capSetCallbackOnError(FHWnd, nil);

    capSetCallbackOnStatus(FHWnd, nil);
    capSetCallbackOnYield(FHWnd, nil);
    capSetCallbackOnFrame(FHWnd, nil);
    capSetCallbackOnVideoStream(FHWnd, nil);
    capSetCallbackOnWaveStream(FHWnd, nil);
    capSetCallbackOnCapControl(FHWnd, nil);
  end;
end;

procedure TJvAVICapture.RestartCallbacks;
begin
  UsedEvents := FUsedEvents;
end;

procedure TJvAVICapture.SetBounds(nLeft, nTop, nWidth, nHeight: Integer);
var
  lWidth, lHeight: Integer;
begin
  // reload video size
  FVideoFormat.Update;

  // else, force the width and height to stay in a constant interval :
  // not less than cMinHeight and cMinWidth
  // not more than the video size
  // Autosizing will have been enforced in the CanAutoSize procedure
  lHeight := Max(Min(nHeight, FVideoFormat.Height), cMinHeight);
  lWidth := Max(Min(nWidth, FVideoFormat.Width), cMinWidth);

  inherited SetBounds(nLeft, nTop, lWidth, lHeight);
end;

procedure TJvAVICapture.EnumDrivers;
var
  I: Integer;
  DeviceName: array [0..MAX_PATH] of Char;
  DeviceVersion: array [0..MAX_PATH] of Char;
begin
  // no more than 10 drivers in the system (cf Win32 API)
  for I := 0 to 9 do
    if capGetDriverDescription(I, DeviceName, SizeOf(DeviceName), DeviceVersion, SizeOf(DeviceVersion)) then
      Drivers.Add(DeviceName);
end;

function TJvAVICapture.Connect(Driver: TJvDriverIndex): Boolean;
begin
  // Request a handle, will create the AviCap internal window
  // will trigger an exception if no parent is set
  HandleNeeded;

  if Driver = -1 then
  begin
    // if Driver is -1, then we disconnect
    Result := Disconnect;
    // force the video format to be 0, 0 and update the size of the control
    FVideoFormat.FHeight := 0;
    FVideoFormat.FWidth := 0;
  end
  else
  begin
    // else we try to connect to that driver