Capture des frames d'un TMediaPlayer

Quelqu'un sait-il comment capturer en TBitmap chaque frame d'un TMediaPlayer, sans les afficher ?

Oh que oui que ça m'interresse....

Si tu as besoin d'un truc...dis toujours... :-)

J'ai développé une TPaintBox qui me permets d'afficher des TBitmaps recto/verso en 3D, et je veux le coupler avec un lecteur de video....

Je les convertirais en WMV ou AVI s'il le faut...

Hep : http://www.delphifr.com/codes/BASSVIDEO-LECTEUR-VIDEO-AVEC-BASS_48975.aspx

Voila, tout beau , tout frais :)

Ton exe fonctionne, mais pas le mien !

héhé

je te poste la source du DFM et du PAS, si tu peux me dire le problème...

Tu choisis une video, il capture la premiere frame...

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, FileCtrl, StdCtrls;

type
  TForm1 = class(TForm)
    DriveComboBox1: TDriveComboBox;
    DirectoryListBox1: TDirectoryListBox;
    FileListBox1: TFileListBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FileListBox1DblClick(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


uses Bass,BassVideo;

procedure TForm1.FormCreate(Sender: TObject);
begin
  if not Bass_Init(-1, 44100, 0, 0, nil) then
  begin
    MessageBox(handle,'gg','Error',MB_OK);
    halt;
  end;

  if not BASSVideo_Init then halt;
  BassVideo_SetConfig(BassVideo_Default, 1);

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  BASSVideo_Free;
  BASS_Free;
end;

var
  Chan : DWORD;
function MyVideoStream(Handle : DWORD; Action, param1, param2 : DWORD; user : Pointer): BOOL; stdcall;
var
  ClientRect : TRect;
begin
result := TRUE;
case Action of
  BassVideo_FoundVideo :
    begin
      // on chope la zone d'affichage
      ClientRect:=form1.ClientRect;
      BASSVideo_SetVideoWindow(Handle, form1.Handle,ClientRect, 0);
    end;

  BassVideo_EndStream :
   begin
      BassVideo_StreamFree(chan);
      // a la fin de la video, voir la progression n'a plus grande importance, on stope le Timer
   end;

  BassVideo_OpenDone :
    begin
    //Ouverture Réussie
    end;

  BassVideo_DShow_Event :
   begin
   end;

end;
end;
procedure TForm1.FileListBox1DblClick(Sender: TObject);
var
    Heure : integer;
    Minute : integer;
    Seconde : integer;
    Length : Double;
  pos : double;
  s:widestring;

begin
     s:= 'C:\Documents and Settings\David HAROUCHE\Bureau\Pagecapt.bmp';

  Chan := BassVideo_StreamCreateFile( PChar(self.FileListBox1.FileName),
                                      BASSVIDEO_VIDEOEFFECT ,
                                      0,
                                      @MyVideoStream,
                                      nil
                                    );
  BASSVideo_SetPosition(Chan,0);
  BassVideo_Pause(chan);
  BassVideo_FrameStep(chan);

    Length := BASSVideo_GetLength(Chan);
    // on calcule le nb H,M,S % à Round(Length) qi donne le temps en seconde...
    Heure:=Round(Length)div 3600;
    Minute := Round(Length - (Heure*3600)) div 60;
    Seconde := Round(Length - (Heure*3600) - (Minute*60));

    self.Caption := Format('%d Heure %d minutes %d secondes',[Heure,Minute,Seconde]);

  pos := BassVideo_GetPosition(Chan);//+ precis que progressDuree.Position
    // On met à jour la barre de progression toutes les 25 secondes de vidéo
    // capturée ...
    if(Round(pos) mod 25 = 0) then Application.ProcessMessages;
  BassVideo.BassVideo_CaptureBitmap(PWideChar(self.FileListBox1.FileName), pos, PWideChar(s), BASS_UNICODE);
  
  BassVideo_StreamFree(Chan);
end;

end.

object Form1: TForm1
  Left = 191
  Top = 149
  Width = 391
  Height = 238
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object DriveComboBox1: TDriveComboBox
    Left = 40
    Top = 24
    Width = 145
    Height = 19
    DirList = DirectoryListBox1
    TabOrder = 0
  end
  object DirectoryListBox1: TDirectoryListBox
    Left = 40
    Top = 56
    Width = 145
    Height = 97
    FileList = FileListBox1
    ItemHeight = 16
    TabOrder = 1
  end
  object FileListBox1: TFileListBox
    Left = 192
    Top = 56
    Width = 145
    Height = 97
    ItemHeight = 13
    TabOrder = 2
    OnDblClick = FileListBox1DblClick
  end
end

J'ai trouvé ! BassVideo.BassVideo_CaptureBitmap(PWideChar(self.FileListBox1.FileName), pos, PWideChar(s), BASS_UNICODE); devient var filename:widestring; filename := self.FileListBox1.FileName; BassVideo.BassVideo_CaptureBitmap(PWideChar(filename), pos, PWideChar(s), BASS_UNICODE);
blueperfect