Capture des frames d'un TMediaPlayer [Résolu]

Signaler
Messages postés
237
Date d'inscription
mardi 13 novembre 2007
Statut
Membre
Dernière intervention
21 novembre 2013
-
Messages postés
237
Date d'inscription
mardi 13 novembre 2007
Statut
Membre
Dernière intervention
21 novembre 2013
-
Quelqu'un sait-il comment capturer en TBitmap chaque frame d'un TMediaPlayer, sans les afficher ?

9 réponses

Messages postés
992
Date d'inscription
jeudi 2 novembre 2000
Statut
Membre
Dernière intervention
24 avril 2013
2
Hep, est tu obligé d'utiliser le TMauvaisMediaPlayer ?

J'ai fait un prog pour réaliser ca (mais pas avec TMediaPlayer) , Capture de la Frame jouée et Capture de toutes les frames (Interval à choisir : ex : toutes les secondes , minutes , dixième de secondes ... )

Si tu es encore intérréssé je posterais cette source ...

Nico
Messages postés
992
Date d'inscription
jeudi 2 novembre 2000
Statut
Membre
Dernière intervention
24 avril 2013
2
Ok, ben je refais un peu l'indentation et je vérifie la source pour avoir une belle syntaxe et j'envoie ça
sur DelphiFR ce soir ...

PS : pour certains formats, ça ne passe pas (les Flv foire , les XVids aussi je pense et les mp4)
PS2: pour chaquue format à decoder , tu dois avoir les codecs sur ton pc (Et oui, c'est pas un VLC inside  )

Nico
Messages postés
237
Date d'inscription
mardi 13 novembre 2007
Statut
Membre
Dernière intervention
21 novembre 2013

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

Si tu as besoin d'un truc...dis toujours... :-)
Messages postés
237
Date d'inscription
mardi 13 novembre 2007
Statut
Membre
Dernière intervention
21 novembre 2013

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...
Messages postés
237
Date d'inscription
mardi 13 novembre 2007
Statut
Membre
Dernière intervention
21 novembre 2013

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...
Messages postés
237
Date d'inscription
mardi 13 novembre 2007
Statut
Membre
Dernière intervention
21 novembre 2013

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.
Messages postés
237
Date d'inscription
mardi 13 novembre 2007
Statut
Membre
Dernière intervention
21 novembre 2013

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
Messages postés
237
Date d'inscription
mardi 13 novembre 2007
Statut
Membre
Dernière intervention
21 novembre 2013

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
Messages postés
237
Date d'inscription
mardi 13 novembre 2007
Statut
Membre
Dernière intervention
21 novembre 2013

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);