1------------------------------------------------------------------------------ 2-- GtkAda - Ada95 binding for the Gimp Toolkit -- 3-- -- 4-- Copyright (C) 1998-2015, AdaCore -- 5-- -- 6-- This library is free software; you can redistribute it and/or modify it -- 7-- under terms of the GNU General Public License as published by the Free -- 8-- Software Foundation; either version 3, or (at your option) any later -- 9-- version. This library is distributed in the hope that it will be useful, -- 10-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12-- -- 13-- As a special exception under Section 7 of GPL version 3, you are granted -- 14-- additional permissions described in the GCC Runtime Library Exception, -- 15-- version 3.1, as published by the Free Software Foundation. -- 16-- -- 17-- You should have received a copy of the GNU General Public License and -- 18-- a copy of the GCC Runtime Library Exception along with this program; -- 19-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20-- <http://www.gnu.org/licenses/>. -- 21-- -- 22------------------------------------------------------------------------------ 23 24with Glib; use Glib; 25with Glib.Object; use Glib.Object; 26with Gtk; use Gtk; 27with Gtk.Box; use Gtk.Box; 28with Gtk.Button; use Gtk.Button; 29with Gtk.Enums; use Gtk.Enums; 30with Gtk.Frame; use Gtk.Frame; 31with Gtk.Grid; use Gtk.Grid; 32with Gtk.Widget; use Gtk.Widget; 33 34package body Create_Buttons is 35 36 procedure Button_Window (Widget : access GObject_Record'Class); 37 -- Toggles the visibility of Widget 38 39 ---------- 40 -- Help -- 41 ---------- 42 43 function Help return String is 44 begin 45 return "a @bGtk_Button@B is the basic widget to which you can associate" 46 & " a callback. Whenever the user presses the mouse on the button," 47 & " one or more functions specified by the user can be called."; 48 end Help; 49 50 ------------------- 51 -- Button_Window -- 52 ------------------- 53 54 procedure Button_Window (Widget : access GObject_Record'Class) is 55 W : constant Gtk_Widget := Gtk_Widget (Widget); 56 begin 57 if W.Get_Visible then 58 W.Hide; 59 else 60 W.Show; 61 end if; 62 end Button_Window; 63 64 --------- 65 -- Run -- 66 --------- 67 68 procedure Run (Frame : access Gtk.Frame.Gtk_Frame_Record'Class) is 69 Box1 : Gtk_Box; 70 Table : Gtk_Grid; 71 Button : array (0 .. 8) of Gtk_Button; 72 Left_A : constant array (0 .. 8) of Gint := 73 (0, 1, 2, 0, 2, 1, 1, 2, 0); 74 Top_A : constant array (0 .. 8) of Gint := (0, 1, 2, 2, 0, 2, 0, 1, 1); 75 76 begin 77 Gtk.Frame.Set_Label (Frame, "Buttons"); 78 79 Gtk_New_Vbox (Box1, Homogeneous => False, Spacing => 0); 80 Frame.Add (Box1); 81 82 Gtk_New (Table); 83 Table.Set_Border_Width (Border_Width => 10); 84 Box1.Pack_Start (Table, Expand => False, Fill => False, Padding => 0); 85 86 for J in Button'Range loop 87 Gtk_New (Button (J), Label => "Button" & Integer'Image (J)); 88 end loop; 89 90 for J in Button'Range loop 91 Button (J).On_Clicked 92 (Button_Window'Access, Button ((J + 1) mod Button'Length)); 93 Table.Attach (Button (J), Left => Left_A (J), Top => Top_A (J)); 94 end loop; 95 96 Show_All (Box1); 97 end Run; 98 99end Create_Buttons; 100