paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

MPlayer: Fix component being broken in Linux (gtk2) after Lazarus commit "bfd34850 LCL-GTK2: Remove a boolean param from GetWidgetInfo and use new func GetOrCreateWidgetInfo. Identify memory leaks." on Aug 11, 2019. Issue #39070. Based on patch by Michael Köcher. Update "Simple" demo project.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9262 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2024-03-03 11:45:23 +00:00
parent 67802d571d
commit 9a46c50c6f
6 changed files with 76 additions and 114 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
components/mplayer/examples/Simple/project1.lpi
View File

@ -1,10 +1,12 @@
<?xml version="1.0" encoding="UTF-8"?> <?xml version="1.0" encoding="UTF-8"?>
<CONFIG> <CONFIG>
<ProjectOptions> <ProjectOptions>
<Version Value="9"/> <Version Value="12"/>
<General> <General>
<Flags>
<CompatibilityMode Value="True"/>
</Flags>
<SessionStorage Value="InProjectDir"/> <SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<ResourceType Value="res"/> <ResourceType Value="res"/>
<UseXPManifest Value="True"/> <UseXPManifest Value="True"/>
<Icon Value="0"/> <Icon Value="0"/>
@ -16,9 +18,10 @@
<Version Value="2"/> <Version Value="2"/>
</PublishOptions> </PublishOptions>
<RunParams> <RunParams>
<local> <FormatVersion Value="2"/>
<FormatVersion Value="1"/> <Modes Count="1">
</local> <Mode0 Name="default"/>
</Modes>
</RunParams> </RunParams>
<RequiredPackages Count="2"> <RequiredPackages Count="2">
<Item1> <Item1>
@ -40,6 +43,7 @@
<ComponentName Value="Form1"/> <ComponentName Value="Form1"/>
<HasResources Value="True"/> <HasResources Value="True"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
</Unit1> </Unit1>
</Units> </Units>
</ProjectOptions> </ProjectOptions>
@ -49,6 +53,9 @@
<IncludeFiles Value="$(ProjOutDir)"/> <IncludeFiles Value="$(ProjOutDir)"/>
</SearchPaths> </SearchPaths>
<Linking> <Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
</Debugging>
<Options> <Options>
<Win32> <Win32>
<GraphicApplication Value="True"/> <GraphicApplication Value="True"/>

2
components/mplayer/examples/Simple/project1.lpr
View File

@ -9,8 +9,6 @@ uses
Interfaces, // this includes the LCL widgetset Interfaces, // this includes the LCL widgetset
Forms, Unit1; Forms, Unit1;
{$IFDEF WINDOWS}{$R project1.rc}{$ENDIF}
{$R *.res} {$R *.res}
begin begin

BIN
components/mplayer/examples/Simple/project1.res
View File

Binary file not shown.

35
components/mplayer/examples/Simple/unit1.lfm
View File

