mplayer + lazarus

Вопросы программирования и использования среды Lazarus.

Модератор: Модераторы

mplayer + lazarus

Сообщение WeX » 17.11.2008 17:53:32

Всем привет. Возникла необходмиость проигрывания видео в своём приложении. Выбор пал на использование mplayer'а. Предполагается что приложение будет работать под linux'ом. Перерыл форум на офсайте лазаруса, нашёл, попробовал вот этот код:

Код: Выделить всё
procedure TMainWindow.RunVideoClick(Sender: TObject);
var
  fDisplay: PDisplay;
  fWindow: Int64;
  mplayerproc: TProcess;
  DummyButton: TButton;
  ScrollBox: TScrollBox;
begin
  ScrollBox:= TScrollBox.Create(nil);
  ScrollBox.Parent:= MainWindow;
  ScrollBox.Left:= 0;
  ScrollBox.Width:= MainWindow.Width;
  ScrollBox.Top:= 0;
  ScrollBox.Height:= MainWindow.Height - 100;
  DummyButton:= TButton.Create(nil);
  DummyButton.Parent:= ScrollBox;;
  DummyButton.Visible:= False;
//  fDisplay := GDK_WINDOW_XDISPLAY(Pointer(PGtkWidget(scrollbox1.Handle)^.window));
  fWindow := GDK_WINDOW_XWINDOW(Pointer(PGtkWidget(DummyButton.Handle)^.window));
  mplayerproc:= TProcess.Create(nil);
  mplayerproc.Options:= [poWaitOnExit];
  mplayerproc.CommandLine:= 'mplayer -slave -quiet -zoom -wid ' + IntToStr(fWindow) + ' /media/data1/klip.avi';
  mplayerproc.Execute;
  mplayerproc.Free;
  DummyButton.Free;
  ScrollBox.Free;
end;


