Capture des frames d'un TMediaPlayer [Résolu]
Signaler
blueperfect
blueperfect
- Messages postés
- 234
- Date d'inscription
- mardi 13 novembre 2007
- Statut
- Membre
- Dernière intervention
- 21 novembre 2013
blueperfect
- Messages postés
- 234
- Date d'inscription
- mardi 13 novembre 2007
- Statut
- Membre
- Dernière intervention
- 21 novembre 2013
A voir également:
- Tmediaplayer
- Delphi tmediaplayer - Meilleures réponses
- Delphi frames - Meilleures réponses
- Jouer des sons avec tmediaplayer - Codes sources - C / C++ / C++.NET (Multimédia)
- Utilisation TMédiaPlayer ✓ - Forum - Delphi / Pascal
- [TMediaplayer] Problème d'affichage dans un PANEL sous XP ? ✓ - Forum - Delphi / Pascal
- TMediaPlayer et Wait ✓ - Forum - Delphi / Pascal
- TMediaPlayer : jouer un video dans un panel1 ✓ - Forum - Delphi / Pascal
9 réponses
Nicolas___
- Messages postés
- 992
- Date d'inscription
- jeudi 2 novembre 2000
- Statut
- Membre
- Dernière intervention
- 24 avril 2013
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
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
Nicolas___
- Messages postés
- 992
- Date d'inscription
- jeudi 2 novembre 2000
- Statut
- Membre
- Dernière intervention
- 24 avril 2013
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
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
blueperfect
- Messages postés
- 234
- 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... :-)
Si tu as besoin d'un truc...dis toujours... :-)
blueperfect
- Messages postés
- 234
- 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...
Je les convertirais en WMV ou AVI s'il le faut...
blueperfect
- Messages postés
- 234
- 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...
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...
blueperfect
- Messages postés
- 234
- 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.
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.
blueperfect
- Messages postés
- 234
- 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
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
blueperfect
- Messages postés
- 234
- 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
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
blueperfect
- Messages postés
- 234
- 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);
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);