Gtk3: implemented basic caret.

This commit is contained in:
zeljan1 2025-01-09 15:03:14 +01:00
parent d25d085dbb
commit 4aac54de10
5 changed files with 382 additions and 42 deletions

View File

@ -0,0 +1,222 @@
{
*****************************************************************************
* 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, LazGdkPixbuf2,
LazPango1, LazPangoCairo1, LazCairo1;
type
{ TGtk3Caret }
TGtk3Caret = class
private
FOwner: PGtkWidget;
FVisible: Boolean;
FBlinkTimerID: guint;
FBlinkState: Boolean;
FBlinkInterval: Integer;
FPosX: Integer;
FPosY: Integer;
FWidth: Integer;
FHeight: Integer;
FRespondToFocus: Boolean;
procedure RedrawCaret;
procedure BlinkTimerCallback;
procedure StartBlinking;
procedure StopBlinking;
procedure SetRespondToFocus(const ARespond: Boolean);
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);
property PosX: integer read FPosX;
property PosY: integer read FPosY;
property RespondToFocus: boolean read FRespondToFocus write SetRespondToFocus;
end;
implementation
uses Gtk3Procs;
{ TGtk3Caret }
procedure TGtk3Caret.RedrawCaret;
var
cr: PCairo_t;
begin
{TODO: Implement bitmap caret.}
if not Assigned(FOwner) or not FVisible then Exit;
cr := gdk_cairo_create(gtk_widget_get_window(FOwner));
try
if FBlinkState then
begin
cairo_rectangle(cr, FPosX, FPosY, FWidth, FHeight);
cairo_set_source_rgb(cr, 0, 0, 0);
cairo_fill(cr);
end else
begin
cairo_rectangle(cr, FPosX, FPosY, FWidth, FHeight);
cairo_set_source_rgb(Cr, 1, 1, 1);
cairo_fill(cr);
end;
finally
cairo_destroy(cr);
end;
end;
constructor TGtk3Caret.Create(AOwner: PGtkWidget; AWidth, AHeight: Integer);
var
ASettings: PGtkSettings;
AValue: TGValue;
begin
inherited Create;
FOwner := AOwner;
FWidth := AWidth;
FHeight := AHeight;
FVisible := False;
FPosX := 0;
FPosY := 0;
FBlinkState := True;
FBlinkTimerID := 0;
ASettings := gtk_settings_get_default;
FillByte(AValue{%H-}, SizeOf(AValue), 0);
AValue.init(G_TYPE_INT);
ASettings^.get_property('gtk-cursor-blink-time', @AValue);
FBlinkInterval := AValue.get_int div CURSOR_ON_MULTIPLIER; // (AValue.get_int * CURSOR_OFF_MULTIPLIER) div CURSOR_DIVIDER;
AValue.unset;
end;
destructor TGtk3Caret.Destroy;
begin
StopBlinking;
Hide;
inherited Destroy;
end;
procedure TGtk3Caret.SetPosition(const X, Y: Integer);
begin
if FVisible then
gtk_widget_queue_draw_area(FOwner, FPosX, FPosY, FWidth, FHeight);
FPosX := X;
FPosY := Y;
if FVisible then
RedrawCaret;
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;
begin
FBlinkState := not FBlinkState;
RedrawCaret;
end;
function BlinkTimerCallbackFunc(Data: gpointer): gboolean; cdecl;
begin
TGtk3Caret(Data).BlinkTimerCallback;
Result := True;
end;
procedure TGtk3Caret.StartBlinking;
begin
if FBlinkTimerID <> 0 then Exit;
FBlinkTimerID := g_timeout_add(FBlinkInterval, @BlinkTimerCallbackFunc, Self);
end;
procedure TGtk3Caret.StopBlinking;
begin
if FBlinkTimerID = 0 then Exit;
g_source_remove(FBlinkTimerID);
FBlinkTimerID := 0;
FBlinkState := False;
end;
procedure TGtk3Caret.SetBlinkInterval(const AInterval: Integer);
begin
if FBlinkInterval = AInterval then
exit;
FBlinkInterval := AInterval;
if FBlinkTimerID <> 0 then
begin
StopBlinking;
StartBlinking;
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);
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
//writeln('Disconnecting focus_in/focus_out events !');
//focus-in-event
g_signal_handlers_disconnect_matched(FOwner, [G_SIGNAL_MATCH_DATA], 0, 0, nil,
nil, Self);
//focus-out-event
g_signal_handlers_disconnect_matched(FOwner, [G_SIGNAL_MATCH_DATA], 0, 0, nil,
nil, Self);
end;
end;
end.

