1{%MainUnit gtk2proc.pp} 2{ 3 ***************************************************************************** 4 This file is part of the Lazarus Component Library (LCL) 5 6 See the file COPYING.modifiedLGPL.txt, included in this distribution, 7 for details about the license. 8 ***************************************************************************** 9} 10 11function DoDeliverPaintMessage(const Target: TObject; var PaintMsg: TLMPaint): PtrInt; 12var 13 WidgetInfo: PWidgetInfo; 14 IsCustomControl: Boolean; 15begin 16 { 17 erase backgound of custom controls 18 use only for real custom controls that are GTKAPIWidget 19 } 20 IsCustomControl := TObject(Target) is TCustomControl; 21 if IsCustomControl then begin 22 Include(TWinControlAccess(Target).FWinControlFlags, wcfEraseBackground); 23 TWinControl(Target).Perform(LM_ERASEBKGND, PtrInt(PaintMsg.DC), 0); 24 Exclude(TWinControlAccess(Target).FWinControlFlags, wcfEraseBackground); 25 end; 26 27 Result := DeliverMessage(Target, PaintMsg); 28 29 if IsCustomControl then begin 30 WidgetInfo := GetWidgetInfo({%H-}PGtkWidget(TCustomControl(Target).Handle)); 31 if WidgetInfo <> nil then 32 WidgetInfo^.UpdateRect := Rect(0,0,0,0); 33 end; 34end; 35 36function DeliverPaintMessage(const Target: Pointer; var TheMessage): GBoolean; 37var 38 PaintMsg: TLMPaint; 39begin 40 if TLMessage(TheMessage).Msg = LM_GTKPAINT then 41 PaintMsg := GtkPaintMessageToPaintMessage(TLMGtkPaint(TheMessage), True) 42 else 43 PaintMsg := TLMPaint(TheMessage); 44 45 Result := DoDeliverPaintMessage(TObject(Target), PaintMsg) = 0; 46 47 FinalizePaintMessage(PLMessage(@PaintMsg)); 48end; 49 50{------------------------------------------------------------------------------- 51 function DeliverPostMessage(const Target: Pointer; var TheMessage): GBoolean; 52 53 'TheMessage' is in TLMessage format. Don't confuse this with tagMsg. 54--------------------------------------------------------------------------------} 55function DeliverPostMessage(const Target: Pointer; var TheMessage): GBoolean; 56begin 57 if TObject(Target) is TWinControl then 58 begin 59 // convert TLMessage into a tagMsg and push on the message queue 60 Result := PostMessage(TWinControl(Target).Handle, 61 TLMessage(TheMessage).Msg, 62 TLMessage(TheMessage).WParam, 63 TLMessage(TheMessage).LParam 64 ); 65 end 66 else 67 begin 68 if TLMessage(TheMessage).Msg <> LM_GTKPAINT then 69 Result := DeliverMessage(Target, TheMessage) = 0 70 else 71 Result := DeliverPaintMessage(Target, TheMessage); 72 end; 73end; 74 75function DeliverGtkPaintMessage(Target: Pointer; Widget: PGtkWidget; 76 Area: PGDKRectangle; RepaintAll, IsAfterGtk: boolean): GBoolean; 77var 78 Msg: TLMGtkPaint; 79 AInfo: PWidgetInfo; 80begin 81 //DebugLn(['DeliverGtkPaintMessage ',DbgSName(TObject(Target)),' Widget=',GetWidgetDebugReport(Widget),' RepaintAll=',RepaintAll,' AfterGtk=',IsAfterGtk,' Area=',dbgs(Area)]); 82 // default is, that a control receives the paint message after gtk (including the child paints) 83 // In case of TCustomControl, there is no gtk painting only the 84 // child paintings. Let the TCustomControl paint the background. 85 // ToDo: Eventually there must be a 'before paint message'. 86 87 if (TObject(Target) is TCustomForm) then 88 begin 89 AInfo := GetWidgetInfo(Widget); 90 AInfo^.FirstPaint := True; 91 end; 92 93 if IsAfterGtk then 94 begin 95 if TObject(Target) is TCustomControl then exit(false); 96 end else 97 begin 98 if not (TObject(Target) is TCustomControl) then exit(false); 99 end; 100 101 if (not RepaintAll) and ((Area^.Width<1) or (Area^.Height<1)) then exit(false); 102 103 Msg.Msg := LM_GTKPAINT; 104 Msg.Data := TLMGtkPaintData.Create; 105 Msg.Data.Widget := Widget; 106 Msg.Data.State := GtkPaint_LCLWidget; 107 Msg.Data.Rect := Bounds(Area^.x, Area^.y, Area^.Width, Area^.Height); 108 Msg.Data.RepaintAll := RepaintAll; 109 110 // the gtk2 has a working double buffering and expose event area 111 Result := DeliverPaintMessage(Target, Msg); 112end; 113 114procedure EventTrace(const TheMessage : string; data : pointer); 115begin 116// if Data = nil then 117 //DebugLn(Format('Trace:Event [%s] fired',[Themessage])) 118// else 119 //DebugLn(Format('Trace:Event [%s] fired for %s', 120 // [TheMessage, TObject(data).Classname])); 121end; 122 123{*************************************************************} 124{ callback routines } 125{*************************************************************} 126 127{------------------------------------------------------------------------------- 128 function gtkNoteBookCloseBtnClicked 129 Params: Widget: PGtkWidget; Data: Pointer 130 Result: GBoolean 131 132 gtkNoteBookCloseBtnClicked is called by the gtk, whenever a close button in 133 the tab of a notebook page is clicked. 134-------------------------------------------------------------------------------} 135function gtkNoteBookCloseBtnClicked({%H-}Widget: PGtkWidget; 136 Data: Pointer): GBoolean; cdecl; 137var APage: TCustomPage; 138begin 139 Result:=true; // handled = true 140 if ComponentIsDestroyingHandle(TWinControl(Data)) then exit; 141 APage:=TCustomPage(Data); 142 TCustomTabControl(APage.Parent).DoCloseTabClicked(APage); 143end; 144 145function FilterFuc({%H-}xevent: PGdkXEvent; {%H-}event: PGdkEvent; {%H-}data: gpointer): TGdkFilterReturn; cdecl; 146{$ifdef windows} 147var 148 AForm: TCustomForm absolute data; 149{$endif} 150begin 151 Result := GDK_FILTER_CONTINUE; 152 {$ifdef windows} 153 if (PMSG(xevent)^.message = WM_NCLBUTTONDOWN) and 154 (PMSG(xevent)^.wParam = HTCAPTION) and 155 not (csDesigning in AForm.ComponentState) and 156 (TWinControlAccess(TWinControl(AForm)).DragKind = dkDock) and 157 (TWinControlAccess(TWinControl(AForm)).DragMode = dmAutomatic) then 158 begin 159 AForm.BeginDrag(True); 160 Result := GDK_FILTER_REMOVE; 161 end; 162 {$endif} 163end; 164 165{------------------------------------------------------------------------------- 166 function GTKRealizeCB 167 Params: Widget: PGtkWidget; Data: Pointer 168 Result: GBoolean 169 170 GTKRealizeCB is called by the gtk, whenever a widget is realized (ie mapped), 171 but before the widget itself gets the realize signal. 172 That means that the gdk window on the xserver has been created. 173-------------------------------------------------------------------------------} 174function gtkRealizeCB(Widget: PGtkWidget; Data: Pointer): GBoolean; cdecl; 175var 176 decor,Func : Longint; 177 TheWindow: PGdkWindow; 178 TheForm: TCustomForm; 179begin 180 Result := CallBackDefaultReturn; 181 182 {$IFDEF EventTrace} 183 EventTrace('realize', nil); 184 {$ENDIF} 185 186 if (Data<>nil) then begin 187 if TObject(Data) is TCustomForm then begin 188 TheForm:=TCustomForm(Data); 189 if TheForm.Parent=nil then begin 190 TheWindow:=gtk_widget_get_toplevel(Widget)^.window; 191 192 //apart from none and sizeable, this will 193 //only work if WM supports motif flags 194 //properly, which very few actually do. 195 196 Decor := GetWindowDecorations(TheForm); 197 Func := GetWindowFunction(TheForm); 198 199 gdk_window_set_decorations(TheWindow, decor); 200 gdk_window_set_functions(TheWindow, func); 201 {$ifdef windows} // for drag/dock 202 gdk_window_add_filter(TheWindow, @FilterFuc, TheForm) 203 {$endif} 204 end; 205 end; 206 207 if (csDesigning in TComponent(Data).ComponentState) then begin 208 //DebugLn(['gtkRealizeCB ',dbgsName(TComponent(Data)),' ',GetWidgetDebugReport(Widget)]); 209 end else begin 210 RealizeAccelerator(TComponent(Data),Widget); 211 end; 212 end; 213end; 214 215{------------------------------------------------------------------------------- 216 function GTKRealizeAfterCB 217 Params: Widget: PGtkWidget; Data: Pointer 218 Result: GBoolean 219 220 GTKRealizeAfterCB is called by the gtk, whenever a widget is realized 221 (ie mapped), and after the widget itself got the realize signal. 222 That means that the gdk window on the xserver has been created and the widget 223 initialized the gdkwindow. This function is used for the second part of 224 the initialization of a widget. 225 226-------------------------------------------------------------------------------} 227function gtkRealizeAfterCB(Widget: PGtkWidget; Data: Pointer): GBoolean; cdecl; 228var 229 MainWidget, ClientWidget: PGtkWidget; 230 WinWidgetInfo: PWidgetInfo; 231 GdkWidget, GdkClient: PGDKWindow; 232 NewEventMask: TGdkEventMask; 233 LCLObject: TObject; 234 TheWinControl: TWinControl; 235begin 236 Result:=CallBackDefaultReturn; 237 if Data=nil then ; 238 {$IFDEF EventTrace} 239 EventTrace('realizeafter', nil); 240 {$ENDIF} 241 MainWidget:=GetMainWidget(Widget); 242 Assert(Assigned(MainWidget), 'gtkRealizeAfterCB: MainWidget not assigned.'); 243 WinWidgetInfo:=g_object_get_data(PGObject(MainWidget), 'widgetinfo'); 244 Assert(Assigned(WinWidgetInfo), 'gtkRealizeAfterCB: WinWidgetInfo not assigned.'); 245 LCLObject:=GetLCLObject(MainWidget); 246 if LCLObject=nil then exit; 247 if (LCLObject is TWinControl) then 248 TheWinControl:=TWinControl(LCLObject) 249 else 250 TheWinControl:=nil; 251 252 // set extra signal masks after the widget window is created 253 // define extra events we're interrested in 254 //if TheWinControl<>nil then DbgOut(' ',TheWinControl.Name,':',TheWinControl.ClassName,' ',DbgS(TheWinControl.Handle)); 255 //DebugLn(' Widget=',DbgS(Widget),' Fixed=',DbgS(GetFixedWidget(Widget)),' Main=',DbgS(GetMainWidget(Widget))); 256 if (TheWinControl<>nil) then begin 257 //DebugLn(['gtkRealizeAfterCB ',GetWidgetDebugReport(Widget)]); 258 {$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF} 259 260 GdkWidget:=GetControlWindow(Widget); 261 NewEventMask:=gdk_window_get_events(GdkWidget) or WinWidgetInfo^.EventMask; 262 gtk_widget_add_events(Widget,NewEventMask); 263 gdk_window_set_events(GdkWidget,NewEventMask); 264 265 ClientWidget:=GetFixedWidget(Widget); 266 GdkClient:=GetControlWindow(ClientWidget); 267 if (ClientWidget<>nil) and (GdkClient<>nil) and (GdkClient<>GdkWidget) then 268 begin 269 //DebugLn(['gtkRealizeAfterCB ClientWindow<>Window']); 270 NewEventMask:=gdk_window_get_events(GdkClient) or WinWidgetInfo^.EventMask; 271 gtk_widget_add_events(ClientWidget,WinWidgetInfo^.EventMask); 272 gdk_window_set_events(GdkClient,NewEventMask); 273 end; 274 //DebugLn('BBB1 ',DbgS(NewEventMask),8),' ',DbgS(Cardinal(gdk_window_get_events(Widget^.Window))); 275 {$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF} 276 end; 277 278 if TheWinControl<>nil then 279 begin 280 TheWinControl.CNPreferredSizeChanged; 281 TGtkPrivateWidgetClass(TheWinControl.WidgetSetClass.WSPrivate).UpdateCursor(WinWidgetInfo); 282 ConnectInternalWidgetsSignals(MainWidget,TheWinControl); 283 284 if (TheWinControl is TCustomPage) 285 and not ((TheWinControl.Parent <> nil) and (TheWinControl.Parent is TTabControl)) 286 then 287 UpdateNotebookPageTab(nil,TheWinControl); 288 289 if TheWinControl is TCustomForm then 290 SetFormShowInTaskbar(TCustomForm(TheWinControl), 291 TCustomForm(TheWinControl).ShowInTaskbar); 292 end; 293end; 294 295function gtkshowCB( {%H-}widget: PGtkWidget; data: gPointer) : GBoolean; cdecl; 296var 297 Mess : TLMShowWindow; 298begin 299 Result := True; 300 301 {$IFDEF EventTrace} 302 EventTrace('show', data); 303 {$ENDIF} 304 FillChar(Mess{%H-},SizeOf(Mess),0); 305 Mess.Msg := LM_SHOWWINDOW; 306 Mess.Show := True; 307 308 Result := DeliverMessage(Data, Mess) = 0; 309end; 310 311function gtkHideCB( {%H-}widget: PGtkWidget; data: gPointer) : GBoolean; cdecl; 312var 313 Mess : TLMShowWindow; 314begin 315 Result := True; 316 317 {$IFDEF EventTrace} 318 EventTrace('hide', data); 319 {$ENDIF} 320 FillChar(Mess{%H-},SizeOf(Mess),0); 321 Mess.Msg := LM_SHOWWINDOW; 322 Mess.Show := False; 323 Result := DeliverMessage(Data, Mess) = 0; 324end; 325 326function gtkactivateCB(widget: PGtkWidget; data: gPointer) : GBoolean; cdecl; 327var 328 Mess: TLMActivate; 329begin 330 Result:= True; 331 {$IFDEF EventTrace} 332 EventTrace('activate', data); 333 {$ENDIF} 334 335 ResetDefaultIMContext; 336 337 if LockOnChange(PgtkObject(Widget),0) > 0 then Exit; 338 339 FillChar(Mess{%H-}, SizeOf(Mess), #0); 340 {$IFDEF VerboseIDEDisplayState} 341 debugln(['gtkactivateCB ',DbgSName(TObject(Data))]); 342 {$ENDIF} 343 Mess.Msg := LM_ACTIVATE; 344 Mess.Active := WA_ACTIVE; 345 Mess.Minimized := False; 346 if GtkWidgetIsA(Widget, gtk_window_get_type) then 347 Mess.ActiveWindow := HWnd({%H-}PtrUInt(PGTKWindow(Widget)^.focus_widget)) 348 else 349 Mess.ActiveWindow := 0; 350 Mess.Result := 0; 351 //DebugLn('gtkactivateCB ',DbgSName(TObject(Data))); 352 DeliverMessage(Data, Mess); 353 354 Result := CallBackDefaultReturn; 355end; 356 357function GTKCheckMenuToggeledCB(AMenuItem: PGTKCheckMenuItem; AData: gPointer): GBoolean; cdecl; 358// AData --> LCLMenuItem 359var 360 LCLMenuItem: TMenuItem; 361begin 362 Result := CallBackDefaultReturn; 363 {$IFDEF EventTrace} 364 EventTrace('toggled', AData); 365 {$ENDIF} 366 367 LCLMenuItem := TMenuItem(AData); 368 // some sanity checks 369 if LCLMenuItem = nil then Exit; 370 if not LCLMenuItem.IsCheckItem then Exit; // ??? 371 372 // the gtk always toggles the check flag 373 // -> restore 'checked' flag if needed 374 if gtk_check_menu_item_get_active(AMenuItem) = LCLMenuItem.Checked then Exit; 375 if LCLMenuItem.AutoCheck then Exit; 376 377 // restore it 378 LockOnChange(PgtkObject(AMenuItem), +1); 379 gtk_check_menu_item_set_active(AMenuItem, LCLMenuItem.Checked); 380 LockOnChange(PgtkObject(AMenuItem), -1); 381end; 382 383function gtkchangedCB( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl; 384var 385 Mess : TLMessage; 386begin 387 Result := CallBackDefaultReturn; 388 389 if ComponentIsDestroyingHandle(TWinControl(Data)) 390 or (LockOnChange(PgtkObject(Widget),0)>0) then exit; 391 392 {$IFDEF EventTrace} 393 EventTrace('changed', data); 394 {$ENDIF} 395 FillChar(Mess{%H-}, SizeOf(Mess), 0); 396 Mess.Msg := LM_CHANGED; 397 DeliverMessage(Data, Mess); 398end; 399 400function GtkEntryDelayCursorPos(AGtkWidget: Pointer): GBoolean; cdecl; 401var 402 Info: PWidgetInfo; 403begin 404 Result := AGtkWidget <> nil; 405 if Result then 406 begin 407 g_idle_remove_by_data(AGtkWidget); 408 Info := GetWidgetInfo(AGtkWidget); 409 if Info <> nil then 410 gtkchanged_editbox(PGtkWidget(AGtkWidget), 411 Info^.LCLObject); 412 end; 413end; 414 415function postpone_changed_signal(Widget: PGtkWidget): GBoolean; cdecl; 416begin 417 Result := gtk_false; 418 g_object_set_data(PGObject(Widget), 'lcl-postpone-changed-signal', nil); 419 gtkchanged_editbox(Widget, GetWidgetInfo(Widget)^.LCLObject); 420end; 421 422procedure gtkchanged_editbox_delete_text(Widget: PGtkWidget; AStartPos, 423 AEndPos: gint; data: gPointer); cdecl; 424var 425 id: gPointer; 426begin 427 // delete key pressed, but nothing is deleted (eg. cursor at the end or empty text) 428 if AStartPos = AEndPos then 429 begin 430 g_signal_stop_emission_by_name(Widget, 'delete-text'); 431 Exit; 432 end; 433 434 id := g_object_get_data(PGObject(Widget), 'lcl-postpone-changed-signal'); 435 if id = nil then 436 begin 437 {%H-}PtrUInt(id) := g_idle_add(TGtkFunction(@postpone_changed_signal), Widget); 438 g_object_set_data(PGObject(Widget), 'lcl-postpone-changed-signal', id); 439 end; 440end; 441 442procedure gtkchanged_editbox_insert_text(Widget: PGtkWidget; ANewText: PgChar; 443 ANewTextLength: gint; APosition: pgint; data: gPointer); cdecl; 444var 445 id: gPointer; 446 EntryText: PgChar; 447 LCLObject: TObject; 448begin 449 EntryText := gtk_entry_get_text(PGtkEntry(Widget)); 450 LCLObject := TObject(data); 451 if (widget <> nil) and (LCLObject is TCustomEdit) then 452 { NumbersOnly: stop signal if inserted text is not a number } 453 if TCustomEdit(LCLObject).NumbersOnly and not IsNumber(ANewText) then 454 begin 455 gtk_entry_set_text(PGtkEntry(widget), EntryText); 456 g_signal_stop_emission_by_name(Widget, 'insert-text'); 457 end; 458 459 id := g_object_get_data(PGObject(Widget), 'lcl-postpone-changed-signal'); 460 if id <> nil then 461 begin 462 g_source_remove({%H-}PtrUInt(id)); 463 g_object_set_data(PGObject(Widget), 'lcl-postpone-changed-signal', nil); 464 end; 465 if LockOnChange(PgtkObject(Widget), 0) > 0 then 466 g_object_set_data(PGObject(Widget), 'lcl-lock-changed-signal', gPointer(-1)) 467 else 468 g_object_set_data(PGObject(Widget), 'lcl-lock-changed-signal', nil); 469end; 470 471function gtkchanged_editbox( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl; 472var 473 Mess : TLMessage; 474 GStart, GEnd: gint; 475 EntryText: PgChar; 476begin 477 //debugln('gtkchanged_editbox'); 478 Result := CallBackDefaultReturn; 479 480 if g_object_get_data(PGObject(Widget), 'lcl-lock-changed-signal') <> nil then 481 begin 482 g_object_set_data(PGObject(Widget), 'lcl-lock-changed-signal', nil); 483 Exit; 484 end; 485 if g_object_get_data(PGObject(Widget), 'lcl-postpone-changed-signal') <> nil then 486 Exit; 487 if LockOnChange(PgtkObject(Widget),0)>0 then exit; 488 {$IFDEF EventTrace} 489 EventTrace('changed_editbox', data); 490 {$ENDIF} 491 if GTK_IS_ENTRY(Widget) then 492 begin 493 {cheat GtkEditable to update cursor pos in gtkEntry. issue #7243} 494 gtk_editable_get_selection_bounds(PGtkEditable(Widget), @GStart, @GEnd); 495 EntryText := gtk_entry_get_text(PGtkEntry(Widget)); 496 if (GStart = GEnd) and 497 (UTF8Length(EntryText) >= PGtkEntry(Widget)^.text_length) then 498 begin 499 if g_object_get_data(PGObject(Widget),'lcl-gtkentry-pasted-data') <> nil then 500 begin 501 g_object_set_data(PGObject(Widget),'lcl-gtkentry-pasted-data',nil); 502 gtk_editable_set_position(PGtkEditable(Widget), GStart); 503 end else 504 begin 505 g_object_set_data(PGObject(Widget),'lcl-gtkentry-pasted-data',Widget); 506 g_idle_add(@GtkEntryDelayCursorPos, Widget); 507 exit; 508 end; 509 end; 510 end; 511 512 FillByte(Mess{%H-},SizeOf(Mess),0); 513 Mess.Msg := CM_TEXTCHANGED; 514 //debugln('gtkchanged_editbox B: DeliverMessage(CM_TextChanged)'); 515 DeliverMessage(Data, Mess); 516end; 517 518function gtkchanged_editbox_delete(widget: PGtkWidget; 519 AType: TGtkDeleteType; APos: gint; data: gPointer): GBoolean; cdecl; 520begin 521 Result := CallBackDefaultReturn; 522end; 523 524function gtkpaste_editbox(Widget: PGtkWidget; data: gPointer): GBoolean; cdecl; 525var 526 FClipText: string; 527 FClip: gtk2.PGtkClipboard; 528 LCLObject: TObject; 529begin 530 Result := CallBackDefaultReturn; 531 532 LCLObject := TObject(data); 533 if (widget <> nil) and (LCLObject is TCustomEdit) then 534 { NumbersOnly } 535 if TCustomEdit(LCLObject).NumbersOnly then 536 begin 537 { get clipboard text and stop signal if pasted text is not a number } 538 FClipText := ''; 539 FClip := gtk_clipboard_get(GDK_SELECTION_CLIPBOARD); 540 if (FClip <> nil) and gtk_clipboard_wait_is_text_available(FClip) then 541 FClipText := gtk_clipboard_wait_for_text(FClip); 542 if Assigned(FClip) and not IsNumber(FClipText) then 543 g_signal_stop_emission_by_name(Widget, 'paste-clipboard'); 544 end; 545end; 546 547function gtkdaychanged(Widget: PGtkWidget; data: gPointer) : GBoolean; cdecl; 548var 549 MSG: TLMessage; 550begin 551 Result := CallBackDefaultReturn; 552 553 if LockOnChange(PgtkObject(Widget),0)>0 then exit; 554 EventTrace('day changed', data); 555 MSG.Msg := LM_DAYCHANGED; 556 DeliverPostMessage(Data, MSG); 557 558 Result := CallBackDefaultReturn; 559end; 560 561function gtktoggledCB( widget: PGtkWidget; data: gPointer): GBoolean; cdecl; 562var 563 Mess : TLMessage; 564 565 procedure ChangeCheckbox(AGrayed,AChecked: boolean); 566 begin 567 LockOnChange(PgtkObject(Widget),1); 568 gtk_toggle_button_set_Inconsistent(PGtkToggleButton(Widget), AGrayed); 569 gtk_toggle_button_set_active(PGtkToggleButton(Widget), AChecked); 570 LockOnChange(PgtkObject(Widget),-1); 571 end; 572 573begin 574 //DebugLn('gtktoggledCB ',DbgSName(TObject(Data))); 575 Result := CallBackDefaultReturn; 576 {$IFDEF EventTrace} 577 EventTrace('toggled', data); 578 {$ENDIF} 579 if LockOnChange(PgtkObject(Widget),0) > 0 then Exit; 580 581 if GtkWidgetIsA(Widget,gtk_toggle_button_get_type) then begin 582 583 if TObject(Data) is TCustomCheckbox then begin 584 if gtk_toggle_button_get_inconsistent(PGtkToggleButton(Widget)) then 585 ChangeCheckbox(false, true) 586 else 587 if TCustomCheckbox(Data).AllowGrayed and 588 gtk_toggle_button_get_active(PGtkToggleButton(Widget)) then 589 ChangeCheckbox(true, false); 590 end; 591 592 end; 593 594 Mess.Msg := LM_CHANGED; 595 Mess.Result := 0; 596 DeliverMessage(Data, Mess); 597 //DebugLn('gtktoggledCB END ',DbgSName(TObject(Data))); 598end; 599 600function gtkExposeEvent(Widget: PGtkWidget; Event : PGDKEventExpose; 601 Data: gPointer): GBoolean; cdecl; 602var 603 DesignOnlySignal: boolean; 604begin 605 Result := CallBackDefaultReturn; 606 {$IFDEF EventTrace} 607 EventTrace('ExposeAfter', data); 608 {$ENDIF} 609 //DebugLn(['gtkExposeEvent ',GetWidgetDebugReport(Widget),' Event^.Count=',Event^.Count]); 610 if (Event^.Count > 0) then exit; 611 612 if not (csDesigning in TComponent(Data).ComponentState) then begin 613 DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstExposeAfter); 614 if DesignOnlySignal then exit; 615 end else begin 616 {$IFDEF VerboseDesignerDraw} 617 DebugLn('gtkExpose', 618 ' Widget=',DbgS(Widget),'=',GetWidgetClassName(Widget), 619 ' ',TComponent(Data).Name, 620 ' ',dbgs(Event^.area.x),',',dbgs(Event^.area.y),',',dbgs(Event^.area.width),',',dbgs(Event^.area.height), 621 ''); 622 {$ENDIF} 623 end; 624 625 //DebugLn(['gtkExposeEvent ',GetWidgetDebugReport(Widget),' ',dbgGRect(@Event^.Area)]); 626 627 DeliverGtkPaintMessage(Data, Widget, @Event^.Area, False, False); 628end; 629 630function gtkExposeEventAfter(Widget: PGtkWidget; Event : PGDKEventExpose; 631 Data: gPointer): GBoolean; cdecl; 632var 633 DesignOnlySignal: boolean; 634 //children: PGList; 635begin 636 Result := CallBackDefaultReturn; 637 {$IFDEF EventTrace} 638 EventTrace('ExposeAfter', data); 639 {$ENDIF} 640 //DebugLn(['gtkExposeEventAfter ',GetWidgetDebugReport(Widget),' Event^.Count=',Event^.Count]); 641 if (Event^.Count > 0) then exit; 642 643 if not (csDesigning in TComponent(Data).ComponentState) then begin 644 DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstExposeAfter); 645 if DesignOnlySignal then exit; 646 end else begin 647 {$IFDEF VerboseDesignerDraw} 648 DebugLn('gtkExposeAfter', 649 ' Widget=',DbgS(Widget),'=',GetWidgetClassName(Widget), 650 ' ',TComponent(Data).Name, 651 ' ',dbgs(Event^.area.x),',',dbgs(Event^.area.y),',',dbgs(Event^.area.width),',',dbgs(Event^.area.height), 652 ''); 653 {$ENDIF} 654 end; 655 656 //DebugLn(['gtkExposeEventAfter ',GetWidgetDebugReport(Widget),' ',dbgGRect(@Event^.Area)]); 657 658 DeliverGtkPaintMessage(Data,Widget,@Event^.Area,false,true); 659end; 660 661procedure ClearTopLevelsFocus(Win: PGtkWidget); 662var 663 List, orgList: PGList; 664 Window: PGtkWindow; 665 event: PGdkEvent; 666 TopLevelWin: PGdkWindow; 667begin 668 669 if not GTK_IS_WINDOW(win) then 670 exit; 671 672 List := gdk_window_get_toplevels; 673 orgList:=List; 674 while List <> nil do 675 begin 676 TopLevelWin := PGdkWindow(List^.Data); 677 if (TopLevelWin<>nil) and (TopLevelWin<>Win^.Window) then 678 begin 679 gdk_window_get_user_data(TopLevelWin, Pgpointer(@Window)); 680 if GTK_IS_WINDOW(Window) 681 and GTK_WIDGET_VISIBLE(Window) 682 and gtk_window_has_TopLevel_Focus(Window) then 683 begin 684 // fake focus-out event 685 {$IFDEF VerboseFocus} 686 DebugLn('NOTE: Window with stalled focus found!, faking focus-out event'); 687 {$ENDIF} 688 event := gdk_event_new(GDK_FOCUS_CHANGE); 689 event^.focus_change.window := TopLevelWin; 690 event^.focus_change._type := GDK_FOCUS_CHANGE; 691 event^.focus_change._in:=0; 692 gtk_main_do_event(event); 693 end; 694 end; 695 list := g_list_next(list); 696 end; 697 if Assigned(orgList) then 698 g_list_free(orgList); 699end; 700 701function gtkfrmactivateAfter({%H-}widget: PGtkWidget; {%H-}Event : PgdkEventFocus; 702 data: gPointer) : GBoolean; cdecl; 703var 704 Mess: TLMActivate; 705 Info: PWidgetInfo; 706{$IFDEF VerboseFocus} 707 LCLObject: TObject; 708 CurFocusWidget: PGtkWidget; 709{$ENDIF} 710begin 711 {$IFDEF EventTrace} 712 EventTrace('activate after', data); 713 {$ENDIF} 714 715 ResetDefaultIMContext; 716 717 FillChar(Mess{%H-},SizeOf(Mess),#0); 718 {$IFDEF VerboseFocus} 719 LCLObject:=TObject(data); 720 DebugLnEnter(['gtkfrmActivateAfter INIT Widget=',DbgS(Widget),' Event^.theIn=',Event^._in, 721 ' LCLObject=',dbgsname(LCLObject)]); 722 CurFocusWidget:=PGtkWidget(GetFocus); 723 if CurFocusWidget<>nil then begin 724 LCLObject:=GetNearestLCLObject(CurFocusWidget); 725 DebugLn(' GetFocus=',DbgS(CurFocusWidget),' ParentLCLObject=',dbgsName(LCLObject)); 726 end; 727 {$ENDIF} 728 729 Info := GetWidgetInfo(Widget); 730 try 731 if (Info <> nil) then 732 Include(Info^.Flags, wwiActivating); 733 {$IFDEF VerboseIDEDisplayState} 734 debugln(['gtkfrmactivateAfter ',DbgSName(TObject(Data))]); 735 {$ENDIF} 736 Mess.Msg := LM_ACTIVATE; 737 Mess.Active := WA_ACTIVE; 738 Mess.Minimized := False; 739 if GtkWidgetIsA(Widget, gtk_window_get_type) then 740 Mess.ActiveWindow := HWnd({%H-}PtrUInt(PGTKWindow(Widget)^.focus_widget)) 741 else 742 Mess.ActiveWindow := 0; 743 Mess.Result := 0; 744 DeliverMessage(Data, Mess); // send message directly (not Post) 745 finally 746 if Info <> nil then 747 Exclude(Info^.Flags, wwiActivating); 748 end; 749 750 Result := CallBackDefaultReturn; 751 {$IFDEF VerboseFocus} 752 DebugLnExit('gtkfrmActivateAfter DONE'); 753 {$ENDIF} 754end; 755 756function gtkfrmdeactivateAfter( {%H-}widget: PGtkWidget; {%H-}Event : PgdkEventFocus; 757 data: gPointer) : GBoolean; cdecl; 758var 759 Mess: TLMActivate; 760 Info: PWidgetInfo; 761{$IFDEF VerboseFocus} 762 LCLObject: TControl; 763{$ENDIF} 764begin 765 {$IFDEF EventTrace} 766 EventTrace('deactivate after', data); 767 {$ENDIF} 768 {$IFDEF VerboseFocus} 769 LCLObject := TControl(GetLCLObject(Widget)); 770 DebugLnEnter(['gtkfrmDeactivate INIT Widget=',DbgS(Widget),' ',Event^._in, 771 ' GetFocus=',DbgS(Widget),' LCLObject=', dbgsName(LCLObject)]); 772 {$ENDIF} 773 ResetDefaultIMContext; 774 775 Info := GetWidgetInfo(Widget); 776 try 777 if (Info<>nil) then 778 Include(Info^.Flags, wwiDeactivating); 779 FillChar(Mess{%H-}, SizeOf(Mess), #0); 780 {$IFDEF VerboseIDEDisplayState} 781 debugln(['gtkfrmdeactivateAfter ',DbgSName(TObject(Data))]); 782 {$ENDIF} 783 Mess.Msg := LM_ACTIVATE; 784 Mess.Active := WA_INACTIVE; 785 Mess.Minimized := False; 786 Mess.ActiveWindow := 0; 787 Mess.Result := 0; 788 DeliverMessage(Data, Mess); 789 finally 790 if Info<>nil then 791 Exclude(Info^.Flags, wwiDeactivating); 792 end; 793 794 Result := CallBackDefaultReturn; 795 {$IFDEF VerboseFocus} 796 DebugLnExit('gtkfrmDeactivate DONE'); 797 {$ENDIF} 798end; 799 800function GTKKeyPress(Widget: PGtkWidget; Event: PGdkEventKey; Data: gPointer) : GBoolean; cdecl; 801begin 802 Result := HandleGtkKeyUpDown(Widget,Event,Data,true,True,'key-press-event'); 803end; 804 805function GTKKeyPressAfter(Widget: PGtkWidget; Event: pgdkeventkey; Data: gPointer): GBoolean; cdecl; 806begin 807 Result := HandleGtkKeyUpDown(Widget,Event,Data,false,True,'key-press-event'); 808end; 809 810function GTKKeyRelease(Widget: PGtkWidget; Event: PGdkEventKey; Data: gPointer) : GBoolean; cdecl; 811begin 812 Result := HandleGtkKeyUpDown(Widget,Event,Data,true,False,'key-release-event'); 813end; 814 815function GTKKeyReleaseAfter(Widget: PGtkWidget; Event: pgdkeventkey; Data: gPointer): GBoolean; cdecl; 816begin 817 Result := HandleGtkKeyUpDown(Widget,Event,Data,false,False,'key-release-event'); 818end; 819 820 821var 822 NeedShiftUpdateAfterFocus: Boolean; 823 824procedure UpdateShiftState(const KeyStateList: TFPList; const ShiftState: TShiftState); 825 826 procedure UpdateList(const AVKeyCode: Integer; const APressed: Boolean); 827 begin 828 if AVKeyCode = 0 then Exit; 829 if APressed 830 then begin 831 if KeyStateList.IndexOf({%H-}Pointer(PtrUInt(AVKeyCode))) < 0 832 then KeyStateList.Add({%H-}Pointer(PtrUInt(AVKeyCode))); 833 end 834 else begin 835 KeyStateList.Remove({%H-}Pointer(PtrUInt(AVKeyCode))); 836 end; 837 end; 838 839const 840 STATE_MAP: array[0..3] of TShiftStateEnum = ( 841 ssShift, 842 ssCtrl, 843 ssAlt, 844 ssSuper 845 ); 846 VK_MAP: array[0..3] of array[0..2] of Byte = ( 847 // (Main key, alt key 1, alt key 2) to check 848 (VK_SHIFT, VK_LSHIFT, VK_RSHIFT), 849 (VK_CONTROL, VK_LCONTROL, VK_RCONTROL), 850 (VK_MENU, VK_LMENU, VK_RMENU), 851 (VK_LWIN, VK_RWIN, 0) 852 ); 853 854var 855 n: Integer; 856 InState: Boolean; 857begin 858 for n := 0 to High(STATE_MAP) do 859 begin 860 InState := STATE_MAP[n] in ShiftState; 861 UpdateList(VK_MAP[n][0], InState); 862 UpdateList(VK_MAP[n][1], InState); 863 UpdateList(VK_MAP[n][2], InState); 864 end; 865end; 866 867function GTKFocusCB(widget: PGtkWidget; {%H-}event: PGdkEventFocus; data: gPointer): GBoolean; cdecl; 868var 869 Mess : TLMessage; 870 LCLObject: TObject; 871 AForm: TCustomForm; 872{$IFDEF VerboseFocus} 873 CurFocusWidget: PGtkWidget; 874{$ENDIF} 875 Mask: TGdkModifierType; 876 AInfo: PWidgetInfo; 877begin 878 {$IFDEF EventTrace} 879 EventTrace('focus', data); 880 {$ENDIF} 881 //DebugLn('GTKFocusCB ',DbgSName(TObject(Data)),' ',GetWidgetDebugReport(Widget)); 882 883 LCLObject:=TObject(data); 884 885 if (widget<>nil) and GTK_IS_WINDOW(widget) and (LCLObject is TCustomForm) then 886 begin 887 // it's a top level window about to be focused, if we are being focused 888 // because of ALT+TABing to this form, the origin form might be left with 889 // invalid focus information (ALT+TAB doesn't trigger focus-out event on those) 890 ClearTopLevelsFocus(Widget); 891 end; 892 893 NeedShiftUpdateAfterFocus := False; 894 gdk_window_get_pointer(nil, nil, nil, @Mask); 895 UpdateShiftState(GTK2WidgetSet.KeyStateList, GTKEventStateToShiftState(Word(Mask))); 896 897 {$IFDEF VerboseFocus} 898 DebugLnEnter(['GTKFocusCB INIT Widget=',DbgS(Widget),' Event^.theIn=',Event^._in, 899 ' LCLObject=',dbgsName(LCLObject)]); 900 CurFocusWidget:=PGtkWidget(GetFocus); 901 if CurFocusWidget<>nil then begin 902 LCLObject:=GetNearestLCLObject(CurFocusWidget); // NOTE: overrides argument data !!! 903 DebugLn('GetFocus=',DbgS(CurFocusWidget), ' ParentLCLFocus=',DbgsName(LCLObject)); 904 {$IFDEF VerboseSizeMsg} 905 DebugLn(['GTKWindowStateEventCB ',DbgSName(TheForm), 906 ' GTK=',GtkWidth,'x',GtkHeight, 907 ' LCL=',TheForm.Width,'x',TheForm.Height, 908 ' SizeType=',SizeMsg.SizeType-Size_SourceIsInterface,'+Size_SourceIsInterface' 909 ]); 910 {$ENDIF} 911 LCLObject := TObject(Data); // restore original LCLObject 912 end; 913 {$ENDIF} 914 915 if LCLObject is TCustomForm then begin 916 // a form became active 917 // it does not mean: the control focus is switch to the form 918 AForm:=TCustomForm(LCLObject); 919 //debugln(['GTKFocusCBAfter ',DbgSName(AForm),' ',DbgSName(AForm.ActiveControl)]); 920 // the PGtkWindow(Data)^.focus_widget shows the last focus call for this 921 // window. If there is a sub window (e.g. docking), then the focus_widget 922 // of the parent window was not updated, so it can not be used. 923 // The gtk will use, if we let it, which will not follow the LCL focus logic. 924 // Follow the LCL logic: 925 if AForm.ActiveControl<>nil then begin 926 Data:=AForm.ActiveControl; 927 //debugln(['GTKFocusCBAfter ',DbgSName(LCLObject),' send=',event^.send_event,' window=',dbgs(event^.window),' in=',event^._in,' type=',event^._type,' Data=',dbgsname(TObject(Data))]); 928 end; 929 end; 930 931 // we do not show selection (gtk behaviour) when widget is unfocused, 932 // so revert back CursorPos.issues #18164,#21897,#23182 933 if GtkWidgetIsA(Widget, gtk_type_entry) then 934 begin 935 AInfo := GetWidgetInfo(Widget); 936 if AInfo <> nil then 937 begin 938 if (AInfo^.LCLObject is TCustomEdit) 939 and ((AInfo^.CursorPos > 0) or (AInfo^.SelLength > 0)) then 940 begin 941 // gtk_entry_set_position(PGtkEntry(Widget), AInfo^.CursorPos); 942 // gtk_editable_select_region(PGtkEditable(Widget), AInfo^.CursorPos, AInfo^.CursorPos); 943 // do not trigger signals, only update pos for lcl 944 PGtkEntry(Widget)^.current_pos := AInfo^.CursorPos; 945 PGtkEntry(Widget)^.selection_bound := AInfo^.CursorPos + AInfo^.SelLength; 946 end; 947 end; 948 end; 949 950 ResetDefaultIMContext; 951 952 //TODO: fill in old focus 953 FillChar(Mess{%H-}, SizeOf(Mess), 0); 954 Mess.msg := LM_SETFOCUS; 955 DeliverMessage(Data, Mess); 956 957 Result := CallBackDefaultReturn; 958 {$IFDEF VerboseFocus} 959 DebugLnExit('GTKFocusCB DONE'); 960 {$ENDIF} 961end; 962 963function GTKKillFocusCB({%H-}widget: PGtkWidget; {%H-}event:PGdkEventFocus; 964 data: gPointer) : GBoolean; cdecl; 965{$IFDEF VerboseFocus} 966var 967 LCLObject: TObject; 968 CurFocusWidget: PGtkWidget; 969{$ENDIF} 970begin 971 {$IFDEF EventTrace} 972 EventTrace('killfocusCB', data); 973 {$ENDIF} 974 //DebugLn('GTKKillFocusCB ',DbgSName(TObject(Data)),' ',GetWidgetDebugReport(Widget)); 975 {$IFDEF VerboseFocus} 976 NeedShiftUpdateAfternFocus := True; // <- JRA: this doesn't look like simply log !!! 977 LCLObject:=TObject(data); 978 DebugLn(['GTKillFocusCB Widget=',DbgS(Widget),' Event^.theIn=',Event^._in, 979 ' LCLObject=',dbgsName(LCLobject)]); 980 CurFocusWidget:=PGtkWidget(GetFocus); 981 if CurFocusWidget<>nil then begin 982 LCLObject:=GetNearestLCLObject(CurFocusWidget); 983 DebugLn('GTKillFocusCB GetFocus=',dbgs(CurFocusWidget),' ParentLCLObject=',dbgsName(LCLObject)); 984 end; 985 {$ENDIF} 986 Result:=CallBackDefaultReturn; 987end; 988 989function GtkEntryDelayClearCursorPos(AGtkWidget: Pointer): GBoolean; cdecl; 990var 991 Info: PWidgetInfo; 992 p: Pgchar; 993 AStart,AEnd: gint; 994begin 995 Result := (AGtkWidget <> nil) and (GTK_IS_WIDGET(AGtkWidget)); 996 if Result then 997 begin 998 g_idle_remove_by_data(AGtkWidget); 999 Info := GetWidgetInfo(AGtkWidget); 1000 if Info <> nil then 1001 begin 1002 gtk_editable_get_selection_bounds(PGtkEditable(AGtkWidget),@AStart, @AEnd); 1003 p := gtk_editable_get_chars(PGtkEditable(AGtkWidget), AStart, AEnd); 1004 if (AStart <> AEnd) then 1005 gtk_clipboard_set_text(gtk_clipboard_get(GDK_SELECTION_PRIMARY), p, -1); 1006 gtk_editable_select_region(PGtkEditable(AGtkWidget), 0, 0); 1007 g_free(p); 1008 end; 1009 end; 1010end; 1011 1012function GTKKillFocusCBAfter({%H-}widget: PGtkWidget; {%H-}event:PGdkEventFocus; 1013 data: gPointer) : GBoolean; cdecl; 1014var 1015 Mess : TLMessage; 1016 Info: PWidgetInfo; 1017 AStart,AEnd: gint; 1018 AForm: TCustomForm; 1019{$IFDEF VerboseFocus} 1020 LCLObject: TObject; 1021 CurFocusWidget: PGtkWidget; 1022{$ENDIF} 1023begin 1024 {$IFDEF EventTrace} 1025 EventTrace('killfocusCBAfter', data); 1026 {$ENDIF} 1027 //DebugLn('GTKKillFocusCBAfter ',DbgSName(TObject(Data)),' ',GetWidgetDebugReport(Widget)); 1028 {$IFDEF VerboseFocus} 1029 NeedShiftUpdateAfternFocus := True; // <- JRA: this doesn't look like simply log !!! 1030 LCLObject:=TObject(data); 1031 DebugLnEnter(['GTKillFocusCBAfter INIT Widget=',DbgS(Widget),' Event^.theIn=',Event^._in, 1032 ' LCLObject=',dbgsName(LCLObject)]); 1033 CurFocusWidget:=PGtkWidget(GetFocus); 1034 if CurFocusWidget<>nil then begin 1035 LCLObject:=GetNearestLCLObject(CurFocusWidget); 1036 DebugLn('GetFocus=',DbgS(CurFocusWidget),' ParentLCLFocus=', dbgsName(LCLObject)); 1037 end; 1038 {$ENDIF} 1039 1040 ResetDefaultIMContext; 1041 1042 // do not send LM_KILLFOCUS message if widget is destroying itself 1043 if Assigned(Data) and 1044 not ((csDestroying in TComponent(Data).ComponentState) or 1045 (csDestroyingHandle in TControl(Data).ControlState)) then 1046 begin 1047 FillChar(Mess{%H-},SizeOf(Mess),0); 1048 Mess.msg := LM_KILLFOCUS; 1049 // do not release the capture widget here 1050 1051 //TODO: fill in new focus 1052 //DebugLn(Format('Trace:TODO: [gtkkillfocusCB] %s finish', [TObject(Data).ClassName])); 1053 1054 DeliverMessage(Data, Mess); 1055 end; 1056 1057 // do not show selection when widget is unfocused 1058 // issues #18164,#21897,#23182 1059 if GtkWidgetIsA(Widget, gtk_type_entry) and Assigned(Data) then 1060 begin 1061 if (csDestroying in TComponent(Data).ComponentState) or 1062 (csDestroyingHandle in TControl(Data).ControlState) then 1063 begin 1064 // DebugLn('NOTICE: Control is destroying itself, do not add new idle timer for ',dbgsName(TControl(Data))); 1065 exit; 1066 end; 1067 AForm := GetParentForm(TControl(Data)); 1068 if Assigned(AForm) and ((csDestroying in AForm.ComponentState) or 1069 (csDestroyingHandle in AForm.ControlState) or 1070 ((fsModal in AForm.FormState) and (AForm.ModalResult <> mrNone)) ) then 1071 begin 1072 // DebugLn('NOTICE: Parent form is destroying, do not add new idle timer for ',dbgsName(TControl(Data))); 1073 exit; 1074 end; 1075 1076 g_idle_add(@GtkEntryDelayClearCursorPos, Widget); 1077 //save now CursorPos and SelStart in WidgetInfo 1078 if (Widget <> nil) then 1079 begin 1080 Info := GetWidgetInfo(Widget); 1081 if Info <> nil then 1082 begin 1083 if (Info^.LCLObject is TCustomEdit) then 1084 begin 1085 gtk_editable_get_selection_bounds(PGtkEditable(Widget),@AStart, @AEnd); 1086 Info^.CursorPos := Min(AStart, AEnd); 1087 Info^.SelLength := Abs(AEnd - AStart); 1088 end; 1089 end; 1090 end; 1091 end; 1092 1093 Result:=true; 1094 {$IFDEF VerboseFocus} 1095 DebugLnExit('GTKillFocusCBAfter DONE'); 1096 {$ENDIF} 1097end; 1098 1099function GTKWindowStateEventCB(widget: PGtkWidget; 1100 state: PGdkEventWindowState; data: gpointer): gboolean; cdecl; 1101var 1102 TheForm: TCustomForm; 1103 SizeMsg: TLMSize; 1104 GtkWidth: LongInt; 1105 GtkHeight: LongInt; 1106 {$IFDEF HasX} 1107 NetAtom: TGdkAtom; 1108 AtomType: TGdkAtom; 1109 AIndex, ADesktop: pguint; 1110 AFormat: gint; 1111 ALength: gint; 1112 {$ENDIF} 1113begin 1114 Result := CallBackDefaultReturn; 1115 1116 // if iconified in changed then OnIconify... 1117 1118 if GTK_WIDGET_REALIZED(Widget) then 1119 begin 1120 if (GDK_WINDOW_STATE_WITHDRAWN and state^.changed_mask <> 0) 1121 or (GDK_WINDOW_STATE_WITHDRAWN and state^.new_window_state <> 0) then 1122 begin 1123 // visibility changed - this is another message block 1124 Exit; 1125 end; 1126 if TObject(Data) is TCustomForm then 1127 begin 1128 TheForm := TCustomForm(Data); 1129 //DebugLn(['GTKWindowStateEventCB ',DbgSName(TheForm),' new_window_state=',state^.new_window_state,' changed_mask=',state^.changed_mask]); 1130 if TheForm.Parent = nil then begin 1131 // toplevel window 1132 // send a WMSize Message (see TCustomForm.WMSize) 1133 // ToDo: this might be too early to use the Widget^.Allocation 1134 // Either send this message later or find a better way to determine the size (including the client area) 1135 GtkWidth:=Widget^.Allocation.Width; 1136 if GtkWidth<0 then GtkWidth:=0; 1137 GtkHeight:=Widget^.Allocation.Height; 1138 if GtkHeight<0 then GtkHeight:=0; 1139 //debugln('GTKWindowStateEventCB ',DbgSName(TObject(Data)),' ',dbgs(state^.new_window_state),' ',WidgetFlagsToString(Widget)); 1140 if ((GDK_WINDOW_STATE_ICONIFIED and state^.new_window_state)>0) then 1141 begin 1142 {$IFDEF HasX} 1143 NetAtom := gdk_atom_intern('_NET_WM_DESKTOP', True); 1144 if NetAtom > 0 then begin 1145 if gdk_property_get(Widget^.window, NetAtom, XA_CARDINAL, 1146 0, 4, 0, @AtomType, @AFormat, @ALength, @AIndex) 1147 then begin 1148 NetAtom := gdk_atom_intern('_NET_CURRENT_DESKTOP', True); 1149 if gdk_property_get(gdk_get_default_root_window, NetAtom, XA_CARDINAL,0, 4, 0, @AtomType, @AFormat, @ALength, @ADesktop) 1150 then if ADesktop^ <> AIndex^ then begin 1151 // form is not on active desktop => ignore 1152 g_free(ADesktop); 1153 g_free(AIndex); 1154 exit; 1155 end 1156 else begin 1157 g_free(ADesktop); 1158 g_free(AIndex); 1159 end; 1160 end; 1161 end; 1162 {$ENDIF} 1163 SizeMsg.SizeType := SIZE_MINIMIZED; 1164 end 1165 else if (GDK_WINDOW_STATE_MAXIMIZED and state^.new_window_state)>0 then 1166 begin 1167 // it can be both maximized + iconified and just loose iconified state 1168 if (state^.changed_mask and (GDK_WINDOW_STATE_MAXIMIZED or GDK_WINDOW_STATE_ICONIFIED)) = 0 then Exit; 1169 SizeMsg.SizeType := SIZE_MAXIMIZED; 1170 end 1171 else 1172 SizeMsg.SizeType := SIZE_RESTORED; 1173 1174 // don't bother the LCL if nothing changed 1175 case SizeMsg.SizeType of 1176 SIZE_RESTORED: if TheForm.WindowState=wsNormal then exit; 1177 SIZE_MINIMIZED: if TheForm.WindowState=wsMinimized then exit; 1178 SIZE_MAXIMIZED: if TheForm.WindowState=wsMaximized then exit; 1179 SIZE_FULLSCREEN: if TheForm.WindowState=wsFullScreen then exit; 1180 end; 1181 1182 with SizeMsg do 1183 begin 1184 Result := 0; 1185 Msg := LM_SIZE; 1186 SizeType := SizeType+Size_SourceIsInterface; 1187 Width := SmallInt(GtkWidth); 1188 Height := SmallInt(GtkHeight); 1189 end; 1190 {$IFDEF VerboseSizeMsg} 1191 DebugLn(['GTKWindowStateEventCB ',DbgSName(TheForm), 1192 ' GTK=',GtkWidth,'x',GtkHeight, 1193 ' LCL=',TheForm.Width,'x',TheForm.Height, 1194 ' SizeType=',SizeMsg.SizeType-Size_SourceIsInterface,'+Size_SourceIsInterface' 1195 ]); 1196 {$ENDIF} 1197 DeliverMessage(TheForm, SizeMsg); 1198 if (gtk_major_version = 2) and (gtk_minor_version <= 8) and 1199 (TheForm.WindowState = wsMaximized) then 1200 gtk_widget_queue_draw({%H-}PGtkWidget(TheForm.Handle)); 1201 1202 if (TheForm = Application.MainForm) 1203 and (GDK_WINDOW_STATE_ICONIFIED and state^.changed_mask <> 0) then 1204 begin 1205 if GDK_WINDOW_STATE_ICONIFIED and state^.new_window_state <> 0 then 1206 Application.IntfAppMinimize 1207 else 1208 Application.IntfAppRestore; 1209 end; 1210 end; 1211 end; 1212 end; 1213end; 1214 1215 1216function gtkdestroyCB(widget: PGtkWidget; data: gPointer) : GBoolean; cdecl; 1217var 1218 Mess: TLMessage; 1219 Info: PWidgetInfo; 1220begin 1221 Result := CallBackDefaultReturn; 1222 //DebugLn(['gtkdestroyCB ',GetWidgetDebugReport(Widget)]); 1223 1224 Info:=GetWidgetInfo(Widget); 1225 if Info = nil then // this widget is already destroyed 1226 Exit; 1227 1228 if (Data = nil) or (Info^.LCLObject <> TObject(Data)) then // this LCLObject does not use this widget anymore 1229 Exit; 1230 1231 if (TObject(Data) is TWinControl) then 1232 begin 1233 if (not TWinControl(Data).HandleAllocated) then 1234 begin 1235 FreeWidgetInfo(Widget); 1236 Exit; 1237 end else 1238 if ({%H-}PGtkWidget(TWinControl(Data).Handle) <> Widget) then // the TWinControl does not use this widget anymore. 1239 Exit; 1240 end; 1241 1242 {$IFDEF EventTrace} 1243 EventTrace('destroyCB', data); 1244 {$ENDIF} 1245 //DebugLn('gtkdestroyCB Data="',DbgSName(TObject(Data)),'" LCLObject="',DbgSName(Info^.LCLObject),'" ',GetWidgetDebugReport(Widget)); 1246 FillChar(Mess{%H-}, SizeOf(Mess), 0); 1247 Mess.msg := LM_DESTROY; 1248 DeliverMessage(Data, Mess); 1249 1250 // NOTE: if the destroy message is posted 1251 // we should post an info destroy message as well 1252 1253 FreeWidgetInfo(Widget); 1254end; 1255 1256procedure DestroyWindowFromPointCB(Widget: PGtkWidget; data: gPointer); cdecl; 1257begin 1258 if {%H-}PGtkWidget(LastWFPResult) <> Widget then Exit; 1259 LastWFPResult := 0; 1260 LastWFPMousePos := Point(High(Integer), High(Integer)); 1261end; 1262 1263function gtkdeleteCB( {%H-}widget : PGtkWidget; {%H-}event : PGdkEvent; 1264 data : gPointer) : GBoolean; cdecl; 1265var Mess : TLMessage; 1266begin 1267 FillChar(Mess{%H-},SizeOf(Mess),0); 1268 Mess.Msg:= LM_CLOSEQUERY; 1269 { Message results : True - do nothing, False - destroy or hide window } 1270 Result:= DeliverMessage(Data, Mess) = 0; 1271end; 1272 1273function gtkresizeCB( {%H-}widget: PGtkWidget; data: gPointer) : GBoolean; cdecl; 1274//var 1275// Mess : TLMessage; 1276begin 1277 Result := CallBackDefaultReturn; 1278 {$IFDEF EventTrace} 1279 EventTrace('resize', data); 1280 {$ENDIF} 1281// Mess.msg := LM_RESIZE; 1282// TControl(data).WindowProc(TLMessage(Mess)); 1283 //DebugLn('Trace:TODO: [gtkresizeCB] fix (or remove) to new LM_SIZE'); 1284//TObject(data).Dispatch(Mess); 1285end; 1286 1287function gtkMonthChanged({%H-}Widget: PGtkWidget; data: gPointer) : GBoolean; cdecl; 1288var 1289 Mess: TLMessage; 1290begin 1291 Result := CallBackDefaultReturn; 1292 {$IFDEF EventTrace} 1293 EventTrace('month changed', data); 1294 {$ENDIF} 1295 FillChar(Mess{%H-},SizeOf(Mess),0); 1296 Mess.Msg := LM_MONTHCHANGED; 1297 DeliverPostMessage(Data, Mess); 1298 1299 Result := CallBackDefaultReturn; 1300end; 1301 1302{------------------------------------------------------------------------------- 1303 procedure DeliverMouseMoveMessage(Widget:PGTKWidget; Event: PGDKEventMotion; 1304 AWinControl: TWinControl); 1305 1306 Translate a gdk mouse motion event into a LCL mouse move message and send it. 1307 1308 Mouse coordinate mapping: 1309 1310 Why mapping: 1311 An lcl control can consists of several gtk widgets, and any message to them is 1312 send to the lcl control. The gtk sends the coordinates relative to the 1313 emitting gdkwindow (not relative to the gtkwidget). And the area of a lcl 1314 control can belong to several gdkwindows. Therefore the mouse coordinates must 1315 be mapped. 1316 1317 What the lcl expects: 1318 For Delphi compatibility the mouse coordinates must be relative to the client 1319 area of the control. 1320 That means for example if the mouse is over the top-left pixel of the client 1321 widget (mostly a gtkfixed widget), then 0,0 is send. 1322 If the mouse is on the top-left pixel of the container widget then the 1323 coordinates can be negative, if there is frame around the client area. 1324-------------------------------------------------------------------------------} 1325procedure DeliverMouseMoveMessage(Widget: PGTKWidget; Event: PGDKEventMotion; 1326 AWinControl: TWinControl); 1327var 1328 Msg: TLMMouseMove; 1329 ShiftState: TShiftState; 1330 MappedXY: TPoint; 1331begin 1332 CheckTransparentWindow({%H-}TLCLIntfHandle(widget), AWinControl); 1333 if (widget=nil) or (AWinControl=nil) then 1334 Exit; 1335 1336 MappedXY := TranslateGdkPointToClientArea(Event^.Window, 1337 Point(TruncToInt(Event^.X), TruncToInt(Event^.Y)), 1338 {%H-}PGtkWidget(AWinControl.Handle)); 1339 MappedXY := SubtractScoll({%H-}PGtkWidget(AWinControl.Handle), MappedXY); 1340 1341 ShiftState := GTKEventStateToShiftState(Event^.State); 1342 with Msg do 1343 begin 1344 Msg := LM_MouseMove; 1345 1346 XPos := MappedXY.X; 1347 YPos := MappedXY.Y; 1348 1349 Keys := ShiftStateToKeys(ShiftState); 1350 1351 Result := 0; 1352 end; 1353 1354 // send the message directly to the LCL 1355 // (Posting the message via queue 1356 // has the risk of getting out of sync with the gtk) 1357 NotifyApplicationUserInput(AWinControl, Msg.Msg); 1358 //DebugLn(['DeliverMouseMoveMessage ',dbgsName(AWinControl)]); 1359 DeliverMessage(AWinControl, Msg); 1360 1361 // if dragmanager is started later then inform g_object issue #19914 1362 if GTK_IS_NOTEBOOK({%H-}PGtkWidget(AWinControl.Handle)) and 1363 DragManager.IsDragging and 1364 (g_object_get_data({%H-}PGObject(AWinControl.Handle),'lclnotebookdragging') = nil) 1365 then 1366 g_object_set_data({%H-}PGObject(AWinControl.Handle), 1367 'lclnotebookdragging', gpointer(PtrInt(1))); 1368end; 1369 1370procedure FixListViewRubberBand(AWidget: PGtkWidget); 1371var 1372 Info: PWidgetInfo; 1373 IconView: PGtkIconView; 1374 Priv: _PGtkIconViewPrivate; 1375begin 1376 Info := GetWidgetInfo(AWidget); 1377 IconView := PGtkIconView(Info^.CoreWidget); 1378 Priv := IconView^.priv; 1379 1380 if Priv^.doing_rubberband then 1381 begin 1382 Priv^.doing_rubberband := False; 1383 gtk_widget_queue_draw(AWidget); 1384 end; 1385end; 1386 1387{------------------------------------------------------------------------------- 1388 function ControlGetsMouseMoveBefore(AControl: TControl): boolean; 1389 1390 Returns true, if mouse move event should be sent before the widget itself 1391 reacts. 1392-------------------------------------------------------------------------------} 1393function ControlGetsMouseMoveBefore({%H-}AControl: TControl; 1394 const ABefore: Boolean; Event: PGDKEventMotion): boolean; 1395var 1396 ShiftState: TShiftState; 1397 Widget: PGtkWidget; 1398 MainView: PGtkWidget; 1399begin 1400 Result := True; 1401 // currently there are no controls, that need after events. 1402 if not ABefore then exit; 1403 1404 // gtk2 column resizing ... issue #21354 1405 if (Event <> nil) and not (csDesigning in AControl.ComponentState) and 1406 (AControl is TListView) and 1407 (TListView(AControl).ViewStyle = vsReport) and 1408 (TListView(AControl).ShowColumnHeaders) then 1409 begin 1410 ShiftState := GTKEventStateToShiftState(Event^.State); 1411 if ssLeft in ShiftState then 1412 begin 1413 Widget := {%H-}PGtkWidget(TWinControl(AControl).Handle); 1414 if GTK_IS_SCROLLED_WINDOW(Widget) then 1415 begin 1416 MainView := gtk_bin_get_child(PGtkBin(Widget)); 1417 if GTK_IS_TREE_VIEW(MainView) then 1418 begin 1419 // here we are 1420 if gtk_tree_view_get_bin_window(PGtkTreeView(MainView)) <> Event^.window then 1421 Result := False; 1422 //TODO: queue column resize when x < 0 1423 // gtk_tree_view_column_queue_resize(tree_column: PGtkTreeViewColumn) 1424 end; 1425 end; 1426 end; 1427 end else 1428 if (Event <> nil) and not (csDesigning in AControl.ComponentState) and 1429 (AControl is TWinControl) and 1430 (TWinControl(AControl).FCompStyle = csListView) and 1431 (TListView(AControl).ViewStyle in [vsIcon, vsSmallIcon]) and 1432 TListView(AControl).MultiSelect then 1433 begin 1434 ShiftState := GTKEventStateToShiftState(Event^.State); 1435 // issue #22991 - this fixes rubberbanding 1436 if [ssShift, ssAlt, ssCtrl, ssLeft, ssRight, ssMiddle, ssDouble] * ShiftState = [] then 1437 FixListViewRubberBand({%H-}PGtkWidget(TWinControl(AControl).Handle)); 1438 end; 1439end; 1440 1441procedure GTKGetDevicePointer(win: PGdkWindow; dev: PGdkDevice; 1442 x, y: pgdouble; mask: PGdkModifierType); 1443var 1444 axes: pgdouble; 1445 i: Integer; 1446begin 1447 axes := g_new(SizeOf(gdouble), dev^.num_axes); 1448 gdk_device_get_state(dev, win, axes, mask); 1449 1450 for i := 0 to dev^.num_axes - 1 do 1451 if (x^ <> 0) and (dev^.axes[i].use = GDK_AXIS_X) then 1452 x^ := axes[i] 1453 else if (y^ <> 0) and (dev^.axes[i].use = GDK_AXIS_Y) then 1454 y^ := axes[i]; 1455 1456 g_free(axes); 1457end; 1458 1459 1460{------------------------------------------------------------------------------- 1461 GTKMotionNotify 1462 Params: widget: PGTKWidget; event: PGDKEventMotion; data: gPointer 1463 Returns: GBoolean 1464 1465 Called whenever the mouse is moved over a widget. 1466 The gtk event is translated into a lcl MouseMove message. 1467 1468-------------------------------------------------------------------------------} 1469function gtkMotionNotify(Widget:PGTKWidget; Event: PGDKEventMotion; 1470 Data: gPointer): GBoolean; cdecl; 1471const 1472 LastModifierKeys: TShiftState = []; 1473var 1474 DesignOnlySignal: boolean; 1475 ShiftState: TShiftState; 1476 ACtl: TWinControl; 1477begin 1478 Result := CallBackDefaultReturn; 1479 1480 if (Event^.is_hint <> 0) and (Event^._type = GDK_MOTION_NOTIFY) then 1481 GTKGetDevicePointer(Event^.window, Event^.device, 1482 @Event^.x, @Event^.y, @Event^.state); 1483 1484 {$IFDEF VerboseMouseBugfix} 1485 DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstMouseMotion); 1486 DebugLn('[GTKMotionNotify] ', 1487 DbgSName(TControl(Data)), 1488 ' Widget=',DbgS(Widget), 1489 ' DSO=',dbgs(DesignOnlySignal), 1490 ' Event^.X=',dbgs(TruncToInt(Event^.X)),' Event^.Y=',dbgs(TruncToInt(Event^.Y)) 1491 ); 1492 {$ENDIF} 1493 1494 ShiftState := GTKEventStateToShiftState(Event^.State); 1495 1496 if (ShiftState*[ssShift, ssCtrl, ssAlt, ssSuper] <> LastModifierKeys) or NeedShiftUpdateAfterFocus 1497 then begin 1498 NeedShiftUpdateAfterFocus := False; 1499 LastModifierKeys := ShiftState*[ssShift, ssCtrl, ssAlt, ssSuper]; 1500 //DebugLn(['Adjust KeyStateList in MouseMove',Integer(LastModifierKeys)]); 1501 UpdateShiftState(GTK2WidgetSet.KeyStateList, LastModifierKeys); 1502 end; 1503 1504 {$IFDEF VerboseMouseCapture} 1505 if (MouseCaptureWidget = Widget) and ([ssLeft,ssRight,ssMiddle]*ShiftState=[]) then 1506 DebugLn(['gtkMotionNotify gtk capture without mouse down: ',GetWidgetDebugReport(Widget)]); 1507 {$ENDIF} 1508 1509 if not (csDesigning in TComponent(Data).ComponentState) then 1510 begin 1511 DesignOnlySignal := GetDesignOnlySignalFlag(Widget, dstMouseMotion); 1512 if DesignOnlySignal then exit; 1513 if not ControlGetsMouseMoveBefore(TControl(Data), True, Event) then exit; 1514 end else 1515 begin 1516 // stop the signal, so that the widget does not auto react 1517 g_signal_stop_emission_by_name(PGTKObject(Widget), 'motion-notify-event'); 1518 Result := CallBackDefaultReturn; // why not True if we want to stop it? 1519 end; 1520 1521 ACtl := TWinControl(Data); 1522 if not (csDesigning in ACtl.ComponentState) and 1523 not (csCaptureMouse in ACtl.ControlStyle) and 1524 ([ssLeft,ssRight,ssMiddle]*ShiftState <> []) and 1525 not (ACtl is TCustomForm) and not (ACtl is TScrollBar) 1526 and not DragManager.IsDragging then 1527 begin 1528 if (Event^.x < 0) or (Event^.y < 0) or 1529 (Event^.x > ACtl.Width) or (Event^.y > ACtl.Height) then 1530 Exit(True); 1531 end; 1532 DeliverMouseMoveMessage(Widget,Event, ACtl); 1533 if ACtl.FCompStyle = csWinControl then 1534 Result := True; // stop signal 1535end; 1536 1537{------------------------------------------------------------------------------- 1538 GTKMotionNotifyAfter 1539 Params: widget: PGTKWidget; event: PGDKEventMotion; data: gPointer 1540 Returns: GBoolean 1541 1542 Called whenever the mouse is moved over a widget as last handler. 1543-------------------------------------------------------------------------------} 1544function GTKMotionNotifyAfter(widget:PGTKWidget; event: PGDKEventMotion; 1545 data: gPointer): GBoolean; cdecl; 1546begin 1547 Result := true; // stop event propagation 1548 1549 if (Event^.is_hint <> 0) and (Event^._type = GDK_MOTION_NOTIFY) then 1550 GTKGetDevicePointer(Event^.window, Event^.device, 1551 @Event^.x, @Event^.y, @Event^.state); 1552 1553 {$IFDEF VerboseMouseBugfix} 1554 DebugLn('[GTKMotionNotifyAfter] ', 1555 DbgSName(TControl(Data))); 1556 {$ENDIF} 1557 1558 // stop the signal, so that it is not sent to the parent widgets 1559 g_signal_stop_emission_by_name(PGTKObject(Widget),'motion-notify-event'); 1560 1561 if (csDesigning in TComponent(Data).ComponentState) then exit; 1562 if ControlGetsMouseMoveBefore(TControl(Data), True, Event) then exit; 1563 1564 DeliverMouseMoveMessage(Widget,Event, TWinControl(Data)); 1565end; 1566 1567 1568// restore old column sizing after dblclick. issue #18381 1569function ReturnColumnSizing(AGtkWidget: Pointer): gboolean; cdecl; 1570var 1571 AIndex: PtrInt; 1572 ASizing: TGtkTreeViewColumnSizing; 1573 Column: PGtkTreeViewColumn; 1574 ColWidth: gint; 1575begin 1576 Result := AGtkWidget <> nil; 1577 if Result then 1578 begin 1579 if g_object_get_data(PGObject(AGtkWidget),'lcl-column-resized-dblclick') <> nil then 1580 begin 1581 AIndex := {%H-}PtrInt(g_object_get_data(PGObject(AGtkWidget),'lcl-column-resized-dblclick') - 1); 1582 ASizing := TGtkTreeViewColumnSizing({%H-}PtrUInt(g_object_get_data(PGObject(AGtkWidget),'lcl-column-resized-dblclick-oldsizing')) - 1); 1583 g_object_set_data(PGObject(AGtkWidget),'lcl-column-resized-dblclick', nil); 1584 g_object_set_data(PGObject(AGtkWidget),'lcl-column-resized-dblclick-oldsizing', nil); 1585 if (AIndex >= 0) then 1586 begin 1587 Column := gtk_tree_view_get_column(PGtkTreeView(AGtkWidget), AIndex); 1588 ColWidth := gtk_tree_view_column_get_width(Column); 1589 gtk_tree_view_column_set_sizing(Column, ASizing); 1590 gtk_tree_view_column_set_fixed_width(Column, ColWidth); 1591 end; 1592 end; 1593 g_idle_remove_by_data(AGtkWidget); 1594 end; 1595end; 1596 1597{resizes column to like autosize does when dblclicked separator. issue #18381} 1598function ResizeColumnOnDblClick({%H-}ACtl: TWinControl; ScrolledWin: PGtkWidget; 1599 TreeView: PGtkTreeView; const AMouseCoord: TPoint): Boolean; 1600var 1601 Adjustment: PGtkAdjustment; 1602 List: PGList; 1603 Column: PGtkTreeViewColumn; 1604 i, Accu: PtrInt; 1605 xoffset: Integer; 1606 Pt: TPoint; 1607 CurSizing: TGtkTreeViewColumnSizing; 1608 ColIndex: Integer; 1609 ColWidth: Integer; 1610begin 1611 Result := True; 1612 Pt := AMouseCoord; 1613 Accu := 0; 1614 ColIndex := -1; 1615 // think about horizontal scrollbar position too ! 1616 Adjustment := gtk_scrolled_window_get_hadjustment(PGtkScrolledWindow(ScrolledWin)); 1617 if Adjustment <> nil then 1618 xoffset := Round(gtk_adjustment_get_value(Adjustment)) 1619 else 1620 xoffset := 0; 1621 1622 List := gtk_tree_view_get_columns(TreeView); 1623 try 1624 for i := 0 to g_list_length(List) - 1 do 1625 begin 1626 Column := g_list_nth_data(List, i); 1627 if Column = nil then 1628 continue; 1629 if gtk_tree_view_column_get_visible(Column) then 1630 begin 1631 ColWidth := gtk_tree_view_column_get_width(Column); 1632 if (Accu + ColWidth + 3 >= Pt.X + xoffset) then 1633 begin 1634 // DebugLn('NOTICE: GtkTreeView column resizing on dblclick ',i); 1635 CurSizing := gtk_tree_view_column_get_sizing(Column); 1636 if gtk_tree_view_column_get_resizable(Column) and 1637 (CurSizing <> GTK_TREE_VIEW_COLUMN_AUTOSIZE) then 1638 begin 1639 gtk_tree_view_column_set_sizing(Column, GTK_TREE_VIEW_COLUMN_AUTOSIZE); 1640 gtk_tree_view_column_set_resizable(Column, True); 1641 1642 ColIndex := i; 1643 // we are adding i + 1 since if i = 0 then ptr is null ! 1644 g_object_set_data(PGObject(TreeView),'lcl-column-resized-dblclick', {%H-}GPointer(ColIndex + 1)); 1645 Accu := Ord(CurSizing); 1646 // we are adding Accu + 1 since if Accu = 0 then ptr is null ! 1647 g_object_set_data(PGObject(TreeView),'lcl-column-resized-dblclick-oldsizing', {%H-}GPointer(Accu + 1)); 1648 Accu := g_idle_add(@ReturnColumnSizing, TreeView); 1649 break; 1650 end; 1651 break; 1652 end; 1653 Accu := Accu + ColWidth + 3 {section separator offset}; 1654 end; 1655 end; 1656 Result := not (ColIndex >= 0); 1657 finally 1658 g_list_free(List); 1659 end; 1660end; 1661 1662{------------------------------------------------------------------------------- 1663 function ControlGetsMouseDownBefore(AControl: TControl): boolean; 1664 1665 Returns true, if mouse down event should be sent before the widget istelf 1666 reacts. 1667-------------------------------------------------------------------------------} 1668function ControlGetsMouseDownBefore(AControl: TControl; 1669 {%H-}AWidget: PGtkWidget; Event : PGdkEventButton): boolean; 1670var 1671 Widget: PGtkWidget; 1672 MainView: PGtkWidget; 1673 Pt: TPoint; 1674begin 1675 Result := True; 1676 if AControl = nil then exit; 1677 1678 if not (csDesigning in AControl.ComponentState) and 1679 (Event^.button = 1) and 1680 (gdk_event_get_type(Event) = GDK_2BUTTON_PRESS) and 1681 (AControl is TWinControl) and 1682 (TWinControl(AControl).FCompStyle = csListView) and 1683 (TListView(AControl).ViewStyle = vsReport) and 1684 (TListView(AControl).ShowColumnHeaders) then 1685 begin 1686 Widget := {%H-}PGtkWidget(TWinControl(AControl).Handle); 1687 if GTK_IS_SCROLLED_WINDOW(Widget) then 1688 begin 1689 MainView := gtk_bin_get_child(PGtkBin(Widget)); 1690 if GTK_IS_TREE_VIEW(MainView) then 1691 begin 1692 if gtk_tree_view_get_bin_window(PGtkTreeView(MainView)) <> Event^.window then 1693 begin 1694 Pt.X := Round(Event^.x_root); 1695 Pt.Y := Round(Event^.y_root); 1696 ScreenToClient(TWinControl(AControl).Handle, Pt); 1697 Result := ResizeColumnOnDblClick(TWinControl(AControl), Widget, 1698 PGtkTreeView(MainView), Pt); 1699 end; 1700 end; 1701 end; 1702 end else 1703 if not (csDesigning in AControl.ComponentState) and 1704 (Event^.button = 1) and 1705 (gdk_event_get_type(Event) = GDK_BUTTON_PRESS) and 1706 (AControl is TWinControl) and 1707 (TWinControl(AControl).FCompStyle = csListView) and 1708 (TListView(AControl).ViewStyle in [vsIcon, vsSmallIcon]) and 1709 TListView(AControl).MultiSelect then 1710 begin 1711 // issue #22991 - this fixes crash after click on listview when modal form 1712 // is closed 1713 FixListViewRubberBand({%H-}PGtkWidget(TWinControl(AControl).Handle)); 1714 end; 1715end; 1716 1717 1718{------------------------------------------------------------------------------- 1719We must stop delivery of events from scrollbars of GtkScrollable, otherwise 1720if we make an double click on scollbar button, and after that click into 1721our control client area we need 2 click to make it focused. 1722gtk_signal_connect_after() is used, otherwise our scrollbar won't react on 1723such event. 1724-------------------------------------------------------------------------------} 1725function gtk2ScrollBarMouseBtnPress(widget: PGtkWidget; event: pgdkEventButton; 1726 data: gPointer): GBoolean; cdecl; 1727begin 1728 Result := True; 1729end; 1730 1731{------------------------------------------------------------------------------- 1732We must stop delivery of events from scrollbars of GtkScrollable, otherwise 1733if we make an double click on scollbar button, and after that click into 1734our control client area we need 2 click to make it focused. 1735gtk_signal_connect_after() is used, otherwise our scrollbar won't react on 1736such event. 1737-------------------------------------------------------------------------------} 1738function gtk2ScrollBarMouseBtnRelease(widget: PGtkWidget; event: pgdkEventButton; 1739 data: gPointer): GBoolean; cdecl; 1740begin 1741 Result := True; 1742end; 1743 1744{------------------------------------------------------------------------------- 1745 gtkMouseBtnPress 1746 Params: widget: PGTKWidget; event: PGDKEventMotion; data: gPointer 1747 Returns: GBoolean 1748 1749 Called whenever the mouse is over a widget and a mouse button is pressed. 1750-------------------------------------------------------------------------------} 1751function gtkMouseBtnPress(widget: PGtkWidget; event: pgdkEventButton; data: gPointer): GBoolean; cdecl; 1752 1753 procedure CheckListSelection; 1754 var 1755 List: PGlist; 1756 ListWidget: PGtkList; 1757 R: TRect; 1758 Info: PWinWidgetInfo; 1759 begin 1760 // When in browse mode and a listbox is focused and nothing is selected, 1761 // the first item is focused. 1762 // Clicking with the mouse on this item won't select it. 1763 Info := GetWidgetInfo(Widget); 1764 if Info = nil then Exit; 1765 if Info^.CoreWidget = nil then Exit; 1766 if not GtkWidgetIsA(Info^.CoreWidget, gtk_list_get_type) then 1767 Exit; 1768 ListWidget := PGtkList(Info^.CoreWidget); 1769 // Check mode 1770 if selection_mode(ListWidget^) <> GTK_SELECTION_BROWSE then Exit; 1771 1772 // Check selection 1773 List := ListWidget^.selection; 1774 if (List <> nil) and (List^.data <> nil) then Exit; 1775 1776 // Check if there are children 1777 List := ListWidget^.children; 1778 if List = nil then Exit; 1779 if List^.Data = nil then Exit; 1780 1781 // we need only to check the first 1782 with PGtkWidget(List^.Data)^.allocation do 1783 R := Bounds(X, Y, Width, Height); 1784 if not PtInRect(R, Point(Trunc(event^.X), Trunc(event^.Y))) then Exit; 1785 // Select it 1786 gtk_list_item_select(PGtkListItem(List^.Data)); 1787 end; 1788 1789 procedure FixTabControlFocusBehaviour; 1790 var 1791 Info: PWidgetInfo; 1792 begin 1793 {gtk_notebook have weird behaviour when clicked. 1794 if there's active control on page it'll loose it's 1795 focus and trigger OnExit (tab is taking focus). 1796 issue #20493} 1797 Info := GetWidgetInfo(Widget); 1798 if not gtk_widget_is_focus(Widget) then 1799 Include(Info^.Flags, wwiTabWidgetFocusCheck); 1800 end; 1801 1802var 1803 DesignOnlySignal: boolean; 1804 Msg: TLMContextMenu; 1805 x, y: gint; 1806 W: PGtkWidget; 1807 Info: PWidgetInfo; 1808 Old: TObject; 1809 Path: PGtkTreePath; 1810 Column: PGtkTreeViewColumn; 1811 {$IFDEF VerboseMouseBugfix} 1812 AWinControl: TWinControl; 1813 {$ENDIF} 1814begin 1815 Result := CallBackDefaultReturn; 1816 1817 {$IFDEF VerboseMouseBugfix} 1818 AWinControl := TWinControl(Data); 1819 DebugLn(''); 1820 DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstMousePress); 1821 DebugLn('[gtkMouseBtnPress] ', 1822 DbgSName(AWinControl), 1823 ' Widget=',DbgS(Widget), 1824 ' ControlWidget=',DbgS(AWinControl.Handle), 1825 ' DSO='+dbgs(DesignOnlySignal), 1826 ' '+dbgs(TruncToInt(Event^.X)),',',dbgs(TruncToInt(Event^.Y)), 1827 ' Type='+dbgs(gdk_event_get_type(Event))); 1828 {$ENDIF} 1829 1830 {$IFDEF EventTrace} 1831 EventTrace('Mouse button Press', data); 1832 {$ENDIF} 1833 1834 ResetDefaultIMContext; 1835 1836 //debugln('[gtkMouseBtnPress] calling DeliverMouseDownMessage Result=',dbgs(Result)); 1837 {$IFDEF Gtk2CallMouseDownBeforeContext} 1838 if DeliverMouseDownMessage(Widget, Event, TWinControl(Data))<>0 then 1839 begin 1840 // Debugln(['[gtkMouseBtnPress] DeliverMouseDownMessage handled, stopping event']); 1841 g_signal_stop_emission_by_name(PGTKObject(Widget), 'button-press-event'); 1842 exit(false); 1843 end; 1844 {$ENDIF} 1845 1846 if not (csDesigning in TComponent(Data).ComponentState) then 1847 begin 1848 // fix gtklist selection first 1849 CheckListSelection; 1850 1851 DesignOnlySignal := GetDesignOnlySignalFlag(Widget, dstMousePress); 1852 if DesignOnlySignal then exit; 1853 if not ControlGetsMouseDownBefore(TControl(Data), Widget, Event) then Exit; 1854 1855 if Event^.button = 1 then 1856 begin 1857 //CaptureMouseForWidget(CaptureWidget,mctGTKIntf); 1858 if (TControl(Data) is TCustomTabControl) and 1859 not (csDesigning in TControl(Data).ComponentState) then 1860 FixTabControlFocusBehaviour; 1861 end 1862 else 1863 // if LCL process LM_CONTEXTMENU then stop the event propagation 1864 if (Event^.button = 3) then 1865 begin 1866 W := Widget; 1867 gdk_display_get_pointer(gtk_widget_get_display(Widget), nil, @x, @y, nil); 1868 Old := nil; 1869 while W <> nil do 1870 begin 1871 Info := GetWidgetInfo(W); 1872 if (Info <> nil) and (Info^.LCLObject <> Old) then 1873 begin 1874 Old := Info^.LCLObject; 1875 FillChar(Msg{%H-}, SizeOf(Msg), #0); 1876 Msg.Msg := LM_CONTEXTMENU; 1877 Msg.hWnd := {%H-}HWND(W); 1878 Msg.XPos := x; 1879 Msg.YPos := y; 1880 1881 Result := DeliverMessage(Old, Msg) <> 0; 1882 if Result then break; 1883 end; 1884 // check if widget has a standard popup menu 1885 if (W = widget) and Assigned(GTK_WIDGET_GET_CLASS(W)^.popup_menu) then 1886 break; 1887 W := gtk_widget_get_parent(W); 1888 end; 1889 1890 {emit selection change when right mouse button pressed 1891 otherwise LCL is not updated since ChangeLock = 1 in case 1892 of pressing right mouse button and 'changed' signal never reach lcl. 1893 Issues #16972, #17888. } 1894 if Result and GTK_IS_TREE_VIEW(Widget) and (event^.button = 3) then 1895 begin 1896 Column := gtk_tree_view_get_column(GTK_TREE_VIEW(Widget), 0); 1897 Path:=nil; 1898 if gtk_tree_view_get_path_at_pos(GTK_TREE_VIEW(Widget), Round(Event^.x), Round(Event^.y), 1899 Path, Column, @x, @y) then 1900 begin 1901 gtk_tree_view_set_cursor(GTK_TREE_VIEW(Widget), Path, Column, False); 1902 gtk_widget_queue_draw(Widget); 1903 end; 1904 g_signal_stop_emission_by_name(PGTKObject(Widget), 'button-press-event'); 1905 end; 1906 1907 end; 1908 end else begin 1909 if (event^.Button=1) and 1910 (TControl(Data) is TCustomTabControl) then 1911 begin 1912 // clicks on the tab control should be handled by the gtk (switching page) 1913 end 1914 else 1915 begin 1916 // stop the signal, so that the widget does not auto react 1917 //DebugLn(['gtkMouseBtnPress stop signal']); 1918 g_signal_stop_emission_by_name(PGTKObject(Widget), 'button-press-event'); 1919 end; 1920 end; 1921 {$IFDEF Gtk2CallMouseDownBeforeContext} 1922 {$ELSE} 1923 //debugln('[gtkMouseBtnPress] calling DeliverMouseDownMessage Result=',dbgs(Result)); 1924 DeliverMouseDownMessage(Widget, Event, TWinControl(Data)); 1925 {$ENDIF} 1926 //debugln(['gtkMouseBtnPress END Control=',DbgSName(TObject(Data))]); 1927end; 1928 1929 1930{------------------------------------------------------------------------------- 1931 procedure DeliverMouseDownMessage(widget: PGtkWidget; event : pgdkEventButton; 1932 AWinControl: TWinControl); 1933 1934 Translate a gdk mouse press event into a LCL mouse down message and send it. 1935-------------------------------------------------------------------------------} 1936function DeliverMouseDownMessage(widget: PGtkWidget; event : pgdkEventButton; 1937 AWinControl: TWinControl): PtrInt; 1938const 1939 LastModifierKeys: TShiftState = []; 1940 WHEEL_DELTA : array[Boolean] of Integer = (-120, 120); 1941var 1942 MessI : TLMMouse; 1943 MessE : TLMMouseEvent; 1944 ShiftState: TShiftState; 1945 MappedXY: TPoint; 1946 EventXY: TPoint; 1947 AClip: gtk2.PGtkClipboard; 1948 AClipText: String; 1949 1950{off $DEFINE VerboseMouseBugfix} 1951 1952 function CheckMouseButtonDown(MouseButton, BtnKey: longint): boolean; 1953 begin 1954 Result := False; 1955 1956 case gdk_event_get_type(Event) of 1957 gdk_2button_press, gdk_3button_press: 1958 // the gtk itself has detected a double/triple click 1959 begin 1960 // they were already detected and sent to the LCL 1961 // -> skip this message 1962 exit; 1963 end; 1964 end; 1965 1966 if (LastMouse.Down) then 1967 if (gdk_event_get_type(Event) in [GDK_BUTTON_PRESS, gdk_2button_press, gdk_3button_press]) then 1968 begin 1969 // After a LastMouse.Down has to follow a LastMouse.Up. Issue #32199 1970 if LastMouse.WinControl <> AWinControl then 1971 Exit; 1972 end 1973 else 1974 begin 1975 {$IFDEF VerboseMouseBugfix} 1976 DebugLn('DeliverMouseDownMessage: NO CLICK: LastMouse.Down=',dbgs(LastMouse.Down), 1977 ' Event^.theType=',dbgs(gdk_event_get_type(Event))); 1978 {$ENDIF} 1979 Exit; 1980 end; 1981 1982 if (LastMouse.Down) and (gdk_event_get_type(Event) = GDK_BUTTON_PRESS) and 1983 (csDesigning in AWinControl.ComponentState) then 1984 exit; 1985 1986 MessI.Msg := CheckMouseButtonDownUp({%H-}TLCLIntfHandle(widget), AWinControl, 1987 LastMouse, EventXY, MouseButton, True); 1988 MessI.Keys := MessI.Keys or BtnKey; 1989 if BtnKey in [MK_XBUTTON1, MK_XBUTTON2] then 1990 MessI.Keys := MessI.Keys or BtnKey shl 11; 1991 case LastMouse.ClickCount of 1992 2: MessI.Keys := MessI.Keys or MK_DOUBLECLICK; 1993 3: MessI.Keys := MessI.Keys or MK_TRIPLECLICK; 1994 4: MessI.Keys := MessI.Keys or MK_QUADCLICK; 1995 end; 1996 1997 {$IFDEF VerboseMouseBugfix} 1998 DebugLn(' ClickCount=',dbgs(LastMouse.ClickCount)); 1999 {$ENDIF} 2000 2001 //DebugLn('DeliverMouseDownMessage ',DbgSName(AWinControl),' Mapped=',dbgs(MappedXY.X),',',dbgs(MappedXY.Y),' Event=',dbgs(EventXY.X),',',dbgs(EventXY.Y),' ',dbgs(LastMouse.ClickCount)); 2002 Result := True; 2003 end; 2004 2005begin 2006 Result := 0; 2007 2008 if GTK_IS_TREE_VIEW(widget) 2009 and (gtk_tree_view_get_bin_window(PGtkTreeView(widget)) <> Event^.window) then 2010 Exit; 2011 2012 CheckTransparentWindow({%H-}TLCLIntfHandle(widget), AWinControl); 2013 if (widget=nil) or (AWinControl=nil) then 2014 Exit; 2015 2016 EventXY := Point(TruncToInt(Event^.X), TruncToInt(Event^.Y)); 2017 ShiftState := GTKEventStateToShiftState(Event^.State); 2018 2019 if ShiftState*[ssShift, ssCtrl, ssAlt, ssSuper] <> LastModifierKeys 2020 then begin 2021 LastModifierKeys := ShiftState*[ssShift, ssCtrl, ssAlt, ssSuper]; 2022 //DebugLn(['Adjust KeyStateList in MouseBtnDown',Integer(LastModifierKeys)]); 2023 UpdateShiftState(GTK2WidgetSet.KeyStateList, LastModifierKeys); 2024 end; 2025 2026 MappedXY := TranslateGdkPointToClientArea(Event^.Window, EventXY, 2027 {%H-}PGtkWidget(AWinControl.Handle)); 2028 MappedXY := SubtractScoll({%H-}PGtkWidget(AWinControl.Handle), MappedXY); 2029 //DebugLn('DeliverMouseDownMessage ',DbgSName(AWinControl),' Mapped=',dbgs(MappedXY.X),',',dbgs(MappedXY.Y),' Event=',dbgs(EventXY.X),',',dbgs(EventXY.Y)); 2030 2031 if event^.Button in [4, 5] then 2032 begin 2033 // this is a mouse wheel event 2034 MessE.Msg := LM_MOUSEWHEEL; 2035 MessE.WheelDelta := WHEEL_DELTA[event^.Button = 4]; 2036 MessE.X := MappedXY.X; 2037 MessE.Y := MappedXY.Y; 2038 MessE.State := ShiftState; 2039 MessE.UserData := AWinControl; 2040 MessE.Button := 0; 2041 2042 // send the message directly to the LCL 2043 NotifyApplicationUserInput(AWinControl, MessE.Msg); 2044 Result:=DeliverMessage(AWinControl, MessE); 2045 end 2046 else 2047 if event^.Button in [6, 7] then 2048 begin 2049 // this is a mouse wheel horizontal-scroll event 2050 MessE.Msg := LM_MOUSEHWHEEL; 2051 MessE.WheelDelta := WHEEL_DELTA[event^.Button = 7]; 2052 MessE.X := MappedXY.X; 2053 MessE.Y := MappedXY.Y; 2054 MessE.State := ShiftState; 2055 MessE.UserData := AWinControl; 2056 MessE.Button := 0; 2057 2058 // send the message directly to the LCL 2059 NotifyApplicationUserInput(AWinControl, MessE.Msg); 2060 Result:=DeliverMessage(AWinControl, MessE); 2061 end 2062 else 2063 begin 2064 // a normal mouse button is pressed 2065 MessI.Keys := 0; 2066 case event^.Button of 2067 1: if not CheckMouseButtonDown(1, MK_LBUTTON) then Exit; 2068 2: if not CheckMouseButtonDown(3, MK_MBUTTON) then Exit; 2069 3: if not CheckMouseButtonDown(2, MK_RBUTTON) then Exit; 2070 8: if not CheckMouseButtonDown(4, MK_XBUTTON1) then Exit; 2071 9: if not CheckMouseButtonDown(5, MK_XBUTTON2) then Exit; 2072 else 2073 begin 2074 MessI.Msg := LM_NULL; 2075 exit; 2076 end; 2077 end; // case 2078 2079 MessI.XPos := MappedXY.X; 2080 MessI.YPos := MappedXY.Y; 2081 2082 MessI.Keys := MessI.Keys or ShiftStateToKeys(ShiftState); 2083 2084 MessI.Result:=0; 2085 2086 {Gtk2 should always send LM_SETFOCUS first, as qt and win32 does. issues #24308, #31900} 2087 if ((MessI.Msg = LM_LBUTTONDOWN) or (MessI.Msg = LM_RBUTTONDOWN) or 2088 (MessI.Msg = LM_MBUTTONDOWN) or (MessI.Msg = LM_LBUTTONDBLCLK) or 2089 (MessI.Msg = LM_XBUTTONDOWN)) and 2090 not AWinControl.Focused and AWinControl.CanFocus and 2091 not (csDesigning in AWinControl.ComponentState) then 2092 begin 2093 if (AWinControl is TCustomEdit) then 2094 begin 2095 AClipText := ''; 2096 AClip := gtk_clipboard_get(GDK_SELECTION_PRIMARY); 2097 if gtk_clipboard_get_owner(AClip) = AClip then 2098 AClip := nil; 2099 if (AClip <> nil) and gtk_clipboard_wait_is_text_available(AClip) then 2100 AClipText := gtk_clipboard_wait_for_text(AClip); 2101 LCLIntf.SetFocus(AWinControl.Handle); 2102 if Assigned(AClip) then 2103 gtk_clipboard_set_text(AClip, PgChar(AClipText), length(AClipText)); 2104 end else 2105 begin 2106 if (AWinControl is TCustomTabControl) 2107 or (AWinControl is TCustomPanel) then 2108 // do not grab focus. issue #32237, #32515 2109 else 2110 LCLIntf.SetFocus(AWinControl.Handle); 2111 end; 2112 end; 2113 2114 // send the message directly to the LCL 2115 NotifyApplicationUserInput(AWinControl, MessI.Msg); 2116 Result := DeliverMessage(AWinControl, MessI); 2117 2118 // issue #19914 2119 if (Result = 0) and (Event^.button = 1) and 2120 GTK_IS_NOTEBOOK({%H-}PGtkWidget(AWinControl.Handle)) and 2121 DragManager.IsDragging then 2122 begin 2123 g_object_set_data({%H-}PGObject(AWinControl.Handle), 2124 'lclnotebookdragging', gpointer(PtrInt(1))); 2125 end; 2126 end; 2127end; 2128 2129{------------------------------------------------------------------------------- 2130 gtkMouseBtnPressAfter 2131 Params: widget: PGTKWidget; event: PGDKEventMotion; data: gPointer 2132 Returns: GBoolean 2133 2134 Called whenever the mouse is over a widget and a mouse button is pressed. 2135 This is the last handler. 2136-------------------------------------------------------------------------------} 2137function gtkMouseBtnPressAfter(widget: PGtkWidget; event : pgdkEventButton; 2138 data: gPointer) : GBoolean; cdecl; 2139begin 2140 Result := True; 2141 2142 {$IFDEF VerboseMouseBugfix} 2143 debugln('[gtkMouseBtnPressAfter] ', 2144 DbgSName(TObject(Data)), 2145 ' Widget=',DbgS(Widget), ' ', GetWidgetClassName(Widget), 2146 ' ',dbgs(TruncToInt(Event^.X)),',',dbgs(TruncToInt(Event^.Y))); 2147 {$ENDIF} 2148 2149 ResetDefaultIMContext; 2150 2151 // stop the signal, so that it is not sent to the parent widgets 2152 g_signal_stop_emission_by_name(PGTKObject(Widget), 'button-press-event'); 2153 2154 if (csDesigning in TComponent(Data).ComponentState) then exit; 2155 if ControlGetsMouseDownBefore(TControl(Data),Widget, Event) then exit; 2156 2157 //debugln('[gtkMouseBtnPressAfter] calling DeliverMouseDownMessage'); 2158 DeliverMouseDownMessage(Widget, Event, TWinControl(Data)); 2159end; 2160 2161{------------------------------------------------------------------------------- 2162 function ControlGetsMouseUpBefore(AControl: TControl): boolean; 2163 2164 Returns true, if mouse up event should be sent before the widget istelf 2165 reacts. 2166-------------------------------------------------------------------------------} 2167function ControlGetsMouseUpBefore({%H-}AControl: TControl): boolean; 2168begin 2169 {$NOTE ControlGetsMouseUpBefore always return true. See if still necessary} 2170 Result:=true; 2171end; 2172 2173{------------------------------------------------------------------------------- 2174 procedure DeliverMouseUpMessage(widget: PGtkWidget; event : pgdkEventButton; 2175 AWinControl: TWinControl); 2176 2177 Translate a gdk mouse release event into a LCL mouse up message and send it. 2178 2179 returns true, if message was handled by LCL 2180-------------------------------------------------------------------------------} 2181function DeliverMouseUpMessage(widget: PGtkWidget; event: pgdkEventButton; 2182 AWinControl: TWinControl): boolean; 2183var 2184 MessI : TLMMouse; 2185 ShiftState: TShiftState; 2186 MappedXY: TPoint; 2187 EventXY: TPoint; 2188 2189 function CheckMouseButtonUp(MouseButton: longint; BtnShiftState: TShiftStateEnum): boolean; 2190 begin 2191 MessI.Msg := CheckMouseButtonDownUp({%H-}TLCLIntfHandle(widget), 2192 AWinControl, LastMouse, EventXY, MouseButton, False); 2193 Include(ShiftState, BtnShiftState); 2194 Result := True; 2195 end; 2196 2197begin 2198 Result := False; 2199 CheckTransparentWindow({%H-}TLCLIntfHandle(widget), AWinControl); 2200 if (widget=nil) or (AWinControl=nil) then 2201 Exit; 2202 EventXY := Point(TruncToInt(Event^.X), TruncToInt(Event^.Y)); 2203 MappedXY := TranslateGdkPointToClientArea(Event^.Window, 2204 EventXY, 2205 {%H-}PGtkWidget(AWinControl.Handle)); 2206 MappedXY := SubtractScoll({%H-}PGtkWidget(AWinControl.Handle), MappedXY); 2207 //DebugLn(['DeliverMouseUpMessage ',GetWidgetDebugReport(Widget),' ',dbgsName(AWinControl),' ',dbgs(MappedXY)]); 2208 2209 ShiftState := GTKEventStateToShiftState(Event^.State); 2210 2211 case event^.Button of 2212 1: if not CheckMouseButtonUp(1, ssLeft) then Exit; 2213 2: if not CheckMouseButtonUp(3, ssMiddle) then Exit; 2214 3: if not CheckMouseButtonUp(2, ssRight) then Exit; 2215 8: if not CheckMouseButtonUp(4, ssExtra1) then Exit; 2216 9: if not CheckMouseButtonUp(5, ssExtra2) then Exit; 2217 else 2218 begin 2219 MessI.Msg := LM_NULL; 2220 Exit; 2221 end; 2222 end; // case 2223 2224 MessI.XPos := MappedXY.X; 2225 MessI.YPos := MappedXY.Y; 2226 2227 // do not send button in shiftstate on mouse up.issue #20916 2228 case event^.Button of 2229 1: ShiftState := ShiftState - [ssLeft]; 2230 2: ShiftState := ShiftState - [ssMiddle]; 2231 3: ShiftState := ShiftState - [ssRight]; 2232 end; 2233 MessI.Keys := ShiftStateToKeys(ShiftState); 2234 case LastMouse.ClickCount of 2235 2: MessI.Keys := MessI.Keys or MK_DOUBLECLICK; 2236 3: MessI.Keys := MessI.Keys or MK_TRIPLECLICK; 2237 4: MessI.Keys := MessI.Keys or MK_QUADCLICK; 2238 end; 2239 2240 if MessI.Msg <> LM_NULL then 2241 begin 2242 // send the message directly to the LCL 2243 // (Posting the message via queue 2244 // has the risk of getting out of sync with the gtk) 2245 if event^.button in [8,9] then 2246 MessI.Keys := MessI.Keys or ((event^.button - 7) shl 16); 2247 MessI.Result := 0; 2248 NotifyApplicationUserInput(AWinControl, MessI.Msg); 2249 DeliverMessage(AWinControl, MessI); 2250 if not AWinControl.HandleAllocated then 2251 Result := True 2252 else if MessI.Result <> 0 then 2253 begin 2254 // issue #19914 2255 if GTK_IS_NOTEBOOK(Widget) then 2256 begin 2257 if g_object_get_data({%H-}PGObject(AWinControl.Handle),'lclnotebookdragging') <> nil then 2258 begin 2259 g_object_steal_data({%H-}PGObject(AWinControl.Handle),'lclnotebookdragging'); 2260 exit; 2261 end; 2262 end; 2263 // handled by the LCL 2264 //DebugLn(['DeliverMouseUpMessage msg was handled by the LCL, Stopping signal ...']); 2265 g_signal_stop_emission_by_name(PGTKObject(Widget), 'button-release-event'); 2266 Result := True; 2267 end; 2268 end; 2269end; 2270 2271{------------------------------------------------------------------------------- 2272 gtkMouseBtnRelease 2273 Params: widget: PGTKWidget; event: PGDKEventMotion; data: gPointer 2274 Returns: GBoolean 2275 2276 Called whenever the mouse is over a widget and a mouse button is released. 2277-------------------------------------------------------------------------------} 2278function gtkMouseBtnRelease(widget: PGtkWidget; event : pgdkEventButton; 2279 data: gPointer) : GBoolean; cdecl; 2280var 2281 DesignOnlySignal: boolean; 2282 AForm: TCustomForm; 2283begin 2284 Result := CallBackDefaultReturn; 2285 {$IFDEF VerboseMouseBugfix} 2286 DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstMouseRelease); 2287 DebugLn(['[gtkMouseBtnRelease] A ',DbgSName(TObject(Data)),' ', 2288 ' Widget=',DbgS(Widget), 2289 ' Event.time=',event^.time, 2290 ' DSO=',DesignOnlySignal, 2291 ' ',TruncToInt(Event^.X),',',TruncToInt(Event^.Y),' Btn=',event^.Button]); 2292 {$ENDIF} 2293 2294 //DebugLn('EEE1 MouseRelease Widget=',DbgS(Widget), 2295 //' EventMask=',DbgS(gdk_window_get_events(Widget^.Window)), 2296 //' GDK_BUTTON_RELEASE_MASK=',DbgS(GDK_BUTTON_RELEASE_MASK)); 2297 2298 ResetDefaultIMContext; 2299 2300 if not (csDesigning in TComponent(Data).ComponentState) then 2301 begin 2302 DesignOnlySignal := GetDesignOnlySignalFlag(Widget, dstMouseRelease); 2303 2304 if (TControl(Data) is TCustomListView) and 2305 (TListView(Data).ViewStyle in [vsIcon, vsSmallIcon]) and 2306 TListView(Data).MultiSelect then 2307 begin 2308 // fixed crash.See issue #22778 2309 FixListViewRubberBand(Widget); 2310 end; 2311 2312 if DesignOnlySignal or (not ControlGetsMouseUpBefore(TControl(Data))) then 2313 begin 2314 ReleaseMouseCapture; 2315 Exit; 2316 end; 2317 end else 2318 begin 2319 // stop the signal, so that the widget does not auto react 2320 if not (TControl(Data) is TCustomTabControl) then 2321 begin 2322 g_signal_stop_emission_by_name(PGTKObject(Widget), 'button-release-event'); 2323 Result := not CallBackDefaultReturn; 2324 end; 2325 end; 2326 if DeliverMouseUpMessage(Widget, Event, TWinControl(Data)) then 2327 begin 2328 ReleaseMouseCapture; 2329 if not DragManager.IsDragging then 2330 Result := not CallBackDefaultReturn 2331 else 2332 begin 2333 // workaround for gtk2 bug where "clicked" isn't triggered 2334 // because of Result=TRUE and we started modal form from OnDropDown event. 2335 // see issue http://bugs.freepascal.org/view.php?id=14318 for details. 2336 if GTK_IS_BUTTON(Widget) then 2337 begin 2338 AForm := GetParentForm(TWinControl(Data)); 2339 if (AForm <> nil) and (fsModal in AForm.FormState) then 2340 gtk_button_clicked(PGtkButton(Widget)); 2341 end; 2342 end; 2343 end else 2344 ReleaseMouseCapture; 2345end; 2346 2347{------------------------------------------------------------------------------- 2348 gtkMouseBtnReleaseAfter 2349 Params: widget: PGTKWidget; event: PGDKEventMotion; data: gPointer 2350 Returns: GBoolean 2351 2352 Called whenever the mouse is over a widget and a mouse button is released. 2353 This is the last handler. 2354-------------------------------------------------------------------------------} 2355function gtkMouseBtnReleaseAfter(widget: PGtkWidget; event : pgdkEventButton; 2356 data: gPointer) : GBoolean; cdecl; 2357begin 2358 Result := True; 2359 2360 {$IFDEF VerboseMouseBugfix} 2361 DebugLn('[gtkMouseBtnReleaseAfter] ',DbgSName(TObject(Data)),' ', 2362 ' Widget=',DbgS(Widget), 2363 ' ',dbgs(TruncToInt(Event^.X)),',',dbgs(TruncToInt(Event^.Y)),' Btn=',dbgs(event^.Button)); 2364 {$ENDIF} 2365 2366 // stop the signal, so that it is not sent to the parent widgets 2367 {$NOTE See if is necessary to stop emission. Return true is enough to avoid propagation} 2368 g_signal_stop_emission_by_name(PGTKObject(Widget),'button-release-event'); 2369 2370 ResetDefaultIMContext; 2371 2372 if (csDesigning in TComponent(Data).ComponentState) then exit; 2373 if ControlGetsMouseUpBefore(TControl(Data)) then exit; 2374 2375 DeliverMouseUpMessage(Widget,Event,TWinControl(Data)); 2376end; 2377 2378function gtkMouseWheelCB(widget: PGtkWidget; event: PGdkEventScroll; 2379 data: gPointer): GBoolean; cdecl; 2380var 2381 AWinControl: TWinControl; 2382 EventXY: TPoint; 2383 ShiftState: TShiftState; 2384 MappedXY: TPoint; 2385 MessE : TLMMouseEvent; 2386begin 2387 Result := False; 2388 2389 AWinControl:=TWinControl(Data); 2390 CheckTransparentWindow({%H-}TLCLIntfHandle(widget), AWinControl); 2391 if (widget=nil) or (AWinControl=nil) then 2392 Exit; 2393 EventXY:=Point(TruncToInt(Event^.X),TruncToInt(Event^.Y)); 2394 ShiftState := GTKEventStateToShiftState(Event^.State); 2395 MappedXY:=TranslateGdkPointToClientArea(Event^.Window,EventXY, 2396 {%H-}PGtkWidget(AWinControl.Handle)); 2397 MappedXY := SubtractScoll({%H-}PGtkWidget(AWinControl.Handle), MappedXY); 2398 //DebugLn('gtkMouseWheelCB ',DbgSName(AWinControl),' Mapped=',dbgs(MappedXY.X),',',dbgs(MappedXY.Y),' Event=',dbgs(EventXY.X),',',dbgs(EventXY.Y)); 2399 2400 // this is a mouse wheel event 2401 FillChar(MessE{%H-},SizeOf(MessE),0); 2402 case event^.direction of 2403 GDK_SCROLL_UP: begin MessE.Msg := LM_MOUSEWHEEL; MessE.WheelDelta := 120; end; 2404 GDK_SCROLL_DOWN: begin MessE.Msg := LM_MOUSEWHEEL; MessE.WheelDelta := -120; end; 2405 GDK_SCROLL_LEFT: begin MessE.Msg := LM_MOUSEHWHEEL; MessE.WheelDelta := -120; end; 2406 GDK_SCROLL_RIGHT: begin MessE.Msg := LM_MOUSEHWHEEL; MessE.WheelDelta := 120; end; 2407 else 2408 exit; 2409 end; 2410 MessE.X := MappedXY.X; 2411 MessE.Y := MappedXY.Y; 2412 MessE.State := ShiftState; 2413 MessE.UserData := AWinControl; 2414 MessE.Button := 0; 2415 2416 // send the message directly to the LCL 2417 NotifyApplicationUserInput(AWinControl, MessE.Msg); 2418 if DeliverMessage(AWinControl, MessE) <> 0 then 2419 Result := True; // message handled by LCL, stop processing 2420end; 2421 2422 2423function gtkclickedCB(widget: PGtkWidget; data: gPointer) : GBoolean; cdecl; 2424var 2425 Mess: TLMessage; 2426begin 2427 Result := CallBackDefaultReturn; 2428 //DebugLn('[gtkclickedCB] ',TObject(Data).ClassName); 2429 EventTrace('clicked', data); 2430 if (LockOnChange(PgtkObject(Widget),0)>0) then exit; 2431 Mess.Msg := LM_CLICKED; 2432 DeliverMessage(Data, Mess); 2433end; 2434 2435function gtkEnterCB(widget: PGtkWidget; data: gPointer) : GBoolean; cdecl; 2436var 2437 Mess : TLMessage; 2438begin 2439 Result := CallBackDefaultReturn; 2440 2441 {$IFDEF EventTrace} 2442 EventTrace('enter', data); 2443 {$ENDIF} 2444 2445 if csDesigning in TControl(Data).ComponentState then begin 2446 // stop the signal, so that the widget does not auto react 2447 g_signal_stop_emission_by_name(PGTKObject(Widget),'enter'); 2448 end; 2449 2450 Mess.msg := LM_MOUSEENTER; 2451 DeliverMessage(Data, Mess); 2452end; 2453 2454function gtkLeaveCB(widget: PGtkWidget; data: gPointer) : GBoolean; cdecl; 2455var 2456 Mess : TLMessage; 2457begin 2458 Result := CallBackDefaultReturn; 2459 2460 {$IFDEF EventTrace} 2461 EventTrace('leave', data); 2462 {$ENDIF} 2463 2464 if csDesigning in TControl(Data).ComponentState then begin 2465 // stop the signal, so that the widget does not auto react 2466 g_signal_stop_emission_by_name(PGTKObject(Widget),'leave'); 2467 end; 2468 2469 Mess.msg := LM_MOUSELEAVE; 2470 DeliverMessage(Data, Mess); 2471end; 2472 2473function gtksize_allocateCB(widget: PGtkWidget; size: pGtkAllocation; 2474 data: gPointer) : GBoolean; cdecl; 2475{$IFDEF VerboseSizeMsg} 2476var 2477 w, h: Gint; 2478{$ENDIF} 2479 2480begin 2481 Result := CallBackDefaultReturn; 2482 2483 EventTrace('size-allocate', data); 2484 2485 //with Size^ do DebugLn(Format('Trace:[gtksize_allocateCB] %s --> X: %d, Y: %d, Width: %d, Height: %d', [TObject(data).ClassName, X, Y, Width, Height])); 2486 2487 if not (TObject(Data) is TControl) then begin 2488 // owner is not TControl -> ignore 2489 DebugLn('WARNING: gtksize_allocateCB: Data is not TControl. Data=', 2490 DbgS(Data),' ',GetWidgetClassName(Widget)); 2491 if Data<>nil then 2492 DebugLn(' Data=',TObject(Data).ClassName); 2493 RaiseGDBException(''); 2494 exit; 2495 end; 2496 2497 {$IFDEF VerboseSizeMsg} 2498 w:=0; h:=0; 2499 if Widget^.window<>nil then 2500 gdk_window_get_size(Widget^.window,@w,@h); 2501 DebugLn(['gtksize_allocateCB: ', 2502 DbgSName(TControl(Data)), 2503 ' widget=',GetWidgetDebugReport(Widget), 2504 ' fixwidget=',DbgS(GetFixedWidget(Widget)), 2505 ' NewSize=',Size^.Width,',',Size^.Height, 2506 ' GtkPos=',Widget^.allocation.x,',',Widget^.allocation.y, 2507 ',',Widget^.allocation.width,'x',Widget^.allocation.height, 2508 ' LCLPos=',TControl(Data).Left,',',TControl(Data).Top, 2509 ',',TControl(Data).Width,'x',TControl(Data).Height, 2510 ' gdkwindow=',w,'x',h]); 2511 {$ENDIF} 2512 {$IFDEF VerboseFormPositioning} 2513 if TControl(Data) is TCustomForm then 2514 DebugLn('VFP gtksize_allocateCB: ',TControl(Data).ClassName,' ',dbgs(Size^.X),',',dbgs(Size^.Y)); 2515 {$ENDIF} 2516 SendSizeNotificationToLCL(Widget); 2517end; 2518 2519function gtksize_allocate_client({%H-}widget: PGtkWidget; {%H-}size: pGtkAllocation; 2520 data: gPointer): GBoolean; cdecl; 2521var 2522 MainWidget: PGtkWidget; 2523 ClientWidget: PGtkWidget; 2524begin 2525 Result := CallBackDefaultReturn; 2526 2527 if (TObject(Data) is TWinControl) then 2528 begin 2529 {$IFDEF VerboseSizeMsg} 2530 DebugLn('gtksize_allocate_client: ', 2531 TControl(Data).Name,':',TControl(Data).ClassName, 2532 ' widget=',DbgS(Widget), 2533 ' NewSize=',dbgs(Size^.Width),',',dbgs(Size^.Height), 2534 ' Allocation='+dbgs(widget^.Allocation.Width)+'x'+dbgs(Widget^.Allocation.Height), 2535 ' Requisiton='+dbgs(widget^.Requisition.Width)+'x'+dbgs(Widget^.Requisition.Height) 2536 ); 2537 {$ENDIF} 2538 if not TWinControl(Data).HandleAllocated then begin 2539 exit; 2540 end; 2541 MainWidget:={%H-}PGtkWidget(TWinControl(Data).Handle); 2542 ClientWidget:=GetFixedWidget(MainWidget); 2543 if GTK_WIDGET_REALIZED(ClientWidget) then begin 2544 // the gtk resizes bottom to top, that means the 2545 // inner widget (client area) is resized before the outer widget 2546 // is resized. Because the LCL reads both sizes, keep this message back. 2547 SaveClientSizeNotification(ClientWidget); 2548 end; 2549 end else begin 2550 // owner is not TWinControl -> ignore 2551 DebugLn('WARNING: gtksize_allocate_client: Data is not TWinControl. Data=', 2552 DbgS(Data)); 2553 exit; 2554 end; 2555end; 2556 2557function gtkconfigureevent( widget: PGtkWidget; event : PgdkEventConfigure; 2558 data: gPointer) : GBoolean; cdecl; 2559var 2560 Allocation : TGtkAllocation; 2561begin 2562 2563 { This signal is emitted for top level controls only, i.e. only controls 2564 that are not children. Thus, we register this event only for forms. 2565 This event is fired when the form is sized, moved or changes Z order. 2566 } 2567 2568 FillChar(Allocation{%H-},SizeOf(TGtkAllocation),0); 2569 with Allocation do begin 2570 X:= Event^.X; 2571 Y:= Event^.Y; 2572 Width:= Event^.Width; 2573 Height:= Event^.Height; 2574 end; 2575 Result:= gtksize_allocateCB( Widget, @Allocation, Data); 2576end; 2577 2578function gtkInsertText(widget: PGtkWidget; char : pChar; 2579 NewTextLength : Integer; Position : pgint; data: gPointer) : GBoolean; cdecl; 2580var 2581 Memo: TCustomMemo; 2582 CurrLength, CutLength: integer; 2583begin 2584 Result := CallBackDefaultReturn; 2585 2586 { GTK does not provide its own max. length for memos 2587 we have to do our own. } 2588 2589 if TObject(Data) is TCustomMemo then begin 2590 if (NewTextLength = 1) and (char^ = #13) and (LineEnding = #10) then 2591 char^ := #10; 2592 Memo:= TCustomMemo(Data); 2593 if Memo.MaxLength <= 0 then Exit; 2594 2595 CurrLength:= gtk_text_get_length(PGtkText(widget)); 2596 if CurrLength + NewTextLength <= Memo.MaxLength then Exit; 2597 2598 CutLength:= CurrLength + NewTextLength - Memo.MaxLength; 2599 2600 if NewTextLength - CutLength > 0 then 2601 gtk_editable_insert_text(PGtkEditable(widget), char, 2602 NewTextLength - CutLength, Position); 2603 2604 g_signal_stop_emission_by_name(PGtkObject(widget), 'insert_text'); 2605 end; 2606 if TObject(Data) is TCustomEdit then 2607 if (NewTextLength = 1) and (char^ = #13) then 2608 g_signal_stop_emission_by_name(PGtkObject(widget), 'insert_text'); 2609end; 2610 2611function gtkSetEditable( {%H-}widget: PGtkWidget; data: gPointer) : GBoolean; cdecl; 2612var 2613 Mess : TLMessage; 2614begin 2615 EventTrace('Set Editable', data); 2616 Mess.msg := LM_SETEDITABLE; 2617 Result:= DeliverMessage(Data, Mess) = 0; 2618end; 2619 2620function gtkMoveWord( {%H-}widget: PGtkWidget; data: gPointer) : GBoolean; cdecl; 2621var 2622 Mess : TLMessage; 2623begin 2624 EventTrace('Move Word', data); 2625 Mess.msg := LM_MOVEWORD; 2626 Result:= DeliverMessage(Data, Mess) = 0; 2627end; 2628 2629function gtkMovePage( {%H-}widget: PGtkWidget; data: gPointer) : GBoolean; cdecl; 2630var 2631 Mess : TLMessage; 2632begin 2633 EventTrace('Move Page', data); 2634 Mess.msg := LM_MOVEPAGE; 2635 Result:= DeliverMessage(Data, Mess) = 0; 2636end; 2637 2638function gtkMoveToRow( {%H-}widget: PGtkWidget; data: gPointer) : GBoolean; cdecl; 2639var 2640 Mess : TLMessage; 2641begin 2642 EventTrace('Move To Row!!', data); 2643 Mess.msg := LM_MOVETOROW; 2644 Result:= DeliverMessage(Data, Mess) = 0; 2645end; 2646 2647function gtkMoveToColumn( {%H-}widget: PGtkWidget; data: gPointer) : GBoolean; cdecl; 2648var 2649 Mess : TLMessage; 2650begin 2651 EventTrace('MoveToColumn', data); 2652 Mess.msg := LM_MOVETOCOLUMN; 2653 Result:= DeliverMessage(Data, Mess) = 0; 2654end; 2655 2656function gtkKillChar( {%H-}widget: PGtkWidget; data: gPointer) : GBoolean; cdecl; 2657var 2658 Mess : TLMessage; 2659begin 2660 EventTrace('Kill Char', data); 2661 Mess.msg := LM_KILLCHAR; 2662 Result:= DeliverMessage(Data, Mess) = 0; 2663end; 2664 2665function gtkKillWord( {%H-}widget: PGtkWidget; data: gPointer) : GBoolean; cdecl; 2666var 2667 Mess : TLMessage; 2668begin 2669 EventTrace('Kill Word', data); 2670 Mess.msg := LM_KILLWORD; 2671 Result:= DeliverMessage(Data, Mess) = 0; 2672end; 2673 2674function gtkKillLine( {%H-}widget: PGtkWidget; data: gPointer) : GBoolean; cdecl; 2675var 2676 Mess : TLMessage; 2677begin 2678 EventTrace('Kill Line', data); 2679 Mess.msg := LM_KILLLINE; 2680 Result:= DeliverMessage(Data, Mess) = 0; 2681end; 2682 2683function gtkCutToClip( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl; 2684var 2685 Mess : TLMessage; 2686begin 2687 EventTrace('Cut to clip', data); 2688 Mess.msg := LM_CUT; 2689 Result:= DeliverMessage(Data, Mess) = 0; 2690end; 2691 2692function gtkCopyToClip( {%H-}widget: PGtkWidget; data: gPointer) : GBoolean; cdecl; 2693var 2694 Mess : TLMessage; 2695begin 2696 EventTrace('Copy to Clip', data); 2697 Mess.msg := LM_COPY; 2698 Result:= DeliverMessage(Data, Mess) = 0; 2699end; 2700 2701function gtkPasteFromClip( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl; 2702var 2703 Mess : TLMessage; 2704begin 2705 EventTrace('Paste from clip', data); 2706 Mess.msg := LM_PASTE; 2707 Result:= DeliverMessage(Data, Mess) = 0; 2708end; 2709 2710function gtkValueChanged({%H-}widget: PGtkWidget; data: gPointer) : GBoolean; cdecl; 2711var 2712 Mess : TLMessage; 2713begin 2714 Result := CallBackDefaultReturn; 2715 EventTrace('Value changed', data); 2716 Mess.msg := LM_CHANGED; 2717 DeliverMessage(Data, Mess); 2718end; 2719 2720{------------------------------------------------------------------------------ 2721 Method: gtkTimerCB 2722 Params: Data - pointer TGtkITimerInfo structure 2723 Returns: 1 - 1 tells gtk to restart the timer 2724 0 - 0 will stop the gtk timer 2725 2726 Callback for gtk timer. 2727 2728 WARNING: There seems to be a bug in gtk-1.2.x which breaks 2729 gtk_timeout_remove so we have to dispose data here & return 0 2730 (s.a. KillTimer). 2731 ------------------------------------------------------------------------------} 2732function gtkTimerCB(Data: gPointer): gBoolean; cdecl; 2733var 2734 TimerInfo: PGtkITimerinfo; 2735begin 2736 EventTrace ('TimerCB', nil); 2737 Result := GdkFalse; // assume: timer will stop 2738 2739 TimerInfo:=PGtkITimerinfo(Data); 2740 2741 if (FTimerData=nil) or (FTimerData.IndexOf(Data)<0) then begin 2742 {$IFDEF VerboseTimer} 2743 DebugLn('gtkTimerCB Timer was killed: TimerInfo=',DbgS(TimerInfo)); 2744 {$ENDIF} 2745 // timer was killed 2746 Result:=GdkFalse; // stop timer 2747 end else begin 2748 {$IFDEF VerboseTimer} 2749 DebugLn('gtkTimerCB Timer Event: TimerInfo=',DbgS(TimerInfo)); 2750 {$ENDIF} 2751 if TimerInfo^.TimerFunc <> nil 2752 then begin 2753 // Call users timer function 2754 //DebugLn(['gtkTimerCB ']); 2755 TimerInfo^.TimerFunc; 2756 Result:=GdkTrue; // timer will go on 2757 end 2758 else begin 2759 Result := GdkFalse; // stop timer 2760 end; 2761 end; 2762 2763 if (Result<>GdkFalse) and (FTimerData.IndexOf(Data)<0) then begin 2764 // timer was killed 2765 // -> stop timer 2766 Result:=GdkFalse; 2767 end; 2768 2769 if Result=GdkFalse then begin 2770 {$IFDEF VerboseTimer} 2771 DebugLn('gtkTimerCB Timer was STOPPED: TimerInfo=',DbgS(TimerInfo)); 2772 {$ENDIF} 2773 // timer will be stopped 2774 // -> free timer data, if not already done 2775 if (FTimerData<>nil) and (FTimerData.IndexOf(Data)>=0) then begin 2776 FTimerData.Remove(Data); 2777 Dispose (TimerInfo); // free memory with timer data 2778 end; 2779 end; 2780end; 2781 2782function gtkFocusInNotifyCB (widget : PGtkWidget; {%H-}event : PGdkEvent; 2783 data : gpointer) : GBoolean; cdecl; 2784var 2785 MessI : TLMEnter; 2786begin 2787 Result := CallBackDefaultReturn; 2788 //DebugLn('[gtkFocusInNotifyCB] ',TControl(data).Name,':',TObject(data).ClassName); 2789 {$IFDEF EventTrace} 2790 EventTrace ('FocusInNotify (alias Enter)', data); 2791 {$ENDIF} 2792 2793 if csDesigning in TControl(Data).ComponentState then begin 2794 // stop the signal, so that the widget does not auto react 2795 g_signal_stop_emission_by_name(PGTKObject(Widget),'focus-in-event'); 2796 end; 2797 2798 MessI.msg := LM_Enter; 2799 DeliverMessage(Data, MessI); 2800end; 2801 2802function gtkFocusOutNotifyCB (widget : PGtkWidget; {%H-}event : PGdkEvent; 2803 data : gpointer) : GBoolean; cdecl; 2804var 2805 MessI : TLMExit; 2806begin 2807 Result := CallBackDefaultReturn; 2808 //DebugLn('[gtkFocusOutNotifyCB] ',TControl(data).Name,':',TObject(data).ClassName); 2809 {$IFDEF EventTrace} 2810 EventTrace ('FocusOutNotify (alias Exit)', data); 2811 {$ENDIF} 2812 2813 if csDesigning in TControl(Data).ComponentState then begin 2814 // stop the signal, so that the widget does not auto react 2815 g_signal_stop_emission_by_name(PGTKObject(Widget),'focus-out-event'); 2816 end; 2817 2818 MessI.msg := LM_Exit; 2819 DeliverMessage(Data, MessI); 2820end; 2821 2822function get_gtk_scroll_type(range: PGTKRange): TGtkScrollType; 2823type 2824 TUnOpaqueTimer=record 2825 timeout_id: guint; 2826 ScrollType: TGTkScrollType; 2827 end; 2828 PUnOpaqueTimer=^TUnopaqueTimer; 2829begin 2830 if (gtk_major_version=2) and (gtk_minor_version<6) and 2831 (Range^.Timer<>nil) then 2832 { gtk2 pre gtk2.6 ONLY, tested gtk2.0. 2833 Later versions (gtk2.6+) have a change-value signal that includes scrolltype anyways } 2834 2835 Result := PUnOpaqueTimer(Range^.Timer)^.ScrollType 2836 else 2837 Result := GTK_SCROLL_NONE; 2838end; 2839 2840{$IFDEF VerboseGtkScrollbars} 2841procedure DebugScrollStyle(Scroll: LongInt); 2842begin 2843 DbgOut('TYPE='); 2844 case Scroll of 2845 GTK_SCROLL_NONE: DbgOut('GTK_SCROLL_NONE '); 2846 GTK_SCROLL_STEP_BACKWARD: DbgOut('GTK_SCROLL_STEP_BACKWARD '); 2847 GTK_SCROLL_STEP_FORWARD: DbgOut('GTK_SCROLL_STEP_FORWARD '); 2848 GTK_SCROLL_PAGE_BACKWARD: DbgOut('GTK_SCROLL_PAGE_BACKWARD '); 2849 GTK_SCROLL_PAGE_FORWARD: DbgOut('GTK_SCROLL_PAGE_FORWARD '); 2850 GTK_SCROLL_JUMP: DbgOut('GTK_SCROLL_JUMP '); 2851 GTK_SCROLL_STEP_UP: DbgOut('GTK_SCROLL_STEP_UP'); 2852 GTK_SCROLL_STEP_DOWN: DbgOut('GTK_SCROLL_STEP_DOWN'); 2853 GTK_SCROLL_PAGE_UP: DbgOut('GTK_SCROLL_PAGE_UP'); 2854 GTK_SCROLL_PAGE_DOWN: DbgOut('GTK_SCROLL_PAGE_DOWN'); 2855 GTK_SCROLL_STEP_LEFT: DbgOut('GTK_SCROLL_STEP_LEFT'); 2856 GTK_SCROLL_STEP_RIGHT: DbgOut('GTK_SCROLL_STEP_RIGHT'); 2857 GTK_SCROLL_PAGE_LEFT: DbgOut('GTK_SCROLL_PAGE_LEFT'); 2858 GTK_SCROLL_PAGE_RIGHT: DbgOut('GTK_SCROLL_PAGE_RIGHT'); 2859 GTK_SCROLL_START: DbgOut('GTK_SCROLL_START'); 2860 GTK_SCROLL_END: DbgOut('GTK_SCROLL_END'); 2861 else 2862 DbgOut(IntToStr(Scroll), '->?'); 2863 end; 2864end; 2865{$ENDIF VerboseGtkScrollbars} 2866 2867function ScrollTypeToSbCode(IsVertSB: boolean; ScrollType: TGtkScrollType; 2868 UpdatePolicy: TGtkUpdateType): Integer; 2869begin 2870 case ScrollType of 2871 GTK_SCROLL_STEP_BACKWARD: 2872 if IsVertSB then 2873 Result := SB_LINEUP 2874 else 2875 Result := SB_LINELEFT; 2876 GTK_SCROLL_STEP_FORWARD: 2877 if IsVertSB then 2878 Result := SB_LINEDOWN 2879 else 2880 Result := SB_LINERIGHT; 2881 GTK_SCROLL_PAGE_BACKWARD: 2882 if IsVertSB then 2883 Result := SB_PAGEUP 2884 else 2885 Result := SB_PAGELEFT; 2886 GTK_SCROLL_PAGE_FORWARD: 2887 if IsVertSB then 2888 Result := SB_PAGEDOWN 2889 else 2890 Result := SB_PAGERIGHT; 2891 GTK_SCROLL_STEP_UP: 2892 Result := SB_LINEUP; 2893 GTK_SCROLL_STEP_DOWN: 2894 Result := SB_LINEDOWN; 2895 GTK_SCROLL_PAGE_UP: 2896 Result := SB_PAGEUP; 2897 GTK_SCROLL_PAGE_DOWN: 2898 Result := SB_PAGEDOWN; 2899 GTK_SCROLL_STEP_LEFT: 2900 Result := SB_LINELEFT; 2901 GTK_SCROLL_STEP_RIGHT: 2902 Result := SB_LINERIGHT; 2903 GTK_SCROLL_PAGE_LEFT: 2904 Result := SB_PAGELEFT; 2905 GTK_SCROLL_PAGE_RIGHT: 2906 Result := SB_PAGERIGHT; 2907 GTK_SCROLL_START: 2908 if IsVertSB then 2909 Result := SB_TOP 2910 else 2911 Result := SB_LEFT; 2912 GTK_SCROLL_END: 2913 if IsVertSB then 2914 Result := SB_BOTTOM 2915 else 2916 Result := SB_RIGHT; 2917 else 2918 begin 2919 {$IFDEF VerboseGtkScrollbars} 2920 debugln('ScrollTypeToSbCode: Scroll_type=', IntToStr(ScrollType)); 2921 {$Endif} 2922 if UpdatePolicy=GTK_UPDATE_CONTINUOUS then 2923 Result := SB_THUMBTRACK 2924 else 2925 Result := SB_THUMBPOSITION; 2926 end; 2927 end; 2928end; 2929 2930function GTKHScrollCB(Adjustment: PGTKAdjustment; data: GPointer): GBoolean; cdecl; 2931var 2932 Msg: TLMHScroll; 2933 Scroll: PGtkRange; 2934 ScrollType: TGtkScrollType; 2935begin 2936 Result := CallBackDefaultReturn; 2937 //DebugLn(Format('Trace:[GTKHScrollCB] Value: %d', [RoundToInt(Adjustment^.Value)])); 2938 Scroll := PgtkRange(g_object_get_data(PGObject(Adjustment), odnScrollBar)); 2939 if Scroll<>nil then begin 2940 Msg.Msg := LM_HSCROLL; 2941 with Msg do begin 2942 Pos := Round(Adjustment^.Value); 2943 if Pos < High(SmallPos) 2944 then SmallPos := Pos 2945 else SmallPos := High(SmallPos); 2946 ScrollBar := HWND({%H-}PtrUInt(Scroll)); 2947 ScrollType := get_gtk_scroll_type(Scroll); 2948 ScrollCode := ScrollTypeToSbCode(False, ScrollType, 2949 gtk_range_get_update_policy(Scroll)); 2950 end; 2951 DeliverMessage(Data, Msg); 2952 end; 2953end; 2954 2955function GTKVScrollCB(Adjustment: PGTKAdjustment; data: GPointer): GBoolean; cdecl; 2956var 2957 Msg: TLMVScroll; 2958 Scroll: PGtkRange; 2959 ScrollType: TGtkScrollType; 2960begin 2961 //TODO: implement SB_THUMBPOSITION message after track is finished 2962 2963 Result := CallBackDefaultReturn; 2964 {$IFDEF SYNSCROLLDEBUG} 2965 DebugLn(Format('Trace:[GTKVScrollCB] Value: %d', [RoundToInt(Adjustment^.Value)])); 2966 {$ENDIF} 2967 Scroll := PgtkRange(g_object_get_data(PGObject(Adjustment), odnScrollBar)); 2968 if Scroll<>nil then begin 2969 Msg.Msg := LM_VSCROLL; 2970 with Msg do begin 2971 Pos := Round(Adjustment^.Value); 2972 if Pos < High(SmallPos) 2973 then SmallPos := Pos 2974 else SmallPos := High(SmallPos); 2975 //DebugLn('GTKVScrollCB A Adjustment^.Value=',dbgs(Adjustment^.Value),' SmallPos=',dbgs(SmallPos)); 2976 ScrollBar := HWND({%H-}PtrUInt(Scroll)); 2977 ScrollType := get_gtk_scroll_type(Scroll); 2978 // GTK1 has a bug with wheel mouse. It sometimes gives the wrong direction. 2979 ScrollCode := ScrollTypeToSbCode(True, ScrollType, 2980 gtk_range_get_update_policy(Scroll)); 2981 //DebugLn('GTKVScrollCB B Adjustment^.Value=',dbgs(Adjustment^.Value),' ScrollCode=',dbgs(ScrollCode),' ScrollType=',dbgs(ScrollType)); 2982 end; 2983 DeliverMessage(Data, Msg); 2984 end; 2985end; 2986 2987function Gtk2RangeScrollCB(ARange: PGtkRange; AScrollType: TGtkScrollType; 2988 AValue: gdouble; AWidgetInfo: PWidgetInfo): gboolean; cdecl; 2989var 2990 Msg: TLMVScroll; 2991 MaxValue: gdouble; 2992 Widget: PGTKWidget; 2993begin 2994 Result := CallBackDefaultReturn; 2995 2996 Widget:=PGTKWidget(ARange); 2997 {$IFDEF SYNSCROLLDEBUG} 2998 DebugLn(Format('Trace:[Gtk2RangeScrollCB] Value: %d', [RoundToInt(AValue)])); 2999 {$ENDIF} 3000 if G_OBJECT_TYPE(ARange) = gtk_hscrollbar_get_type then 3001 Msg.Msg := LM_HSCROLL 3002 else 3003 Msg.Msg := LM_VSCROLL; 3004 3005 if ARange^.adjustment^.page_size > 0 then 3006 MaxValue := ARange^.adjustment^.upper - ARange^.adjustment^.page_size 3007 else 3008 MaxValue := ARange^.adjustment^.upper; 3009 3010 if (AValue > MaxValue) then 3011 AValue := MaxValue 3012 else if (AValue < ARange^.adjustment^.lower) then 3013 AValue := ARange^.adjustment^.lower; 3014 3015 with Msg do 3016 begin 3017 Pos := Round(AValue); 3018 if Pos < High(SmallPos) then 3019 SmallPos := Pos 3020 else 3021 SmallPos := High(SmallPos); 3022 3023 ScrollBar := HWND({%H-}PtrUInt(ARange)); 3024 ScrollCode := GtkScrollTypeToScrollCode(AScrollType); 3025 end; 3026 DeliverMessage(AWidgetInfo^.LCLObject, Msg); 3027 3028 if Msg.Scrollcode=SB_THUMBTRACK then 3029 begin 3030 if Widget^.state = 0 then 3031 begin 3032 Msg.ScrollCode := SB_THUMBPOSITION; 3033 DeliverMessage(AWidgetInfo^.LCLObject, Msg); 3034 Msg.ScrollCode:=SB_ENDSCROLL; 3035 DeliverMessage(AWidgetInfo^.LCLObject, Msg); 3036 end; 3037 end 3038 else Widget^.state := 1; 3039 3040 if (AWidgetInfo^.LCLObject is TScrollingWinControl) and 3041 ((Msg.ScrollCode=SB_LINEUP) or (Msg.ScrollCode=SB_LINEDOWN)) then 3042 Result:=True; 3043end; 3044 3045procedure Gtk2RangeValueChanged(ARange: PGTKRange; data: GPointer); cdecl; 3046var 3047 Msg: TLMVScroll; 3048 MaxValue: gdouble; 3049 Widget: PGTKWidget; 3050 AValue: gDouble; 3051begin 3052 // used only by TScrollingWinControl ! #issue #25479 3053 Widget := PGTKWidget(ARange); 3054 if G_OBJECT_TYPE(ARange) = gtk_hscrollbar_get_type then 3055 Msg.Msg := LM_HSCROLL 3056 else 3057 Msg.Msg := LM_VSCROLL; 3058 3059 AValue := gtk_range_get_value(ARange); 3060 3061 if ARange^.adjustment^.page_size > 0 then 3062 MaxValue := ARange^.adjustment^.upper - ARange^.adjustment^.page_size 3063 else 3064 MaxValue := ARange^.adjustment^.upper; 3065 3066 if (AValue > MaxValue) then 3067 AValue := MaxValue 3068 else if (AValue < ARange^.adjustment^.lower) then 3069 AValue := ARange^.adjustment^.lower; 3070 3071 with Msg do 3072 begin 3073 Pos := Round(AValue); 3074 if Pos < High(SmallPos) then 3075 SmallPos := Pos 3076 else 3077 SmallPos := High(SmallPos); 3078 3079 ScrollBar := HWND({%H-}PtrUInt(ARange)); 3080 ScrollCode := SB_THUMBTRACK; 3081 end; 3082 3083 // do not send messages to LCL if we are already synced. 3084 if (Msg.Msg = LM_VSCROLL) and 3085 (TScrollingWinControl(PWidgetInfo(Data)^.LCLObject).VertScrollBar.Position = Msg.Pos) then 3086 exit 3087 else 3088 if (Msg.Msg = LM_HSCROLL) and 3089 (TScrollingWinControl(PWidgetInfo(Data)^.LCLObject).HorzScrollBar.Position = Msg.Pos) then 3090 exit; 3091 3092 DeliverMessage(PWidgetInfo(Data)^.LCLObject, Msg); 3093 3094 if Msg.Scrollcode=SB_THUMBTRACK then 3095 begin 3096 if Widget^.state = 0 then 3097 begin 3098 Msg.ScrollCode := SB_THUMBPOSITION; 3099 DeliverMessage(PWidgetInfo(Data)^.LCLObject, Msg); 3100 Msg.ScrollCode:=SB_ENDSCROLL; 3101 DeliverMessage(PWidgetInfo(Data)^.LCLObject, Msg); 3102 end; 3103 end 3104 else Widget^.state := 1; 3105end; 3106 3107function Gtk2RangeScrollPressCB(Widget: PGtkWidget; 3108 Event: PGdkEventButton; Data: gPointer): gboolean; cdecl; 3109begin 3110 Widget^.state := 2; 3111 Result := CallBackDefaultReturn;; 3112end; 3113 3114function Gtk2RangeScrollReleaseCB(Widget: PGtkWidget; 3115 Event: PGdkEventButton; Data: gPointer): gboolean; cdecl; 3116var 3117 Avalue: gdouble; 3118 WidgetInfo: PWidgetInfo; 3119begin 3120 AValue:=PGtkRange(Widget)^.adjustment^.value; 3121 WidgetInfo:=GetWidgetInfo(Widget); 3122 if not Assigned(WidgetInfo) then 3123 WidgetInfo:=GetWidgetInfo(Widget^.parent); 3124 if Assigned(WidgetInfo) and (Widget^.state = 1) then 3125 Gtk2RangeScrollCB(PGtkRange(Widget), 0, AValue, WidgetInfo); 3126 Widget^.state := 0; 3127 Result := CallBackDefaultReturn; 3128end; 3129 3130function Gtk2RangeUbuntuScrollCB(Adjustment: PGTKAdjustment; data: GPointer): GBoolean; cdecl; 3131var 3132 Msg: TLMVScroll; 3133 AWidgetInfo: PWidgetInfo; 3134 Scroll: PGtkRange; 3135 ScrollType: TGtkScrollType; 3136 LastPos: PtrInt; 3137begin 3138 Result := CallBackDefaultReturn; 3139 AWidgetInfo:=PWidgetInfo(Data); 3140 3141 //debugln(['Gtk2RangeUbuntuScrollCB ',DbgSName(AWidgetInfo^.LCLObject)]); 3142 Scroll := PgtkRange(g_object_get_data(PGObject(Adjustment), odnScrollBar)); 3143 if Scroll<>nil then begin 3144 FillByte(Msg{%H-},SizeOf(Msg),0); 3145 if Scroll^.orientation=GTK_ORIENTATION_VERTICAL then 3146 Msg.Msg := LM_VSCROLL 3147 else 3148 Msg.Msg := LM_HSCROLL; 3149 with Msg do begin 3150 Pos := Round(Adjustment^.Value); 3151 if Pos < High(SmallPos) 3152 then SmallPos := Pos 3153 else SmallPos := High(SmallPos); 3154 3155 LastPos:={%H-}PtrInt(g_object_get_data(PGObject(Adjustment), odnScrollBarLastPos)); 3156 if LastPos=Pos then begin 3157 //debugln(['Gtk2RangeUbuntuScrollCB duplicate message => skip']); 3158 exit; 3159 end; 3160 g_object_set_data(PGObject(Adjustment), odnScrollBarLastPos, {%H-}gpointer(Pos)); 3161 3162 //DebugLn('Gtk2RangeUbuntuScrollCB A Adjustment^.Value=',dbgs(Adjustment^.Value),' SmallPos=',dbgs(SmallPos)); 3163 ScrollBar := HWND({%H-}PtrUInt(Scroll)); 3164 ScrollType := get_gtk_scroll_type(Scroll); 3165 ScrollCode := ScrollTypeToSbCode(True, ScrollType, 3166 gtk_range_get_update_policy(Scroll)); 3167 //DebugLn('Gtk2RangeUbuntuScrollCB B Adjustment^.Value=',dbgs(Adjustment^.Value),' ScrollCode=',dbgs(ScrollCode),' ScrollType=',dbgs(ScrollType)); 3168 end; 3169 DeliverMessage(AWidgetInfo^.LCLObject, Msg); 3170 Result:=true; 3171 end; 3172end; 3173 3174function Gtk2ScrolledWindowScrollCB(AScrollWindow: PGtkScrolledWindow; AEvent: PGdkEventScroll; AWidgetInfo: PWidgetInfo): gboolean; cdecl; 3175var 3176 Msg: TLMVScroll; 3177 AValue: Double; 3178 Range: PGtkRange; 3179begin 3180 {$IFDEF SYNSCROLLDEBUG} 3181 debugln(['Gtk2ScrolledWindowScrollCB ']); 3182 {$ENDIF} 3183 case AEvent^.direction of 3184 GDK_SCROLL_UP, 3185 GDK_SCROLL_DOWN: Msg.Msg := LM_VSCROLL; 3186 GDK_SCROLL_LEFT, 3187 GDK_SCROLL_RIGHT: Msg.Msg := LM_HSCROLL; 3188 end; 3189 3190 case Msg.Msg of 3191 LM_VSCROLL: Range := GTK_RANGE(AScrollWindow^.vscrollbar); 3192 LM_HSCROLL: Range := GTK_RANGE(AScrollWindow^.hscrollbar); 3193 end; 3194 3195 AValue := power(Range^.adjustment^.page_size, 2 / 3); 3196 3197 if (AEvent^.direction = GDK_SCROLL_UP) or 3198 (AEvent^.direction = GDK_SCROLL_LEFT) 3199 then 3200 AValue := -AValue; 3201 3202 AValue := gtk_range_get_value(Range) + AValue; 3203 3204 AValue := Max(AValue, Range^.adjustment^.lower); 3205 AValue := Min(AValue, Range^.adjustment^.upper - Range^.adjustment^.page_size); 3206 3207 with Msg do 3208 begin 3209 Pos := Round(AValue); 3210 if Pos < High(SmallPos) then 3211 SmallPos := Pos 3212 else 3213 SmallPos := High(SmallPos); 3214 3215 ScrollBar := HWND({%H-}PtrUInt(Range)); 3216 ScrollCode := SB_THUMBPOSITION; 3217 end; 3218 Result := DeliverMessage(AWidgetInfo^.LCLObject, Msg) <> 0; 3219end; 3220 3221{------------------------------------------------------------------------------ 3222 Function: GTKKeySnooper 3223 Params: Widget: The widget for which this event is fired 3224 Event: The keyevent data 3225 FuncData: the user parameter passed when the snooper was installed 3226 Returns: True if other snoopers shouldn't handled 3227 3228 Keeps track of which keys are pressed. The keycode is casted to a pointer and 3229 if it exists in the KeyStateList, it is pressed. 3230 ------------------------------------------------------------------------------} 3231function GTKKeySnooper(Widget: PGtkWidget; Event: PGdkEventKey; 3232 FuncData: gPointer): gInt; cdecl; 3233var 3234 KeyStateList: TFPList absolute FuncData; 3235 3236 procedure UpdateToggleList(const AVKeyCode: Integer); 3237 begin 3238 // Check for a toggle 3239 // If the remove was successfull, the key was on 3240 // else it was off so we should set the toggle flag 3241 if KeyStateList.Remove({%H-}Pointer(PtrUInt(AVKeyCode or KEYMAP_TOGGLE))) < 0 3242 then KeyStateList.Add({%H-}Pointer(PtrUInt(AVKeyCode or KEYMAP_TOGGLE))); 3243 end; 3244 3245 procedure UpdateList(const AVKeyCode: Integer; const APressed: Boolean); 3246 begin 3247 if AVKeyCode = 0 then Exit; 3248 if APressed 3249 then begin 3250 if KeyStateList.IndexOf({%H-}Pointer(PtrUInt(AVKeyCode))) < 0 3251 then KeyStateList.Add({%H-}Pointer(PtrUInt(AVKeyCode))); 3252 end 3253 else begin 3254 KeyStateList.Remove({%H-}Pointer(PtrUInt(AVKeyCode))); 3255 end; 3256 end; 3257 3258const 3259 STATE_MAP: array[0..3] of TShiftStateEnum = ( 3260 ssShift, 3261 ssCtrl, 3262 ssAlt, 3263 ssSuper 3264 ); 3265 VK_MAP: array[0..3] of array[0..2] of Byte = ( 3266 // (Main key, alt key 1, alt key 2) to check 3267 (VK_SHIFT, VK_LSHIFT, VK_RSHIFT), 3268 (VK_CONTROL, VK_LCONTROL, VK_RCONTROL), 3269 (VK_MENU, VK_LMENU, VK_RMENU), 3270 (VK_LWIN, VK_RWIN, 0) 3271 ); 3272var 3273 KeyCode: Word; 3274 KCInfo: TKeyCodeInfo; 3275 VKey: Byte; 3276 Pressed, InState: Boolean; 3277 3278 n: Integer; 3279 ShiftState: TShiftState; 3280 3281begin 3282 Result := 0; 3283 3284 // TODO: Remove when KeyStateList is obsolete 3285 3286 case gdk_event_get_type(Event) of 3287 GDK_KEY_PRESS: Pressed := True; 3288 GDK_KEY_RELEASE: Pressed := False; 3289 else 3290 // not interested 3291 Exit; 3292 end; 3293 3294 KeyCode := Event^.hardware_keycode; 3295 //DebugLn('GTKKeySnooper: KeyCode=%u -> %s', [KeyCode, Event^._String ]); 3296 3297 if KeyCode > High(MKeyCodeInfo) 3298 then begin 3299 if Pressed 3300 then DebugLn('[WARNING] Key pressed with keycode (%u) larger than expected: K=0x%x S="%s"', [ 3301 KeyCode, 3302 Event^.KeyVal, 3303 Event^._String 3304 ]); 3305 Exit; 3306 end; 3307 3308 KCInfo := MKeyCodeInfo[KeyCode]; 3309 if KCInfo.VKey1 = 0 3310 then begin 3311 if Pressed 3312 then DebugLn('[WARNING] Key pressed without VKey: K=0x%x S="%s"', [ 3313 Event^.KeyVal, 3314 Event^._String 3315 ]); 3316 Exit; 3317 end; 3318 3319 if KeyStateList = nil then exit; 3320 3321 ShiftState := GTKEventStateToShiftState(Event^.State); 3322 3323 if (KCInfo.Flags and KCINFO_FLAG_SHIFT_XOR_NUM <> 0) 3324 and ((ssShift in ShiftState) xor (ssNum in ShiftState)) 3325 then VKey := KCInfo.VKey2 3326 else VKey := KCInfo.VKey1; 3327 3328 UpdateList(VKey, Pressed); 3329 if Pressed then 3330 UpdateToggleList(VKey); 3331 3332 // Add special left and right codes 3333 case Event^.KeyVal of 3334 GDK_Key_Shift_L: UpdateList(VK_LSHIFT, Pressed); 3335 GDK_Key_Shift_R: UpdateList(VK_RSHIFT, Pressed); 3336 GDK_Key_Control_L: UpdateList(VK_LCONTROL, Pressed); 3337 GDK_Key_Control_R: UpdateList(VK_RCONTROL, Pressed); 3338 GDK_Key_Alt_L: UpdateList(VK_LMENU, Pressed); 3339 GDK_Key_Alt_R: UpdateList(VK_RMENU, Pressed); 3340 end; 3341 3342 // Recheck the list against the modifiers 3343 for n := 0 to High(STATE_MAP) do 3344 begin 3345 // Skip our current key, since the state is updated after the event 3346 if VKey = VK_MAP[n][0] then Continue; 3347 if VKey = VK_MAP[n][1] then Continue; 3348 if VKey = VK_MAP[n][2] then Continue; 3349 3350 InState := STATE_MAP[n] in ShiftState; 3351 UpdateList(VK_MAP[n][0], InState); 3352 UpdateList(VK_MAP[n][1], InState); 3353 UpdateList(VK_MAP[n][2], InState); 3354 end; 3355 3356 // if the VKey has multiple VK_codes then SHIFT distinguishes between them 3357 // In that case SHIFT is not pressed 3358 // On the next event the shift flag will be restored based on modifiers 3359 if Pressed and ((KCInfo.Flags and KCINFO_FLAG_SHIFT_XOR_NUM) <> 0) 3360 then begin 3361 UpdateList(VK_SHIFT, False); 3362 UpdateList(VK_LSHIFT, False); 3363 UpdateList(VK_RSHIFT, False); 3364 end; 3365end; 3366 3367function gtkYearChanged({%H-}Widget: PGtkWidget; data: gPointer) : GBoolean; cdecl; 3368var 3369 MSG: TLMessage; 3370begin 3371 Result := CallBackDefaultReturn; 3372 3373 EventTrace('year changed', data); 3374 MSG.Msg := LM_YEARCHANGED; 3375 DeliverPostMessage(Data, MSG); 3376end; 3377 3378procedure GtkDragDataReceived(widget:PGtkWidget; context:PGdkDragContext; 3379 x:gint; y:gint; selection_data:PGtkSelectionData; info:guint; time:guint; Data: gPointer);cdecl; 3380var 3381 S: TStringList; 3382 I: Integer; 3383 FileName, DecodedFileName: String; 3384 Files: Array of String; 3385 Form: TControl; 3386 Result: Boolean; 3387 U: TURI; 3388begin 3389 //DebugLn('GtkDragDataReceived ' + PChar(selection_data^.data)); 3390 Result := False; 3391 3392 if selection_data^.data <> nil then // data is list of uri 3393 try 3394 SetLength(Files{%H-}, 0); 3395 S := TStringList.Create; 3396 try 3397 S.Text := PChar(selection_data^.data); 3398 3399 for I := 0 to S.Count - 1 do 3400 begin 3401 FileName := S[I]; 3402 3403 if FileName = '' then Continue; 3404 // uri = protocol://hostname/file name 3405 U := ParseURI(FileName); 3406 if (SameText(U.Host, 'localhost') or (U.Host = '')) and SameText(U.Protocol, 'file') 3407 and URIToFileName(FileName, DecodedFileName) then // convert uri of local files to file name 3408 begin 3409 FileName := DecodedFileName; 3410 end; 3411 // otherwise: protocol and hostname are preserved! 3412 3413 if FileName = '' then Continue; 3414 SetLength(Files, Length(Files) + 1); 3415 Files[High(Files)] := FileName; 3416 //DebugLn('GtkDragDataReceived ' + DbgS(I) + ': ' + PChar(FileName)); 3417 end; 3418 finally 3419 S.Free; 3420 end; 3421 3422 if Length(Files) > 0 then 3423 begin 3424 Form := nil; 3425 if (TObject(Data) is TWinControl) then 3426 Form := TWinControl(Data).IntfGetDropFilesTarget; 3427 3428 if Form is TCustomForm then 3429 TCustomForm(Form).IntfDropFiles(Files) 3430 else 3431 if (Application <> nil) and (Application.MainForm <> nil) then 3432 Application.MainForm.IntfDropFiles(Files); 3433 3434 if Application <> nil then 3435 Application.IntfDropFiles(Files); 3436 3437 Result := True; 3438 end; 3439 except 3440 Application.HandleException(nil); 3441 end; 3442 3443 gtk_drag_finish(Context, Result, false, time); 3444end; 3445 3446{------------------------------------------------------------------------------ 3447 ClipboardSelectionReceivedHandler 3448 3449 This handler is called whenever a clipboard owner sends data. Because the LCL 3450 caches all requests, this is typically data from another application. 3451 Copy the received selection data record and buffer to 3452 internal record and buffer (ClipboardSelectionData) 3453 ------------------------------------------------------------------------------} 3454procedure ClipboardSelectionReceivedHandler({%H-}TargetWidget: PGtkWidget; 3455 SelectionData: PGtkSelectionData; TimeID: guint32; {%H-}Data: Pointer); cdecl; 3456var TempBuf: Pointer; 3457 c: PClipboardEventData; 3458 i: integer; 3459begin 3460 // at any time there can be several requests 3461 // find the request with the correct TimeID 3462 i:=ClipboardSelectionData.Count-1; 3463 while (i>=0) do begin 3464 c:=PClipboardEventData(ClipboardSelectionData[i]); 3465 if c^.TimeID=TimeID then break; 3466 dec(i); 3467 end; 3468 {$IFDEF DEBUG_CLIPBOARD} 3469 DebugLn('[ClipboardSelectionReceivedHandler] A TimeID=',dbgs(TimeID),' RequestIndex=',dbgs(i), 3470 ' selection=',dbgs(SelectionData^.selection)+'='+GdkAtomToStr(SelectionData^.selection), 3471 ' target=',dbgs(SelectionData^.Target)+'='+GdkAtomToStr(SelectionData^.Target), 3472 ' theType=',dbgs(SelectionData^._type)+'='+GdkAtomToStr(SelectionData^._type), 3473 ' format=',dbgs(SelectionData^.format), 3474 ' len=',dbgs(SelectionData^.length) 3475 ); 3476 {$ENDIF} 3477 if i<0 then exit; 3478 // free old data 3479 if (c^.Data.Data<>nil) then FreeMem(c^.Data.Data); 3480 // copy the information 3481 c^.Data:=SelectionData^; 3482 // copy the raw data to an internal buffer (the gtk buffer will be destroyed 3483 // right after this event) 3484 {$IFDEF DEBUG_CLIPBOARD} 3485 DebugLn('[ClipboardSelectionReceivedHandler] B DataLen=',dbgs(c^.Data.Length)); 3486 {$ENDIF} 3487 if (c^.Data.Data<>nil) 3488 and (c^.Data.Length>0) then begin 3489 GetMem(TempBuf,c^.Data.Length); 3490 Move(c^.Data.Data^,TempBuf^,c^.Data.Length); 3491 c^.Data.Data:=TempBuf; 3492 {$IFDEF DEBUG_CLIPBOARD} 3493 DebugLn('[ClipboardSelectionReceivedHandler] C FirstCharacter=',dbgs(ord(PChar(c^.Data.Data)[0]))); 3494 {$ENDIF} 3495 end else begin 3496 {if (SelectionData^.Target <> GDK_TARGET_STRING) 3497 and (SelectionData^.length<0) then begin 3498 if gtk_selection_convert (TargetWidget, SelectionData^.selection, 3499 GDK_TARGET_STRING, TimeID)<>GdkFalse 3500 then begin 3501 DebugLn('[ClipboardSelectionReceivedHandler] D TimeID=',dbgs(TimeID),' RequestIndex=',dbgs(i), 3502 ' selection=',dbgs(SelectionData^.selection)+'='+GdkAtomToStr(SelectionData^.selection), 3503 ' target=',dbgs(SelectionData^.Target)+'='+GdkAtomToStr(SelectionData^.Target), 3504 ' theType=',dbgs(SelectionData^.theType)+'='+GdkAtomToStr(SelectionData^.theType), 3505 ' format=',dbgs(SelectionData^.format), 3506 ' len=',dbgs(SelectionData^.length) 3507 ); 3508 end; 3509 end;} 3510 c^.Data.Data:=nil; 3511 end; 3512end; 3513 3514// Helper procedures for ClipboardSelectionRequestHandler : 3515 3516procedure Transform2CompoundText(SelectionData: PGtkSelectionData; MemStream: TMemoryStream); 3517var 3518 Buffer: Pointer; 3519 BufLength: integer; 3520 P: PChar; 3521begin 3522 BufLength:=integer(MemStream.Size); 3523 P:=StrAlloc(BufLength); 3524 MemStream.Read(P^,BufLength); 3525 Buffer:=nil; 3526 BufLength:=0; 3527 gdk_string_to_compound_text(P, 3528 @SelectionData^._Type, 3529 @SelectionData^.Format,ppguchar(@Buffer),@BufLength); 3530 StrDispose(P); 3531 gtk_selection_data_set(SelectionData,SelectionData^.Target, 3532 SelectionData^.Format,Buffer,BufLength); 3533 gdk_free_compound_text(Buffer); 3534end; 3535 3536procedure SetData(SelectionData: PGtkSelectionData; MemStream: TMemoryStream); 3537var 3538 Buffer: Pointer; 3539 BufLength: integer; 3540begin 3541 BufLength:=integer(MemStream.Size); 3542 GetMem(Buffer,BufLength); 3543 Assert(Assigned(Buffer) and (BufLength>0), 'SetData: GTK2 clipboard Buffer=Nil or empty.'); 3544 MemStream.Read(Buffer^,BufLength); 3545 gtk_selection_data_set(SelectionData,SelectionData^.Target,8,Buffer,BufLength); 3546 FreeMem(Buffer); 3547end; 3548 3549{------------------------------------------------------------------------------ 3550 ClipboardSelectionRequestHandler 3551 3552 This signal is emitted if someone requests the clipboard data. 3553 Since the lcl clipboard caches all requests this will typically be another 3554 application. 3555 ------------------------------------------------------------------------------} 3556procedure ClipboardSelectionRequestHandler({%H-}TargetWidget: PGtkWidget; 3557 SelectionData: PGtkSelectionData; {%H-}Info: cardinal; {%H-}TimeID: cardinal; 3558 {%H-}Data: Pointer); cdecl; 3559var 3560 ClipboardType: TClipboardType; 3561 FormatID: cardinal; 3562 MemStream: TMemoryStream; 3563begin 3564 {$IFDEF DEBUG_CLIPBOARD} 3565 DebugLn('*** [ClipboardSelectionRequestHandler] START'); 3566 {$ENDIF} 3567 if SelectionData^.Target=0 then exit; 3568 for ClipboardType:=Low(TClipboardType) to High(TClipboardType) do 3569 begin 3570 if SelectionData^.Selection<>ClipboardTypeAtoms[ClipboardType] then 3571 Continue; 3572 if ClipboardHandler[ClipboardType]=nil then 3573 break; 3574 // handler found for this type of clipboard 3575 // now create a stream and find a supported format 3576 {$IFDEF DEBUG_CLIPBOARD} 3577 DebugLn('[ClipboardSelectionRequestHandler] "',ClipboardTypeName[ClipboardType],'" Format=',GdkAtomToStr(SelectionData^.Target),' ID=',dbgs(SelectionData^.Target)); 3578 {$ENDIF} 3579 MemStream:=TMemoryStream.Create; 3580 try 3581 // the gtk-interface provides automatically some formats, that the lcl 3582 // does not know. Wrapping them to lcl formats ... 3583 FormatID:=SelectionData^.Target; 3584 if ((FormatID=gdk_atom_intern('UTF8_STRING',GdkTrue)) 3585 and (ClipboardExtraGtkFormats[ClipboardType][gfUTF8_STRING])) 3586 or ((FormatID=gdk_atom_intern('COMPOUND_TEXT',GdkTrue)) 3587 and (ClipboardExtraGtkFormats[ClipboardType][gfCOMPOUND_TEXT])) 3588 or ((FormatID=gdk_atom_intern('STRING',GdkTrue)) 3589 and (ClipboardExtraGtkFormats[ClipboardType][gfSTRING])) 3590 or ((FormatID=gdk_atom_intern('TEXT',GdkTrue)) 3591 and (ClipboardExtraGtkFormats[ClipboardType][gfTEXT])) 3592 then 3593 FormatID:=gdk_atom_intern('text/plain',GdkTrue); 3594 3595 {$IFDEF DEBUG_CLIPBOARD} 3596 DebugLn('[ClipboardSelectionRequestHandler] FormatID=',dbgs(FormatID),'=',GdkAtomToStr(FormatID),' ',dbgs(ClipboardExtraGtkFormats[ClipboardType][gfCOMPOUND_TEXT])); 3597 {$ENDIF} 3598 // get the requested data by calling a handler for this clipboard type 3599 // and build data for gtk 3600 ClipboardHandler[ClipboardType](FormatID,MemStream); 3601 if MemStream.Size=0 then 3602 break; 3603 MemStream.Position:=0; 3604 if (FormatID=gdk_atom_intern('text/plain',GdkTrue)) 3605 and (SelectionData^.Target=gdk_atom_intern('COMPOUND_TEXT',GdkTrue)) then 3606 // if the format was wrapped, transform text/plain back to COMPOUND_TEXT 3607 Transform2CompoundText(SelectionData, MemStream) 3608 else 3609 SetData(SelectionData, MemStream); 3610 finally 3611 MemStream.Free; 3612 end; 3613 break; 3614 end; // for 3615end; 3616 3617{------------------------------------------------------------------------------ 3618 ClipboardSelectionLostOwnershipHandler 3619 3620 This signal is emitted if another application gets the clipboard ownership. 3621 ------------------------------------------------------------------------------} 3622function ClipboardSelectionLostOwnershipHandler({%H-}TargetWidget: PGtkWidget; 3623 EventSelection: PGdkEventSelection; {%H-}Data: Pointer): cardinal; cdecl; 3624var ClipboardType: TClipboardType; 3625begin 3626 //DebugLn('*** [ClipboardSelectionLostOwnershipHandler] ',DbgS(targetwidget)); 3627 for ClipboardType:=Low(TClipboardType) to High(TClipboardType) do 3628 if EventSelection^.Selection=ClipboardTypeAtoms[ClipboardType] then begin 3629 {$IFDEF DEBUG_CLIPBOARD} 3630 DebugLn('*** [ClipboardSelectionLostOwnershipHandler] ',ClipboardTypeName[ClipboardType]); 3631 {$ENDIF} 3632 if (ClipboardWidget<>nil) 3633 and (gdk_selection_owner_get(ClipboardTypeAtoms[ClipboardType]) 3634 <> GetControlWindow(ClipboardWidget)) 3635 and Assigned(ClipboardHandler[ClipboardType]) then begin 3636 // handler found for this type of clipboard 3637 {$IFDEF DEBUG_CLIPBOARD} 3638 DebugLn('[ClipboardSelectionLostOwnershipHandler] ',ClipboardTypeName[ClipboardType]); 3639 {$ENDIF} 3640 ClipboardHandler[ClipboardType](0,nil); 3641 ClipboardHandler[ClipboardType]:=nil; 3642 end; 3643 break; 3644 end; 3645 Result:=1; 3646end; 3647 3648{------------------------------------------------------------------------------- 3649 procedure GTKStyleChanged(Widget: PGtkWidget; previous_style : PGTKStyle; 3650 Data: Pointer); cdecl; 3651 3652 Handler for style changes. For example the user changes the theme. 3653 But also called on every widget realize, so it should not release all styles 3654 everytime. 3655-------------------------------------------------------------------------------} 3656{$IFDEF EventTrace} 3657procedure GTKStyleChanged({%H-}Widget: PGtkWidget; {%H-}previous_style : PGTKStyle; 3658 {%H-}Data: Pointer); cdecl; 3659begin 3660 EventTrace('style-set', nil); 3661 //ReleaseAllStyles; 3662end; 3663 3664procedure GTKStyleChangedAfter({%H-}Widget: PGtkWidget; {%H-}previous_style : PGTKStyle; 3665 {%H-}Data: Pointer); cdecl; 3666begin 3667 EventTrace('style-set', nil); 3668 3669 { Note: 3670 This event is called for many widgets but not for all. 3671 It is called on creation and called when the theme changes. 3672 The resizing should occur when all styles were updated by the gtk. 3673 The gtk itself uses size messages via queue. 3674 Maybe the solution is to use g_idle_add for the top level form and resize. 3675 } 3676 //debugln('style-set after ',DbgSName(TWinControl(Data))); 3677 //LCLObject.InvalidateClientRectCache(False); 3678end; 3679{$ENDIF} 3680 3681 3682function gtkListBoxSelectionChangedAfter(widget: PGtkWidget; data: gPointer 3683 ): GBoolean; cdecl; 3684var 3685 Mess: TLMessage; 3686 GtkList: PGtkList; 3687begin 3688 Result := CallBackDefaultReturn; 3689 {$IFDEF EventTrace} 3690 EventTrace('gtkListSelectionChangedAfter', data); 3691 {$ENDIF} 3692 GtkList:=PGtkList(widget); 3693 if (GtkList^.selection = nil) or (LockOnChange(PGtkObject(widget),0) > 0) then 3694 Exit; 3695 FillChar(Mess{%H-},SizeOf(Mess),0); 3696 Mess.msg := LM_SelChange; 3697 if gtkListGetSelectionMode(GtkList)=GTK_SELECTION_SINGLE then 3698 gtk_list_set_selection_mode(GtkList,GTK_SELECTION_BROWSE); 3699 DeliverMessage(Data, Mess); 3700end; 3701 3702//DRAG CALLBACK FUNCTIONS 3703 3704function edit_drag_data_received({%H-}widget : pgtkWidget; 3705 Context : pGdkDragContext; 3706 {%H-}X, {%H-}Y : Integer; 3707 SelData : pGtkSelectionData; 3708 {%H-}info : Integer; 3709 time : Integer; 3710 data : pointer) : GBoolean; cdecl; 3711Var 3712 Texts : String; 3713Begin 3714 Result:=false; 3715 //DebugLn('Trace:***********Drag Data Received*******************'); 3716 if Seldata^.Length > 0 then 3717 Begin 3718 Texts := StrPas(PChar(SelData^.data)); 3719 //DebugLn('Trace:' + Texts); 3720 //DebugLn('Trace:0'); 3721 TCustomEdit(Data).Caption := Texts; 3722 //DebugLn('Trace:1'); 3723 end; 3724 gtk_drag_finish(Context,false,false,time); 3725end; 3726 3727function edit_source_drag_data_get({%H-}widget : pgtkWidget; 3728 {%H-}Context : pGdkDragContext; 3729 Selection_data : pGtkSelectionData; 3730 info : Integer; 3731 {%H-}time : Integer; 3732 data : pointer) : GBoolean; cdecl; 3733var 3734 strTemp : PChar; 3735 Texts : String; 3736Begin 3737 Result:=false; 3738 if (info = TARGET_ROOTWIN) then begin 3739 //DebugLn('Trace:I WAS DROPPED ON THE ROOTWIN') 3740 end 3741 else Begin 3742 //DebugLn('Trace:*********Setting Data************'); 3743 Texts := TCustomEdit(data).Text; 3744 //DebugLn('Trace:0'); 3745 strTemp := StrAlloc(length(Texts) + 1); 3746 try 3747 StrPCopy(strTemp, Texts); 3748 //DebugLn('Trace:1'); 3749 gtk_selection_data_set(selection_data,selection_data^.target, 3750 8, 3751 PGUChar(StrTemp), 3752 length(Texts)+1); 3753 //DebugLn('Trace:2'); 3754 finally 3755 strDispose(strTemp); 3756 end; 3757 //DebugLn('Trace:3'); 3758 end; 3759end; 3760 3761 3762function Edit_source_drag_data_delete ({%H-}Widget: pGtkWidget; 3763 {%H-}Context: pGdkDragContext; {%H-}Data: gpointer): gBoolean ; cdecl; 3764begin 3765 //DebugLn('Trace:***************'); 3766 //DebugLn('Trace:DELETE THE DATA'); 3767 Result:=false; 3768end; 3769 3770// combobox callbacks 3771function gtkComboBoxShowAfter({%H-}widget: PGtkWidget; data: gPointer): GBoolean; cdecl; 3772var 3773 Mess : TLMCommand; 3774 AComboBox: TCustomComboBox absolute data; 3775begin 3776 Result := True; 3777 EventTrace('ComboBoxShowAfter', data); 3778 3779 AComboBox.IntfGetItems; 3780 3781 FillChar(Mess{%H-},SizeOf(Mess),0); 3782 Mess.Msg := CN_Command; 3783 Mess.NotifyCode := CBN_DROPDOWN; 3784 3785 Result := DeliverMessage(Data, Mess) = 0; 3786end; 3787 3788function gtkComboBoxHideAfter({%H-}widget: PGtkWidget; data: gPointer): GBoolean; cdecl; 3789var 3790 Mess : TLMCommand; 3791begin 3792 Result := True; 3793 EventTrace('ComboBoxHideAfter', data); 3794 FillChar(Mess{%H-},SizeOf(Mess),0); 3795 Mess.Msg := CN_Command; 3796 Mess.NotifyCode := CBN_CLOSEUP; 3797 3798 Result := DeliverMessage(Data, Mess) = 0; 3799end; 3800 3801// notebook callbacks 3802procedure DrawNotebookPageIcon(Page: TCustomPage; Widget: PGtkWidget); 3803var 3804 NoteBook: TCustomTabControl; 3805 NoteBookWidget: PGtkWidget; 3806 PageWidget: PGtkWidget; 3807 TabWidget: PGtkWidget; 3808 ImageIndex: Integer; 3809begin 3810 NoteBook := Page.Parent as TCustomTabControl; 3811 ImageIndex := NoteBook.GetImageIndex(Page.PageIndex); 3812 if (NoteBook.Images = nil) or (ImageIndex < 0) 3813 or (Page.ImageIndex >= NoteBook.Images.Count) 3814 or (not NoteBook.HandleAllocated) 3815 or (not Page.HandleAllocated) 3816 then exit; 3817 NoteBookWidget := {%H-}PGtkWidget(NoteBook.Handle); 3818 PageWidget := {%H-}PGtkWidget(Page.Handle); 3819 3820 // get the tab container and the tab icon widget 3821 TabWidget := gtk_notebook_get_tab_label(PGtkNoteBook(NotebookWidget), 3822 PageWidget); 3823 if TabWidget = nil then exit; 3824 {$IFDEF VerboseGtkToDos}{$note reimplement}{$ENDIF} 3825 DrawImageListIconOnWidget(NoteBook.Images.ResolutionForPPI[NoteBook.ImagesWidth, NoteBook.Font.PixelsPerInch, NoteBook.GetCanvasScaleFactor], 3826 ImageIndex, Widget); 3827end; 3828 3829function PageIconWidgetExposeAfter(Widget: PGtkWidget; Event: PGDKEventExpose; 3830 Data: gPointer): GBoolean; cdecl; 3831var 3832 ThePage: TCustomPage absolute Data; 3833begin 3834 Result := false; 3835 //DebugLn('PageIconWidgetExposeAfter ',DbgS(Widget)); 3836 EventTrace('PageIconWidgetExposeAfter', Data); 3837 if (Event^.Count > 0) then exit; 3838 DrawNotebookPageIcon(ThePage, Widget); 3839end; 3840 3841 3842