1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
{
*****************************************************************************
See the file COPYING.modifiedLGPL.txt, included in this distribution,
for details about the license.
*****************************************************************************
Author: Željan Rikalo
}
unit qlclopenglwidget;
// this unit can be used only with Qt5 widgetset.
interface
uses
{$IFDEF LCLQt5}qt5,{$ENDIF}
{$IFDEF LCLQt6}qt6,{$ENDIF}
qtobjects, qtwidgets,
Classes, SysUtils, Types, Controls, LCLType;
type
QLCLOpenGLWidget_gl_Override = procedure of object cdecl;
const
QtPasLibrary = {$IFDEF LCLQt5}Qt5PasLib;{$ENDIF}{$IFDEF LCLQt6}Qt6PasLib;{$ENDIF}
function QLCLOpenGLWidget_Create(parent: QWidgetH = nil; f: QtWindowFlags = 0): QWidgetH; cdecl; external QtPasLibrary name 'QLCLOpenGLWidget_Create';
procedure QLCLOpenGLWidget_Destroy(handle: QWidgetH); cdecl; external QtPasLibrary name 'QLCLOpenGLWidget_Destroy';
procedure QLCLOpenGLWidget_override_paintGL(handle: QLCLOpenGLWidgetH; hook: QLCLOpenGLWidget_gl_Override); cdecl; external QtPasLibrary name 'QLCLOpenGLWidget_override_paintGL';
procedure QLCLOpenGLWidget_InheritedPaintGL(handle: QLCLOpenGLWidgetH); cdecl; external QtPasLibrary name 'QLCLOpenGLWidget_InheritedPaintGL';
type
{ TQtOpenGLWidget }
TQtOpenGLWidget = class(TQtWidget)
protected
function CreateWidget(const Params: TCreateParams):QWidgetH; override;
procedure paintGL(); cdecl; virtual;
public
function GetContainerWidget: QWidgetH; override;
procedure AttachEvents; override;
procedure DetachEvents; override;
procedure InitializeWidget; override;
procedure SlotPaintBg(Sender: QObjectH; Event: QEventH); cdecl; override;
procedure SlotPaint(Sender: QObjectH; Event: QEventH); cdecl; override;
function EventFilter(Sender: QObjectH; Event: QEventH): Boolean; cdecl; override;
end;
implementation
{ TQtOpenGLWidget }
function TQtOpenGLWidget.CreateWidget(const Params: TCreateParams): QWidgetH;
var
Parent: QWidgetH;
begin
if Params.WndParent <> 0 then
Parent := TQtWidget(Params.WndParent).GetContainerWidget
else
Parent := nil;
Widget := QLCLOpenGLWidget_Create(Parent);
Result := Widget;
end;
procedure TQtOpenGLWidget.paintGL(); cdecl;
begin
//writeln('TLCLOpenGLWidget.paintGL() ');
QLCLOpenGLWidget_InheritedPaintGL(QLCLOpenGLWidgetH(Widget));
end;
function TQtOpenGLWidget.GetContainerWidget: QWidgetH;
begin
Result := Widget;
end;
procedure TQtOpenGLWidget.AttachEvents;
begin
QLCLOpenGLWidget_override_paintGL(QLCLOpenGLWidgetH(Widget),
@paintGL);
inherited AttachEvents;
end;
procedure TQtOpenGLWidget.DetachEvents;
begin
inherited DetachEvents;
QLCLOpenGLWidget_override_paintGL(QLCLOpenGLWidgetH(Widget),
QLCLOpenGLWidget_gl_Override(NilMethod));
end;
procedure TQtOpenGLWidget.InitializeWidget;
begin
inherited InitializeWidget;
end;
procedure TQtOpenGLWidget.SlotPaintBg(Sender: QObjectH; Event: QEventH); cdecl;
begin
//
end;
procedure TQtOpenGLWidget.SlotPaint(Sender: QObjectH; Event: QEventH); cdecl;
begin
//
end;
function TQtOpenGLWidget.EventFilter(Sender: QObjectH; Event: QEventH
): Boolean; cdecl;
begin
Result := inherited EventFilter(Sender, Event);
end;
end.
|