Видео проигрывается, но само приложение какбы виснет, система считает что оно неотвечает =((( Все элементы на форме неактивны =((( Подскажите что делать, или может есть идеи получше как встроить mplayer в сво проект...
lazarus собран под gtk2 если это важно
WeX
незнакомец
 
Сообщения: 6
Зарегистрирован: 17.11.2008 17:44:38

Re: mplayer + lazarus

Сообщение B4rr4cuda » 17.11.2008 18:27:37

Важно, хз почему, но плагин wlxmplayer не пашет собака на втором гтк. А чтоб приложение не висло - пускай процесс из потока.
http://doublecmd.svn.sourceforge.net/viewvc/doublecmd/trunk/plugins/wlx/WlxMplayer/
Аватара пользователя
B4rr4cuda
энтузиаст
 
Сообщения: 693
Зарегистрирован: 28.12.2007 07:48:35

Re: mplayer + lazarus

Сообщение WeX » 18.11.2008 12:54:48

Спасибо, покопаюсь, может что получится

Добавлено спустя 2 часа 10 минут 25 секунд:
Так начались проблемы...

Сделал модуль следующего содержания:
Код: Выделить всё
unit wxmplayer;

{$mode objfpc}{$H+}

{$DEFINE LCLGTK2}

interface

uses
  {$IFDEF UNIX}
  cthreads,
  {$ENDIF}
  Classes, SysUtils, x,
  {$IFDEF LCLGTK} gtk, gdk, glib, {$ENDIF}
  {$IFDEF LCLGTK2} gtk2, gdk2, glib2, gdk2x, {$ENDIF}
  Process, math, xlib, ExtCtrls;

type
  TExProcess = class
  protected
    p: TProcess;
    s: string;
    function _GetExitStatus(): integer;
  public
    RezList:TStringList;
    constructor Create(commandline: string);
    procedure Execute;
    destructor Destroy;
    procedure OnReadLn(str: string);
    property ExitStatus: integer read _GetExitStatus;
end;

const buf_len = 3000;

implementation

function TExProcess._GetExitStatus(): integer;
begin
  Result:=p.ExitStatus;
end;

constructor TExProcess.Create(commandline: string);
begin
  RezList:=TStringList.Create;
  s:='';
  p:=TProcess.Create(nil);
  p.CommandLine:=commandline;
  p.Options:=[poUsePipes,poNoConsole];
end;

procedure TExProcess.Execute;
var
  buf: string;
  i, j, c, n: integer;
begin
  p.Execute;
  repeat
    SetLength(buf, buf_len);
    SetLength(buf, p.output.Read(buf[1], length(buf)));
    s:=s + buf;
    repeat
      i:=Pos(#13, s);
      j:=Pos(#10, s);
      if i=0 then i:=j;
      if j=0 then j:=i;
      if j = 0 then Break;
      OnReadLn(Copy(s, 1, min(i, j) - 1));
      s:=Copy(s, max(i, j) + 1, length(s) - max(i, j));
    until false;
  until buf = '';
  if s <> ''then
  OnReadLn(s);
end;

destructor TExProcess.Destroy;
begin
  RezList.Free;
  p.Free;
end;

procedure TExProcess.OnReadLn(str: string);
begin
RezList.Add(str);
end;

type
  TMPlayer=class(TThread)
  public
    hWidget:THandle;
    fileName:string;
    xid:TWindow;
    pr:TProcess;
    pmplayer:string;
    constructor Create(AFilename:String);
    destructor destroy; override;
    procedure SetParentWidget(AWidget:thandle);
  protected
    procedure Execute; override;
  private
end;

constructor TMPlayer.Create(AFilename:String);
var pf:TExProcess;
begin
  inherited Create(true);
  filename:='"'+AFilename+'"';
  pf:=TExProcess.Create('which mplayer');
  pf.Execute;
  pmplayer:=pf.RezList[0]+' ';
  pf.Free;
  writeln('PLUGIN : found mplayer in :' + pmplayer);
end;

destructor TMPlayer.destroy;
begin
  if pr.Running then
  pr.Terminate(0);
  pr.Free;
  inherited destroy;
end;

procedure TMPlayer.SetParentWidget(AWidget: THandle);
var widget, mySocket:PGtkWidget;
begin
  widget := gtk_vbox_new(FALSE,0);
  mySocket := gtk_socket_new();
  gtk_container_add (GTK_CONTAINER(widget), mySocket);
  gtk_widget_show(mySocket);
  gtk_widget_show(widget);
  gtk_container_add (GTK_CONTAINER (PGtkWidget(Awidget)), widget);
  gtk_widget_realize(mySocket);
  gtk_widget_hide(PGtkWidget(AWidget));
{$IFDEF LCLGTK}
  xid:=(PGdkWindowPrivate(widget^.window))^.xwindow;
{$ENDIF}
{$IFDEF LCLGTK2}
  xid:=GDK_WINDOW_XID(widget^.window);
{$ENDIF}
  hWidget:= THandle(widget);
end;

procedure TMPlayer.Execute;
begin
  pr:=TProcess.Create(nil);
  pr.Options := Pr.Options + [poWaitOnExit,poNoConsole];
  pr.CommandLine:=pmplayer+fileName+' -wid '+IntToStr(xid);
  pr.Execute;
end;
end.


Создал новый проект, подключил этот модуль к нему, попробовал скомпилировать, приложение собирается удачно, но неработает... В консоли пишет:

Threading has been used before cthreads was initialized.
Make cthreads one of the first units in your uses clause.

Что с этим делать??? я так понял ему чтото ненравится в использовании модуля cthreads???
WeX
незнакомец
 
Сообщения: 6
Зарегистрирован: 17.11.2008 17:44:38

Re: mplayer + lazarus

Сообщение Odyssey » 18.11.2008 15:28:19

WeX писал(а):Threading has been used before cthreads was initialized.
Make cthreads one of the first units in your uses clause.

Что с этим делать??? я так понял ему чтото ненравится в использовании модуля cthreads???


Ему не нравится, что потоки были использованы до инициализации cthreads. Требует поставить cthreads первым или одним из первых модулей в секции uses.
Odyssey
энтузиаст
 
Сообщения: 581
Зарегистрирован: 29.11.2007 17:32:24

Re: mplayer + lazarus

Сообщение B4rr4cuda » 18.11.2008 15:35:28

Код: Выделить всё
{$DEFINE LCLGTK2}

Это нужно только для библиотеки, если твой модуль используется в обычном приложении, то убирай дефайн, т.к. Лазарь его обьявляет автоматом в зависимости от используемого виджета.
Аватара пользователя
B4rr4cuda
энтузиаст
 
Сообщения: 693
Зарегистрирован: 28.12.2007 07:48:35

Re: mplayer + lazarus

Сообщение WeX » 19.11.2008 13:11:39

Odyssey писал(а):Ему не нравится, что потоки были использованы до инициализации cthreads. Требует поставить cthreads первым или одним из первых модулей в секции uses.


Поставил я в самое начало uses, всёравно ему не нравится =(( Туже самую ошибку выдаёт
WeX
незнакомец
 
Сообщения: 6
Зарегистрирован: 17.11.2008 17:44:38

Re: mplayer + lazarus

Сообщение Odyssey » 19.11.2008 14:29:00

Тогда можно попробовать
1) Добавить cthreads первым модулем в uses-секцию проекта, или
2) В меню Lazarus: Проект -> Параметры компилятора -> закладка "Другое", в поле "Параметры пользователя" добавить опцию dUseCThreads
Odyssey
энтузиаст
 
Сообщения: 581
Зарегистрирован: 29.11.2007 17:32:24

Re: mplayer + lazarus

Сообщение Mr.Smart » 19.11.2008 14:37:20

WeX писал(а):
Odyssey писал(а):Ему не нравится, что потоки были использованы до инициализации cthreads. Требует поставить cthreads первым или одним из первых модулей в секции uses.


Поставил я в самое начало uses, всёравно ему не нравится =(( Туже самую ошибку выдаёт

Так этот модуль должен быть в самам начале проекта, а не модуля
Код: Выделить всё
program project1;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF},
....

файл с расширением lpr
Mr.Smart
долгожитель
 
Сообщения: 1797
Зарегистрирован: 29.03.2008 01:01:11
Откуда: из леса!

Re: mplayer + lazarus

Сообщение WeX » 19.11.2008 15:35:17

Mr.Smart писал(а):Так этот модуль должен быть в самам начале проекта, а не модуля


Спасибо, помогло =))

Добавлено спустя 57 минут 24 секунды:
И опять, приложение собирается, вроде уже всё должно работать, но:

Код: Выделить всё
TApplication.HandleException Access violation
  Stack trace:
  $0000000000734182 line 149 of wxmplayer.pas
  $00000000004BAE6A line 42 of main.pas
  $00000000005BE9AD line 2095 of include/control.inc
  $00000000005D4A7E line 57 of include/buttoncontrol.inc
  $00000000005D5290 line 185 of include/buttons.inc
  $00000000005D57DD line 329 of include/buttons.inc
  $00000000005D54A9 line 240 of include/buttons.inc
  $0000000000496628
  $00000000005B3882 line 4749 of include/wincontrol.inc
  $00000000007328BA line 103 of lclmessageglue.pas
  $00000000007314C6 line 1629 of gtk2wsstdctrls.pp
  $00007F351BE3CBBF


149я строка в wxmplayer.pas это:
Код: Выделить всё
xid:=GDK_WINDOW_XID(widget^.window);

42я в main.pas:
Код: Выделить всё
player.SetParentWidget(Form1.Panel1.Handle);


Вообще часть кода для запуска mplayer:
Код: Выделить всё
var
  player: TMPlayer;
...
procedure TForm1.Button1Click(Sender: TObject);
begin
  player.Create('/mnt/arc/eurotip.avi');
  player.SetParentWidget(Form1.Panel1.Handle);
  player.Execute;
end;


Пробовал собрать под gtk тоже самое...
WeX
незнакомец
 
Сообщения: 6
Зарегистрирован: 17.11.2008 17:44:38

Re: mplayer + lazarus

Сообщение tema » 11.08.2017 00:08:59

Ооооо! Займусь некропостингом :D
Мне нужно именно это.
Есть окно gvncviewer написанное на сях.
В сях окно создайтся так:
Код: Выделить всё
GtkWidget *window;
GtkWidget *layout;
window = gtk_window_new(GTK_WINDOW_TOPLEVEL);
layout = gtk_vbox_new(FALSE, 0);
gtk_container_add(GTK_CONTAINER(window), layout);

Хочу его принять в свою программу. Скопировал из кода выше и сделал у себя:
Код: Выделить всё
Form2.Visible:=true;
  widget := gtk_vbox_new(FALSE,0);
  mySocket := gtk_socket_new;
  gtk_container_add (GTK_CONTAINER(widget), mySocket);
  gtk_widget_show(mySocket);
  gtk_widget_show(widget);
  gtk_container_add (GTK_CONTAINER (PGtkWidget(Form2.Handle)), widget);
  gtk_widget_realize(mySocket);
  xid:=gdk_window_xwindow(widget^.window);
showmessage(inttostr(xid));

В сях изменил:
Код: Выделить всё
window = gtk_plug_new((Window) gembed);

Шоу мессадж выводит 0. Ну я всё равно узнал wid и написал его руками в переменную gembed, но не отображается и всё тут :(
Ошибок никаких нигде не написано....
tema
постоялец
 
Сообщения: 318
Зарегистрирован: 24.03.2011 20:19:27

Re: mplayer + lazarus

Сообщение olegy123 » 11.08.2017 07:58:41

https://cboard.cprogramming.com/linux-p ... other.html
Код: Выделить всё
GtkWidget *plug;
plug = gtk_plug_new (win_id_of_socket);
gtk_container_add (GTK_CONTAINER (plug), vbox);
gtk_widget_show ( plug );

это у gtk2

в gtk3 может связь упростили
https://developer.gnome.org/gtk3/stable/GtkSocket.html

но смотри есть проблемы:
два процесса которые друг друга не могут контролировать, если один начнет пересоздавать окно - второму что делать?
в Интерпрайз с этим хуком пошлют далеко.
olegy123
энтузиаст
 
Сообщения: 579
Зарегистрирован: 25.02.2016 12:10:20

Re: mplayer + lazarus

Сообщение tema » 11.08.2017 11:39:45

Ну rdesktop же как-то справляется. Если "окно-монитор" киляется, то уничтожится и дочерний процесс. Это нормально. Не понял как применить процитированный код. У меня же так и написано. Я же говорю: не работает.
tema
постоялец
 
Сообщения: 318
Зарегистрирован: 24.03.2011 20:19:27

Re: mplayer + lazarus

Сообщение Alex2013 » 17.08.2017 02:22:05

А зачем писать программу именно под Линукс ? Там же почти все плееры прекрасно под Wine пашут ... А уж если специально под Wine отладить то вообще хлопот не будет !
Alex2013
энтузиаст
 
Сообщения: 662
Зарегистрирован: 03.04.2013 11:59:44

Re: mplayer + lazarus

Сообщение Лекс Айрин » 17.08.2017 09:17:26

под никсами и своих плееров полно.
Аватара пользователя
Лекс Айрин
долгожитель
 
Сообщения: 3914
Зарегистрирован: 19.02.2013 16:54:51

Re: mplayer + lazarus

Сообщение olegy123 » 17.08.2017 12:53:34

tema писал(а):Ну rdesktop же как-то справляется. Если "окно-монитор" киляется, то уничтожится и дочерний процесс. Это нормально. Не понял как применить процитированный код. У меня же так и написано. Я же говорю: не работает.

Два процесса, друг с другом не взаимодействуют, кроме как stdio.
По коду, ниче пока не скажу.
olegy123
энтузиаст
 
Сообщения: 579
Зарегистрирован: 25.02.2016 12:10:20

След.

Вернуться в Lazarus

Кто сейчас на конференции

Сейчас этот форум просматривают: Google Adsense [Bot], Yandex [Bot] и гости: 5

Рейтинг@Mail.ru