View File

@ -31,7 +31,7 @@ uses
LCLPlatformDef, InterfaceBase, LCLProc, LCLType, LMessages, LCLMessageGlue,
Controls, Forms, Graphics, GraphUtil, IntfGraphics, StdCtrls, ComCtrls,
LazGtk3, LazGdk3, LazGlib2, LazGObject2, LazCairo1, LazPango1, LazGio2,
LazGdkPixbuf2, gtk3widgets, gtk3objects, gtk3procs, gtk3boxes;
LazGdkPixbuf2, gtk3widgets, gtk3objects, gtk3procs, gtk3boxes, gtk3caret;
type

View File

@ -241,6 +241,12 @@ const
gtk3CLBText = 1; // PGChar
gtk3CLBDisabled = 3; // gboolean
// defaults from gtktext.c
CURSOR_ON_MULTIPLIER = 2;
CURSOR_OFF_MULTIPLIER = 1;
CURSOR_PEND_MULTIPLIER = 3;
CURSOR_DIVIDER = 3;

View File

@ -332,11 +332,23 @@ end;
function TGtk3WidgetSet.CreateCaret(Handle: HWND; Bitmap: hBitmap; width,
Height: Integer): Boolean;
var
Caret: TGtk3Caret;
Widget: TGtk3Widget;
GtkWidget: PGtkWidget;
begin
{$IFDEF GTK3DEBUGNOTIMPLEMENTED}
DebugLn('WARNING: TGtk3WidgetSet.CreateCaret not implemented ...');
{$ENDIF}
Result := inherited CreateCaret(Handle, Bitmap, width, Height);
Result := False;
if Handle = 0 then
exit;
Widget := TGtk3Widget(Handle);
if Widget = nil then
exit;
GtkWidget := Widget.GetContainerWidget;
//TODO: TGtk3Caret Bitmap
Caret := TGtk3Caret.Create(GtkWidget, Width, Height);
Caret.RespondToFocus := True;
g_object_set_data(PGObject(GtkWidget), 'gtk3-caret', Caret);
Result := True;
end;
function TGtk3WidgetSet.CreateCompatibleBitmap(DC: HDC; Width, Height: Integer
@ -531,11 +543,26 @@ begin
end;
function TGtk3WidgetSet.DestroyCaret(Handle: HWND): Boolean;
var
Caret: TGtk3Caret;
Widget: TGtk3Widget;
GtkWidget: PGtkWidget;
begin
{$IFDEF GTK3DEBUGNOTIMPLEMENTED}
DebugLn('WARNING: TGtk3WidgetSet.DestroyCaret not implemented ...');
{$ENDIF}
Result:=inherited DestroyCaret(Handle);
Result := False;
if Handle = 0 then
exit;
Widget := TGtk3Widget(Handle);
if Widget = nil then
exit;
GtkWidget := Widget.GetContainerWidget;
Caret := TGtk3Caret(g_object_get_data(PGObject(GtkWidget), 'gtk3-caret'));
if Assigned(Caret) then
begin
Caret.RespondToFocus := False;
Caret.Free;
g_object_set_data(PGObject(GtkWidget), 'gtk3-caret', nil);
Result := True;
end;
end;
function TGtk3WidgetSet.DestroyCursor(Handle: HCURSOR): Boolean;
@ -706,12 +733,12 @@ var
theRect.Bottom := theRect.Top + AP.cY;
if (Flags and DT_VCENTER) > 0 then
begin
OffsetRect(theRect, 0, ((Rect.Bottom - Rect.Top) - (theRect.Bottom - theRect.Top)) div 2);
Types.OffsetRect(theRect, 0, ((Rect.Bottom - Rect.Top) - (theRect.Bottom - theRect.Top)) div 2);
end
else
if (Flags and DT_BOTTOM) > 0 then
begin
OffsetRect(theRect, 0, (Rect.Bottom - Rect.Top) - (theRect.Bottom - theRect.Top));
Types.OffsetRect(theRect, 0, (Rect.Bottom - Rect.Top) - (theRect.Bottom - theRect.Top));
end;
end;
end
@ -760,9 +787,9 @@ var
if not CalcRect then
case LeftOffset of
DT_CENTER:
OffsetRect(theRect, (Rect.Right - theRect.Right) div 2, 0);
Types.OffsetRect(theRect, (Rect.Right - theRect.Right) div 2, 0);
DT_RIGHT:
OffsetRect(theRect, Rect.Right - theRect.Right, 0);
Types.OffsetRect(theRect, Rect.Right - theRect.Right, 0);
end;
end;
@ -1749,11 +1776,24 @@ begin
end;
function TGtk3WidgetSet.HideCaret(hWnd: HWND): Boolean;
var
Caret: TGtk3Caret;
Widget: TGtk3Widget;
GtkWidget: PGtkWidget;
begin
{$IFDEF GTK3DEBUGNOTIMPLEMENTED}
DebugLn('WARNING: TGtk3WidgetSet.HideCaret not implemented ...');
{$ENDIF}
Result:=inherited HideCaret(hWnd);
Result := False;
if hWnd = 0 then
exit;
Widget := TGtk3Widget(hWnd);
if Widget = nil then
exit;
GtkWidget := Widget.GetContainerWidget;
Caret := TGtk3Caret(g_object_get_data(PGObject(GtkWidget), 'gtk3-caret'));
if Assigned(Caret) then
begin
Caret.Hide;
Result := True;
end;
end;
function TGtk3WidgetSet.GetActiveWindow: HWND;
@ -1813,20 +1853,46 @@ begin
end;
function TGtk3WidgetSet.GetCaretPos(var lpPoint: TPoint): Boolean;
var
Widget: TGtk3Widget;
GtkWidget: PGtkWidget;
Caret: TGtk3Caret;
begin
{$IFDEF GTK3DEBUGNOTIMPLEMENTED}
DebugLn('WARNING: TGtk3WidgetSet.GetCaretPos not implemented ...');
{$ENDIF}
Result:=inherited GetCaretPos(lpPoint);
Result := False;
Widget := TGtk3Widget(GetFocus);
if Widget = nil then
exit;
GtkWidget := TGtk3Widget(Widget).getContainerWidget;
if not Assigned(GtkWidget) then
Exit;
Caret := TGtk3Caret(g_object_get_data(PGObject(GtkWidget), 'gtk3-caret'));
if not Assigned(Caret) then
Exit;
lpPoint.X := Caret.PosX;
lpPoint.Y := Caret.PosY;
Result := True;
end;
function TGtk3WidgetSet.GetCaretRespondToFocus(handle: HWND;
var ShowHideOnFocus: boolean): Boolean;
var
GtkWidget: PGtkWidget;
Caret: TGtk3Caret;
begin
{$IFDEF GTK3DEBUGNOTIMPLEMENTED}
DebugLn('WARNING: TGtk3WidgetSet.GetCaretPosRespondToFocus not implemented ...');
{$ENDIF}
Result:=inherited GetCaretRespondToFocus(handle, ShowHideOnFocus);
Result := False;
if Handle = 0 then
exit;
GtkWidget := TGtk3Widget(handle).getContainerWidget;
if not Assigned(GtkWidget) then
Exit;
Caret := TGtk3Caret(g_object_get_data(PGObject(GtkWidget), 'gtk3-caret'));
if not Assigned(Caret) then
Exit;
ShowHideOnFocus := Caret.RespondToFocus;
Result := True;
end;
function TGtk3WidgetSet.GetCharABCWidths(DC: HDC; p2, p3: UINT; const ABCStructs
@ -3470,28 +3536,56 @@ begin
end;
function TGtk3WidgetSet.SetCaretPos(X, Y: Integer): Boolean;
var
Widget: TGtk3Widget;
begin
{$IFDEF GTK3DEBUGNOTIMPLEMENTED}
DebugLn('WARNING: TGtk3WidgetSet.SetCaretPos not implemented ...');
{$ENDIF}
Result:=inherited SetCaretPos(X, Y);
Widget := TGtk3Widget(GetFocus);
if Widget = nil then
exit;
Result := SetCaretPosEx(HWND(Widget),X,Y);
end;
function TGtk3WidgetSet.SetCaretPosEx(Handle: HWnd; X, Y: Integer): Boolean;
var
Caret: TGtk3Caret;
Widget: TGtk3Widget;
GtkWidget: PGtkWidget;
begin
{$IFDEF GTK3DEBUGNOTIMPLEMENTED}
DebugLn('WARNING: TGtk3WidgetSet.SetCaretPosEx not implemented ...');
{$ENDIF}
Result:=inherited SetCaretPosEx(Handle, X, Y);
Result := False;
if Handle = 0 then
exit;
Widget := TGtk3Widget(Handle);
if Widget = nil then
exit;
GtkWidget := Widget.GetContainerWidget;
Caret := TGtk3Caret(g_object_get_data(PGObject(GtkWidget), 'gtk3-caret'));
if Assigned(Caret) then
begin
Caret.SetPosition(X, Y);
Result := True;
end;
end;
function TGtk3WidgetSet.SetCaretRespondToFocus(handle: HWND;
ShowHideOnFocus: boolean): Boolean;
var
Caret: TGtk3Caret;
Widget: TGtk3Widget;
GtkWidget: PGtkWidget;
begin
{$IFDEF GTK3DEBUGNOTIMPLEMENTED}
DebugLn('WARNING: TGtk3WidgetSet.SetCaretRespondToFocus not implemented ...');
{$ENDIF}
Result:=inherited SetCaretRespondToFocus(handle, ShowHideOnFocus);
Result := False;
if handle = 0 then
exit;
Widget := TGtk3Widget(Handle);
if Widget = nil then
exit;
GtkWidget := Widget.GetContainerWidget;
Caret := TGtk3Caret(g_object_get_data(PGObject(GtkWidget), 'gtk3-caret'));
if Assigned(Caret) then
begin
Caret.RespondToFocus := ShowHideOnFocus;
Result := True;
end;
end;
function TGtk3WidgetSet.SetCursor(ACursor: HCURSOR): HCURSOR;
@ -3892,11 +3986,24 @@ begin
end;
function TGtk3WidgetSet.ShowCaret(hWnd: HWND): Boolean;
var
Caret: TGtk3Caret;
Widget: TGtk3Widget;
GtkWidget: PGtkWidget;
begin
{$IFDEF GTK3DEBUGNOTIMPLEMENTED}
DebugLn('WARNING: TGtk3WidgetSet.ShowCaret not implemented ...');
{$ENDIF}
Result:=inherited ShowCaret(hWnd);
Result := False;
if hWnd = 0 then
exit;
Widget := TGtk3Widget(hWnd);
if Widget = nil then
exit;
GtkWidget := Widget.GetContainerWidget;
Caret := TGtk3Caret(g_object_get_data(PGObject(GtkWidget), 'gtk3-caret'));
if Assigned(Caret) then
begin
Caret.Show;
Result := True;
end;
end;
function TGtk3WidgetSet.ShowScrollBar(Handle: HWND; wBar: Integer;

View File

@ -131,7 +131,7 @@ end;"/>
<License Value="modified LGPL-2
"/>
<Version Major="4" Minor="99"/>
<Files Count="548">
<Files Count="549">
<Item1>
<Filename Value="carbon/agl.pp"/>
<AddToUsesPkgSection Value="False"/>
@ -2705,6 +2705,11 @@ end;"/>
<Filename Value="cocoa/cocoatoolbar.inc"/>
<Type Value="Include"/>
</Item548>
<Item549>
<Filename Value="gtk3/gtk3caret.pas"/>
<AddToUsesPkgSection Value="False"/>
<UnitName Value="gtk3caret"/>
</Item549>
</Files>
<CompatibilityMode Value="True"/>
<LazDoc Paths="../../docs/xml/lcl"/>