freepascal.ru

Код: Выделить всё

uses
..................................
  x,
  {$IFDEF LCLGTK} gtk, gdk, glib, {$ENDIF}
  {$IFDEF LCLGTK2} gtk2, gdk2, glib2, gdk2x, {$ENDIF}
  {$IFDEF LCLQT} qt4, {$ENDIF}
................................................................

type

//Class implementing mplayer control
{ TMPlayer }

TMPlayer=class(TThread)
        public
          //---------------------
          hWidget:THandle;   //the integrable widget
          fileName:string;        //filename
          xid:TWindow;      //X window handle
          pr:TProcess;            //mplayer's process
          pmplayer:string;        //path to mplayer
          //---------------------
          constructor Create(AFilename:String);
          destructor destroy; override;
          procedure SetParentWidget(AWidget:thandle);
        protected
          procedure Execute; override;
        private

     end;

{ TMPlayer }

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);
{$IFDEF LCLQT}
begin
  xid:= QWidget_winId(QWidgetH(AWidget));
  hWidget:= AWidget;
end;
{$ELSE}
var
   widget,
   mySocket:PGtkWidget;   //the socket
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;
{$ENDIF}


procedure TMPlayer.Execute;
begin
   pr:=TProcess.Create(nil);
   pr.Options := Pr.Options + [poWaitOnExit,poNoConsole{,poUsePipes}]; //mplayer stops if poUsePipes used.
   pr.CommandLine:=pmplayer+fileName+' -wid '+IntToStr(xid);
   pr.Execute;
end;

.........................................................

function ListLoad(ParentWin:thandle;FileToLoad:pchar;ShowFlags:integer):thandle; stdcall;
var p:TMPlayer;
begin
   p:=TMPlayer.Create(string(FileToLoad));
   p.SetParentWidget(ParentWin);
   
   //Create list if none
   if not assigned(List) then
       List:=TStringList.Create;

   //add to list new plugin window and it's info
   List.AddObject(IntToStr(integer(p.hWidget)),TPlugInfo.Create);
   with TPlugInfo(List.Objects[List.Count-1]) do
     begin
       fFileToLoad:=FileToLoad;
       fShowFlags:=ShowFlags;
       AddControl(p);
     end;
     
Result:=integer(p.hWidget);

p.Resume;

end;

Код: Выделить всё

 FreeLibrary(FModuleHandle);