Testgtk source code
This code is part of testgtk, a demo application packaged with GtkAda. Testgtk demonstrates the various widgets of GtkAda
-----------------------------------------------------------------------
-- GtkAda - Ada95 binding for the Gimp Toolkit --
-- --
-- Copyright (C) 1998-1999 --
-- Emmanuel Briot, Joel Brobecker and Arnaud Charlet --
-- Copyright (C) 2000-2006 AdaCore --
-- --
-- This library is free software; you can redistribute it and/or --
-- modify it under the terms of the GNU General Public --
-- License as published by the Free Software Foundation; either --
-- version 2 of the License, or (at your option) any later version. --
-- --
-- This library is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
-- General Public License for more details. --
-- --
-- You should have received a copy of the GNU General Public --
-- License along with this library; if not, write to the --
-- Free Software Foundation, Inc., 59 Temple Place - Suite 330, --
-- Boston, MA 02111-1307, USA. --
-- --
--
--
--
--
--
--
--
-----------------------------------------------------------------------
with Glib;
use Glib;
with Gtk.Box;
use Gtk.Box;
with Gtk.Button;
use Gtk.Button;
with Gtk.Check_Button;
use Gtk.Check_Button;
with Gtk.Enums;
use Gtk.Enums;
with Gtk.Frame;
use Gtk.Frame;
with Gtk.Handlers;
use Gtk.Handlers;
with Gtk.Label;
use Gtk.Label;
with Gtk.Size_Group;
use Gtk.Size_Group;
with Gtk.Table;
use Gtk.Table;
package body Create_Size_Groups
is
procedure Add_Row
(Table :
access Gtk_Table_Record'Class;
Row : Guint;
Group : Gtk_Size_Group;
Text : String);
-- Add a new row in Table, with a label Text .
-- The option menu in that row is added to the group Group.
procedure Toggle_Grouping
(Check_Button :
access Gtk_Check_Button_Record'Class;
Group : Gtk_Size_Group);
-- Toggle whether the size group is active.
package Toggle_Cb
is new Gtk.Handlers.User_Callback
(Gtk_Check_Button_Record, Gtk_Size_Group);
----------
-- Help --
----------
function Help
return String
is
begin
return
"@bGtk_Size_Group@B provides a mechanism
for grouping a number
of"
& " widgets together so they
all request the same amount
of space."
& " This
is typically useful
when you want a column
of widgets to have"
& " the same size, but you can't
use a @bGtk_Table@B widget."
& ASCII.LF
& "Note that size groups only affect the amount
of space requested,"
& "
not the size that the widgets finally receive. If you want the"
& " widgets
in a @bGtk_Size_Group@B to actually be the same size,"
& " you need to pack them
in such a way that they get the size they"
& " request
and not more. For example,
if you are packing your"
& " widgets into a table, you would
not include the FILL flag.";
end Help;
-------------
-- Add_Row --
-------------
procedure Add_Row
(Table :
access Gtk_Table_Record'Class;
Row : Guint;
Group : Gtk_Size_Group;
Text : String)
is
Label : Gtk_Label;
Button : Gtk_Button;
begin
Gtk_New (Label, Text);
Set_Alignment (Label, 0.0, 1.0);
Attach
(Table => Table,
Child => Label,
Left_Attach => 0,
Right_Attach => 1,
Top_Attach => Row,
Bottom_Attach => Row + 1,
Xoptions => Expand
or Fill,
Yoptions => 0);
Gtk_New (Button, Text);
Gtk.Size_Group.Add_Widget (Group, Button);
Attach
(Table => Table,
Child => Button,
Left_Attach => 1,
Right_Attach => 2,
Top_Attach => Row,
Bottom_Attach => Row + 1,
Xoptions => 0, -- !!! Do
not force any size, see Help
Yoptions => 0);
end Add_Row;
---------------------
-- Toggle_Grouping --
---------------------
procedure Toggle_Grouping
(Check_Button :
access Gtk_Check_Button_Record'Class;
Group : Gtk_Size_Group)
is
begin
-- Note: we use both the properties and the directy function call only
-- to demonstrate the two technics. No other technical reason.
if Get_Active (Check_Button)
then
Set_Property (Group, Mode_Property, Horizontal);
else
Gtk.Size_Group.Set_Mode (Group, None);
end if;
end Toggle_Grouping;
---------
-- Run --
---------
procedure Run (Frame :
access Gtk.Frame.Gtk_Frame_Record'Class)
is
Vbox : Gtk_Box;
Group : Gtk_Size_Group;
Table : Gtk_Table;
F : Gtk_Frame;
Toggle : Gtk_Check_Button;
begin
Gtk_New_Vbox (Vbox, Homogeneous => False);
Add (Frame, Vbox);
Set_Label (Frame, "Size group");
Gtk_New (Group, Horizontal);
Gtk_New (F, "Options1");
Pack_Start (Vbox, F, Expand => False, Fill => False);
Gtk_New (Table, 2, 2, False);
Add (F, Table);
Set_Border_Width (Table, 5);
Set_Row_Spacings (Table, 5);
Set_Col_Spacings (Table, 10);
Add_Row (Table, 0, Group, "foofoofoofoofoofoofoofoofoo");
Add_Row (Table, 1, Group, "foofoofoo");
Gtk_New (F, "Options2");
Pack_Start (Vbox, F, Expand => False, Fill => False);
Gtk_New (Table, 2, 2, False);
Add (F, Table);
Set_Border_Width (Table, 5);
Set_Row_Spacings (Table, 5);
Set_Col_Spacings (Table, 10);
Add_Row (Table, 0, Group, "foo");
Add_Row (Table, 1, Group, "foofoofoofoofoofoo");
Gtk_New (Toggle, "Enable grouping");
Pack_Start (Vbox, Toggle, Expand => False, Fill => False);
Set_Active (Toggle, True);
Toggle_Cb.Connect
(Toggle, "toggled",
Toggle_Cb.To_Marshaller (Toggle_Grouping'Access), Group);
Show_All (Frame);
end Run;
end Create_Size_Groups;