Skip to content
GitLab
Menu
Projects
Groups
Snippets
/
Help
What's new
7
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Switch to GitLab Next
Sign in / Register
Toggle navigation
Menu
Open sidebar
FPC
Lazarus
Lazarus
Commits
02115d37
Commit
02115d37
authored
Jan 20, 2022
by
Juha Manninen
Browse files
LCL-GTK3: Turn WriteLn into DebugLn. Make sure they compile. Cleanup.
parent
b2b36894
Changes
21
Hide whitespace changes
Inline
Side-by-side
lcl/interfaces/gtk3/gtk3bindings/lazcairo1.pas
View file @
02115d37
...
...
@@ -49,7 +49,7 @@ unit LazCairo1;
October 2007
*)
{$mode ObjFpc}
{$mode ObjFpc}
{$H+}
interface
...
...
@@ -195,13 +195,13 @@ type
Tcairo_content_t
=
cairo_content_t
;
cairo_format_t
=
(
//
CAIRO_FORMAT_INVALID = -1,
CAIRO_FORMAT_INVALID
=
-
1
,
CAIRO_FORMAT_ARGB32
,
CAIRO_FORMAT_RGB24
,
CAIRO_FORMAT_A8
,
CAIRO_FORMAT_A1
//
CAIRO_FORMAT_RGB16_565
//
CAIRO_FORMAT_RGB30
CAIRO_FORMAT_A1
,
CAIRO_FORMAT_RGB16_565
,
CAIRO_FORMAT_RGB30
);
cairo_extend_t
=
(
...
...
lcl/interfaces/gtk3/gtk3bindings/lazpangocairo1.pas
View file @
02115d37
...
...
@@ -22,8 +22,7 @@
unit
LazPangoCairo1
;
{$mode objfpc}
{$H+}
{$mode objfpc}{$H+}
interface
uses
LazGlib2
,
LazPango1
,
LazCairo1
,
LazGObject2
;
...
...
lcl/interfaces/gtk3/gtk3boxes.pas
View file @
02115d37
unit
gtk3boxes
;
{
*****************************************************************************
This file is part of the Lazarus Component Library (LCL)
See the file COPYING.modifiedLGPL.txt, included in this distribution,
for details about the license.
*****************************************************************************
}
unit
Gtk3Boxes
;
{$mode objfpc}{$H+}
interface
...
...
lcl/interfaces/gtk3/gtk3cellrenderer.pas
View file @
02115d37
...
...
@@ -262,7 +262,8 @@ begin
else
ANaturalHeight := 0;
}
// writeln('1.minimumheight ',AMinHeight,' naturalheight ',ANaturalHeight,' min ',dbgs(minimum_height <> nil),' nat ',dbgs(natural_height <> nil));
//DebugLn(['1.minimumheight ',AMinHeight,' naturalheight ',ANaturalHeight,
// ' min ',dbgs(minimum_height <> nil),' nat ',dbgs(natural_height<>nil)]);
AWinControl
:=
GetControl
(
widget
);
if
AWinControl
=
Nil
then
exit
;
...
...
@@ -291,7 +292,7 @@ begin
if
natural_height
<>
nil
then
natural_height
^
:=
gint
(
MeasureItemStruct
.
itemHeight
);
//
writel
n('Final cell height ',MeasureItemStruct.itemHeight);
//
DebugL
n('Final cell height ',MeasureItemStruct.itemHeight);
end
;
procedure
LCLIntfCellRenderer_GetSize
(
cell
:
PGtkCellRenderer
;
widget
:
PGtkWidget
;
...
...
@@ -620,7 +621,7 @@ const
class_size
:
SizeOf
(
TLCLIntfCellRenderer
)
+
1024
;
base_init
:
nil
;
// TGBaseInitFunc;
base_finalize
:
nil
;
// TGBaseFinalizeFunc;
class_init
:
@
LCLIntfCellRenderer_ClassInit
;
class_init
:
TGClassInitFunc
(
@
LCLIntfCellRenderer_ClassInit
)
;
class_finalize
:
nil
;
// @LCLIntfCellRenderer_ClassFinalize; // nil; // TGClassFinalizeFunc;
class_data
:
nil
;
instance_size
:
SizeOf
(
TLCLIntfCellRenderer
)
+
1024
;
...
...
@@ -641,7 +642,7 @@ end;
function
LCLIntfCellRenderer_New
:
PGtkCellRenderer
;
begin
// PGtkCellRenderer(g_type_class_ref(LCLIntfCellRenderer_GetType));
Result
:=
g_object_new
(
LCLIntfCellRenderer_GetType
,
nil
,[]);
Result
:=
PGtkCellRenderer
(
g_object_new
(
LCLIntfCellRenderer_GetType
,
nil
,[])
)
;
end
;
procedure
LCLIntfCellRenderer_CellDataFunc
(
cell_layout
:
PGtkCellLayout
;
...
...
lcl/interfaces/gtk3/gtk3defines.inc
View file @
02115d37
{
$DEFINE
GTK3
}
{
$DEFINE
USEGTK3ALPHA
}
{
.
$DEFINE
GTK3DEBUGCORE
}
{
.
$DEFINE
GTK3DEBUGSIZE
}
{
.
$DEFINE
VerboseGtk3DeviceContext
}
...
...
@@ -12,35 +11,6 @@
{
.
$DEFINE
GTK3DEBUGKEYPRESS
}
{
.
$DEFINE
GTK3DEBUGMENUS
}
{
.
$DEFINE
GTK3DEBUGPREFERREDSIZE
}
{
$IFNDEF
USEGTK3ALPHA
}
(
*
{
$error
' . . . '
}
{
$error
' \|/ '
}
{
$error
' `--+--'
'}
{$error '
/|
\
'}
{$error '
' | '
'}
{$error '
|
'}
{$error '
|
'}
{$error '
,
--
'#`--. '
}
{
$error
' |#######| '
}
{
$error
' _.-'
#######`-._ '}
{
$error
' ,-'
###############`-. '}
{
$error
' ,'
#####################`, '}
{
$error
' /#########################\ '
}
{
$error
' |###########################| '
}
{
$error
'|#############################| '
}
{
$error
'|#############################| '
}
{
$error
'|#############################| '
}
{
$error
'|#############################| '
}
{
$error
' |###########################| '
}
{
$error
' \#########################/ '
}
{
$error
' `.#####################,'
'}
{$error '
`._###############_,' '}
{$error ' `
--..
#####..--' '}
*
)
{
$error
'THIS IS CURRENTLY ALPHA CODE AND IT IS USED ONLY BY GTK3LCL DEVELOPERS.'
}
{
$error
'IF YOU WANT TO TEST gtk3 THEN UNCOMMENT DEFINE USEGTK3ALPHA ABOVE.'
}
{
$error
'PLEASE DO NOT FILL BUG REPORTS ON MANTIS WHILE GTK3LCL IS IN ALPHA STAGE'
}
{
$ENDIF
}
lcl/interfaces/gtk3/gtk3int.pas
View file @
02115d37
...
...
@@ -14,9 +14,9 @@
*****************************************************************************
}
unit
gtk3int
;
{$mode objfpc}{$H+}
{$i gtk3defines.inc}
{$mode objfpc}
{$H+}
interface
...
...
lcl/interfaces/gtk3/gtk3lclintf.inc
View file @
02115d37
...
...
@@ -309,15 +309,15 @@ function TGtk3WidgetSet.RawImage_DescriptionFromBitmap(ABitmap: HBITMAP; out ADe
const
CairoImageFormatToDepth
:
array
[
cairo_format_t
]
of
integer
=
(
//
{CAIRO_FORMAT_RGB30}15,
//
{CAIRO_FORMAT_RGB16_565}16,
{
CAIRO_FORMAT_
A
RGB
32
}
32
,
{
CAIRO_FORMAT_
RGB24
}
24
,
{
CAIRO_FORMAT_A
8
}
8
,
{
CAIRO_FORMAT_
A1
}
1
{
CAIRO_FORMAT_RGB30
}
15
,
{
CAIRO_FORMAT_RGB16_565
}
16
,
{
CAIRO_FORMAT_ARGB32
}
32
,
{
CAIRO_FORMAT_RGB
24
}
24
,
{
CAIRO_FORMAT_
A8
}
8
,
{
CAIRO_FORMAT_A
1
}
1
,
{
CAIRO_FORMAT_
INVALID
}
-
1
);
//============================
var
Image
:
TGtk3Image
absolute
ABitmap
;
...
...
@@ -993,7 +993,7 @@ begin
Desc
.
Height
:=
DCSize
.
cy
;
{
$ifdef
VerboseGtk3WinApi
}
Write
Ln
(
'Trace:< [WinAPI GetRawImageFromDevice]'
);
Debug
Ln
(
'Trace:< [WinAPI GetRawImageFromDevice]'
);
{
$endif
}
(
*
...
...
@@ -1096,7 +1096,8 @@ begin
Widget
:=
GetStyleWidget
(
lgsVScale
);
MinWidth
:=
Widget
^.
requisition
.
width
;
end
;
//DebugLn(['TGtk3WidgetSet.GetControlConstraints ',DbgSName(SizeConstraints.Control),' ',MinWidth,',',MinHeight]);
//DebugLn(['TGtk3WidgetSet.GetControlConstraints ',DbgSName(SizeConstraints.Control),
// ' ',MinWidth,',',MinHeight]);
end
;
SizeConstraints
.
SetInterfaceConstraints
(
MinWidth
,
MinHeight
,
...
...
@@ -1181,7 +1182,7 @@ function waithandle_iocallback({%H-}source: PGIOChannel; condition: TGIOConditio
// var
// lEventHandler: PWaitHandleEventHandler absolute data;
begin
//
d
ebug
l
n('waithandle_iocallback lEventHandler=',HexStr(Cardinal(lEventHandler),8));
//
D
ebug
L
n(
[
'waithandle_iocallback lEventHandler=',HexStr(Cardinal(lEventHandler),8)
]
);
// lEventHandler^.OnEvent(lEventHandler^.UserData, condition);
Result
:=
true
;
end
;
...
...
@@ -1203,7 +1204,8 @@ begin
lEventHandler
^.
OnEvent
:=
AEventHandler
;
lEventHandler
^.
GSourceID
:=
g_io_add_watch
(
giochannel
,
AFlags
,
@
waithandle_iocallback
,
lEventHandler
);
//debugln('TGtk3WidgetSet.AddEventHandler lEventHandler=',HexStr(Cardinal(lEventHandler),8),' AHandle=',dbgs(lEventHandler^.Handle));
//DebugLn(['TGtk3WidgetSet.AddEventHandler lEventHandler=',HexStr(Cardinal(lEventHandler),8),
// ' AHandle=',dbgs(lEventHandler^.Handle)]);
lEventHandler
^.
PrevHandler
:=
nil
;
lEventHandler
^.
NextHandler
:=
FWaitHandles
;
if
FWaitHandles
<>
nil
then
...
...
@@ -1229,7 +1231,8 @@ begin
lEventHandler
^.
PrevHandler
^.
NextHandler
:=
lEventHandler
^.
NextHandler
;
if
lEventHandler
^.
NextHandler
<>
nil
then
lEventHandler
^.
NextHandler
^.
PrevHandler
:=
lEventHandler
^.
PrevHandler
;
//debugln('TGtk3WidgetSet.RemoveEventHandler lEventHandler=',HexStr(Cardinal(lEventHandler),8),' AHandle=',dbgs(lEventHandler^.Handle));
//DebugLn(['TGtk3WidgetSet.RemoveEventHandler lEventHandler=',HexStr(Cardinal(lEventHandler),8),
// ' AHandle=',dbgs(lEventHandler^.Handle)]);
Dispose
(
lEventHandler
);
*
)
AHandler
:=
nil
;
...
...
@@ -1243,7 +1246,8 @@ begin
// g_source_remove(lEventHandler^.GSourceID);
// lEventHandler^.GSourceID := g_io_add_watch(lEventHandler^.GIOChannel,
// NewFlags, @waithandle_iocallback, lEventHandler);
//debugln('TGtk3WidgetSet.SetEventHandlerFlags lEventHandler=',HexStr(Cardinal(lEventHandler),8),' AHandle=',dbgs(lEventHandler^.Handle));
//DebugLn(['TGtk3WidgetSet.SetEventHandlerFlags lEventHandler=',HexStr(Cardinal(lEventHandler),8),
// ' AHandle=',dbgs(lEventHandler^.Handle)]);
end
;
procedure
TGtk3WidgetSet
.
SetRubberBandRect
(
const
ARubberBand
:
HWND
;
const
ARect
:
TRect
);
...
...
lcl/interfaces/gtk3/gtk3objects.pas
View file @
02115d37
...
...
@@ -13,10 +13,10 @@
for details about the license.
*****************************************************************************
}
unit
gtk3objects
;
unit
Gtk3Objects
;
{$mode objfpc}{$H+}
{$i gtk3defines.inc}
{$mode objfpc}
{$H+}
interface
...
...
@@ -736,11 +736,11 @@ begin
if
not
AOwnsContext
then
begin
AContext
:=
gtk_widget_get_pango_context
(
AWidget
);
//
DebugLn('TGtk3Font.Create AContext created from widget ....context=',dbgHex(PtrUInt(AContext)));
//DebugLn('TGtk3Font.Create AContext created from widget ....context=',dbgHex(PtrUInt(AContext)));
end
else
begin
AContext
:=
pango_cairo_create_context
(
ACairo
);
//
DebugLn('TGtk3Font.Create AContext created from pango cairo ....');
//DebugLn('TGtk3Font.Create AContext created from pango cairo ....');
end
;
FHandle
:=
pango_font_description_copy
(
pango_context_get_font_description
(
AContext
));
FFontName
:=
pango_font_description_get_family
(
FHandle
);
...
...
@@ -749,18 +749,18 @@ begin
if
FHandle
^.
get_size_is_absolute
then
begin
FHandle
^.
set_absolute_size
(
FHandle
^.
get_size
);
//
writel
n('**TGtk3Font.Create size is absolute ',FFontName,' size ',FHandle^.get_size);
//
DebugL
n(
[
'**TGtk3Font.Create size is absolute ',FFontName,' size ',FHandle^.get_size
]
);
end
else
begin
FHandle
^.
set_size
(
FHandle
^.
get_size
);
//
writel
n('*TGtk3Font.Create size is not absolute ',FFontName,' size ',FHandle^.get_size);
//
DebugL
n(
[
'*TGtk3Font.Create size is not absolute ',FFontName,' size ',FHandle^.get_size
]
);
end
;
FLayout
^.
set_font_description
(
FHandle
);
//
writel
n('TGtk3Font.Create1 ',FFontName);
//
DebugL
n('TGtk3Font.Create1 ',FFontName);
if
AOwnsContext
then
g_object_unref
(
AContext
);
//
writel
n('TGtk3Font.Create1 ',FFontName);
//
DebugL
n('TGtk3Font.Create1 ',FFontName);
end
;
constructor
TGtk3Font
.
Create
(
ALogFont
:
TLogFont
;
const
ALongFontName
:
String
);
...
...
@@ -1368,7 +1368,7 @@ begin
else
AFont
:=
FFont
;
if
AFont
<>
nil
then
;
d
ebug
l
n
([
'TGtk3DeviceContext.ApplyFont ToDo'
]);
D
ebug
L
n
([
'TGtk3DeviceContext.ApplyFont ToDo'
]);
end
;
procedure
TGtk3DeviceContext
.
ApplyPen
;
...
...
@@ -1459,7 +1459,7 @@ var
ARect
:
TGdkRectangle
;
begin
{$ifdef VerboseGtk3DeviceContext}
Write
Ln
(
'TGtk3DeviceContext.Create ('
,
Debug
Ln
(
'TGtk3DeviceContext.Create ('
,
' WidgetHandle: '
,
dbghex
(
PtrInt
(
AWidget
)),
' FromPaintEvent:'
,
BoolToStr
(
APaintEvent
),
' )'
);
{$endif}
...
...
@@ -1533,7 +1533,7 @@ constructor TGtk3DeviceContext.Create(AWindow: PGdkWindow;
const
APaintEvent
:
Boolean
);
begin
{$ifdef VerboseGtk3DeviceContext}
Write
Ln
(
'TGtk3DeviceContext.Create ('
,
Debug
Ln
(
'TGtk3DeviceContext.Create ('
,
' WindowHandle: '
,
dbghex
(
PtrInt
(
AWindow
)),
' FromPaintEvent:'
,
BoolToStr
(
APaintEvent
),
' )'
);
{$endif}
...
...
@@ -1562,7 +1562,7 @@ var
AGdkRect
:
TGdkRectangle
;
begin
{$ifdef VerboseGtk3DeviceContext}
Write
Ln
(
'TGtk3DeviceContext.CreateFromCairo ('
,
Debug
Ln
(
'TGtk3DeviceContext.CreateFromCairo ('
,
' WidgetHandle: '
,
dbghex
(
PtrInt
(
AWidget
)),
' FromPaintEvent:'
,
BoolToStr
(
True
),
' )'
);
{$endif}
...
...
@@ -1584,7 +1584,7 @@ end;
destructor
TGtk3DeviceContext
.
Destroy
;
begin
{$ifdef VerboseGtk3DeviceContext}
Write
Ln
(
'TGtk3DeviceContext.Destroy '
,
dbgHex
(
PtrUInt
(
Self
)));
Debug
Ln
(
'TGtk3DeviceContext.Destroy '
,
dbgHex
(
PtrUInt
(
Self
)));
{$endif}
DeleteObjects
;
if
FOwnsCairo
and
(
pcr
<>
nil
)
then
...
...
@@ -2003,7 +2003,7 @@ var
ATempBrush
:
TGtk3Brush
;
begin
{$ifdef VerboseGtk3DeviceContext}
//
Write
Ln('TGtk3DeviceContext.fillRect ',Format('x %d y %d w %d h %d',[x, y, w, h]));
//
Debug
Ln('TGtk3DeviceContext.fillRect ',Format('x %d y %d w %d h %d',[x, y, w, h]));
{$endif}
cairo_save
(
pcr
);
...
...
@@ -2173,7 +2173,6 @@ end;
function
TGtk3DeviceContext
.
drawFocusRect
(
const
aRect
:
TRect
):
boolean
;
var
Context
:
PGtkStyleContext
;
//AValue: TGValue;
begin
Result
:=
False
;
...
...
lcl/interfaces/gtk3/gtk3private.pas
View file @
02115d37
...
...
@@ -14,10 +14,10 @@
*****************************************************************************
}
unit
g
tk3
p
rivate
;
unit
G
tk3
P
rivate
;
{$i gtk3defines.inc}
{$mode objfpc}{$H+}
{$i gtk3defines.inc}
interface
...
...
lcl/interfaces/gtk3/gtk3procs.pas
View file @
02115d37
...
...
@@ -13,9 +13,10 @@
for details about the license.
*****************************************************************************
}
unit
g
tk3
p
rocs
;
{$i gtk3defines.inc}
unit
G
tk3
P
rocs
;
{$mode objfpc}{$H+}
{$i gtk3defines.inc}
interface
...
...
@@ -839,7 +840,7 @@ begin
{$IFDEF NoStyle}
exit
;
{$ENDIF}
//
d
ebug
l
n('UpdateSysColorMap ',GetWidgetDebugReport(Widget));
//
D
ebug
L
n('UpdateSysColorMap ',GetWidgetDebugReport(Widget));
// gtk_widget_set_rc_style(Widget);
MainStyle
:=
Widget
^.
get_style
;
if
MainStyle
=
nil
then
exit
;
...
...
lcl/interfaces/gtk3/gtk3widgets.pas
View file @
02115d37
...
...
@@ -14,10 +14,10 @@
*****************************************************************************
}
unit
gtk3widgets
;
unit
Gtk3Widgets
;
{$mode objfpc}{$H+}
{$i gtk3defines.inc}
{$mode objfpc}
{$H+}
interface
...
...
@@ -1050,6 +1050,10 @@ begin
begin
// DebugLn('****** GDK_MAP FOR ',dbgsName(TGtk3Widget(Data).LCLObject));
end
;
GDK_UNMAP
:
begin
// DebugLn('****** GDK_UNMAP FOR ',dbgsName(TGtk3Widget(Data).LCLObject));
end
;
GDK_PROPERTY_NOTIFY
:
begin
// DebugLn('****** GDK_PROPERTY_NOTIFY FOR ',dbgsName(TGtk3Widget(Data).LCLObject));
...
...
@@ -1344,8 +1348,7 @@ begin
end
;
otherwise
DebugLn
(
'****** GDK unhandled event type '
+
dbgsName
(
TGtk3Widget
(
Data
).
LCLObject
));
WriteLn
(
event
^.
type_
);
// DebugLn(event^.type_);
end
;
end
;
...
...
@@ -1607,7 +1610,7 @@ var
Range
:
PGtkRange
;
begin
{$IFDEF SYNSCROLLDEBUG}
d
ebug
l
n
([
'Gtk3ScrolledWindowScrollEvent '
]);
D
ebug
L
n
([
'Gtk3ScrolledWindowScrollEvent '
]);
{$ENDIF}
Result
:=
False
;
case
AEvent
^.
scroll
.
direction
of
...
...
@@ -2558,7 +2561,7 @@ begin
FWidget
^.
Visible
:=
AValue
;
end
;
function
TGtk3Widget
.
QueryInterface
(
constref
iid
:
TGuid
;
out
obj
):
LongInt
;
cdecl
;
function
TGtk3Widget
.
QueryInterface
(
constref
iid
:
TGuid
;
out
obj
):
LongInt
;
{$IFDEF WINDOWS}
stdcall
{$ELSE}
cdecl
{$ENDIF}
;
begin
if
GetInterface
(
iid
,
obj
)
then
Result
:=
0
...
...
@@ -2566,12 +2569,12 @@ begin
Result
:=
E_NOINTERFACE
;
end
;
function
TGtk3Widget
.
_AddRef
:
LongInt
;
cdecl
;
function
TGtk3Widget
.
_AddRef
:
LongInt
;
{$IFDEF WINDOWS}
stdcall
{$ELSE}
cdecl
{$ENDIF}
;
begin
Result
:=
-
1
;
// no ref counting
end
;
function
TGtk3Widget
.
_Release
:
LongInt
;
cdecl
;
function
TGtk3Widget
.
_Release
:
LongInt
;
{$IFDEF WINDOWS}
stdcall
{$ELSE}
cdecl
{$ENDIF}
;
begin
Result
:=
-
1
;
end
;
...
...
@@ -3615,7 +3618,7 @@ begin
begin
if
not
(
atext
[
i
]
in
[
'0'
..
'9'
])
then
begin
g_signal_stop_emission_by_name
(
Self
,
'insert-text'
);
g_signal_stop_emission_by_name
(
PGObject
(
Self
)
,
'insert-text'
);
exit
;
end
;
end
;
...
...
@@ -3646,15 +3649,8 @@ begin
end
;
procedure
TGtk3Entry
.
SetBounds
(
Left
,
Top
,
Width
,
Height
:
integer
);
var
val
:
TGvalue
;
begin
val
.
clear
;
val
.
init
(
G_TYPE_UINT
);
val
.
set_uint
(
Width
);
inherited
SetBounds
(
Left
,
Top
,
Width
,
Height
);
PGtkEntry
(
FWidget
)^.
set_property
(
'width-request'
,@
val
);
val
.
unset
;
end
;
procedure
TGtk3Entry
.
InitializeWidget
;
...
...
@@ -7449,21 +7445,21 @@ begin
if
msk
and
GDK_WINDOW_STATE_FOCUSED
<>
0
then
begin
if
AState
and
GDK_WINDOW_STATE_FOCUSED
<>
0
then
writel
n
(
'Focused'
)
DebugL
n
(
'Focused'
)
else
writel
n
(
'Defocused'
);
DebugL
n
(
'Defocused'
);
exit
;
end
else
if
msk
and
GDK_WINDOW_STATE_WITHDRAWN
<>
0
then
begin
if
AState
and
GDK_WINDOW_STATE_WITHDRAWN
<>
0
then
writel
n
(
'Shown'
)
DebugL
n
(
'Shown'
)
else
writel
n
(
'Hidden'
);
DebugL
n
(
'Hidden'
);
exit
;
end
else
begin
writel
n
(
format
(
'other changes state=%.08x mask=%.08x'
,[
AState
,
msk
]));
DebugL
n
(
format
(
'other changes state=%.08x mask=%.08x'
,[
AState
,
msk
]));
exit
;
end
;
...
...
lcl/interfaces/gtk3/gtk3winapi.inc
View file @
02115d37
...
...
@@ -67,13 +67,13 @@ function TGtk3WidgetSet.BitBlt(DestDC: HDC; X, Y, Width, Height: Integer;
SrcDC
:
HDC
;
XSrc
,
YSrc
:
Integer
;
Rop
:
DWORD
)
:
Boolean
;
begin
{
$ifdef
VerboseGtk3DeviceContext
}
Write
Ln
(
'Trace:> [TGtk3WidgetSet.BitBlt]'
);
Debug
Ln
(
'Trace:> [TGtk3WidgetSet.BitBlt]'
);
{
$endif
}
Result
:=
StretchBlt
(
DestDC
,
X
,
Y
,
Width
,
Height
,
SrcDC
,
XSrc
,
YSrc
,
Width
,
Height
,
ROP
);
{
$ifdef
VerboseGtk3DeviceContext
}
Write
Ln
(
'Trace:< [TGtk3WidgetSet.BitBlt]'
);
Debug
Ln
(
'Trace:< [TGtk3WidgetSet.BitBlt]'
);
{
$endif
}
end
;
...
...
@@ -177,10 +177,13 @@ begin
end
;
function
TGtk3WidgetSet
.
ClipboardRegisterFormat
(
const
AMimeType
:
string
)
:
TClipboardFormat
;
var
xGA
:
PGdkAtom
;
begin
if
Assigned
(
Application
)
then
Result
:=
{
%
H
-
}
TClipboardFormat
(
TGdkAtom
.
intern
(
PChar
(
AMimeType
),
False
))
else
begin
xGA
:=
TGdkAtom
.
intern
(
PChar
(
AMimeType
),
False
);
Result
:=
TClipboardFormat
(
xGA
);
end
else
RaiseGDBException
(
'ERROR: TGtk3WidgetSet.ClipboardRegisterFormat gdk not initialized'
);
end
;
...
...
@@ -223,7 +226,7 @@ begin
RGN_COPY
:
begin
AStatus
:=
cairo_region_intersect
(
RDest
,
RSrc1
);
//
writel
n('CombineRgn RGN_COPY ',AStatus);
//
DebugL
n(
[
'CombineRgn RGN_COPY ',AStatus
]
);
end
;
RGN_DIFF
:
begin
...
...
@@ -726,7 +729,7 @@ var
end
;
Gtk3WordWrap
(
DC
,
PChar
(
AStr
),
MaxWidth
,
Lines
,
NumLines
);
//
writel
n('WORD WRAP RESULTED IN ',NumLines,' lines for ',AStr,' MAX=',MaxWidth);
//
DebugL
n(
[
'WORD WRAP RESULTED IN ',NumLines,' lines for ',AStr,' MAX=',MaxWidth
]
);
if
(
Flags
and
DT_CALCRECT
)
<>
0
then
begin
LineWidth
:=
0
;
...
...
@@ -752,7 +755,8 @@ var
if
NumLines
>
1
then
Inc
(
theRect
.
Bottom
,
(
NumLines
-
1
)
*
TM
.
tmDescent
);
// space between lines
// debugln('TGtk3WidgetSet.DrawText A ',dbgs(theRect),' TM.tmHeight=',dbgs(TM.tmHeight),' LineWidth=',dbgs(LineWidth),' NumLines=',dbgs(NumLines));
//DebugLn('TGtk3WidgetSet.DrawText A ',dbgs(theRect),' TM.tmHeight=',dbgs(TM.tmHeight),
// ' LineWidth=',dbgs(LineWidth),' NumLines=',dbgs(NumLines));
end
;
if
not
CalcRect
then
...
...
@@ -812,7 +816,6 @@ var
function
NeedOffsetCalc
:
Boolean
;
begin
Result
:=
(
TGtk3DeviceContext
(
DC
)
.
CurrentFont
.
LogFont
.
lfOrientation
<>
0
)
and
(
Flags
and
DT_SINGLELINE
<>
0
)
and
(
Flags
and
DT_VCENTER
=
0
)
and
(
Flags
and
DT_CENTER
=
0
)
and
...
...
@@ -1264,8 +1267,8 @@ var
begin
Result
:=
0
;
{
$ifdef
VerboseEnumFonts
}
Write
Ln
(
'[TGtk3WidgetSet.EnumFontFamiliesEx] Charset='
,
lpLogFont
^.
lfCharSet
,
' face '
,
lpLogFont
^.
lfFaceName
,
' pitchAndFamily='
,
lpLogFont
^.
lfPitchAndFamily
);
Debug
Ln
(
[
'[TGtk3WidgetSet.EnumFontFamiliesEx] Charset='
,
lpLogFont
^.
lfCharSet
,
' face '
,
lpLogFont
^.
lfFaceName
,
' pitchAndFamily='
,
lpLogFont
^.
lfPitchAndFamily
]
);
{
$endif
}
Result
:=
0
;
Metric
.
ntmentm
.
ntmAvgWidth
:=
0
;
// just to shutup compiler
...
...
@@ -1475,9 +1478,9 @@ begin
// get transformation
GetWindowOrgEx
(
DC
,
@
DCOrigin
);
//
writel
n('ExtSelectClipRgn DCOrigin=',dbgs(DCOrigin),' R=',dbgs(R));
//
DebugL
n('ExtSelectClipRgn DCOrigin=',dbgs(DCOrigin),' R=',dbgs(R));
// OffsetRect(R, -DCOrigin.X, -DCOrigin.Y);
//
writel
n('ExtSelectClipRgn after DCOrigin=',dbgs(DCOrigin),' R=',dbgs(R));
//
DebugL
n('ExtSelectClipRgn after DCOrigin=',dbgs(DCOrigin),' R=',dbgs(R));
Clip
:=
CreateRectRGN
(
0
,
0
,
R
.
Right
-
R
.
Left
,
R
.
Bottom
-
R
.
Top
);
cairo_region_translate
(
TGtk3Region
(
Clip
)
.
Handle
,
-
DCOrigin
.
X
,
-
DCOrigin
.
Y
);
...
...
@@ -2222,7 +2225,7 @@ begin
if
not
IsValidGDIObject
(
GDIObj
)
then
begin
{
$ifdef
VerboseGtk3WinAPI
}
Write
Ln
(
'Trace:< TGtk3WidgetSet.GetObject Invalid GDI Object'
);
Debug
Ln
(
'Trace:< TGtk3WidgetSet.GetObject Invalid GDI Object'
);
{
$endif
}
Exit
;
end
;
...
...
@@ -2438,7 +2441,7 @@ end;
function
TGtk3WidgetSet
.
GetSysColor
(
nIndex
:
Integer
)
:
DWORD
;
begin
{
$IFDEF
GTK3DEBUGNOTIMPLEMENTED
}
writel
n
(
'TGtk3WidgetSet.GetSysColor WARNING: SOME SYSCOLORS ARE STILL HARDCODED nIndex='
,
nIndex
);
DebugL
n
(
[
'TGtk3WidgetSet.GetSysColor WARNING: SOME SYSCOLORS ARE STILL HARDCODED nIndex='
,
nIndex
]
);
{
$ENDIF
}
if
(
nIndex
=
COLOR_WINDOW
)
or
(
nIndex
=
COLOR_WINDOWTEXT
)
or
(
nIndex
=
COLOR_HIGHLIGHT
)
or
(
nIndex
=
COLOR_HIGHLIGHTTEXT
)
then
...
...
@@ -2715,7 +2718,7 @@ begin
if
not
IsValidDC
(
DC
)
and
(
P
<>
nil
)
then
begin
{
$ifdef
VerboseGtk3WinAPI
}
Write
Ln
(
'Trace: < [WinAPI GetWindowOrgEx] No valid DC or P is nil'
);
Debug
Ln
(
'Trace: < [WinAPI GetWindowOrgEx] No valid DC or P is nil'
);
{
$endif
}
exit
;
end
;
...
...
@@ -3373,15 +3376,12 @@ begin
if
IsValidHandle
(
AHandle
)
then
begin
TGtk3Widget
(
AHandle
)
.
SetCapture
;
//if (Result <> 0) then
begin
Message
.
Msg
:=
0
;
FillChar
(
Message
,
SizeOf
(
Message
),
0
);
Message
.
msg
:=
LM_CAPTURECHANGED
;
Message
.
wParam
:=
0
;
Message
.
lParam
:=
PtrInt
(
Result
);
LCLMessageGlue
.
DeliverMessage
(
TGtk3Widget
(
AHandle
)
.
LCLObject
,
Message
);
end
;
Message
.
Msg
:=
0
;
FillChar
(
Message
,
SizeOf
(
Message
),
0
);
Message
.
msg
:=
LM_CAPTURECHANGED
;