Merge branch 'main' into 'main'

Gtk2: Rare memory leak fix + themed DrawFocusRect

See merge request freepascal.org/lazarus/lazarus!145
This commit is contained in:
Maxim Ganetsky 2023-04-24 12:18:10 +00:00
commit 53b6b28129
2 changed files with 46 additions and 0 deletions

View File

@ -130,7 +130,24 @@ begin
end;
destructor TGtkMessageQueue.destroy;
var
QueueItem : TGtkMessageQueueItem;
NextQueueItem : TGtkMessageQueueItem;
begin
// cleanup outstanding PostMessages
// for example, this situation may appear on slow systems
Lock;
try
QueueItem:=FirstMessageItem;
while (QueueItem<>nil) do begin
NextQueueItem := TGtkMessageQueueItem(QueueItem.Next);
RemoveMessage(QueueItem,FPMF_All,true);
QueueItem := NextQueueItem;
end;
finally
Unlock;
end;
inherited Destroy;
fPaintMessages.destroy;
{$IFNDEF USE_GTK_MAIN_OLD_ITERATION}

View File

@ -2231,6 +2231,9 @@ var
APen, TempPen: HPEN;
LogPen : TLogPen;
R: TRect;
P: Pointer;
AValue: TGValue;
Style: PGtkStyle;
begin
Result := False;
if IsValidDC(DC) then
@ -2246,6 +2249,32 @@ begin
else
R := Rect;
// paint a themed focus rectangle with fallback to the default method
P := GetStyleWidget(lgsDefault);
if P <> nil then
begin
FillChar(AValue{%H-}, SizeOf(AValue), 0);
g_value_init(@AValue, G_TYPE_INT);
gtk_widget_style_get_property(P, 'focus-line-width', @AValue);
if AValue.data[0].v_int > 0 then
LogPen.lopnWidth.X := AValue.data[0].v_int;
end;
if (DevCtx.Widget <> nil) then
begin
Style := gtk_widget_get_style(DevCtx.Widget);
if (Style <> nil) then
begin
gtk_paint_focus(
Style, DevCtx.Drawable, GTK_WIDGET_STATE(DevCtx.Widget){GTK_STATE_ACTIVE},
nil, DevCtx.Widget, nil,
R.Left, R.Top,
R.Width, R.Height);
Result := True;
exit;
end;
end;
APen := CreatePenIndirect(LogPen);
TempPen := SelectObject(DC, APen);
OldRop := SetROP2(DC, R2_XORPEN);