mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-07 21:38:00 +02:00
Gtk3: rewritten TGtk3Caret so it works under wayland too. issue #41395
This commit is contained in:
parent
b2302cef64
commit
548f2b0657
@ -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.
|
||||
|
||||
|
@ -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;
|
||||
|
Loading…
Reference in New Issue
Block a user