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
This commit is contained in:
drewski207
parent
498fd01a38
commit
f996e855de
@ -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>
|
||||||
@ -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.
|
||||||
|
|
||||||
Loading…
Reference in New Issue
Block a user