jvavicapture.pas

East make Tray Icon in delphi

var
  SelfObj: TJvAVICapture;
  res: Boolean;
begin
  res := True;
  // get the Pointer to self from the window user data
  SelfObj := TJvAVICapture(GetWindowLong(hWnd, GWL_USERDATA));
  if SelfObj <> nil then
    SelfObj.DoCapControl(nState, res);

  Result := LRESULT(Ord(res));
end;

//=== { TJvVideoFormat } =====================================================

constructor TJvVideoFormat.Create;
begin
  inherited Create;
  FHWnd := 0;
end;

procedure TJvVideoFormat.Update;
var
  BmpInfo: BITMAPINFOHEADER;
begin
  if (FHWnd <> 0) and capDriverConnected(FHWnd) then
  begin
    // get format from the AviCap window
    capGetVideoFormat(FHWnd, @BmpInfo, SizeOf(BmpInfo));

    // update the internal values
    FWidth := BmpInfo.biWidth;
    FHeight := BmpInfo.biHeight;
    FBitDepth := BmpInfo.biBitCount;
    FCompression := BmpInfo.biCompression;

    case BitDepth of
      0:
        FPixelFormat := pfDevice;
      1:
        FPixelFormat := pf1bit;
      4:
        FPixelFormat := pf4bit;
      8:
        FPixelFormat := pf8bit;
      16:
        FPixelFormat := pf15bit;
      24:
        FPixelFormat := pf24bit;
      32:
        FPixelFormat := pf32bit;
    else
      FPixelFormat := pfCustom;
    end;
  end;
end;

//=== { TJvAudioFormat } =====================================================

constructor TJvAudioFormat.Create;
begin
  inherited Create;
  FHWnd := 0;
  FExtra := nil;
end;

procedure TJvAudioFormat.Update;
var
  Info: tWAVEFORMATEX;
begin
  if (FHWnd <> 0) and capDriverConnected(FHWnd) then
  begin
    // gets the format from the AviCap window
    capGetAudioFormat(FHWnd, @Info, SizeOf(Info));

    // sets the internal values
    FFormatTag := Info.wFormatTag;
    FChannels := Info.nChannels;
    FSamplesPerSec := Info.nSamplesPerSec;
    FAvgBytesPerSec := Info.nAvgBytesPerSec;
    FBlockAlign := Info.nBlockAlign;
    FBitsPerSample := Info.wBitsPerSample;
    FExtraSize := Info.cbSize;

    // if there is extra data, save it too
    if FExtraSize > 0 then
    begin
      // if there was extra data saved before, free it before
      if FExtra <> nil then
        FreeMem(FExtra);
      GetMem(FExtra, ExtraSize);
      CopyMemory(FExtra, (PChar(@Info)) + SizeOf(tWAVEFORMATEX), FExtraSize);
    end;
  end;
end;

function TJvAudioFormat.Apply: Boolean;
var
  pwfex: PWaveFormatEx;
begin
  Result := False;
  if FHWnd <> 0 then
  begin
    FillWaveFormatEx(pwfex);
    Result := capSetAudioFormat(FHWnd, pwfex, SizeOf(tWAVEFORMATEX) + pwfex^.cbSize);
  end;
end;

procedure TJvAudioFormat.FillWaveFormatEx(var wfex: PWaveFormatEx);
begin
  case FormatTag of
    WAVE_FORMAT_PCM:
      begin
        GetMem(wfex, SizeOf(tWAVEFORMATEX));
        wfex^.wFormatTag := FFormatTag;
        // ensure maximum 2 channels
        wfex^.nChannels := FChannels mod 3;
        wfex^.nSamplesPerSec := FSamplesPerSec;
        // ensure 8 or 16 bits
        wfex^.wBitsPerSample := ((FBitsPerSample div 8) mod 3) * 8;
        // using rules defined in Documentation
        wfex^.nBlockAlign := wfex.nChannels * wfex.wBitsPerSample div 8;
        wfex^.nAvgBytesPerSec := wfex.nSamplesPerSec * wfex.nBlockAlign;
        wfex^.cbSize := 0;
      end;
  else
    GetMem(wfex, SizeOf(tWAVEFORMATEX) + FExtraSize);
    wfex^.wFormatTag := FFormatTag;
    wfex^.nChannels := FChannels;
    wfex^.nSamplesPerSec := FSamplesPerSec;
    wfex^.nAvgBytesPerSec := FAvgBytesPerSec;
    wfex^.nBlockAlign := FBlockAlign;
    wfex^.wBitsPerSample := FBitsPerSample;
    wfex^.cbSize := FExtraSize;

      // copy Extra to the end of the structure
    CopyMemory((PChar(@wfex)) + SizeOf(tWAVEFORMATEX), FExtra, FExtraSize);
  end;
