added gtk3 example of how to attach glib signal handlers to pascal classes TMethod directly

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2883 8e941d3f-bd1b-0410-a28a-d453659cc2b4

bindings/gtk3/examples/signaltoclassmethod/signaltoclassmethod.lpi

@@ -0,0 +1,75 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="signaltoclassmethod"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="Gtk3Pkg"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="signaltoclassmethod.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="signaltoclassmethod"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="signaltoclassmethod"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Other>
+      <CompilerMessages>
+        <MsgFileName Value=""/>
+      </CompilerMessages>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

bindings/gtk3/examples/signaltoclassmethod/signaltoclassmethod.lpr

@@ -0,0 +1,110 @@
+program signaltoclassmethod;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, Math, GLib2, GObject2, Gtk3, Gdk3, sysutils;
+
+type
+
+  { TClassApp }
+
+  TClassApp = class
+  private
+    Win: PGtkWindow;
+    Button: PGtkButton;
+    procedure CreateWidgets;
+    // these procedures are signal handlers. they are called when a signal is emitted
+    function MouseMove(Event: PGdkEvent; Widget: PGtkWidget): gboolean; cdecl;
+    procedure WindowDestroy(AWidget: PGtkWidget); cdecl;
+    procedure ButtonClick(AWidget: PGtkWidget); cdecl;
+    procedure MapWindow(AWidget: PgtkWidget); cdecl;
+  public
+    constructor Create;
+    procedure Run;
+  end;
+
+procedure ConnectWidgetSignalToMethod(AGObject: PGObject; ASignalName: String; AMethod: TMethod; Flags: TGConnectFlags);
+begin
+  Flags := Flags or G_CONNECT_SWAPPED;
+  g_signal_connect_data(AGObject, PChar(ASignalName), TGCallback(AMethod.Code), AMethod.Data, nil, Flags);
+end;
+
+
+
+{ TClassApp }
+
+procedure TClassApp.CreateWidgets;
+begin
+  // first create window
+  Win := TGtkWindow.new(GTK_WINDOW_TOPLEVEL);
+  Win^.set_title('Hello World!');
+  Win^.set_size_request(700,200);
+
+  //then create a button and add it to the window
+  Button := TGtkButton.new_with_label('Set TMethod class name as title');
+  Win^.add(PGtkWidget(Button));
+
+  // now connect signals
+  ConnectWidgetSignalToMethod(Win, 'destroy', TMethod(@WindowDestroy), 0);
+  ConnectWidgetSignalToMethod(Win, 'map', TMethod(@MapWindow), 0);
+  ConnectWidgetSignalToMethod(Button, 'clicked', TMethod(@ButtonClick), 0);
+  ConnectWidgetSignalToMethod(Win, 'motion-notify-event', TMethod(@MouseMove),0);
+
+  Win^.show_all;
+end;
+
+function TClassApp.MouseMove(Event: PGdkEvent; Widget: PGtkWidget): gboolean; cdecl;
+var
+Str: String;
+begin
+  Str := 'Mouse move: '+ g_type_name_from_instance(PGTypeInstance(Widget))
+      + ' For Class: ' +  Self.ClassName +  ' at ' + IntTostr(Round(Event^.motion.x))
+      + ':' + IntToStr(Round(Event^.motion.y));
+  Win^.title:=PChar(Str);
+end;
+
+constructor TClassApp.Create;
+begin
+  gtk_init(@argc, @argv);
+  CreateWidgets;
+end;
+
+procedure TClassApp.Run;
+begin
+  gtk_main;
+end;
+
+procedure TClassApp.WindowDestroy(AWidget: PGtkWidget); cdecl;
+begin
+  if gtk_main_level > 0 then
+    gtk_main_quit;
+end;
+
+procedure TClassApp.ButtonClick(AWidget: PGtkWidget); cdecl;
+var
+  name: String;
+begin
+  name := Self.ClassName;
+  Win^.set_title(PChar(name));
+end;
+
+procedure TClassApp.MapWindow(AWidget: PgtkWidget); cdecl;
+var
+mask : TGdkEventMask;
+begin
+  mask := gdk_window_get_events(Win^.window);
+  mask := mask or GDK_POINTER_MOTION_MASK;
+  gdk_window_set_events(Win^.window, mask);
+end;
+
+
+begin
+  SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide, exOverflow, exUnderflow, exPrecision]);
+  with TClassApp.Create do
+  begin
+    Run;
+    Free;
+  end;
+end.
+