lasarus_compotents/PasLibVlc/Lazarus/DemoPasLibVlc/MainFormUnit.pas

(*
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 *
 * Any non-GPL usage of this software or parts of this software is strictly
 * forbidden.
 *
 * The "appropriate copyright message" mentioned in section 2c of the GPLv2
 * must read: "Code from FAAD2 is copyright (c) Nero AG, www.nero.com"
 *
 *)

{$I ..\..\source\compiler.inc}

unit MainFormUnit;

interface

uses
  {$IFDEF UNIX}Unix,{$ENDIF}
  {$IFDEF MSWINDOWS}{$IFNDEF FPC}Windows,{$ENDIF}{$ENDIF}
  {$IFDEF LCLGTK2}Gtk2, {$IFDEF UNIX}Gdk2x,{$ENDIF}{$ENDIF}
  {$IFDEF LCLQT}Qt4, QtWidgets, {$ENDIF}
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus,
  ExtCtrls, {$IFNDEF FPC}StdCtrls,{$ENDIF} PasLibVlcUnit;

type

  { TMainForm }

  TMainForm = class(TForm)
    FileMenuItem: TMenuItem;
    OpenDialog: TOpenDialog;
    MainMenu: TMainMenu;
    MenuFile: TMenuItem;
    MenuFileOpen: TMenuItem;
    MenuFileQuit: TMenuItem;
    OpenMenuItem: TMenuItem;
    QuitMenuItem: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure MenuFileOpenClick(Sender: TObject);
    procedure MenuFileQuitClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    p_li : libvlc_instance_t_ptr;
    p_mi : libvlc_media_player_t_ptr;
    procedure PlayerInit();
    procedure PlayerPlay(fileName: WideString);
    procedure PlayerStop();
    procedure PlayerDestroy();
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.lfm}

{ TMainForm }

procedure TMainForm.PlayerInit();
begin
  libvlc_dynamic_dll_init();

  if (libvlc_dynamic_dll_error <> '') then
  begin
    MessageDlg(libvlc_dynamic_dll_error, mtError, [mbOK], 0);
    Application.Terminate();
    exit;
  end;

  with TArgcArgs.Create([
    WideString(libvlc_dynamic_dll_path),
    '--intf=dummy',
    '--ignore-config',
    '--quiet',
    '--no-video-title-show',
    '--no-video-on-top'
  ]) do
  begin
    p_li := libvlc_new(ARGC, ARGS);
    Free;
  end;

  if (p_li <> NIL) then
  begin
    p_mi := libvlc_media_player_new(p_li);
  end;
end;

procedure TMainForm.PlayerPlay(fileName: WideString);
var
  p_md : libvlc_media_t_ptr;
  a_st : AnsiString;
  p_st : PAnsiChar;
begin
  a_st := UTF8Encode(fileName);
  p_st := PAnsiChar(@a_st[1]);

  if (p_li <> NIL) then
  begin
    p_md := libvlc_media_new_path(p_li, p_st);
    if (p_md <> NIL) then
    begin
      if (p_mi <> NIL) then
      begin
        //libvlc_video_set_key_input(p_mi, 1);
        //libvlc_video_set_mouse_input(p_mi, 1);
        libvlc_media_player_set_display_window(p_mi, SELF.Handle);
        libvlc_media_player_set_media(p_mi, p_md);
        libvlc_media_player_play(p_mi);
      end;
      libvlc_media_release(p_md);
    end;
  end;
end;

procedure TMainForm.PlayerStop();
begin
  if (p_mi <> NIL) then
  begin
    libvlc_media_player_stop(p_mi);
    Sleep(50);
    while (libvlc_media_player_is_playing(p_mi) <> 0) do
    begin
      Sleep(50);
    end;
    libvlc_media_player_release(p_mi);
    p_mi := NIL;
    Sleep(50);
  end;
end;

procedure TMainForm.PlayerDestroy();
begin
  if (p_li <> NIL) then
  begin
    PlayerStop();
    libvlc_release(p_li);
    p_li := NIL;
  end;
  libvlc_dynamic_dll_done();
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  p_li := NIL;
  p_mi := NIL;
  {$IFDEF LCLGTK2}
    Caption := Caption + ' LCL GTK2';
  {$ELSE}
    {$IFDEF LCLQT}
      Caption := Caption + ' LCL QT';
    {$ELSE}
      Caption := Caption + ' LCL WIN';
    {$ENDIF}
  {$ENDIF}
  Caption := Caption + ' x' + {$IFDEF CPUX32}'32'{$ELSE}'64'{$ENDIF};
  PlayerInit();
  if (libvlc_dynamic_dll_vlc_version_str <> '') then
  begin
    Caption := Caption + ', libvlc: ' + libvlc_dynamic_dll_vlc_version_str;
    if (ParamStr(1) <> '') then
    begin
      PlayerPlay(ParamStr(1));
    end;
  end;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  PlayerDestroy();
end;

procedure TMainForm.MenuFileOpenClick(Sender: TObject);
begin
  if OpenDialog.Execute() then
  begin
    {$IFDEF MSWINDOWS}
      PlayerPlay(WideString(StringReplace(OpenDialog.FileName, '/', '\', [rfReplaceAll])));
    {$ELSE}
      PlayerPlay(OpenDialog.FileName);
    {$ENDIF}
  end;
end;

procedure TMainForm.MenuFileQuitClick(Sender: TObject);
begin
  Application.Terminate;
end;


end.