Gtk3: rewritten TGtk3Caret so it works under wayland too. issue #41395

This commit is contained in:
zeljan1 2025-02-04 08:28:10 +01:00
parent b2302cef64
commit 548f2b0657
2 changed files with 96 additions and 169 deletions

View File

@ -1,102 +1,51 @@
{
*****************************************************************************
* gtk3caret.pas *
* ------------- *
* *
* *
*****************************************************************************
*****************************************************************************
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 gtk3caret;
{$mode objfpc}{$H+}
interface
uses Classes, SysUtils, LazGtk3, LazGdk3, LazGObject2, LazGLib2, LazCairo1,
LCLType;
uses
Classes, SysUtils, LazGtk3, LazGdk3, LazGObject2, LazGLib2, LazCairo1, LCLType,
gtk3procs;
type
{ TGtk3Caret }
TGtk3Caret = class
private
FOwner: PGtkWidget;
FVisible: Boolean;
FCaretWidget: PGtkWidget;
FBlinkTimerID: guint;
FBlinkState: Boolean;
FBlinkInterval: Integer;
FPos: TPoint;
FLastPos: TPoint;
FWidth: Integer;
FHeight: Integer;
FRespondToFocus: Boolean;
FPosChanging: boolean;
procedure BlinkTimerCallback;
procedure CairoDrawCaret(cr: Pcairo_t; const X, Y: integer);
FPos: TPoint;
FVisible: boolean;
procedure BlinkTimerCallback; cdecl;
procedure StartBlinking;
procedure StopBlinking;
procedure SetRespondToFocus(const ARespond: Boolean);
class procedure OnDraw(AWidget: PGtkWidget; cr: PCairo_t; Data: gPointer); cdecl; static;
public
constructor Create(AOwner: PGtkWidget; AWidth, AHeight: Integer);
destructor Destroy; override;
procedure Show;
procedure Hide;
procedure SetPosition(const X, Y: Integer); //Set x and y at once and call one redraw for both.
procedure SetBlinkInterval(const AInterval: Integer);
procedure RedrawCaret;
procedure SetPosition(X, Y: Integer);
procedure SetBlinkInterval(AInterval: Integer);
procedure SetRespondToFocus(ARespond: Boolean);
property RespondToFocus: Boolean read FRespondToFocus write SetRespondToFocus;
property PosX: integer read FPos.X;
property PosY: integer read FPos.Y;
property RespondToFocus: boolean read FRespondToFocus write SetRespondToFocus;
property Visible: boolean read FVisible;
end;
implementation
uses Gtk3Procs, gtk3int, Gtk3Widgets;
uses gtk3widgets, gtk3int;
{ TGtk3Caret }
procedure TGtk3Caret.CairoDrawCaret(cr: Pcairo_t; const X, Y: integer);
function BlinkTimerCallbackFunc(Data: gpointer): gboolean; cdecl;
begin
if cr = nil then
exit;
cairo_set_operator(cr, CAIRO_OPERATOR_DIFFERENCE);
if FBlinkState then
cairo_set_source_rgb(cr, 0, 0, 0)
else
cairo_set_source_rgb(cr, 1, 1, 1);
cairo_rectangle(cr, X, Y , FWidth, FHeight);
cairo_fill(cr);
end;
procedure TGtk3Caret.RedrawCaret;
var
cr: PCairo_t;
W: TGtk3Widget;
AHaveContext: Boolean;
R: TRect;
begin
{TODO: Implement bitmap caret.}
if not Assigned(FOwner) or not FVisible then Exit;
W := TGtk3Widget(HwndFromGtkWidget(FOwner));
if W = nil then
exit;
if Gtk3IsGdkWindow(gtk_widget_get_window(FOwner)) then
cr := gdk_cairo_create(gtk_widget_get_window(FOwner))
else
exit;
try
cairoDrawCaret(cr, FPos.X, FPos.Y);
finally
cairo_destroy(cr);
end;
TGtk3Caret(Data).BlinkTimerCallback;
Result := True;
end;
constructor TGtk3Caret.Create(AOwner: PGtkWidget; AWidth, AHeight: Integer);
@ -105,96 +54,54 @@ var
AValue: TGValue;
begin
inherited Create;
FVisible := False;
FPos := Point(0, 0);
FOwner := AOwner;
FWidth := AWidth;
FHeight := AHeight;
FVisible := False;
FPos.X := -1;
FPos.Y := -1;
FLastPos.X := -1;
FLastPos.Y := -1;
FBlinkState := True;
FBlinkTimerID := 0;
FRespondToFocus := False;
FCaretWidget := gtk_drawing_area_new();
gtk_widget_set_size_request(FCaretWidget, FWidth, FHeight);
// Set drawing event for the caret
g_signal_connect_data(FCaretWidget, 'draw', TGCallback(@OnDraw), Self, nil, G_CONNECT_DEFAULT);
PGtkFixed(FOwner)^.put(FCaretWidget, 0, 0);
g_object_set_data(FCaretWidget,'lclwidget', TGtk3Widget(HwndFromGtkWidget(FOwner)));
FCaretWidget^.set_can_focus(False);
FCaretWidget^.show;
FCaretWidget^.set_opacity(0);
ASettings := gtk_settings_get_default;
FillByte(AValue{%H-}, SizeOf(AValue), 0);
FillByte(AValue, SizeOf(AValue), 0);
AValue.init(G_TYPE_INT);
ASettings^.get_property('gtk-cursor-blink-time', @AValue);
FBlinkInterval := (AValue.get_int div CURSOR_ON_MULTIPLIER) div 2; // (AValue.get_int * CURSOR_OFF_MULTIPLIER) div CURSOR_DIVIDER;
FBlinkInterval := (AValue.get_int div CURSOR_ON_MULTIPLIER);
AValue.unset;
StartBlinking;
end;
destructor TGtk3Caret.Destroy;
begin
StopBlinking;
Hide;
gtk_widget_destroy(FCaretWidget);
inherited Destroy;
end;
procedure TGtk3Caret.SetPosition(const X, Y: Integer);
procedure TGtk3Caret.BlinkTimerCallback; cdecl;
begin
if (FPos.X = X) and (FPos.Y = Y) then
exit;
FPosChanging := True; // stop timer changing FBlinkState and call RedrawCaret until we go out from this proc.
FBlinkState := False;
if FVisible then
begin
if (FLastPos.X >= 0) and (FLastPos.Y >=0) and (FLastPos.X <> FPos.X) or (FLastPos.Y <> FPos.Y) then
FOwner^.queue_draw_area(FLastPos.X, FLastPos.Y, FWidth, FHeight);
if (FPos.X >= 0) and (FPos.Y >= 0) then
FOwner^.queue_draw_area(FPos.X, FPos.Y, FWidth, FHeight);
end;
FLastPos.X := FPos.X;
FLastPos.Y := FPos.Y;
FPos.X := X;
FPos.Y := Y;
if FVisible then
RedrawCaret; // redraw caret with CAIRO_OPERATOR_DIFFERENCE while FBlinkState = false.
FBlinkState := True;
if FVisible then
RedrawCaret;
FPosChanging := False;
end;
procedure TGtk3Caret.Show;
begin
if FVisible then Exit;
FVisible := True;
FBlinkState := True;
StartBlinking;
RedrawCaret;
end;
procedure TGtk3Caret.Hide;
begin
if not FVisible then Exit;
StopBlinking;
RedrawCaret;
FVisible := False;
end;
procedure TGtk3Caret.BlinkTimerCallback;
var
W: TGtk3Widget;
begin
if FPosChanging or not FVisible then
exit;
FBlinkState := not FBlinkState;
RedrawCaret;
end;
function BlinkTimerCallbackFunc(Data: gpointer): gboolean; cdecl;
begin
TGtk3Caret(Data).BlinkTimerCallback;
Result := True;
gtk_widget_queue_draw(FCaretWidget);
end;
procedure TGtk3Caret.StartBlinking;
begin
if FBlinkTimerID <> 0 then Exit;
FBlinkTimerID := g_timeout_add(FBlinkInterval, @BlinkTimerCallbackFunc, Self);
FBlinkTimerID := g_timeout_add_full(G_PRIORITY_DEFAULT_IDLE, FBlinkInterval, @BlinkTimerCallbackFunc, Self, nil);
end;
procedure TGtk3Caret.StopBlinking;
@ -205,10 +112,49 @@ begin
FBlinkState := False;
end;
procedure TGtk3Caret.SetBlinkInterval(const AInterval: Integer);
class procedure TGtk3Caret.OnDraw(AWidget: PGtkWidget; cr: PCairo_t; Data: GPointer); cdecl;
begin
if FBlinkInterval = AInterval then
if Data = nil then
exit;
if not TGtk3Caret(Data).FVisible then
begin
cairo_set_operator(cr, CAIRO_OPERATOR_CLEAR);
cairo_paint(cr);
end else
begin
if TGtk3Caret(Data).FBlinkState then
cairo_set_source_rgb(cr, 0, 0, 0)
else
cairo_set_source_rgba(cr, 1, 1, 1, 0);
cairo_rectangle(cr, 0, 0, TGtk3Caret(Data).FWidth, TGtk3Caret(Data).FHeight);
cairo_fill(cr);
end;
end;
procedure TGtk3Caret.Show;
begin
if not FCaretWidget^.get_visible then
gtk_widget_show(FCaretWidget);
FVisible := True;
if FCaretWidget^.get_opacity = 0 then
FCaretWidget^.set_opacity(1); // triggers redraw
end;
procedure TGtk3Caret.Hide;
begin
FVisible := False;
end;
procedure TGtk3Caret.SetPosition(X, Y: Integer);
begin
FPos.X := X;
FPos.Y := Y;
gtk_fixed_move(PGtkFixed(FOwner), FCaretWidget, X, Y);
end;
procedure TGtk3Caret.SetBlinkInterval(AInterval: Integer);
begin
if FBlinkInterval = AInterval then Exit;
FBlinkInterval := AInterval;
if FBlinkTimerID <> 0 then
begin
@ -217,42 +163,11 @@ begin
end;
end;
function FocusEventHandler({%H-}AWidget: PGtkWidget; AEvent: PGdkEvent; AUserData: gpointer): gboolean; cdecl;
var
Caret: TGtk3Caret;
Event: PGdkEventFocus;
begin
Result := gtk_false;
Caret := TGtk3Caret(AUserData);
if not Assigned(Caret) then
exit;
if AEvent^.type_ = GDK_FOCUS_CHANGE then
begin
Event := PGdkEventFocus(AEvent);
if Event^.in_ <> 0 then
Caret.Show
else
Caret.Hide;
Result := gtk_true;
end;
end;
procedure TGtk3Caret.SetRespondToFocus(const ARespond: Boolean);
procedure TGtk3Caret.SetRespondToFocus(ARespond: Boolean);
begin
if FRespondToFocus = ARespond then Exit;
FRespondToFocus := ARespond;
if FRespondToFocus then
begin
g_signal_connect_data(FOwner, 'focus-in-event', TGCallback(@FocusEventHandler), Self, nil, []);
g_signal_connect_data(FOwner, 'focus-out-event', TGCallback(@FocusEventHandler), Self, nil, []);
end else
begin
g_signal_handlers_disconnect_matched(FOwner, [G_SIGNAL_MATCH_DATA], 0, 0, nil,
nil, Self);
g_signal_handlers_disconnect_matched(FOwner, [G_SIGNAL_MATCH_DATA], 0, 0, nil,
nil, Self);
end;
end;
end.

View File

@ -980,7 +980,7 @@ type
implementation
uses {$IFDEF GTK3DEBUGKEYPRESS}TypInfo,{$ENDIF}gtk3int,imglist,lclproc, LazLogger;
uses {$IFDEF GTK3DEBUGKEYPRESS}TypInfo,{$ENDIF}gtk3int, gtk3caret, imglist,lclproc, LazLogger;
const
act_count:integer=0; // application activity - don't touch.
@ -1961,6 +1961,7 @@ procedure TGtk3Widget.GtkEventFocus(Sender: PGtkWidget; Event: PGdkEvent);
cdecl;
var
Msg: TLMessage;
ACaret: TGtk3Caret;
begin
{$IF DEFINED(GTK3DEBUGEVENTS) OR DEFINED(GTK3DEBUGFOCUS)}
DebugLn('TGtk3Widget.GtkEventFocus ',dbgsName(LCLObject),' FocusIn ',dbgs(Event^.focus_change.in_ <> 0));
@ -1971,6 +1972,17 @@ begin
else
Msg.Msg := LM_KILLFOCUS;
DeliverMessage(Msg);
if g_object_get_data(PGObject(getContainerWidget),'gtk3-caret') <> nil then
begin
ACaret := TGtk3Caret(g_object_get_data(PGObject(getContainerWidget),'gtk3-caret'));
if ACaret.RespondToFocus then
begin
if Msg.Msg = LM_SETFOCUS then
ACaret.Show
else
ACaret.Hide;
end;
end;
end;
procedure TGtk3Widget.GtkEventDestroy; cdecl;