end;

//=== { TJvCaptureSettings } =================================================

constructor TJvCaptureSettings.Create;
begin
  inherited Create;
  FHWnd := 0;
  FFrameDelay := 1;
end;

procedure TJvCaptureSettings.SetKeyAbort(nKeyAbort: TJvVirtualKey);
var
  Modifiers: Word;
begin
  // Unregister any previous hotkey
  if FKeyAbort <> 0 then
    UnregisterHotKey(FHWnd, 0);

  // register hotkey, only if needed
  if nKeyAbort <> 0 then
  begin
    Modifiers := 0;
    if (nKeyAbort and $4000) <> 0 then
      Modifiers := Modifiers or MOD_SHIFT;
    if (nKeyAbort and $8000) <> 0 then
      Modifiers := Modifiers or MOD_CONTROL;
    if RegisterHotKey(FHWnd, 0, Modifiers, nKeyAbort and $FF) then
      FKeyAbort := nKeyAbort;
  end
  else
    FKeyAbort := nKeyAbort;
end;

procedure TJvCaptureSettings.Update;
var
  Parms: TCAPTUREPARMS;
begin
  if FHWnd <> 0 then
  begin
    // get capture settings from window
    capCaptureGetSetup(FHWnd, @Parms, SizeOf(Parms));

    // udapte internal settings
    with Parms do
    begin
      FFrameDelay := dwRequestMicroSecPerFrame;
//      FFramesPerSec             := 1/dwRequestMicroSecPerFrame*1E6;
      FConfirmCapture := fMakeUserHitOKToCapture;
      FPercentDropForError := wPercentDropForError;
      FYield := FYield;
      FNumVideoBuffer := wNumVideoRequested;
      FCaptureAudio := FCaptureAudio;
      FNumAudioBuffer := wNumAudioRequested;
      FAbortLeftMouse := FAbortLeftMouse;
      FAbortRightMouse := FAbortRightMouse;
      FKeyAbort := vKeyAbort;
      FLimitEnabled := FLimitEnabled;
      FTimeLimit := wTimeLimit;
      FStepCapture2x := fStepCaptureAt2x;
      FStepCaptureAverageFrames := wStepCaptureAverageFrames;
      FAudioBufferSize := dwAudioBufferSize;
      FAudioMaster := (AVStreamMaster = AVSTREAMMASTER_AUDIO);
      FMCIControl := FMCIControl;
      FMCIStep := fStepMCIDevice;
      FMCIStartTime := dwMCIStartTime;
      FMCIStopTime := dwMCIStopTime;
    end;
  end;
end;

function TJvCaptureSettings.Apply: Boolean;
var
  Parms: TCAPTUREPARMS;
begin
  Result := False;
  if FHWnd <> 0 then
  begin
    // get original values from window
    capCaptureGetSetup(FHWnd, @Parms, SizeOf(Parms));

    // set our own values
    with Parms do
    begin
      dwRequestMicroSecPerFrame := FFrameDelay;
      fMakeUserHitOKToCapture := ConfirmCapture;
      wPercentDropForError := PercentDropForError;
      FYield := Yield;
      wNumVideoRequested := NumVideoBuffer;
      FCaptureAudio := CaptureAudio;
      wNumAudioRequested := NumAudioBuffer;
      FAbortLeftMouse := AbortLeftMouse;
      FAbortRightMouse := AbortRightMouse;
      vKeyAbort := FKeyAbort;
      FLimitEnabled := LimitEnabled;
      wTimeLimit := TimeLimit;
      fStepCaptureAt2x := StepCapture2x;
      wStepCaptureAverageFrames := StepCaptureAverageFrames;
      dwAudioBufferSize := AudioBufferSize;
      if AudioMaster then
        AVStreamMaster := AVSTREAMMASTER_AUDIO
      else
        AVStreamMaster := AVSTREAMMASTER_NONE;
      FMCIControl := Self.FMCIControl;
      fStepMCIDevice := Self.FMCIStep;
      dwMCIStartTime := FMCIStartTime;
      dwMCIStopTime := FMCIStopTime;
    end;

    // apply new settings
    Result := capCaptureSetSetup(FHWnd, @Parms, SizeOf(Parms));
  end;
