babaev-an/lasarus_compotents
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Стартовый пул

Browse Source
This commit is contained in:
Александр Бабаев
2024-04-02 08:46:59 +03:00
parent fd57fffd3a
commit 3bb34d000b
5591 changed files with 3291734 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

111
PasLibVlc/Lazarus/DemoPasLibVlc/DemoPasLibVlc.lpi Normal file
View File

@@ -0,0 +1,111 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="10"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="DemoPasLibVlc"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<UseVersionInfo Value="True"/>
<MajorVersionNr Value="1"/>
<Language Value="0415"/>
<StringTable CompanyName="Robert Jędrzejczyk" FileDescription="DemoPasLibVlc" InternalName="DemoPasLibVlc" LegalCopyright="Robert Jędrzejczyk" LegalTrademarks="Robert Jędrzejczyk" OriginalFilename="DemoPasLibVlc" ProductName="DemoPasLibVlc" ProductVersion="DemoPasLibVlc"/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="PasLibVlcPlayer"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="DemoPasLibVlc.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="MainFormUnit.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="DemoPasLibVlc"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<SyntaxMode Value="Delphi"/>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
<RelocatableUnit Value="True"/>
<Optimizations>
<OptimizationLevel Value="4"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<UseHeaptrc Value="True"/>
<UseExternalDbgSyms Value="True"/>
</Debugging>
<LinkSmart Value="True"/>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<Verbosity>
<ShoLineNum Value="True"/>
</Verbosity>
<WriteFPCLogo Value="False"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

41
PasLibVlc/Lazarus/DemoPasLibVlc/DemoPasLibVlc.lpr Normal file
View File

@@ -0,0 +1,41 @@
(*
* 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}
program DemoPasLibVlc;
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, MainFormUnit;
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.

32
PasLibVlc/Lazarus/DemoPasLibVlc/MainFormUnit.lfm Normal file
View File

@@ -0,0 +1,32 @@
object MainForm: TMainForm
Left = 270
Height = 367
Top = 122
Width = 515
Caption = 'DemoPasLibVlc'
Menu = MainMenu
OnCreate = FormCreate
OnDestroy = FormDestroy
LCLVersion = '1.8.4.0'
object OpenDialog: TOpenDialog
left = 16
top = 16
end
object MainMenu: TMainMenu
left = 16
top = 72
object FileMenuItem: TMenuItem
Caption = 'File'
object OpenMenuItem: TMenuItem
Caption = 'Open'
ShortCut = 16463
OnClick = MenuFileOpenClick
end
object QuitMenuItem: TMenuItem
Caption = 'Quit'
ShortCut = 49233
OnClick = MenuFileQuitClick
end
end
end
end

208
PasLibVlc/Lazarus/DemoPasLibVlc/MainFormUnit.pas Normal file
View File

@@ -0,0 +1,208 @@
(*
* 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.