@ -7,12 +7,12 @@ object Form1: TForm1
Caption = 'Form1' Caption = 'Form1'
ClientHeight = 390 ClientHeight = 390
ClientWidth = 583 ClientWidth = 583
LCLVersion = '3.99.0.0'
OnCreate = FormCreate OnCreate = FormCreate
LCLVersion = '1.2.4.0'
object MPlayerControl1: TMPlayerControl object MPlayerControl1: TMPlayerControl
Left = 6 Left = 6
Height = 334 Height = 336
Top = 27 Top = 25
Width = 571 Width = 571
Align = alClient Align = alClient
BorderSpacing.Around = 6 BorderSpacing.Around = 6
@ -21,28 +21,29 @@ object Form1: TForm1
end end
object Panel1: TPanel object Panel1: TPanel
Left = 0 Left = 0
Height = 21 Height = 19
Top = 0 Top = 0
Width = 583 Width = 583
Align = alTop Align = alTop
AutoSize = True AutoSize = True
ClientHeight = 21 BevelOuter = bvNone
ClientHeight = 19
ClientWidth = 583 ClientWidth = 583
TabOrder = 1 TabOrder = 1
object PlaySpeedButton: TSpeedButton object PlaySpeedButton: TSpeedButton
Left = 1 Left = 0
Height = 19 Height = 19
Top = 1 Top = 0
Width = 26 Width = 32
Align = alLeft Align = alLeft
AutoSize = True AutoSize = True
Caption = 'Play' Caption = ' Play '
OnClick = PlaySpeedButtonClick OnClick = PlaySpeedButtonClick
end end
object PauseSpeedButton: TSpeedButton object PauseSpeedButton: TSpeedButton
Left = 27 Left = 32
Height = 19 Height = 19
Top = 1 Top = 0
Width = 35 Width = 35
Align = alLeft Align = alLeft
AutoSize = True AutoSize = True
@ -50,9 +51,9 @@ object Form1: TForm1
OnClick = PauseSpeedButtonClick OnClick = PauseSpeedButtonClick
end end
object StopSpeedButton: TSpeedButton object StopSpeedButton: TSpeedButton
Left = 62 Left = 67
Height = 19 Height = 19
Top = 1 Top = 0
Width = 28 Width = 28
Align = alLeft Align = alLeft
AutoSize = True AutoSize = True
@ -60,9 +61,9 @@ object Form1: TForm1
OnClick = StopSpeedButtonClick OnClick = StopSpeedButtonClick
end end
object OpenSpeedButton: TSpeedButton object OpenSpeedButton: TSpeedButton
Left = 90 Left = 95
Height = 19 Height = 19
Top = 1 Top = 0
Width = 52 Width = 52
Align = alLeft Align = alLeft
AutoSize = True AutoSize = True
@ -79,7 +80,7 @@ object Form1: TForm1
end end
object OpenDialog1: TOpenDialog object OpenDialog1: TOpenDialog
Options = [ofFileMustExist, ofEnableSizing, ofViewDetail] Options = [ofFileMustExist, ofEnableSizing, ofViewDetail]
left = 235 Left = 235
top = 127 Top = 127
end end
end end

12
components/mplayer/examples/Simple/unit1.pas
View File

@ -5,8 +5,10 @@ unit Unit1;
interface interface
uses uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, Classes, SysUtils, FileUtil, LazFileUtils, LazUtf8, LResources,
Buttons, ComCtrls, ExtCtrls, MPlayerCtrl; Forms, Controls, Graphics, Dialogs, Buttons, ComCtrls, ExtCtrls,
{$ifdef MSWINDOWS} WinDirs, {$endif}
MPlayerCtrl;
type type
@ -80,8 +82,10 @@ begin
{$else $IFDEF Windows} {$else $IFDEF Windows}
// Download MPlayer generic for Windows and save under Programm Folder Directory // Download MPlayer generic for Windows and save under Programm Folder Directory
// http://sourceforge.net/projects/mplayer-win32/ // http://sourceforge.net/projects/mplayer-win32/
MPlayerControl1.MPlayerPath:=extractfilepath(application.exename)+'MPlayer\mplayer.exe' ; MPlayerControl1.MPlayerPath := Application.Location + 'MPlayer\mplayer.exe' ;
//MPlayerControl1.StartParam:='-zoom -fs'; // Or: if your MPlayer is installed as usual:
// MPlayerControl1.MPlayerPath := AppendPathDelim(GetWindowsSpecialDir(FOLDERID_ProgramFilesX86, false)) + 'MPlayer for Windows\mplayer.exe';
//MPlayerControl1.StartParam:='-zoom -fs';
{$endif} {$endif}
end; end;

124
components/mplayer/mplayerctrl.pas
View File

