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