From 7973be2612e83d418ad4086dfdfe8624eab83746 Mon Sep 17 00:00:00 2001 From: drewski207 Date: Wed, 29 Aug 2012 04:04:36 +0000 Subject: [PATCH] Added gobject inheritance demo git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2501 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../examples/inheritance/gtk3mybutton.pas | 125 ++++++++++++++++++ .../examples/inheritance/inheritancedemo.lpi | 83 ++++++++++++ .../examples/inheritance/inheritancedemo.lpr | 49 +++++++ 3 files changed, 257 insertions(+) create mode 100644 bindings/gtk3/examples/inheritance/gtk3mybutton.pas create mode 100644 bindings/gtk3/examples/inheritance/inheritancedemo.lpi create mode 100644 bindings/gtk3/examples/inheritance/inheritancedemo.lpr diff --git a/bindings/gtk3/examples/inheritance/gtk3mybutton.pas b/bindings/gtk3/examples/inheritance/gtk3mybutton.pas new file mode 100644 index 000000000..a8b76e970 --- /dev/null +++ b/bindings/gtk3/examples/inheritance/gtk3mybutton.pas @@ -0,0 +1,125 @@ +unit gtk3mybutton; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, GLib2, GObject2, Gtk3; + +type + + { TMyButton } + + TObjectProcedure = procedure of object; + + PMyButton = ^TMyButton; + TMyButton = object(TGtkButton) + private + FOnClicked: TObjectProcedure; + saved_caption: String; + function OnTimer: GBoolean; cdecl; + procedure clicked; + procedure init; + public + function get_type: TGType; static; + function new: PMyButton; static; + + procedure QuitProgram; + + property OnClicked: TObjectProcedure read FOnClicked write FOnClicked; + + + end; + + { TMyButtonClass } + PMyButtonClass = ^TMyButtonClass; + TMyButtonClass = object(TGtkButtonClass) + origclicked: procedure(button: PGtkButton); cdecl; + procedure init; + end; + + +implementation +var + MY_BUTTON_TYPE: TGType = 0; + +{ TMyButtonClass } + +procedure TMyButtonClass.init; +begin + origclicked := clicked; + Pointer(clicked) := @TMyButton.clicked; +end; + +{ TMyButton } + +function TMyButton.OnTimer: GBoolean; cdecl; +var + klass: PMyButtonClass; +begin + Result := False; + label_ := PChar(saved_caption); + saved_caption:=''; + + if Assigned(FOnClicked) then + FOnClicked; + + klass := PMyButtonClass(g_type_instance.g_class); + + + if Assigned(klass^.origclicked) then + klass^.origclicked(@self); + + + + +end; + +procedure TMyButton.clicked; +begin + // we'll add a delay and update the text. the timer calls the inherited method. + g_timeout_add(3000, TGSourceFunc(@TMyButton.OnTimer), @Self); + saved_caption:=label_; + label_ := 'Wait for it...'; +end; + +procedure TMyButton.init; +begin + +end; + +function TMyButton.get_type: TGType; +var + Info: TGTypeInfo; +begin + if MY_BUTTON_TYPE = 0 then + begin + Info.class_size:=SizeOf(TMyButtonClass); + Info.base_init:= nil; + Info.base_finalize:=nil; + Info.class_init:= TGClassInitFunc(@TMyButtonClass.init); + Info.class_finalize:=nil; + Info.class_data:=nil; + Info.instance_size:=SizeOf(TMyButton); + Info.n_preallocs:=0; + Info.instance_init:=TGInstanceInitFunc(@TMyButton.init); + Info.value_table:=nil; + + MY_BUTTON_TYPE := g_type_register_static(gtk_button_get_type, 'MyButton', @Info, 0); + end; + Result := MY_BUTTON_TYPE; +end; + +function TMyButton.new: PMyButton; +begin + Result := PMyButton(g_object_new(TMyButton.get_type, nil, [])); +end; + +procedure TMyButton.QuitProgram; +begin + gtk_main_quit; +end; + +end. + diff --git a/bindings/gtk3/examples/inheritance/inheritancedemo.lpi b/bindings/gtk3/examples/inheritance/inheritancedemo.lpi new file mode 100644 index 000000000..ca107d666 --- /dev/null +++ b/bindings/gtk3/examples/inheritance/inheritancedemo.lpi @@ -0,0 +1,83 @@ + + + + + + + + + + + + + <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"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + </local> + </RunParams> + <RequiredPackages Count="1"> + <Item1> + <PackageName Value="Gtk3Pkg"/> + </Item1> + </RequiredPackages> + <Units Count="2"> + <Unit0> + <Filename Value="inheritancedemo.lpr"/> + <IsPartOfProject Value="True"/> + <UnitName Value="inheritancedemo"/> + </Unit0> + <Unit1> + <Filename Value="gtk3mybutton.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="gtk3mybutton"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <Target> + <Filename Value="inheritancedemo"/> + </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> diff --git a/bindings/gtk3/examples/inheritance/inheritancedemo.lpr b/bindings/gtk3/examples/inheritance/inheritancedemo.lpr new file mode 100644 index 000000000..3b763ebf3 --- /dev/null +++ b/bindings/gtk3/examples/inheritance/inheritancedemo.lpr @@ -0,0 +1,49 @@ +program inheritancedemo; + +{$mode objfpc}{$H+} + +uses + Classes, Gtk3,GObject2,GLib2, Math, gtk3mybutton; + +// these procedures are signal handlers. they are called when a signal is emitted +procedure Gtk_Window_Destroy(Sender: PGtkWidget; user_data: gpointer); cdecl; +begin + if gtk_main_level > 0 then + gtk_main_quit; +end; + +procedure Button_Click(Sender: PGtkWidget; user_data: gpointer); cdecl; +begin + gtk_main_quit; +end; + +procedure CreateWidgets; +var + Win: PGtkWindow; + Button: PMyButton; +begin + // first create window + Win := TGtkWindow.new(GTK_WINDOW_TOPLEVEL); + Win^.set_title('Hello World!'); + Win^.set_size_request(300,200); + + //then create a button and add it to the window + Button := TMyButton.new; + Button^.label_:='Quit'; + Button^.tooltip_text:='Don''t click me unless you want to!'; + Win^.add(PGtkWidget(Button)); + + // now connect signals + g_signal_connect_data(Win, 'destroy', TGCallback(@Gtk_Window_Destroy), nil, nil, 0); + //g_signal_connect_data(Button, 'clicked', TGCallback(@Button_Click), nil, nil, 0); + Button^.OnClicked:=@Button^.QuitProgram; + + Win^.show_all; +end; +begin + SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide, exOverflow, exUnderflow, exPrecision]); + gtk_init(@argc, @argv); + CreateWidgets; + gtk_main; +end. +