@ -70,6 +70,10 @@ Changes:
Exposed OnMouseWheel and implemented wheelmouse scrolling through video in FullFeatured Exposed OnMouseWheel and implemented wheelmouse scrolling through video in FullFeatured
demo demo
/ Mike Thompson / Mike Thompson
2024-02-22 Removed GTK2 related Stuff.
IDE was crashing when MPlayer had been installed before!
Added a Panel as Child to FCanvas for Output Video.
/ six1
TODO TODO
EXTENSIVE TESTING UNDER LINUX EXTENSIVE TESTING UNDER LINUX
@ -99,7 +103,7 @@ uses
LResources, LMessages, Graphics, ExtCtrls, FileUtil, Process, UTF8Process, LResources, LMessages, Graphics, ExtCtrls, FileUtil, Process, UTF8Process,
LazFileUtils LazFileUtils
{$ifdef Linux} {$ifdef Linux}
, gtk2int, gtk2, glib2, gdk2x, Gtk2WSControls, GTK2Proc, Gtk2Def , gtk2, gdk2x
{$endif} {$endif}
; ;
@ -157,6 +161,9 @@ type
FOutList: TStringList; FOutList: TStringList;
FVideoInfo: TVideoInfo; FVideoInfo: TVideoInfo;
FAudioInfo: TAudioInfo; FAudioInfo: TAudioInfo;
{$ifdef Linux}
FDisplayPanel: TPanel;
{$endif}
function GetPosition: single; function GetPosition: single;
function GetRate: single; function GetRate: single;
procedure SetImagePath(AValue: string); procedure SetImagePath(AValue: string);
@ -240,16 +247,6 @@ type
property OnGrabImage; // Fired when mplayer reports the filename of the image grab property OnGrabImage; // Fired when mplayer reports the filename of the image grab
end; end;
{ TWSMPlayerControl }
{$ifdef Linux}
TWSMPlayerControl = class(TGtk2WSWinControl)
published
class function CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND; override;
class procedure DestroyHandle(const AWinControl: TWinControl); override;
end;
{$endif}
Const Const
ON_PLAYING_INTERVAL = 500 / (24*60*60*1000); ON_PLAYING_INTERVAL = 500 / (24*60*60*1000);
@ -438,19 +435,25 @@ procedure TCustomMPlayerControl.WMPaint(var Message: TLMPaint);
begin begin
Include(FControlState, csCustomPaint); Include(FControlState, csCustomPaint);
inherited WMPaint(Message); inherited WMPaint(Message);
if (csDesigning in ComponentState) and (FCanvas<>nil) then begin if (FCanvas<>nil) then begin
with FCanvas do begin if (csDesigning in ComponentState) then begin
if Message.DC <> 0 then with FCanvas do begin
Handle := Message.DC; if Message.DC <> 0 then
Brush.Color:=clLtGray; Handle := Message.DC;
Pen.Color:=clRed; Brush.Color:=clLtGray;
Rectangle(0,0,Self.Width-1,Self.Height-1); Rectangle(0,0,Self.Width-1,Self.Height-1);
MoveTo(0,0); Pen.Color:=clRed;
LineTo(Self.Width,Self.Height); Line(0, 0, Self.Width, Self.Height);
MoveTo(0,Self.Height); Line(0, Self.Height, Self.Width, 0);
LineTo(Self.Width,0); if Message.DC <> 0 then
if Message.DC <> 0 then Handle := 0;
Handle := 0; end;
end else
begin
with FCanvas do begin
Brush.Color := clBlack;
Rectangle(0,0,Self.Width,Self.Height);
end;
end; end;
end; end;
Exclude(FControlState, csCustomPaint); Exclude(FControlState, csCustomPaint);
@ -537,6 +540,13 @@ begin
TControlCanvas(FCanvas).Control := Self; TControlCanvas(FCanvas).Control := Self;
SetInitialBounds(0, 0, 160, 90); SetInitialBounds(0, 0, 160, 90);
{$ifdef Linux}
FDisplayPanel := TPanel.Create(self);
FDisplayPanel.Parent := self;
FDisplayPanel.Visible := false;
FDisplayPanel.Top := -200;
{$endif}
FOutlist := TStringList.Create; FOutlist := TStringList.Create;
FMPlayerPath := 'mplayer' + GetExeExt; FMPlayerPath := 'mplayer' + GetExeExt;
@ -639,11 +649,11 @@ begin
if not FindMPlayerPath then if not FindMPlayerPath then
raise Exception.Create(MPlayerPath+' not found'); raise Exception.Create(MPlayerPath+' not found');
{$IFDEF Linux} {$ifdef Linux}
CurWindowID := GDK_WINDOW_XWINDOW({%H-}PGtkWidget(PtrUInt(Handle))^.window); CurWindowID := GDK_WINDOW_XWINDOW({%H-}PGtkWidget(PtrUInt(FDisplayPanel.Handle))^.window);
{$else} {$else}
CurWindowID := Handle; CurWindowID := Handle;
{$ENDIF} {$endif}
FPlayerProcess := TProcessUTF8.Create(Self); FPlayerProcess := TProcessUTF8.Create(Self);
FPlayerProcess.Options := FPlayerProcess.Options + [poUsePipes, poNoConsole]; FPlayerProcess.Options := FPlayerProcess.Options + [poUsePipes, poNoConsole];
@ -740,7 +750,7 @@ begin
begin begin
if DC <> 0 then if DC <> 0 then
Handle := DC; Handle := DC;
Brush.Color := clLtGray; Brush.Color := clBlack;
Rectangle(0, 0, Self.Width, Self.Height); Rectangle(0, 0, Self.Width, Self.Height);
if DC <> 0 then if DC <> 0 then
Handle := 0; Handle := 0;
@ -811,65 +821,7 @@ begin
end; end;
end; end;
{$ifdef Linux}
function MPLayerWidgetDestroyCB(Widget: PGtkWidget; {%H-}data: gPointer): GBoolean; cdecl;
begin
FreeWidgetInfo(Widget); // created in TWSMPlayerControl.CreateHandle
Result:=false;
end;
{ TWSMPlayerControl }
class function TWSMPlayerControl.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND;
var
NewWidget: PGtkWidget;
WidgetInfo: PWidgetInfo;
Allocation: TGTKAllocation;
begin
if csDesigning in AWinControl.ComponentState then
Result:=inherited CreateHandle(AWinControl,AParams)
else begin
NewWidget:=gtk_event_box_new;
WidgetInfo := GetWidgetInfo(NewWidget,true); // destroyed in MPLayerWidgetDestroyCB
WidgetInfo^.LCLObject := AWinControl;
WidgetInfo^.Style := AParams.Style;
WidgetInfo^.ExStyle := AParams.ExStyle;
WidgetInfo^.WndProc := {%H-}PtrUInt(AParams.WindowClass.lpfnWndProc);
// set allocation
Allocation.X := AParams.X;
Allocation.Y := AParams.Y;
Allocation.Width := AParams.Width;
Allocation.Height := AParams.Height;
gtk_widget_size_allocate(NewWidget, @Allocation);
if csDesigning in AWinControl.ComponentState then begin
// at designtime setup normal handlers
TGtk2WidgetSet(WidgetSet).FinishCreateHandle(AWinControl,NewWidget,AParams);
end else begin
// at runtime
g_signal_connect(GPointer(NewWidget), 'destroy',
TGTKSignalFunc(@MPLayerWidgetDestroyCB), WidgetInfo);
end;
Result:=HWND({%H-}PtrUInt(Pointer(NewWidget)));
DebugLn(['TWSMPlayerControl.CreateHandle ',dbgs(NewWidget)]);
end;
end;
class procedure TWSMPlayerControl.DestroyHandle(const AWinControl: TWinControl
);
begin
inherited DestroyHandle(AWinControl);
end;
{$endif}
initialization initialization
{$ifdef Linux}
RegisterWSComponent(TCustomMPlayerControl,TWSMPlayerControl);
{$endif}
{$I mplayerctrl.lrs} {$I mplayerctrl.lrs}
end. end.