1{%MainUnit gtk3int.pas} 2 3{ TGtk3WidgetSet } 4 5var 6 Gtk3MPF: TGPollFunc; 7 8function Gtk3PollFunction(ufds:PGPollFD; nfsd:guint; timeout:gint):gint; cdecl; 9begin 10 Result := nfsd; 11 if TimeOut = -1 then 12 Gtk3WidgetSet.FMainPoll := ufds 13 else 14 Gtk3WidgetSet.FMainPoll := nil; 15 if Gtk3MPF <> nil then 16 begin 17 // writeln('Gtk3PollFunction timeout ',TimeOut,' nfsd ',nfsd,' ufds.revents ',ufds^.revents); 18 Gtk3MPF(ufds, nfsd, timeout); 19 end; 20end; 21 22{hook into gtk3 main event loop, used for testing purposes only atm.} 23procedure Gtk3MainEventLoop(AEvent: PGdkEvent; AData: gPointer); cdecl; 24var 25 AList: PGList; 26 APt: TPoint; 27 AWindow: HWND; 28 AComboBox: TGtk3ComboBox; 29 AWidget: gpointer; 30 AContext: Pcairo_t; 31 x: Double; 32 y: Double; 33 x2: Double; 34 y2: Double; 35 ARegion: Pcairo_region_t; 36 ARect: Tcairo_rectangle_int_t; 37begin 38 {$IFDEF GTK3DEBUGCORE} 39 DebugLn('** TGtk3WidgetSet.Gtk3MainEventLoop **'); 40 {$ENDIF} 41 42 // even this does not work correct 43 (* 44 if (AEvent^.type_ = GDK_CONFIGURE) then 45 begin 46 AWidget := g_object_get_data(AEvent^.configure.window,'lclwidget'); 47 if AWidget <> nil then 48 begin 49 if wtWindow in TGtk3Widget(AWidget).WidgetType then 50 begin 51 TGtk3Window(AWidget).Gtk3ActivateWindow(AEvent); 52 DebugLn('** WindowState event ',dbgsName(TGtk3Widget(AWidget).LCLObject),' windowState=',dbgs(TGtk3Window(AWidget).GetWindowState)); 53 end else 54 DebugLn('** WindowState event not wtWindow ',dbgsName(TGtk3Widget(AWidget).LCLObject)); 55 end else 56 DebugLn('** WindowState event UNKNOWN WINDOW !!!'); 57 end; 58 *) 59 60 (* 61 if (AEvent^.type_ = GDK_EXPOSE) then 62 begin 63 AWidget := g_object_get_data(AEvent^.expose.window,'lclwidget'); 64 if (AWidget <> nil) then 65 begin 66 ARegion := gdk_window_get_clip_region(AEvent^.expose.window); 67 cairo_region_get_extents(ARegion, @ARect); 68 DebugLn('Gtk3MainEventLoop*** EXPOSED ',dbgsName(TGtk3Widget(AWidget).LCLObject), 69 ' ownswindow ',dbgs(TGtk3Widget(AWidget).GetContainerWidget^.get_has_window), 70 ' window ',dbgHex(PtrUInt(AEvent^.expose.window)), 71 ' extents ',Format('x %d y %d x2 %d y2 %d',[ARect.x, ARect.y, ARect.width, ARect.height])); 72 73 (* do not use this otherwise painting is corrupted !!!! testing purposes only 74 AContext := gdk_cairo_create(AEvent^.expose.window); 75 cairo_clip_extents(AContext, @x, @y, @x2, @y2); 76 DebugLn('Gtk3MainEventLoop*** EXPOSED ',dbgsName(TGtk3Widget(AWidget).LCLObject), 77 ' window ',dbgHex(PtrUInt(AEvent^.expose.window)), 78 ' extents ',Format('x %2.2n y %2.2n x2 %2.2n y2 %2.2n',[x, y, x2, y2])); 79 cairo_surface_flush(cairo_get_target(AContext)); 80 cairo_surface_mark_dirty(cairo_get_target(AContext)); 81 cairo_destroy(AContext); 82 *) 83 end; 84 end; 85 *) 86 87 gtk_main_do_event(AEvent); 88end; 89 90procedure TGtk3WidgetSet.Gtk3Create; 91var 92 AGtkThread: PGThread; 93 AId: String; 94begin 95 g_type_init; 96 gtk_init(@argc, @argv); 97 AGtkThread := g_thread_self(); 98 AId := 'org.lcl.thread_' + dbgHex(PtrUInt(AGtkThread)); 99 FGtk3Application := TGtkApplication.new(PgChar(AId), G_APPLICATION_NON_UNIQUE); 100 // FGtk3Application^.set_application_id(PgChar(AId)); 101 FGtk3Application^.register(nil, nil); 102 103 GTK3WidgetSet := Self; 104end; 105 106procedure TGtk3WidgetSet.Gtk3Destroy; 107begin 108 Gtk3MPF := nil; 109 GTK3WidgetSet := nil; 110 WakeMainThread := nil; 111 112 if Assigned(FAppIcon) then 113 FAppIcon^.unref; 114 FAppIcon := nil; 115end; 116 117procedure TGtk3WidgetSet.SetDefaultAppFontName; 118var 119 AValue: TGValue; 120begin 121 FillByte(AValue, SizeOf(AValue), 0); 122 AValue.init(G_TYPE_STRING); 123 g_object_get_property(gtk_settings_get_default, 'gtk-font-name', @AValue); 124 FDefaultAppFontName := AValue.get_string; 125 AValue.unset; 126end; 127 128procedure TGtk3WidgetSet.InitSysColorBrushes; 129var 130 i: integer; 131 LogBrush: TLogBrush; 132begin 133 LogBrush.lbHatch := 0; 134 FillChar(LogBrush, SizeOf(TLogBrush), 0); 135 for i := Low(FSysColorBrushes) to High(FSysColorBrushes) do 136 begin 137 LogBrush.lbColor := GetSysColor(i); 138 FSysColorBrushes[i] := CreateBrushIndirect(LogBrush); 139 TGtk3Brush(FSysColorBrushes[i]).Shared := True; 140 end; 141end; 142 143procedure TGtk3WidgetSet.FreeSysColorBrushes; 144 145 procedure DeleteAndNilObject(var h: HGDIOBJ); 146 begin 147 if h <> 0 then 148 TGtk3Brush(h).Shared := False; 149 DeleteObject(h); 150 h := 0; 151 end; 152 153var 154 i: Integer; 155begin 156 for i := Low(FSysColorBrushes) to High(FSysColorBrushes) do 157 if FSysColorBrushes[i] <> HBRUSH(-1) then 158 DeleteAndNilObject(FSysColorBrushes[i]); 159end; 160 161{$IFNDEF UNIX} 162procedure TGtk3WidgetSet.DoWakeMainThread(Sender: TObject); 163begin 164 g_main_context_wakeup(g_main_context_default); 165 CheckSynchronize; 166end; 167{$ENDIF} 168 169function TGtk3WidgetSet.CreateDCForWidget(AWidget: PGtkWidget; 170 AWindow: PGdkWindow; cr: Pcairo_t): HDC; 171begin 172 if AWindow <> nil then 173 begin 174 Result := HDC(TGtk3DeviceContext.Create(AWindow, False)) 175 end else 176 begin 177 if cr <> nil then 178 Result := HDC(TGtk3DeviceContext.CreateFromCairo(AWidget, Cr)) 179 else 180 Result := HDC(TGtk3DeviceContext.Create(AWidget, False)); 181 end; 182 TGtk3DeviceContext(Result).CanRelease := True; 183end; 184 185procedure TGtk3WidgetSet.AddWindow(AWindow: PGtkWindow); 186var 187 AList: PGList; 188begin 189 if Assigned(FGtk3Application) then 190 FGtk3Application^.add_window(AWindow); 191end; 192 193{$IFDEF UNIX} 194var 195 threadsync_pipein, threadsync_pipeout: cint; 196 threadsync_giochannel: pgiochannel; 197 childsig_pending: boolean; 198 199 procedure ChildEventHandler({%H-}sig: longint; {%H-}siginfo: psiginfo; 200 {%H-}sigcontext: psigcontext); cdecl; 201 begin 202 childsig_pending := true; 203 WakeMainThread(nil); 204 end; 205 206 procedure InstallSignalHandler; 207 var 208 child_action: sigactionrec; 209 begin 210 child_action.sa_handler := @ChildEventHandler; 211 fpsigemptyset(child_action.sa_mask); 212 child_action.sa_flags := 0; 213 fpsigaction(SIGCHLD, @child_action, nil); 214 end; 215 216 function threadsync_iocallback({%H-}source: PGIOChannel; {%H-}condition: TGIOCondition; 217 data: gpointer): gboolean; cdecl; 218 var 219 thrashspace: array[1..1024] of byte; 220 begin 221 // read the sent bytes 222 fpread(threadsync_pipein, {%H-}thrashspace[1], 1); 223 224 Result := true; 225 // one of children signaled ? 226 if childsig_pending then 227 begin 228 childsig_pending := false; 229 TGtk3WidgetSet(data).ProcessChildSignal; 230 end; 231 // execute the to-be synchronized method 232 if IsMultiThread then 233 CheckSynchronize; 234 end; 235 236procedure TGtk3WidgetSet.InitSynchronizeSupport; 237begin 238 WakeMainThread := @PrepareSynchronize; 239 assignpipe(threadsync_pipein, threadsync_pipeout); 240 threadsync_giochannel := g_io_channel_unix_new(threadsync_pipein); 241 g_io_add_watch(threadsync_giochannel, G_IO_IN, @threadsync_iocallback, Self); 242end; 243 244procedure TGtk3WidgetSet.ProcessChildSignal; 245var 246 pid: tpid; 247 reason: TChildExitReason; 248 status: integer; 249 info: dword; 250 handler: PChildSignalEventHandler; 251begin 252 repeat 253 status:=0; 254 pid := fpwaitpid(-1, status, WNOHANG); 255 if pid <= 0 then break; 256 if wifexited(status) then 257 begin 258 reason := cerExit; 259 info := wexitstatus(status); 260 end else 261 if wifsignaled(status) then 262 begin 263 reason := cerSignal; 264 info := wtermsig(status); 265 end else 266 continue; 267 268 handler := FChildSignalHandlers; 269 while handler <> nil do 270 begin 271 if handler^.pid = pid then 272 begin 273 handler^.OnEvent(handler^.UserData, reason, info); 274 break; 275 end; 276 handler := handler^.NextHandler; 277 end; 278 until false; 279end; 280 281procedure TGtk3WidgetSet.PrepareSynchronize(AObject: TObject); 282var 283 thrash: char; 284begin 285 // wake up GUI thread by sending a byte through the threadsync pipe 286 thrash:='l'; 287 fpwrite(threadsync_pipeout, thrash, 1); 288end; 289{$ENDIF} 290 291constructor TGtk3WidgetSet.Create; 292var 293 AValue: TGValue; 294 i: Integer; 295begin 296 SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide, exOverflow, exUnderflow, exPrecision]); 297 inherited Create; 298 FCSSTheme := TStringList.Create; 299 FThemeName := ''; 300 FTimerData := TFPList.Create; 301 {$IFDEF GTK3DEBUGCORE} 302 DebugLn('** TGtk3WidgetSet.Create **'); 303 {$ENDIF} 304 Gtk3Create; 305 FMainPoll := nil; 306 Gtk3MPF := g_main_context_get_poll_func(g_main_context_default); 307 g_main_context_set_poll_func(g_main_context_default, @Gtk3PollFunction); 308 309 {install our event handler, so we can see all events before its delivery to GdkWindows} 310 gdk_event_handler_set(@Gtk3MainEventLoop, Self, nil); 311 312 {$IFDEF UNIX} 313 InitSynchronizeSupport; 314 // InstallSignalHandler; 315 {$ELSE} 316 WakeMainThread := @DoWakeMainThread; 317 {$ENDIF} 318 CharSetEncodingList := TList.Create; 319 CreateDefaultCharsetEncodings; 320 FillByte(AValue, SizeOf(AValue), 0); 321 AValue.init(G_TYPE_BOOLEAN); 322 AValue.set_boolean(True); 323 g_object_set_property(gtk_settings_get_default,'gtk-button-images',@AValue); 324 AValue.unset; 325 326 FGlobalCursor := 0; 327 FAppIcon := nil; 328 FStockNullBrush := 0; 329 FStockBlackBrush := 0; 330 FStockLtGrayBrush := 0; 331 FStockGrayBrush := 0; 332 FStockDkGrayBrush := 0; 333 FStockWhiteBrush := 0; 334 335 FStockNullPen := 0; 336 FStockBlackPen := 0; 337 FStockWhitePen := 0; 338 FStockSystemFont := 0; 339 FStockDefaultDC := 0; 340 341 Styles := TStringList.Create; 342 343 InitStockItems; 344 // initialize default app font name 345 SetDefaultAppFontName; 346 // InitSysColorBrushes; 347 for i := Low(FSysColorBrushes) to High(FSysColorBrushes) do 348 FSysColorBrushes[i] := HBRUSH(-1); 349 350 // g_object_set_property(gtk_settings_get_default,'gtk-enable-mnemonics',@AValue); 351 // g_object_set_property(gtk_settings_get_default,'gtk-auto-mnemonics',@AValue); 352end; 353 354destructor TGtk3WidgetSet.Destroy; 355begin 356 {$IFDEF GTK3DEBUGCORE} 357 DebugLn('** TGtk3WidgetSet.Destroy **'); 358 {$ENDIF} 359 ReleaseAllStyles; 360 Styles.Free; 361 Styles := nil; 362 FreeStockItems; 363 Gtk3Destroy; 364 FTimerData.Free; 365 Gtk3DefaultContext.Free; 366 Gtk3ScreenContext.Free; 367 if Assigned(CharSetEncodingList) then 368 begin 369 ClearCharsetEncodings; 370 FreeAndNil(CharSetEncodingList); 371 end; 372 FreeSysColorBrushes; 373 FCSSTheme.Free; 374 inherited Destroy; 375end; 376 377function TGtk3WidgetSet.LCLPlatform: TLCLPlatform; 378begin 379 Result := lpGtk3; 380end; 381 382procedure TGtk3WidgetSet.AppInit(var ScreenInfo: TScreenInfo); 383//var 384// AId: String; 385var 386 ScreenDC: HDC; 387begin 388 {$IFDEF GTK3DEBUGCORE} 389 DebugLn('TGtk3WidgetSet.AppInit'); 390 {$ENDIF} 391 ScreenDC := GetDC(0); 392 try 393 ScreenInfo.PixelsPerInchX := GetDeviceCaps(ScreenDC, LOGPIXELSX); 394 ScreenInfo.PixelsPerInchY := GetDeviceCaps(ScreenDC, LOGPIXELSY); 395 ScreenInfo.ColorDepth := GetDeviceCaps(ScreenDC, BITSPIXEL); 396 finally 397 ReleaseDC(0, ScreenDC); 398 end; 399end; 400 401procedure TGtk3WidgetSet.LoadCSSTheme; 402var 403 ACSSProvider: PGtkCssProvider; 404 ASettings: PGtkSettings; 405 AValue: TGValue; 406begin 407 ASettings := gtk_settings_get_default; 408 FillByte(AValue, SizeOf(AValue), 0); 409 AValue.init(G_TYPE_STRING); 410 ASettings^.get_property('gtk-theme-name', @AValue); 411 FThemeName := AValue.get_string; 412 AValue.unset; 413 ACSSProvider := gtk_css_provider_get_named(PGChar(FThemeName), ''); 414 if not Assigned(ACSSProvider) then 415 exit; 416 {$note from here we must parse css and get eg tooltip background-color and color etc.} 417 FCSSTheme.Text := gtk_css_provider_to_string(ACSSProvider); 418end; 419 420procedure TGtk3WidgetSet.ClearCSSTheme; 421begin 422 FCSSTheme.Clear; 423end; 424 425function TGtk3WidgetSet.GetCSSTheme(AList: TStrings): boolean; 426begin 427 Result := FCSSTheme.Count > 0; 428 if not Result then 429 LoadCSSTheme; 430 AList.Assign(FCSSTheme); 431end; 432 433function TGtk3WidgetSet.GetThemeName: string; 434begin 435 if FThemeName = '' then 436 LoadCSSTheme; 437 Result := FThemeName; 438end; 439 440procedure TGtk3WidgetSet.AppRun(const ALoop: TApplicationMainLoop); 441begin 442 {$IFDEF GTK3DEBUGCORE} 443 DebugLn('TGtk3WidgetSet.AppRun'); 444 {$ENDIF} 445 if Assigned(ALoop) then 446 ALoop; 447end; 448 449procedure TGtk3WidgetSet.AppWaitMessage; 450begin 451 {$IFDEF GTK3DEBUGCORE} 452 DebugLn('TGtk3WidgetSet.AppWaitMessage'); 453 {$ENDIF} 454 gtk_main_iteration; 455end; 456 457procedure TGtk3WidgetSet.AppProcessMessages; 458begin 459 {$IFDEF GTK3DEBUGCORE} 460 DebugLn('TGtk3WidgetSet.AppProcessMessages'); 461 {$ENDIF} 462 while gtk_events_pending do 463 gtk_main_iteration_do(False); 464end; 465 466procedure TGtk3WidgetSet.AppTerminate; 467var 468 AList: PGList; 469begin 470 {$IFDEF GTK3DEBUGCORE} 471 DebugLn('TGtk3WidgetSet.AppTerminate ',dbgs(gtk_main_level)); 472 {$ENDIF} 473 // g_main_context_release(g_main_context_default); 474 if Assigned(FGtk3Application) then 475 begin 476 FGtk3Application^.quit; 477 AList := FGtk3Application^.get_windows; 478 if Assigned(AList) then 479 begin 480 {$IFDEF GTK3DEBUGCORE} 481 DebugLn('TGtk3WidgetSet.Gtk3Destroy app Windows list ',dbgs(g_list_length(AList))); 482 {$ENDIF} 483 g_list_free(AList); 484 end else 485 begin 486 {$IFDEF GTK3DEBUGCORE} 487 DebugLn('TGtk3WidgetSet.Gtk3Destroy app Windows list is null '); 488 {$ENDIF} 489 end; 490 FGtk3Application^.release; 491 FGtk3Application^.unref; 492 FGtk3Application := nil; 493 end; 494 if gtk_main_level > 0 then 495 gtk_main_quit; 496end; 497 498procedure TGtk3WidgetSet.AppMinimize; 499begin 500 DebugLn('TGtk3WidgetSet.AppMinimize missing'); 501end; 502 503procedure TGtk3WidgetSet.AppRestore; 504begin 505 DebugLn('TGtk3WidgetSet.AppRestore missing'); 506end; 507 508procedure TGtk3WidgetSet.AppBringToFront; 509begin 510 DebugLn('TGtk3WidgetSet.AppBringToFront missing'); 511end; 512 513procedure TGtk3WidgetSet.AppSetIcon(const Small, Big: HICON); 514var 515 DoDestroyIcon: Boolean; 516 AIcon: PGdkPixbuf; 517begin 518 // DebugLn('TGtk3WidgetSet.AppSetIcon Small=',dbgHex(Small),' Big=',dbgHex(Big)); 519 DoDestroyIcon := Big = 0; 520 if DoDestroyIcon then 521 begin 522 if Assigned(FAppIcon) then 523 FAppIcon^.unref; 524 FAppIcon := nil; 525 end else 526 begin 527 AIcon := TGtk3Image(Big).Handle; 528 FAppIcon := PGdkPixbuf(AIcon)^.copy; 529 end; 530end; 531 532procedure TGtk3WidgetSet.AppSetTitle(const ATitle: string); 533begin 534 if Assigned(Application.MainForm) and (Application.MainForm.HandleAllocated) then 535 begin 536 TGtk3Window(Application.MainForm.Handle).Title := ATitle; 537 end; 538end; 539 540function TGtk3WidgetSet.AppRemoveStayOnTopFlags(const ASystemTopAlso: Boolean 541 ): Boolean; 542begin 543 Result := inherited AppRemoveStayOnTopFlags(ASystemTopAlso); 544end; 545 546function TGtk3WidgetSet.AppRestoreStayOnTopFlags(const ASystemTopAlso: Boolean 547 ): Boolean; 548begin 549 Result := inherited AppRestoreStayOnTopFlags(ASystemTopAlso); 550end; 551 552function TGtk3WidgetSet.CreateStandardCursor(ACursor: SmallInt): HCURSOR; 553var 554 CursorValue: Integer; 555begin 556 Result := 0; 557 if ACursor < crLow then Exit; 558 if ACursor > crHigh then Exit; 559 case TCursor(ACursor) of 560 crDefault: CursorValue := GDK_LEFT_PTR; 561 crArrow: CursorValue := GDK_Arrow; 562 crCross: CursorValue := GDK_Cross; 563 crIBeam: CursorValue := GDK_XTerm; 564 crSizeNESW: CursorValue := GDK_BOTTOM_LEFT_CORNER; 565 crSizeNS: CursorValue := GDK_SB_V_DOUBLE_ARROW; 566 crSizeNWSE: CursorValue := GDK_TOP_LEFT_CORNER; 567 crSizeWE: CursorValue := GDK_SB_H_DOUBLE_ARROW; 568 crSizeNW: CursorValue := GDK_TOP_LEFT_CORNER; 569 crSizeN: CursorValue := GDK_TOP_SIDE; 570 crSizeNE: CursorValue := GDK_TOP_RIGHT_CORNER; 571 crSizeW: CursorValue := GDK_LEFT_SIDE; 572 crSizeE: CursorValue := GDK_RIGHT_SIDE; 573 crSizeSW: CursorValue := GDK_BOTTOM_LEFT_CORNER; 574 crSizeS: CursorValue := GDK_BOTTOM_SIDE; 575 crSizeSE: CursorValue := GDK_BOTTOM_RIGHT_CORNER; 576 crUpArrow: CursorValue := GDK_LEFT_PTR; 577 crHourGlass:CursorValue := GDK_WATCH; 578 crHSplit: CursorValue := GDK_SB_H_DOUBLE_ARROW; 579 crVSplit: CursorValue := GDK_SB_V_DOUBLE_ARROW; 580 crAppStart: CursorValue := GDK_LEFT_PTR; 581 crHelp: CursorValue := GDK_QUESTION_ARROW; 582 crHandPoint:CursorValue := GDK_Hand2; 583 crSizeAll: CursorValue := GDK_FLEUR; 584 else 585 CursorValue := -1; 586 end; 587 if CursorValue <> -1 then 588 Result := HCURSOR({%H-}PtrUInt(gdk_cursor_new(CursorValue))); 589end; 590 591function TGtk3WidgetSet.DCGetPixel(CanvasHandle: HDC; X, Y: integer 592 ): TGraphicsColor; 593var 594 ANewPix: PGdkPixbuf; 595begin 596 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 597 DebugLn('WARNING: TGtk3WidgetSet.DCGetPixel not implemented ...'); 598 {$ENDIF} 599 Result := 0; 600 if IsValidDC(CanvasHandle) then 601 begin 602 if (TGtk3DeviceContext(CanvasHandle).ParentPixmap <> nil) then 603 begin 604 ANewPix := gdk_pixbuf_new_subpixbuf(TGtk3DeviceContext(CanvasHandle).ParentPixmap, X, Y, 1, 1); 605 // cairo_get_c 606 // gdk_pixbuf_get_pixels(ANewPix); 607 ANewPix^.unref; 608 end; 609 end; 610end; 611 612procedure TGtk3WidgetSet.DCSetPixel(CanvasHandle: HDC; X, Y: integer; 613 AColor: TGraphicsColor); 614var 615 ASavedPenColor: TColor; 616 cr: PCairo_t; 617begin 618 if IsValidDC(CanvasHandle) then 619 begin 620 cr := TGtk3DeviceContext(CanvasHandle).Widget; 621 ASavedPenColor := TGtk3DeviceContext(CanvasHandle).CurrentPen.Color; 622 TGtk3DeviceContext(CanvasHandle).CurrentPen.Color := AColor; 623 cairo_move_to(cr, X, Y); 624 cairo_line_to(cr, X, Y); 625 cairo_stroke(cr); 626 TGtk3DeviceContext(CanvasHandle).CurrentPen.Color := ASavedPenColor; 627 end; 628end; 629 630procedure TGtk3WidgetSet.DCRedraw(CanvasHandle: HDC); 631begin 632 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 633 DebugLn('WARNING: TGtk3WidgetSet.DCRedraw not implemented ...'); 634 {$ENDIF} 635end; 636 637procedure TGtk3WidgetSet.DCSetAntialiasing(CanvasHandle: HDC; AEnabled: Boolean 638 ); 639begin 640 // inherited DCSetAntialiasing(CanvasHandle, AEnabled); 641 if IsValidDC(CanvasHandle) then 642 begin 643 if AEnabled then 644 cairo_set_antialias(TGtk3DeviceContext(CanvasHandle).Widget, CAIRO_ANTIALIAS_DEFAULT) 645 else 646 cairo_set_antialias(TGtk3DeviceContext(CanvasHandle).Widget, CAIRO_ANTIALIAS_NONE); 647 end; 648end; 649 650procedure TGtk3WidgetSet.SetDesigning(AComponent: TComponent); 651begin 652 // inherited SetDesigning(AComponent); 653end; 654 655function gtk3TimerProc(Data: gPointer): gBoolean; cdecl; 656var 657 TimerInfo: PGtkITimerinfo; 658begin 659 Result := False; 660 661 TimerInfo := PGtkITimerinfo(Data); 662 663 if (FTimerData = nil) or (FTimerData.IndexOf(Data)<0) then 664 begin 665 Result := False // timer was killed 666 end else 667 begin 668 if TimerInfo^.TimerFunc <> nil then 669 begin 670 TimerInfo^.TimerFunc; 671 Result := True; // timer will go on 672 end else 673 begin 674 Result := False; // stop timer 675 end; 676 end; 677 678 if Result and (FTimerData.IndexOf(Data)<0) then 679 begin 680 // timer was killed 681 // -> stop timer 682 Result := False; 683 end; 684end; 685 686procedure gtk3TimerDestroyed(Data: gPointer); cdecl; 687var 688 TimerInfo: PGtkITimerinfo; 689begin 690 if (FTimerData <> nil) and Assigned(Data) and 691 (FTimerData.IndexOf(Data) >= 0) then 692 begin 693 TimerInfo := PGtkITimerinfo(Data); 694 FTimerData.Remove(Data); 695 Dispose(TimerInfo); 696 end; 697end; 698 699function TGtk3WidgetSet.CreateTimer(Interval: integer; TimerFunc: TWSTimerProc 700 ): THandle; 701var 702 TimerInfo: PGtkITimerinfo; 703begin 704 if ((Interval < 1) or (not Assigned(TimerFunc))) 705 then 706 Result := 0 707 else begin 708 New(TimerInfo); 709 FillByte(TimerInfo^,SizeOf(TGtkITimerinfo),0); 710 TimerInfo^.TimerFunc := TimerFunc; 711 {$IFDEF VerboseTimer} 712 DebugLn(['TGtk3WidgetSet.CreateTimer Interval=',dbgs(Interval)]); 713 {$ENDIF} 714 Result:= g_timeout_add_full(0 {G_PRIORITY_DEFAULT}, Interval, @gtk3TimerProc, TimerInfo, @gtk3TimerDestroyed); 715 if Result = 0 then 716 Dispose(TimerInfo) 717 else begin 718 TimerInfo^.TimerFunc := TimerFunc; 719 TimerInfo^.TimerHandle:=Result; 720 FTimerData.Add(TimerInfo); 721 end; 722 end; 723end; 724 725function TGtk3WidgetSet.DestroyTimer(TimerHandle: THandle): boolean; 726var 727 n: integer; 728 TimerInfo: PGtkITimerinfo; 729begin 730 Result := False; 731 n := FTimerData.Count; 732 while (n > 0) do 733 begin 734 dec (n); 735 TimerInfo := PGtkITimerinfo(FTimerData.Items[n]); 736 if (TimerInfo^.TimerHandle = guint(TimerHandle)) then 737 begin 738 // in gtk3 timeout is automatically removed 739 TimerInfo^.TimerHandle := 0; 740 // g_timeout_remove(TimerInfo^.TimerHandle); 741 FTimerData.Delete(n); 742 Dispose(TimerInfo); 743 end; 744 end; 745 Result := True; 746end; 747 748function TGtk3WidgetSet.IsValidDC(const DC: HDC): Boolean; 749begin 750 Result := DC <> 0; 751end; 752 753function TGtk3WidgetSet.IsValidGDIObject(const AGdiObject: HGDIOBJ): Boolean; 754begin 755 Result := AGdiObject <> 0; 756end; 757 758function TGtk3WidgetSet.IsValidHandle(const AHandle: HWND): Boolean; 759begin 760 Result := AHandle <> 0; 761end; 762 763procedure TGtk3WidgetSet.InitStockItems; 764var 765 LogBrush: TLogBrush; 766 logPen : TLogPen; 767begin 768 FillChar(LogBrush,SizeOf(TLogBrush),0); 769 LogBrush.lbStyle := BS_NULL; 770 FStockNullBrush := CreateBrushIndirect(LogBrush); 771 TGtk3Brush(FStockNullBrush).Shared := True; 772 773 LogBrush.lbStyle := BS_SOLID; 774 LogBrush.lbColor := $000000; 775 FStockBlackBrush := CreateBrushIndirect(LogBrush); 776 TGtk3Brush(FStockBlackBrush).Shared := True; 777 778 LogBrush.lbColor := $C0C0C0; 779 FStockLtGrayBrush := CreateBrushIndirect(LogBrush); 780 TGtk3Brush(FStockLtGrayBrush).Shared := True; 781 782 LogBrush.lbColor := $808080; 783 FStockGrayBrush := CreateBrushIndirect(LogBrush); 784 TGtk3Brush(FStockGrayBrush).Shared := True; 785 786 LogBrush.lbColor := $404040; 787 FStockDkGrayBrush := CreateBrushIndirect(LogBrush); 788 TGtk3Brush(FStockDkGrayBrush).Shared := True; 789 790 LogBrush.lbColor := $FFFFFF; 791 FStockWhiteBrush := CreateBrushIndirect(LogBrush); 792 TGtk3Brush(FStockWhiteBrush).Shared := True; 793 794 LogPen.lopnStyle := PS_NULL; 795 LogPen.lopnWidth := Point(0, 0); // create cosmetic pens 796 LogPen.lopnColor := $FFFFFF; 797 FStockNullPen := CreatePenIndirect(LogPen); 798 TGtk3Pen(FStockNullPen).Shared := True; 799 800 LogPen.lopnStyle := PS_SOLID; 801 FStockWhitePen := CreatePenIndirect(LogPen); 802 TGtk3Pen(FStockWhitePen).Shared := True; 803 804 LogPen.lopnColor := $000000; 805 FStockBlackPen := CreatePenIndirect(LogPen); 806 TGtk3Pen(FStockBlackPen).Shared := True; 807 808 FStockSystemFont := 0; // styles aren't initialized yet 809 810 FStockDefaultDC := 0; // app must be initialized 811end; 812 813procedure TGtk3WidgetSet.FreeStockItems; 814 procedure DeleteAndNilObject(var h: HGDIOBJ); 815 begin 816 if h <> 0 then 817 TGtk3ContextObject(h).Shared := False; 818 DeleteObject(h); 819 h := 0; 820 end; 821begin 822 DeleteAndNilObject(FStockNullBrush); 823 DeleteAndNilObject(FStockBlackBrush); 824 DeleteAndNilObject(FStockLtGrayBrush); 825 DeleteAndNilObject(FStockGrayBrush); 826 DeleteAndNilObject(FStockDkGrayBrush); 827 DeleteAndNilObject(FStockWhiteBrush); 828 829 DeleteAndNilObject(FStockNullPen); 830 DeleteAndNilObject(FStockBlackPen); 831 DeleteAndNilObject(FStockWhitePen); 832 833 DeleteAndNilObject(FStockSystemFont); 834end; 835 836function TGtk3WidgetSet.CreateDefaultFont: HFONT; 837var 838 AFont: TGtk3Font; 839 cr: Pcairo_t; 840begin 841 Result := 0; 842 cr := gdk_cairo_create(gdk_get_default_root_window); 843 AFont := TGtk3Font.Create(cr, nil); 844 cairo_destroy(cr); 845 Result := HFONT(AFont); 846end; 847 848