mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-09-11 20:19:14 +02:00
Gtk3: implemented basic caret.
This commit is contained in:
parent
d25d085dbb
commit
4aac54de10
222
lcl/interfaces/gtk3/gtk3caret.pas
Normal file
222
lcl/interfaces/gtk3/gtk3caret.pas
Normal 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.
|
@ -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
|
||||
|
||||
|
@ -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;
|
||||
|
||||
|
||||
|
||||
|
||||
|
@ -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;
|
||||
|
@ -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"/>
|
||||
|
Loading…
Reference in New Issue
Block a user