1{ $Id: gtkwinapiwindow.pp 41387 2013-05-24 18:30:06Z juha $ } 2{ 3 /*************************************************************************** 4 GTKWinapiWindow.pp 5 ------------------- 6 gtkimplementation for basic window 7 Initial Revision : Sun Jan 9 16:00:00 GMT+1 2000 8 9 10 ***************************************************************************/ 11 12 ***************************************************************************** 13 This file is part of the Lazarus Component Library (LCL) 14 15 See the file COPYING.modifiedLGPL.txt, included in this distribution, 16 for details about the license. 17 ***************************************************************************** 18} 19{ 20@abstract(A GTK widget to support controls derived from a wincontrol) 21@author(TGTKWinapiWindow - Marc Weustink <marc@@freepascal.org>) 22@created(2000) 23@lastmod(2004) 24} 25unit GTKWinapiWindow; 26 27{$mode objfpc}{$H+} 28 29interface 30 31uses 32 SysUtils, LCLProc, 33 {$IFDEF gtk2} 34 GtkExtra, glib2, gdk2pixbuf, gdk2, gtk2, 35 {$ELSE} 36 glib, gdk, gtk, gdkpixbuf, gtkextra, 37 {$ENDIF} 38 Controls, GTKProc, GtkDef; 39 40{ $Define VerboseCaret} 41// the gtk has a function to draw the cursor, but it does not support xor 42// so it does not work with synedit and twilight hightlighter settings 43{$IFNDEF GTK1}{off $DEFINE Has_gtk_draw_insertion_cursor}{$ENDIF} 44 45type 46 PGTKAPIWidget = ^TGTKAPIWidget; 47 TGTKAPIWidget = record 48 // ! the ScrolledWindow must be the first attribute of this record ! 49 ScrolledWindow: TGTKScrolledWindow; 50 Reserved1: Word; // workaround gtk2 win32 fpc bug: SizeOf(TGTKScrolledWindow) is less than in real 51 Frame: PGtkFrame; 52 Client: PGtkWidget; 53 end; 54 55 PGTKAPIWidgetClass = ^TGTKAPIWidgetClass; 56 TGTKAPIWidgetClass = record 57 ParentClass: TGTKScrolledWindowClass; 58 end; 59 60procedure HideCaretOfWidgetGroup(ChildWidget: PGtkWidget; 61 var MainWidget: PGtkWidget; var CaretWasVisible: boolean); 62 63function GTKAPIWidget_GetType: GType; 64function GTKAPIWidget_New: PGTKWidget; 65procedure GTKAPIWidget_CreateCaret(APIWidget: PGTKAPIWidget; 66 AWidth, AHeight: Integer; ABitmap: PGDKPixmap); 67procedure GTKAPIWidget_DestroyCaret(APIWidget: PGTKAPIWidget); 68procedure GTKAPIWidget_InvalidateCaret(APIWidget: PGTKAPIWidget); 69procedure GTKAPIWidget_HideCaret(APIWidget: PGTKAPIWidget; var OldVisible: boolean); 70procedure GTKAPIWidget_ShowCaret(APIWidget: PGTKAPIWidget); 71procedure GTKAPIWidget_SetCaretPos(APIWidget: PGTKAPIWidget; X, Y: Integer); 72procedure GTKAPIWidget_GetCaretPos(APIWidget: PGTKAPIWidget; var X, Y: Integer); 73procedure GTKAPIWidget_SetCaretRespondToFocus(APIWidget: PGTKAPIWidget; 74 ShowHideOnFocus: boolean); 75procedure GTKAPIWidget_GetCaretRespondToFocus(APIWidget: PGTKAPIWidget; 76 var ShowHideOnFocus: boolean); 77 78procedure GTKAPIWidget_SetShadowType(APIWidget: PGTKAPIWidget; AShadowType: TGtkShadowType); 79 80function GTK_APIWIDGETCLIENT_TYPE: GType; 81 82implementation 83 84const 85 CURSOR_ON_MULTIPLIER = 2; 86 CURSOR_OFF_MULTIPLIER = 1; 87 CURSOR_DIVIDER = 3; 88 89//--------------------------------------------------------------------------- 90// gtk_winapiwindow_internal 91//--------------------------------------------------------------------------- 92type 93 TCaretInfo = record 94 X: Integer; 95 Y: Integer; 96 Width: Integer; 97 Height: Integer; 98 Visible: Boolean; // Caret is on (can be visible/invisible due to Blinking) 99 IsDrawn: Boolean; // Caret is visible at the moment 100 Blinking: Boolean; // Caret should blink 101 BlinkTime: Integer; // Blink time = show + hide time 102 BlinkTimeout: Integer; // Time after which if there is no user interaction happened blinking must finish 103 BlinkHide: boolean; // current blinking phase is Hide 104 Pixmap: PGDKPixMap; 105 BackPixmap: PGDKPixMap; 106 Timer: guint; 107 ShowHideOnFocus: boolean; // true = hide on loose focus, show on get focus 108 Invalidated: boolean; 109 end; 110 111 PGTKAPIWidgetClient = ^TGTKAPIWidgetClient; 112 TGTKAPIWidgetClient = record 113 // ! the Widget must be the first attribute of the record ! 114 Widget: TGtkFixed; 115 Caret: TCaretInfo; 116 {$IFNDEF gtk2} 117 // the IC is only implemented for GKT1. GTK2 needs different code. 118 ic: TGdkIC; 119 ic_attr: PGdkICAttr; 120 {$ENDIF} 121 end; 122 123 PGTKAPIWidgetClientClass = ^TGTKAPIWidgetClientClass; 124 TGTKAPIWidgetClientClass = record 125 ParentClass: TGTKFixedClass; 126// ParentClass: TGTKWidgetClass; 127 128 set_scroll_adjustments: procedure(Widget: PGTKWidget; 129 HAdjustment, VAdjustment: PGTKAdjustment); cdecl; 130 end; 131 132{------------------------------------------------------------------------------ 133 procedure HideCaretOfWidgetGroup(ChildWidget: PGtkWidget; 134 var MainWidget: PGtkWidget; var CaretWasVisible: boolean); 135 136 Find main widget and if it is a API widget, hide caret. 137 ------------------------------------------------------------------------------} 138procedure HideCaretOfWidgetGroup(ChildWidget: PGtkWidget; 139 var MainWidget: PGtkWidget; var CaretWasVisible: boolean); 140var 141 LCLObject: TObject; 142 IsAPIWidget: Boolean; 143begin 144 MainWidget:=ChildWidget; 145 LCLObject:=GetNearestLCLObject(ChildWidget); 146 if (LCLObject is TWinControl) then 147 MainWidget:=PGtkWidget(TWinControl(LCLObject).Handle); 148 IsAPIWidget:=GtkWidgetIsA(MainWidget,GTKAPIWidget_GetType); 149 CaretWasVisible:=false; 150 if IsAPIWidget then 151 GTKAPIWidget_HideCaret(PGTKAPIWidget(MainWidget),CaretWasVisible); 152end; 153 154{$IFDEF gtk2} 155//////////////////////////////////////////////////// 156// TEMP solution until gtkmarshal.inc is implemeted 157// to get this compiled 158//////////////////////////////////////////////////// 159procedure gtk_marshal_VOID__POINTER_POINTER (closure: PGClosure; 160 return_value: PGValue; 161 n_param_values: guint; 162 param_values: PGValue; 163 invocation_hint: gpointer; 164 marshal_data: gpointer); cdecl; external gtklib; 165//////////////////////////////////////////////////// 166{$ELSE} 167//////////////////////////////////////////////////// 168// TEMP solution until attr is defined as PGdkICAttr 169//////////////////////////////////////////////////// 170function _gdk_ic_new(attr:PGdkICAttr; mask:TGdkICAttributesType):TGdkIC;cdecl;external gdkdll name 'gdk_ic_new'; 171function _gdk_ic_attr_new:PGdkICAttr;cdecl;external gdkdll name 'gdk_ic_attr_new'; 172procedure _gdk_ic_attr_destroy(attr:PGdkICAttr);cdecl;external gdkdll name 'gdk_ic_attr_destroy'; 173function _gdk_ic_set_attr(ic:TGdkIC; attr:PGdkICAttr; mask:TGdkICAttributesType):TGdkICAttributesType;cdecl;external gdkdll name 'gdk_ic_set_attr'; 174//////////////////////////////////////////////////// 175{$ENDIF} 176 177type 178 {$IFDEF gtk2} 179 GTKEventResult = gboolean; 180 {$ELSE} 181 GTKEventResult = gint; 182 {$ENDIF} 183 184var 185 MParentClass: PGtkFixedClass; 186 187function GTKAPIWidgetClient_Timer(Client: Pointer): GTKEventResult; cdecl; forward; 188procedure GTKAPIWidgetClient_Realize(AWidget: PGTKWidget); cdecl; forward; 189procedure GTKAPIWidgetClient_UnRealize(AWidget: PGTKWidget); cdecl; forward; 190procedure GTKAPIWidgetClient_SizeAllocate (AWidget: PGTKWidget; AAllocation: PGtkAllocation); cdecl; forward; 191 192 193function GTKAPIWidgetClient_KeyPress(Widget: PGTKWidget; 194 Event: PGDKEventKey): GTKEventResult; cdecl; forward; 195function GTKAPIWidgetClient_ButtonPress(Widget: PGTKWidget; 196 Event: PGDKEventButton): GTKEventResult; cdecl; forward; 197function GTKAPIWidgetClient_FocusIn(AWidget: PGTKWidget; 198 Event: PGdkEventFocus): GTKEventResult; cdecl; forward; 199function GTKAPIWidgetClient_FocusOut(AWidget: PGTKWidget; 200 Event: PGdkEventFocus): GTKEventResult; cdecl; forward; 201 202procedure GTKAPIWidgetClient_ClassInit(theClass: Pointer);cdecl; forward; 203{$ifdef gtk2} 204procedure GTKAPIWidgetClient_Init(Client:PGTypeInstance; theClass: Pointer); cdecl; forward; 205{$else} 206procedure GTKAPIWidgetClient_Init(Client, theClass: Pointer); cdecl; forward; 207{$endif} 208function GTKAPIWidgetClient_GetType: GType; forward; 209function GTKAPIWidgetClient_New: PGTKWidget; forward; 210 211procedure GTKAPIWidgetClient_HideCaret(Client: PGTKAPIWidgetClient; 212 var OldVisible: boolean); forward; 213procedure GTKAPIWidgetClient_ShowCaret(Client: PGTKAPIWidgetClient); forward; 214procedure GTKAPIWidgetClient_DrawCaret(Client: PGTKAPIWidgetClient; CalledByTimer: boolean); forward; 215procedure GTKAPIWidgetClient_CreateCaret(Client: PGTKAPIWidgetClient; 216 AWidth, AHeight: Integer; ABitmap: PGDKPixmap); forward; 217procedure GTKAPIWidgetClient_DestroyCaret(Client: PGTKAPIWidgetClient); forward; 218procedure GTKAPIWidgetClient_InvalidateCaret(Client: PGTKAPIWidgetClient); forward; 219function GTKAPIWidgetClient_IsPainting(Client: PGTKAPIWidgetClient): boolean; forward; 220procedure GTKAPIWidgetClient_SetCaretPos(Client: PGTKAPIWidgetClient; 221 AX, AY: Integer); forward; 222procedure GTKAPIWidgetClient_GetCaretPos(Client: PGTKAPIWidgetClient; 223 var X, Y: Integer); forward; 224procedure GTKAPIWidgetClient_SetCaretRespondToFocus(Client: PGTKAPIWidgetClient; 225 ShowHideOnFocus: boolean); forward; 226procedure GTKAPIWidgetClient_GetCaretRespondToFocus(Client: PGTKAPIWidgetClient; 227 var ShowHideOnFocus: boolean); forward; 228 229function GTKAPIWidgetClient_GetCursorBlink(Client: PGTKAPIWidgetClient): gboolean; forward; 230function GTKAPIWidgetClient_GetCursorBlinkTime(Client: PGTKAPIWidgetClient): gint; forward; 231function GTKAPIWidgetClient_GetCursorBlinkTimeout(Client: PGTKAPIWidgetClient): gint; forward; 232//----------------------------- 233 234procedure GTKAPIWidget_SetShadowType(APIWidget: PGTKAPIWidget; 235 AShadowType: TGtkShadowType); 236begin 237 if (APIWidget^.Frame <> nil) then 238 gtk_frame_set_shadow_type(APIWidget^.Frame, AShadowType) 239{$ifdef gtk2} 240 else 241 gtk_scrolled_window_set_shadow_type(PGtkScrolledWindow(APIWidget), AShadowType); 242{$endif} 243end; 244 245function GTK_APIWIDGETCLIENT_TYPE: GType; 246begin 247 GTK_APIWIDGETCLIENT_TYPE := GTKAPIWidgetClient_GetType; 248end; 249 250 251function GTKAPIWidgetClient_GetType: GType; 252const 253 TYPE_NAME = 'LCLWinapiClient'; 254 TheType: GType = 0; 255 Info: TGTKTypeInfo = ( 256 type_name: TYPE_NAME; 257 object_size: SizeOf(TGTKAPIWidgetClient){+100}; 258 class_size: SizeOf(TGTKAPIWidgetClientClass){+100}; 259 class_init_func: @GTKAPIWidgetClient_ClassInit; 260 object_init_func: @GTKAPIWidgetClient_Init; 261 reserved_1: nil; 262 reserved_2: nil; 263 base_class_init_func: nil; 264 ); 265begin 266 if (TheType = 0) 267 then begin 268 TheType := gtk_type_from_name(TYPE_NAME); 269 {$IFDEF gtk2} 270 if TheType = 0 then TheType := gtk_type_unique(GTK_TYPE_FIXED, @Info); 271 {$ELSE} 272 if TheType = 0 then TheType := gtk_type_unique(gtk_fixed_type, @Info); 273 {$ENDIF} 274 end; 275 Result := TheType; 276end; 277 278procedure GTKAPIWidgetClient_ClassInit(theClass: Pointer);cdecl; 279// theClass: PGTKAPIWidgetClientClass 280var 281 ObjectClass: PGTKObjectClass; 282 WidgetClass: PGTKWidgetClass; 283 ClientClass: PGTKAPIWidgetClientClass; 284 SignalID: Guint; 285begin 286 ObjectClass := PGTKObjectClass(theClass); 287 WidgetClass := PGTKWidgetClass(theClass); 288 ClientClass := PGTKAPIWidgetClientClass(theClass); 289 290 MParentClass := gtk_type_class(gtk_fixed_get_type); 291 SignalID := gtk_signal_new( 292 'set_scroll_adjustments', 293 GTK_RUN_FIRST, 294 {$IFDEF gtk2} 295 gtk_class_type(ObjectClass), 296 {$ELSE} 297 ObjectClass^.thetype, 298 {$ENDIF} 299 (@ClientClass^.set_scroll_adjustments - Pointer(theClass)), 300 {$IFDEF gtk2} 301 @gtk_marshal_VOID__POINTER_POINTER, 302 {$ELSE} 303 @gtk_marshal_NONE__POINTER_POINTER, 304 {$ENDIF} 305 GTK_TYPE_NONE, 306 2, 307 [gtk_adjustment_get_type, gtk_adjustment_get_type] 308 ); 309 310 ClientClass^.set_scroll_adjustments := nil; 311 312 with WidgetClass^ do 313 begin 314 set_scroll_adjustments_signal := SignalID; 315 realize := @GTKAPIWidgetClient_Realize; 316 unrealize := @GTKAPIWidgetClient_UnRealize; 317 size_allocate := @GTKAPIWidgetClient_SizeAllocate; 318 button_press_event := @GTKAPIWidgetClient_ButtonPress; 319 key_press_event := @GTKAPIWidgetClient_KeyPress; 320 focus_in_event := @GTKAPIWidgetClient_FocusIn; 321 focus_out_event := @GTKAPIWidgetClient_FocusOut; 322 end; 323end; 324 325{$ifdef gtk2} 326procedure GTKAPIWidgetClient_Init(Client:PGTypeInstance; theClass: Pointer); cdecl; 327{$else} 328procedure GTKAPIWidgetClient_Init(Client, theClass: Pointer); cdecl; 329{$endif} 330// Client: PGTKAPIWidgetClient 331// theClass: PGTKAPIWidgetClientClass 332begin 333 if theClass=nil then ; 334 gtk_widget_set_flags(PGTKWidget(Client), GTK_CAN_FOCUS); 335 gtk_widget_set_flags(PGTKWidget(Client), GTK_CAN_DEFAULT); 336 {$IfDef GTK2} 337 gtk_widget_unset_flags(PGTKWidget(Client), GTK_NO_WINDOW); 338 {$EndIf} 339 with PGTKAPIWidgetClient(Client)^.Caret do 340 begin 341 Visible := False; 342 IsDrawn := False; 343 Blinking := GTKAPIWidgetClient_GetCursorBlink(PGTKAPIWidgetClient(Client)); 344 BlinkTime := GTKAPIWidgetClient_GetCursorBlinkTime(PGTKAPIWidgetClient(Client)); 345 BlinkTimeout := GTKAPIWidgetClient_GetCursorBlinkTimeout(PGTKAPIWidgetClient(Client)); 346 X := 0; 347 Y := 0; 348 Width := 1; 349 Height := 10; 350 Pixmap := nil; 351 BackPixmap := nil; 352 Timer := 0; 353 ShowHideOnFocus := true; 354 end; 355 356 {$IFNDEF NoStyle} 357 gtk_widget_set_app_paintable(PGTKWidget(Client),true); 358 {$ENDIF} 359end; 360 361function GTKAPIWidgetClient_New: PGTKWidget; 362begin 363 Result := PGTKWidget(gtk_type_new(GTKAPIWidgetClient_GetType())); 364end; 365 366function GTKAPIWidgetClient_Timer(Client: Pointer): GTKEventResult; cdecl; 367// returning 0 would stop the timer, 1 will restart it 368var 369 WClient: PGTKAPIWidgetClient; 370begin 371 WClient := PGTKAPIWidgetClient(Client); 372 if WClient^.Caret.Timer <= 0 then 373 begin 374 Result := gtk_false; 375 exit; 376 end; 377 WClient^.Caret.BlinkHide := not WClient^.Caret.BlinkHide; 378 GTKAPIWidgetClient_DrawCaret(Client,true); 379 if WClient^.Caret.Timer <> 0 then 380 Result := gtk_true 381 else 382 Result := gtk_false; 383end; 384 385procedure GTKAPIWidgetClient_Realize(AWidget: PGTKWidget); cdecl; 386{$IFNDEF gtk2} 387 procedure RealizeIC; // MG: it isn't called, why that? 388 var 389 width, height: GInt; 390 mask: TGdkEventMask; 391 colormap: PGdkColormap; 392 attrmask: TGdkICAttributesType; 393 style, supported_style: TGdkIMStyle; 394 ic: PGdkIC; 395 ic_attr: PGdkICAttr; 396 begin 397 // Note: code is based on gtkentry implementation 398 // don't know if all is needed 399 // MWE 400 401 if gdk_im_ready = 0 then Exit; 402 403 ic_attr := _gdk_ic_attr_new; 404 PGTKAPIWidgetClient(AWidget)^.ic_attr := ic_attr; 405 if ic_attr = nil then Exit; 406 407 attrmask := GDK_IC_ALL_REQ; 408 supported_style := GDK_IM_PREEDIT_NONE or 409 GDK_IM_PREEDIT_NOTHING or 410 GDK_IM_PREEDIT_POSITION or 411 GDK_IM_STATUS_NONE or 412 GDK_IM_STATUS_NOTHING; 413 414 if (AWidget^.thestyle <> nil) 415 and (PGtkStyle(AWidget^.thestyle)^.font^.theType <> GDK_FONT_FONTSET) 416 then supported_style := supported_style and not GDK_IM_PREEDIT_POSITION; 417 418 style := gdk_im_decide_style(supported_style); 419 ic_attr^.style := style; 420 ic_attr^.client_window := AWidget^.window; 421 422 colormap := gtk_widget_get_colormap(AWidget); 423 if colormap <> gtk_widget_get_default_colormap 424 then begin 425 attrmask := attrmask or GDK_IC_PREEDIT_COLORMAP; 426 ic_attr^.preedit_colormap := colormap; 427 end; 428 attrmask := attrmask or GDK_IC_PREEDIT_FOREGROUND or GDK_IC_PREEDIT_BACKGROUND; 429 ic_attr^.preedit_foreground := PGtkStyle(AWidget^.thestyle)^.fg[GTK_STATE_NORMAL]; 430 ic_attr^.preedit_background := PGtkStyle(AWidget^.thestyle)^.base[GTK_STATE_NORMAL]; 431 432 if (style and GDK_IM_PREEDIT_MASK) = GDK_IM_PREEDIT_POSITION 433 then begin 434 if (AWidget^.thestyle <> nil) 435 and (PGtkStyle(AWidget^.thestyle)^.font^.thetype <> GDK_FONT_FONTSET) 436 then begin 437 DebugLn('[WAWc] over-the-spot style requires fontset'); 438 end 439 else begin 440 gdk_window_get_size(AWidget^.window, @width, @height); 441 442 attrmask := attrmask or GDK_IC_PREEDIT_POSITION_REQ; 443 ic_attr^.spot_location.x := 0; 444 ic_attr^.spot_location.y := guint16(height); 445 ic_attr^.preedit_area.x := 0; 446 ic_attr^.preedit_area.y := 0; 447 ic_attr^.preedit_area.width := guint16(width); 448 ic_attr^.preedit_area.height := guint16(height); 449 ic_attr^.preedit_fontset := PGtkStyle(AWidget^.thestyle)^.font; 450 end; 451 end; 452 453 ic := _gdk_ic_new(ic_attr, attrmask); 454 PGTKAPIWidgetClient(AWidget)^.ic := ic; 455 if ic = nil 456 then begin 457 DebugLn('[WAWc] Can''t create input context.') 458 end 459 else begin 460 mask := gdk_window_get_events(AWidget^.Window); 461 mask := mask or gdk_ic_get_events(ic); 462 gdk_window_set_events(AWidget^.Window, mask); 463 464 if GTK_WIDGET_HAS_FOCUS(Awidget) 465 then gdk_im_begin(ic, AWidget^.Window); 466 end; 467 end; 468{$ENDIF} 469 470// All //@ marked lines are already set by the inherited realize 471// we only have to (re)set the event mask 472 473var 474 Info: PWidgetInfo; 475//@ Attributes: TGdkWindowAttr; 476//@ AttributesMask: gint; 477begin 478 PGTKWidgetClass(MParentClass)^.realize(AWidget); 479 480//@ gtk_widget_set_flags(AWidget, GTK_REALIZED); 481 482 {$IFNDEF GTK1} 483 gtk_widget_set_double_buffered(AWidget, True); // True bites caret => ToDo 484 gtk_widget_set_redraw_on_allocate(AWidget, False); 485 {$ENDIF} 486 487//@ with Attributes do 488//@ begin 489//@ Window_type := gdk_window_child; 490//@ X := AWidget^.allocation.x; 491//@ Y := AWidget^.allocation.y; 492//@ Width := AWidget^.allocation.width; 493//@ Height := AWidget^.allocation.height; 494//@ WClass := GDK_INPUT_OUTPUT; 495//@ Visual := gtk_widget_get_visual(AWidget); 496//@ Colormap := gtk_widget_get_colormap(AWidget); 497//@ Event_mask := gtk_widget_get_events(AWidget) 498//@ or GDK_EXPOSURE_MASK or GDK_BUTTON_PRESS_MASK or GDK_BUTTON_RELEASE_MASK 499//@ or GDK_BUTTON_MOTION_MASK or GDK_ENTER_NOTIFY_MASK or GDK_LEAVE_NOTIFY_MASK 500//@ or GDK_KEY_PRESS_MASK or GDK_KEY_RELEASE_MASK; 501//@ end; 502//@ AttributesMask := GDK_WA_X or GDK_WA_Y or GDK_WA_VISUAL or GDK_WA_COLORMAP; 503//@ 504//@ AWidget^.Window := gdk_window_new(gtk_widget_get_parent_window(AWidget), 505//@ @Attributes, AttributesMask); 506//@ 507//@ gdk_window_set_user_data(AWidget^.Window, AWidget); 508 509 gdk_window_set_events(AWidget^.Window, gdk_window_get_events(AWidget^.Window) 510 or GDK_EXPOSURE_MASK or GDK_BUTTON_PRESS_MASK or GDK_BUTTON_RELEASE_MASK 511 or GDK_BUTTON_MOTION_MASK or GDK_ENTER_NOTIFY_MASK or GDK_LEAVE_NOTIFY_MASK 512 or GDK_KEY_PRESS_MASK or GDK_KEY_RELEASE_MASK); 513 514//@ AWidget^.Style := gtk_style_attach(AWidget^.Style, AWidget^.Window); 515//@ gtk_style_set_background(AWidget^.Style, AWidget^.Window, GTK_STATE_NORMAL); 516 Info := GetWidgetInfo(AWidget); 517 if (Info = nil) or ([wwiNoEraseBkgnd] * Info^.Flags = []) then 518 gdk_window_set_back_pixmap(AWidget^.Window, nil, GdkFalse); 519end; 520 521procedure GTKAPIWidgetClient_UnRealize(AWidget: PGTKWidget); cdecl; 522begin 523 with PGTKAPIWidgetClient(AWidget)^.Caret do 524 begin 525 if Timer <> 0 526 then begin 527 gtk_timeout_remove(Timer); 528 Timer := 0; 529 end; 530 end; 531 532 {$IFNDEF GTK2} 533 with PGTKAPIWidgetClient(AWidget)^ do 534 begin 535 if ic <> nil 536 then begin 537 gdk_ic_destroy(ic); 538 ic := nil; 539 end; 540 if ic_attr <> nil 541 then begin 542 _gdk_ic_attr_destroy(ic_attr); 543 ic_attr := nil; 544 end; 545 end; 546 {$ENDIF} 547 548 PGTKWidgetClass(MParentClass)^.unrealize(AWidget); 549end; 550 551procedure GTKAPIWidgetClient_SizeAllocate(AWidget: PGTKWidget; 552 AAllocation: PGtkAllocation); cdecl; 553{$IFNDEF GTK2} 554var 555 width, height: GInt; 556 ic: PGdkIC; 557 ic_attr: PGdkICAttr; 558{$ENDIF} 559begin 560 PGTKWidgetClass(MParentClass)^.size_allocate(AWidget, AAllocation); 561 562 {$IFNDEF GTK2} 563 ic := PGTKAPIWidgetClient(AWidget)^.ic; 564 ic_attr := PGTKAPIWidgetClient(AWidget)^.ic_attr; 565 566 if (ic <> nil) 567 and (gdk_ic_get_style(ic) and GDK_IM_PREEDIT_POSITION <> 0) 568 then begin 569 gdk_window_get_size(AWidget^.Window, @width, @height); 570 ic_attr^.preedit_area.width := guint16(width); 571 ic_attr^.preedit_area.height := guint16(height); 572 _gdk_ic_set_attr(ic, ic_attr, GDK_IC_PREEDIT_AREA); 573 end; 574 {$ENDIF} 575end; 576 577 578function GTKAPIWidgetClient_KeyPress(Widget: PGTKWidget; 579 Event: PGDKEventKey): GTKEventResult; cdecl; 580begin 581 if (Widget=nil) or (Event=nil) then ; 582 583 584 // DO NOT supress further processing. The next one who changes that please do the debugging too. 585 // just do not. 586 587{$ifdef gtk2} 588 Result := gtk_False; 589{$else} 590 Result := gtk_True; 591{$endif} 592end; 593 594function GTKAPIWidgetClient_ButtonPress(Widget: PGTKWidget; 595 Event: PGDKEventButton): GTKEventResult; cdecl; 596begin 597 {$IFDEF VerboseFocus} 598 DebugLn('GTKAPIWidgetClient_ButtonPress ',DbgS(Widget)); 599 {$ENDIF} 600 if Event=nil then ; 601 Result := gtk_False; 602end; 603 604function GTKAPIWidgetClient_FocusIn(AWidget: PGTKWidget; 605 Event: PGdkEventFocus): GTKEventResult; cdecl; 606begin 607 {$IFDEF VerboseFocus} 608 DebugLn('GTKAPIWidgetClient_FocusIn ',DbgS(AWidget),' ',dbgs(event^.{$ifdef gtk1}thein{$else}_in{$endif})); 609 {$ENDIF} 610 611 gtk_widget_set_flags(AWidget, GTK_HAS_FOCUS); 612 GTKAPIWidgetClient_DrawCaret(PGTKAPIWidgetClient(AWidget), False); 613 614 {$IFNDEF GTK2} 615 if PGTKAPIWidgetClient(AWidget)^.ic <> nil 616 then gdk_im_begin(PGTKAPIWidgetClient(AWidget)^.ic, AWidget^.Window); 617 {$ENDIF} 618 619 Result := gtk_False; 620end; 621 622function GTKAPIWidgetClient_FocusOut(AWidget: PGTKWidget; 623 Event: PGdkEventFocus): GTKEventResult; cdecl; 624begin 625 {$IFDEF VerboseFocus} 626 DebugLn('GTKAPIWidgetClient_FocusOut ',DbgS(AWidget),' ',dbgs(event^.{$ifdef gtk1}thein{$else}_in{$endif})); 627 {$ENDIF} 628 629 gtk_widget_unset_flags(AWidget, GTK_HAS_FOCUS); 630 GTKAPIWidgetClient_DrawCaret(PGTKAPIWidgetClient(AWidget), False); 631 632 {$IFNDEF GTK2} 633 gdk_im_end; 634 {$ENDIF} 635 636 Result := gtk_False; 637end; 638 639procedure GTKAPIWidgetClient_HideCaret(Client: PGTKAPIWidgetClient; 640 var OldVisible: boolean); 641begin 642 if Client = nil 643 then begin 644 DebugLn('WARNING: [GTKAPIWidgetClient_HideCaret] Got nil client'); 645 Exit; 646 end; 647 {$IFDEF VerboseCaret} 648 DebugLn(['GTKAPIWidgetClient_HideCaret ',DbgS(Client),' ShowHideOnFocus=',Client^.Caret.ShowHideOnFocus]); 649 {$ENDIF} 650 OldVisible:=Client^.Caret.Visible; 651 Client^.Caret.Visible := False; 652 GTKAPIWidgetClient_DrawCaret(Client,false); 653 654 {if (Client^.Caret.IsDrawn) then begin 655 with Client^.Caret do begin 656 DebugLn('GTKAPIWidgetClient_ShowCaret IsDrawn=',dbgs(IsDrawn),' Visible=',dbgs(Visible), 657 ' Blinking='+dbgs(Blinking),' HasFocus=',dbgs(gtk_widget_has_focus(PGtkWidget(Client))), 658 ' ShowHideOnFocus='+dbgs(ShowHideOnFocus), 659 ' Window='+dbgs(PGtkWidget(Client)^.Window<>nil), 660 ' Style='+dbgs(gtk_widget_get_style(PGtkWidget(Client))<>nil)); 661 end; 662 end;} 663end; 664 665function GTKAPIWidgetClient_GetCursorBlink(Client: PGTKAPIWidgetClient): gboolean; 666{$ifndef GTK1} 667var 668 settings: PGtkSettings; 669{$endif} 670begin 671{$ifdef GTK1} 672 Result := True; 673{$else} 674 settings := gtk_widget_get_settings(PGtkWidget(Client)); 675 g_object_get(settings, 'gtk-cursor-blink', @Result, nil); 676{$endif} 677end; 678 679function GTKAPIWidgetClient_GetCursorBlinkTime(Client: PGTKAPIWidgetClient): gint; 680{$ifndef GTK1} 681var 682 settings: PGtkSettings; 683{$endif} 684begin 685{$ifdef GTK1} 686 Result := 1200; 687{$else} 688 settings := gtk_widget_get_settings(PGtkWidget(Client)); 689 g_object_get(settings, 'gtk-cursor-blink-time', @Result, nil); 690{$endif} 691end; 692 693function GTKAPIWidgetClient_GetCursorBlinkTimeout(Client: PGTKAPIWidgetClient): gint; 694{$ifndef GTK1} 695var 696 settings: PGtkSettings; 697{$endif} 698begin 699{$ifdef GTK1} 700 Result := $7FFFFFFF; 701{$else} 702 settings := gtk_widget_get_settings(PGtkWidget(Client)); 703 g_object_get(settings, 'gtk-cursor-blink-timeout', @Result, nil); 704{$endif} 705end; 706 707procedure GTKAPIWidgetClient_DrawCaret(Client: PGTKAPIWidgetClient; CalledByTimer: boolean); 708{ ShowCaret/HideCaret are used in winapi like: 709 ShowCaret (paint xor) 710 Blinking (restore) 711 StartPaintEvent 712 HideCaret 713 Painting 714 ShowCaret 715 EndPaintEvent 716 Blinking 717 718 Moving a caret works like this: HideCaret, move, ShowCaret 719 720 The gtk2 uses double buffering with clipping. 721 This means, during a paint event you can only paint in the clipping area, 722 which does not need to be rectangular. 723 => If the caret would be painted outside the paint event, then we can not hide 724 it if the clipping area does not completely contain the old position. 725 => Therefore we can only paint either inside or outside the paint event. 726 Painting outside the paint event means that between painting and showing 727 caret there are other events, so continuus painting will hardly show the 728 caret. It appears to be almost invisible. 729 => Therefore we must paint only inside the paint event 730 Algorithm: 731 InvalidateRect automatically invalidates the caret 732 Hide 733 outside paint event: invalidate and IsDrawn:=false 734 inside paint event: IsDrawn:=false 735 Show 736 outside paint event: invalidate 737 inside paint event: draw and IsDrawn:=true 738 739 Blinking makes it more complicated, because a Hide triggers an OnPaint, 740 which triggers in synedit code HideCaret+ShowCaret. 741} 742var 743 Widget: PGTKWidget; 744 WidgetStyle: PGTKStyle; 745 HasFocus: boolean; 746 WidgetIsPainting: Boolean; 747{$IFDEF Has_gtk_draw_insertion_cursor} 748 location: TGdkRectangle; 749{$ENDIF} 750 751 procedure DrawCursor(Pixmap: PGdkPixmap; X, Y, Width, Height: Integer); 752 const 753 GC_STATE: array[Boolean] of TGtkStateType = 754 ( 755 GTK_STATE_INSENSITIVE, 756 GTK_STATE_NORMAL 757 ); 758 var 759 ForeGroundGC: PGdkGC; 760 begin 761 // set draw function to xor 762 ForeGroundGC := WidgetStyle^.fg_gc[GC_STATE[PtrUInt(Pixmap) <> 1]]; 763 //gdk_gc_get_values(ForeGroundGC,@ForeGroundGCValues); 764 //OldGdkFunction:=ForeGroundGCValues.thefunction; 765 {$IFDEF VerboseCaret} 766 DebugLn(['GTKAPIWidgetClient_DrawCaret Real Draw ',X,',',Y]); 767 {$ENDIF} 768 gdk_gc_set_function(ForeGroundGC,GDK_invert); 769 try 770 // draw the caret 771 //DebugLn('DRAWING'); 772 gdk_draw_rectangle( 773 Widget^.Window, 774 ForeGroundGC, 775 1, 776 X, Y-1, // Y-1 for Delphi compatibility 777 Width, Height 778 ); 779 finally 780 // restore draw function 781 gdk_gc_set_function(ForeGroundGC, GDK_COPY); 782 end; 783 end; 784 785begin 786 if Client = nil then 787 begin 788 DebugLn('WARNING: [GTKAPIWidgetClient_DrawCaret] Got nil client'); 789 Exit; 790 end; 791 792 Widget := PGTKWidget(Client); 793 WidgetStyle := gtk_widget_get_style(Widget); 794 WidgetIsPainting := GTKAPIWidgetClient_IsPainting(Client); 795 796 with Client^.Caret do 797 begin 798 HasFocus := gtk_widget_has_focus(Widget); 799 if WidgetIsPainting then 800 Invalidated := false; 801 802 {$IFDEF VerboseCaret} 803 DebugLn(['GTKAPIWidgetClient_DrawCaret START Client=',DbgS(Client),' Timer=',Timer,' Blink=',Blinking,' BlinkHide=',BlinkHide,' Visible=',Visible,' ShowHideOnFocus=',ShowHideOnFocus,' Focus=',gtk_widget_has_focus(Widget),' IsDrawn=',IsDrawn,' W=',Width,' H=',Height,' WidgetIsPainting=',WidgetIsPainting]); 804 {$ENDIF} 805 806 if IsDrawn and 807 ( 808 (not Visible) or 809 (Blinking and BlinkHide) 810 ) then 811 begin 812 // hide caret (restore background) 813 if WidgetIsPainting then 814 begin 815 if (BackPixmap <> nil) and (Widget<>nil) and (WidgetStyle<>nil) then 816 begin 817 gdk_draw_pixmap( 818 Widget^.Window, 819 WidgetStyle^.bg_gc[GTK_STATE_NORMAL], 820 BackPixmap, 0, 0, 821 X, Y-1, // Y-1 for Delphi compatibility 822 Width, Height 823 ); 824 {$IFDEF VerboseCaret} 825 DebugLn(['GTKAPIWidgetClient_DrawCaret Real Hide ',X,',',Y]); 826 {$ENDIF} 827 end; 828 IsDrawn := False; 829 Invalidated:=false; 830 end else 831 begin 832 // paint only during painting, otherwise invalidate 833 {$IFDEF VerboseCaret} 834 DebugLn(['GTKAPIWidgetClient_DrawCaret Invalidate Hide ',X,',',Y]); 835 {$ENDIF} 836 GTKAPIWidgetClient_InvalidateCaret(Client); 837 IsDrawn := false; 838 end; 839 end 840 else 841 if Visible 842 and (HasFocus or (not ShowHideOnFocus)) 843 and (not IsDrawn) 844 and (not (Blinking and BlinkHide)) 845 and (Widget^.Window<>nil) 846 and (WidgetStyle<>nil) 847 then begin 848 //if Pixmap <> nil then 849 //DebugLn('Trace:TODO: [GTKAPIWidgetClient_DrawCaret] Implement bitmap'); 850 851 if WidgetIsPainting then 852 begin 853 //Create backbitmap if needed 854 if (BackPixmap = nil) 855 and (Widget^.Window<>nil) 856 and (Width>0) 857 and (Height>0) 858 then 859 BackPixmap := gdk_pixmap_new(Widget^.Window, Width, Height, -1); 860 861 // store background 862 if (BackPixmap <> nil) 863 and (Widget<>nil) 864 and (WidgetStyle<>nil) 865 and (Width>0) and (Height>0) 866 then begin 867 {$IFDEF VerboseCaret} 868 DebugLn(['GTKAPIWidgetClient_DrawCaret Store ',X,',',Y]); 869 {$ENDIF} 870 gdk_draw_pixmap( 871 BackPixmap, 872 WidgetStyle^.bg_gc[GTK_STATE_NORMAL], 873 Widget^.Window, 874 X, Y-1, // Y-1 for Delphi compatibility 875 0, 0, 876 Width, Height 877 ); 878 end; 879 880 // draw caret 881 {$IFDEF VerboseCaret} 882 DebugLn(['GTKAPIWidgetClient_DrawCaret SHOWING Client=',DbgS(Client) 883 ,' ',cardinal(WidgetStyle) 884 ,' ',cardinal(Widget^.Window) 885 ,' X=',X,' Y=',Y 886 ,' W=',Width 887 ,' H=',Height 888 ]); 889 {$ENDIF} 890 if (WidgetStyle<>nil) 891 and (Widget^.Window<>nil) 892 and (Width>0) 893 and (Height>0) 894 then begin 895 {$IFDEF Has_gtk_draw_insertion_cursor} 896 if Width <= 3 then 897 begin 898 location.x := X; 899 location.y := Y - 1; 900 location.width := 0; 901 location.height := Height; 902 gtk_draw_insertion_cursor(Widget, Widget^.Window, nil, @location, PtrUInt(Pixmap) <> 1, 903 GTK_TEXT_DIR_LTR, false); 904 end 905 else 906 {$ENDIF} 907 DrawCursor(Pixmap, X, Y, Width, Height); 908 end else 909 DebugLn('***: Draw Caret failed: Client=',DbgS(Client), 910 ' X='+dbgs(X)+' Y='+dbgs(Y)+' W='+dbgs(Width)+' H='+dbgs(Height), 911 ' ',dbgs(Pixmap<>nil),',',dbgs(Widget^.Window),',',dbgs(WidgetStyle)); 912 IsDrawn := True; 913 Invalidated:=false; 914 end else begin 915 // not in a paint event => use only invalidate 916 {$IFDEF VerboseCaret} 917 DebugLn(['GTKAPIWidgetClient_DrawCaret Invalidate Show']); 918 {$ENDIF} 919 GTKAPIWidgetClient_InvalidateCaret(Client); 920 end; 921 end; 922 923 // stop, start timer 924 if Visible and Blinking and ((not ShowHideOnFocus) or HasFocus) then 925 begin 926 if Timer = 0 then 927 if IsDrawn then 928 Timer := gtk_timeout_add(BlinkTime * CURSOR_ON_MULTIPLIER div CURSOR_DIVIDER, 929 @GTKAPIWidgetClient_Timer, Client) 930 else 931 Timer := gtk_timeout_add(BlinkTime * CURSOR_OFF_MULTIPLIER div CURSOR_DIVIDER, 932 @GTKAPIWidgetClient_Timer, Client) 933 end else 934 begin 935 if Timer <> 0 then 936 begin 937 gtk_timeout_remove(Timer); 938 Timer := 0; 939 end; 940 end; 941 942 {$IFDEF VerboseCaret} 943 DebugLn(['GTKAPIWidgetClient_DrawCaret END Client=',DbgS(Client),' Timer=',Timer,' Blink=',Blinking,' BlinkHide=',BlinkHide,' Visible=',Visible,' ShowHideOnFocus=',ShowHideOnFocus,' Focus=',gtk_widget_has_focus(Widget),' IsDrawn=',IsDrawn,' W=',Width,' H=',Height,' WidgetIsPainting=',WidgetIsPainting]); 944 {$ENDIF} 945 end; 946end; 947 948procedure GTKAPIWidgetClient_ShowCaret(Client: PGTKAPIWidgetClient); 949begin 950 //DebugLn('[GTKAPIWidgetClient_ShowCaret] A Client=',DbgS(Client)); 951 if Client = nil 952 then begin 953 DebugLn('WARNING: [GTKAPIWidgetClient_ShowCaret] Got nil client'); 954 Exit; 955 end; 956 957 {$IFDEF VerboseCaret} 958 DebugLn('GTKAPIWidgetClient_ShowCaret ',DbgS(Client)); 959 {$ENDIF} 960 961 Client^.Caret.Visible := True; 962 GTKAPIWidgetClient_DrawCaret(Client,false); 963end; 964 965procedure GTKAPIWidgetClient_CreateCaret(Client: PGTKAPIWidgetClient; 966 AWidth, AHeight: Integer; ABitmap: PGDKPixmap); 967var 968 IsVisible: Boolean; 969 WasVisible: boolean; 970begin 971 {$IFDEF VerboseCaret} 972 DebugLn(['********** [GTKAPIWidgetClient_CreateCaret] A Client=',DbgS(Client),' Width=',AWidth,' Height=',AHeight,' Bitmap=',ABitmap<>nil]); 973 {$ENDIF} 974 if Client = nil 975 then begin 976 DebugLn('WARNING: [GTKAPIWidgetClient_CreateCaret] Got nil client'); 977 Exit; 978 end; 979 980 with Client^.Caret do 981 begin 982 IsVisible := Visible; 983 if IsVisible then GTKAPIWidgetClient_HideCaret(Client,WasVisible); 984 985 if (Width <> AWidth) or (Height <> AHeight) 986 then begin 987 if BackPixmap <> nil then gdk_pixmap_unref(BackPixmap); 988 BackPixmap := nil; 989 Width := AWidth; 990 Height := AHeight; 991 end; 992 993 Pixmap := ABitmap; 994 995 if IsVisible then GTKAPIWidgetClient_ShowCaret(Client); 996 end; 997end; 998 999procedure GTKAPIWidgetClient_DestroyCaret(Client: PGTKAPIWidgetClient); 1000var 1001 WasVisible: boolean; 1002begin 1003 {$IFDEF VerboseCaret} 1004 DebugLn('********** [GTKAPIWidgetClient_DestroyCaret] A Client=',DbgS(Client)); 1005 {$ENDIF} 1006 if Client = nil 1007 then begin 1008 DebugLn('WARNING: [GTKAPIWidgetClient_DestroyCaret] Got nil client'); 1009 Exit; 1010 end; 1011 1012 with Client^.Caret do begin 1013 if Visible then begin 1014 Visible:=false; 1015 GTKAPIWidgetClient_HideCaret(Client,WasVisible); 1016 end; 1017 1018 if Timer<>0 then begin 1019 gtk_timeout_remove(Timer); 1020 Timer:=0; 1021 end; 1022 1023 if BackPixmap <> nil then begin 1024 gdk_pixmap_unref(BackPixmap); 1025 BackPixmap := nil; 1026 end; 1027 Pixmap := nil; 1028 end; 1029 {$IFDEF VerboseCaret} 1030 DebugLn('********** B[GTKAPIWidgetClient_DestroyCaret] A Client=',DbgS(Client)); 1031 {$ENDIF} 1032end; 1033 1034procedure GTKAPIWidgetClient_InvalidateCaret(Client: PGTKAPIWidgetClient); 1035begin 1036 {$IFDEF VerboseCaret} 1037 DebugLn('********** [GTKAPIWidgetClient_InvalidateCaret] A Client=',DbgS(Client)); 1038 {$ENDIF} 1039 with Client^.Caret do begin 1040 if not Invalidated then begin 1041 {$IFDEF VerboseCaret} 1042 DebugLn(['GTKAPIWidgetClient_InvalidateCaret invalidate caret: X=',X,' Y=',Y-1,' ',Width,'x',Height]); 1043 {$ENDIF} 1044 gtk_widget_queue_draw_area(PGtkWidget(Client), 1045 X, Y-1, // Y-1 for Delphi compatibility 1046 Width,Height); 1047 Invalidated:=true; 1048 end; 1049 end; 1050 {$IFDEF VerboseCaret} 1051 DebugLn('********** B[GTKAPIWidgetClient_InvalidateCaret] A Client=',DbgS(Client)); 1052 {$ENDIF} 1053end; 1054 1055function GTKAPIWidgetClient_IsPainting(Client: PGTKAPIWidgetClient): boolean; 1056{$IFNDEF Gtk1} 1057var 1058 Info: PWidgetInfo; 1059{$ENDIF} 1060begin 1061 {$IFDEF Gtk1} 1062 // the gtk1 has no double buffering, there is no difference between 1063 // painting outside/inside OnPaint 1064 Result:=true; 1065 {$ELSE} 1066 Info:=GetWidgetInfo(Client,false); 1067 Result:=(Info<>nil) and (Info^.PaintDepth>0); 1068 {$ENDIF} 1069end; 1070 1071procedure GTKAPIWidgetClient_SetCaretPos(Client: PGTKAPIWidgetClient; 1072 AX, AY: Integer); 1073var 1074 IsVisible, WasVisible: Boolean; 1075begin 1076 {$IFDEF VerboseCaret} 1077 DebugLn('[GTKAPIWIDGETCLIENT] SetCaretPos '+inttostr(ax)+','+Inttostr(ay)); 1078 {$ENDIF} 1079 1080 if Client = nil 1081 then begin 1082 DebugLn('WARNING: [GTKAPIWidgetClient_SetCaretPos] Got nil client'); 1083 Exit; 1084 end; 1085 1086 with Client^.Caret do 1087 begin 1088 if (X=AX) and (Y=AY) then exit; 1089 IsVisible := Visible; 1090 if IsVisible then GTKAPIWidgetClient_HideCaret(Client,WasVisible); 1091 X := AX; 1092 Y := AY; 1093 BlinkHide:=false;// start show phase 1094 Invalidated:=false; 1095 if Timer<>0 then begin 1096 // reset timer 1097 gtk_timeout_remove(Timer); 1098 Timer:=0; 1099 end; 1100 if IsVisible then GTKAPIWidgetClient_ShowCaret(Client); 1101 end; 1102end; 1103 1104procedure GTKAPIWidgetClient_GetCaretPos(Client: PGTKAPIWidgetClient; 1105 var X, Y: Integer); 1106begin 1107 if Client = nil 1108 then begin 1109 DebugLn('WARNING: [GTKAPIWidgetClient_GetCaretPos] Got nil client'); 1110 Exit; 1111 end; 1112 1113 X := Client^.Caret.X; 1114 Y := Client^.Caret.Y; 1115end; 1116 1117procedure GTKAPIWidgetClient_SetCaretRespondToFocus(Client: PGTKAPIWidgetClient; 1118 ShowHideOnFocus: boolean); 1119begin 1120 {$IFDEF VerboseCaret} 1121 DebugLn(['[GTKAPIWidgetClient_SetCaretRespondToFocus] A ',ShowHideOnFocus]); 1122 {$ENDIF} 1123 if Client = nil 1124 then begin 1125 DebugLn( 1126 'WARNING: [GTKAPIWidgetClient_SetCaretRespondToFocus] Got nil client'); 1127 Exit; 1128 end; 1129 1130 Client^.Caret.ShowHideOnFocus:=ShowHideOnFocus; 1131end; 1132 1133procedure GTKAPIWidgetClient_GetCaretRespondToFocus(Client: PGTKAPIWidgetClient; 1134 var ShowHideOnFocus: boolean); 1135begin 1136 if Client = nil 1137 then begin 1138 DebugLn( 1139 'WARNING: [GTKAPIWidgetClient_GetCaretRespondToFocus] Got nil client'); 1140 Exit; 1141 end; 1142 1143 ShowHideOnFocus:=Client^.Caret.ShowHideOnFocus; 1144end; 1145 1146//--------------------------------------------------------------------------- 1147// GTKAPIWidget 1148//--------------------------------------------------------------------------- 1149 1150function GTKAPIWidget_FocusIn(Widget: PGTKWidget; 1151 Event: PGdkEventFocus): GTKEventResult; cdecl; 1152var 1153 TopLevel: PGTKWidget; 1154begin 1155 //DebugLn('Trace:[GTKAPIWidget_FocusIn]'); 1156 1157 if Event=nil then ; 1158 TopLevel := gtk_widget_get_toplevel(Widget); 1159 if gtk_type_is_a(gtk_object_type(PGTKObject(TopLevel)), gtk_window_get_type) 1160 then gtk_window_set_focus(PGTKWindow(TopLevel), PGTKAPIWidget(Widget)^.Client); 1161 1162 Result := gtk_True; 1163end; 1164 1165function GTKAPIWidget_FocusOut(Widget: PGTKWidget; 1166 Event: PGdkEventFocus): GTKEventResult; cdecl; 1167begin 1168 if (Event=nil) or (Widget=nil) then ; 1169 //DebugLn('Trace:[GTKAPIWidget_FocusOut]'); 1170 Result := gtk_True; 1171end; 1172 1173 1174procedure GTKAPIWidget_ClassInit(wawClass: Pointer); cdecl; 1175//wawClass: PGTKAPIWidgetClass 1176var 1177 WidgetClass: PGTKWidgetClass; 1178begin 1179 WidgetClass := PGTKWidgetClass(wawClass); 1180 1181 WidgetClass^.focus_in_event := @GTKAPIWidget_FocusIn; 1182 WidgetClass^.focus_out_event := @GTKAPIWidget_FocusOut; 1183end; 1184 1185{$ifdef gtk2} 1186procedure GTKAPIWidget_Init(waw:PGTypeInstance; theClass: Pointer); cdecl; 1187{$else} 1188procedure GTKAPIWidget_Init(waw, theClass: Pointer); cdecl; 1189{$endif} 1190// waw: PGTKAPIWidget; 1191// theClass: PGTKAPIWidgetClass 1192var 1193 Widget: PGTKWidget; 1194begin 1195 if theClass=nil then ; 1196 Widget := PGTKWidget(waw); 1197 gtk_widget_set_flags(Widget, GTK_CAN_FOCUS); 1198end; 1199 1200function GTKAPIWidget_GetType: GType; 1201const 1202 WAW_NAME = 'LCLWinapiWidget'; 1203 wawInfo: TGTKTypeInfo = ( 1204 type_name: WAW_NAME; 1205 object_size: SizeOf(TGTKAPIWidget)+100; // a TGTKScrolledWindow 1206 class_size: SizeOf(TGTKAPIWidgetClass)+100; 1207 class_init_func: @GTKAPIWidget_ClassInit; 1208 object_init_func : @GTKAPIWidget_Init; 1209 reserved_1: nil; 1210 reserved_2: nil; 1211 base_class_init_func: nil; 1212 ); 1213begin 1214 if (GTKAPIWidget_Type = 0) 1215 then begin 1216 GTKAPIWidget_Type := gtk_type_from_name(WAW_NAME); 1217 if GTKAPIWidget_Type = 0 1218 then GTKAPIWidget_Type := gtk_type_unique(gtk_scrolled_window_get_type, @wawInfo); 1219 end; 1220 Result := GTKAPIWidget_Type; 1221end; 1222 1223{$IFDEF GTK1} 1224function Laz_GTK_OBJECT_CONSTRUCTED(AnObject: PGtkObject): gboolean; cdecl;external gtkdll name 'gtk_object_constructed'; 1225{$ENDIF GTK1} 1226 1227function GTKAPIWidget_new: PGTKWidget; 1228var 1229 APIWidget: PGTKAPIWidget; 1230{$IFDEF gtk1} 1231var 1232 NewArgs: array[0..1] of TGTKArg; 1233{$ENDIF} 1234begin 1235{$IFDEF gtk1} 1236 FillChar(NewArgs[0],SizeOf(TGTKArg)*(High(NewArgs)-Low(NewArgs)+1),0); 1237 NewArgs[0].theType:=GTK_ADJUSTMENT_TYPE; 1238 NewArgs[0].name:='hadjustment'; 1239 NewArgs[1].theType:=GTK_ADJUSTMENT_TYPE; 1240 NewArgs[1].name:='vadjustment'; 1241 1242 // something is rotten with gtk_widget_newv on some platforms 1243 //Result := gtk_widget_newv(GTKAPIWidget_GetType, 2, @ARGS[0]); 1244 1245 // do it step by step 1246 Result:=gtk_type_new(GTKAPIWidget_GetType); 1247 gtk_object_arg_set (PGtkObject(Result), @NewArgs[0], NULL); 1248 gtk_object_arg_set (PGtkObject(Result), @NewArgs[1], NULL); 1249 if (not Laz_GTK_OBJECT_CONSTRUCTED (PGtkObject(Result))) then 1250 gtk_object_default_construct (PGtkObject(Result)); 1251{$ELSE} 1252 // MWE: IMO the arguments can't work since we supply the adjustments as nil 1253 // for gtk2 newv doesn't exist so the decision is easy 1254 // TODO: check if we still need to pass the args in gtk1 1255 Result := gtk_widget_new(GTKAPIWidget_GetType, nil, []); 1256{$ENDIF} 1257 1258 APIWidget := PGTKAPIWidget(Result); 1259 gtk_container_set_border_width(PGTKContainer(APIWidget),0); 1260 1261 // create client widget 1262 APIWidget^.Client := GTKAPIWidgetClient_New; 1263 gtk_object_set_data(PGTKObject(Result), 'Fixed', APIWidget^.Client); 1264 gtk_object_set_data(PGTKObject(APIWidget^.Client), 'Main', Result); 1265 gtk_widget_show(APIWidget^.Client); 1266 gtk_container_add(PGTKContainer(APIWidget), APIWidget^.Client); 1267end; 1268 1269procedure GTKAPIWidget_CreateCaret(APIWidget: PGTKAPIWidget; 1270 AWidth, AHeight: Integer; ABitmap: PGDKPixmap); 1271begin 1272 if APIWidget = nil 1273 then begin 1274 DebugLn('WARNING: [GTKAPIWidget_CreateCaret] Got nil client'); 1275 Exit; 1276 end; 1277 GTKAPIWidgetClient_CreateCaret(PGTKAPIWidgetClient(APIWidget^.Client), 1278 AWidth, AHeight, ABitmap); 1279end; 1280 1281procedure GTKAPIWidget_DestroyCaret(APIWidget: PGTKAPIWidget); 1282begin 1283 if APIWidget = nil 1284 then begin 1285 DebugLn('WARNING: [GTKAPIWidget_DestroyCaret] Got nil client'); 1286 Exit; 1287 end; 1288 GTKAPIWidgetClient_DestroyCaret(PGTKAPIWidgetClient(APIWidget^.Client)); 1289end; 1290 1291procedure GTKAPIWidget_InvalidateCaret(APIWidget: PGTKAPIWidget); 1292begin 1293 {$IFDEF VerboseCaret} 1294 DebugLn('[GTKAPIWidget_InvalidateCaret] A'); 1295 {$ENDIF} 1296 if APIWidget = nil 1297 then begin 1298 DebugLn('WARNING: [GTKAPIWidget_InvalidateCaret] Got nil client'); 1299 Exit; 1300 end; 1301 GTKAPIWidgetClient_InvalidateCaret(PGTKAPIWidgetClient(APIWidget^.Client)); 1302end; 1303 1304procedure GTKAPIWidget_HideCaret(APIWidget: PGTKAPIWidget; 1305 var OldVisible: boolean); 1306begin 1307 {$IFDEF VerboseCaret} 1308 DebugLn('[GTKAPIWidget_HideCaret] A'); 1309 {$ENDIF} 1310 if APIWidget = nil 1311 then begin 1312 DebugLn('WARNING: [GTKAPIWidget_HideCaret] Got nil client'); 1313 Exit; 1314 end; 1315 GTKAPIWidgetClient_HideCaret(PGTKAPIWidgetClient(APIWidget^.Client),OldVisible); 1316end; 1317 1318procedure GTKAPIWidget_ShowCaret(APIWidget: PGTKAPIWidget); 1319begin 1320 {$IFDEF VerboseCaret} 1321 DebugLn('[GTKAPIWidget_ShowCaret] A'); 1322 {$ENDIF} 1323 if APIWidget = nil 1324 then begin 1325 DebugLn('WARNING: [GTKAPIWidget_ShowCaret] Got nil client'); 1326 Exit; 1327 end; 1328 GTKAPIWidgetClient_ShowCaret(PGTKAPIWidgetClient(APIWidget^.Client)); 1329end; 1330 1331procedure GTKAPIWidget_SetCaretPos(APIWidget: PGTKAPIWidget; X, Y: Integer); 1332begin 1333 {$IFDEF VerboseCaret} 1334 DebugLn('[GTKAPIWidget_SetCaretPos] A'); 1335 {$ENDIF} 1336 if APIWidget = nil 1337 then begin 1338 DebugLn('WARNING: [GTKAPIWidget_SetCaretPos] Got nil client'); 1339 Exit; 1340 end; 1341 GTKAPIWidgetClient_SetCaretPos(PGTKAPIWidgetClient(APIWidget^.Client), X, Y); 1342end; 1343 1344procedure GTKAPIWidget_GetCaretPos(APIWidget: PGTKAPIWidget; var X, Y: Integer); 1345begin 1346 if APIWidget = nil 1347 then begin 1348 DebugLn('WARNING: [GTKAPIWidget_GetCaretPos] Got nil client'); 1349 Exit; 1350 end; 1351 GTKAPIWidgetClient_GetCaretPos(PGTKAPIWidgetClient(APIWidget^.Client), X, Y); 1352end; 1353 1354procedure GTKAPIWidget_SetCaretRespondToFocus(APIWidget: PGTKAPIWidget; 1355 ShowHideOnFocus: boolean); 1356begin 1357 {$IFDEF VerboseCaret} 1358 DebugLn(['[GTKAPIWidget_SetCaretRespondToFocus] A ',ShowHideOnFocus]); 1359 {$ENDIF} 1360 if APIWidget = nil 1361 then begin 1362 DebugLn('WARNING: [GTKAPIWidget_SetCaretRespondToFocus] Got nil client'); 1363 Exit; 1364 end; 1365 GTKAPIWidgetClient_SetCaretRespondToFocus( 1366 PGTKAPIWidgetClient(APIWidget^.Client), ShowHideOnFocus); 1367end; 1368 1369procedure GTKAPIWidget_GetCaretRespondToFocus(APIWidget: PGTKAPIWidget; 1370 var ShowHideOnFocus: boolean); 1371begin 1372 if APIWidget = nil 1373 then begin 1374 DebugLn('WARNING: [GTKAPIWidget_GetCaretRespondToFocus] Got nil client'); 1375 Exit; 1376 end; 1377 GTKAPIWidgetClient_GetCaretRespondToFocus( 1378 PGTKAPIWidgetClient(APIWidget^.Client), ShowHideOnFocus); 1379end; 1380 1381initialization 1382 MParentClass := nil; 1383 1384end. 1385 1386 1387