end;

function TJvCaptureSettings.GetFPS: Double;
begin
  Result := 1 / FFrameDelay * 1.0E6;
end;

procedure TJvCaptureSettings.SetFPS(const Value: Double);
begin
  FFrameDelay := Round(1.0E6 / Value);
end;

procedure TJvCaptureSettings.SetFrameDelay(const Value: Cardinal);
begin
  // to avoid division by 0 and stupid value for a time delay
  // between two frames
  if Value = 0 then
    FFrameDelay := 1
  else
    FFrameDelay := Value;
end;

//=== { TJvPalette } =========================================================

constructor TJvPalette.Create;
begin
  inherited Create;
  FHWnd := 0;
end;

function TJvPalette.Load(FileName: string): Boolean;
begin
  Result := (FHWnd <> 0) and capPaletteOpen(FHWnd, PChar(FileName));
end;

function TJvPalette.Save(FileName: string): Boolean;
begin
  Result := (FHWnd <> 0) and capPaletteSave(FHWnd, PChar(FileName));
end;

function TJvPalette.PasteFromClipboard: Boolean;
begin
  Result := (FHWnd <> 0) and capPalettePaste(FHWnd);
end;

function TJvPalette.AutoCreate(nbFrames: Integer; nbColors: TJvPaletteNbColors): Boolean;
begin
  Result := (FHWnd <> 0) and capPaletteAuto(FHWnd, nbFrames, nbColors);
end;

function TJvPalette.ManuallyCreate(Flag: Boolean; nbColors: TJvPaletteNbColors): Boolean;
begin
  Result := (FHWnd <> 0) and capPaletteManual(FHWnd, Flag, nbColors);
end;

//=== { TJvAVICapture } ======================================================

constructor TJvAVICapture.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FScrollPos := TJvScrollPos.Create;
  // Not connected yet
  FDriverIndex := -1;
  FFileSizeAlloc := 0;
  FOverlaying := False;
  FPreviewing := False;
  FUsedEvents := [];
  FVideoLeft := 0;
  FVideoTop := 0;
  FDrivers := TStringList.Create;
  // Preview frame delay = 50ms between frames (20 frames per second)
  FPreviewFrameDelay := 50;
  FVideoFormat := TJvVideoFormat.Create;
  FAudioFormat := TJvAudioFormat.Create;
  // Default to PCM, 11.025khz 8 bit Mono
  with FAudioFormat do
  begin
    FormatTag := WAVE_FORMAT_PCM;
    Channels := 1;
    BitsPerSample := 8;
    SamplesPerSec := 11025;
  end;
  FCaptureSettings := TJvCaptureSettings.Create;
  FPalette := TJvPalette.Create;
  SetBounds(0, 0, 320, 240);
  EnumDrivers;
  // set all events to 'used'
  UsedEvents := [ueError, ueStatus, ueYield, ueFrame, ueVideoStream, ueWaveStream, ueCapControl];
end;

destructor TJvAVICapture.Destroy;
begin
  Disconnect;
  FDrivers.Free;
  FCaptureSettings.Free;
  FAudioFormat.Free;
  FVideoFormat.Free;
  FPalette.Free;
  FScrollPos.Free;
  inherited Destroy;
end;

procedure TJvAVICapture.CreateWindowHandle(const Params: TCreateParams);
begin
  // ensure the TWinControl is fully created first
  inherited CreateWindowHandle(Params);
  // no hint to show
  //ParentShowHint := False;
  //ShowHint := False;