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

Messages postés
237
Date d'inscription
mardi 13 novembre 2007
Statut
Membre
Dernière intervention
21 novembre 2013
- - Dernière réponse : blueperfect
Messages postés
237
Date d'inscription
mardi 13 novembre 2007
Statut
Membre
Dernière intervention
21 novembre 2013
- 15 janv. 2009 à 00:42
Quelqu'un sait-il comment capturer en TBitmap chaque frame d'un TMediaPlayer, sans les afficher ?
Afficher la suite 

9 réponses

Meilleure réponse
Messages postés
1039
Date d'inscription
jeudi 2 novembre 2000
Statut
Membre
Dernière intervention
24 avril 2013
2
3
Merci
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

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 129 internautes nous ont dit merci ce mois-ci

Commenter la réponse de Nicolas___
Messages postés
1039
Date d'inscription
jeudi 2 novembre 2000
Statut
Membre
Dernière intervention
24 avril 2013
2
3
Merci
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

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 129 internautes nous ont dit merci ce mois-ci

Commenter la réponse de Nicolas___
Messages postés
237
Date d'inscription
mardi 13 novembre 2007
Statut
Membre
Dernière intervention
21 novembre 2013
0
Merci
Oh que oui que ça m'interresse....

Si tu as besoin d'un truc...dis toujours... :-)
Commenter la réponse de blueperfect
Messages postés
237
Date d'inscription
mardi 13 novembre 2007
Statut
Membre
Dernière intervention
21 novembre 2013
0
Merci
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...
Commenter la réponse de blueperfect
Messages postés
237
Date d'inscription
mardi 13 novembre 2007
Statut
Membre
Dernière intervention
21 novembre 2013
0
Merci
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...
Commenter la réponse de blueperfect
Messages postés
237
Date d'inscription
mardi 13 novembre 2007
Statut
Membre
Dernière intervention
21 novembre 2013
0
Merci
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.
Commenter la réponse de blueperfect
Messages postés
237
Date d'inscription
mardi 13 novembre 2007
Statut
Membre
Dernière intervention
21 novembre 2013
0
Merci
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
Commenter la réponse de blueperfect
Messages postés
237
Date d'inscription
mardi 13 novembre 2007
Statut
Membre
Dernière intervention
21 novembre 2013
0
Merci
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
Commenter la réponse de blueperfect
Messages postés
237
Date d'inscription
mardi 13 novembre 2007
Statut
Membre
Dernière intervention
21 novembre 2013
0
Merci
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);
Commenter la réponse de blueperfect