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) 2000 --
-- Emmanuel Briot, Joel Brobecker and Arnaud Charlet --
-- --
-- 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 Gdk.Drawable;
use Gdk.Drawable;
with Gdk.Event;
use Gdk.Event;
with Gdk.Rectangle;
use Gdk.Rectangle;
with Gdk.Window;
use Gdk.Window;
with Glib;
use Glib;
with Gtk.Adjustment;
use Gtk.Adjustment;
with Gtk.Button;
use Gtk.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.Layout;
use Gtk.Layout;
with Gtk.Scrolled_Window;
use Gtk.Scrolled_Window;
with Gtk.Style;
use Gtk.Style;
package body Create_Layout
is
package Event_Cb
is new Gtk.Handlers.Return_Callback
(Gtk_Layout_Record, Boolean);
----------
-- Help --
----------
function Help
return String
is
begin
return "A @bGtk_Layout@B
is a mixture between a @bGtk_Viewport@B
and"
& " a @bGtk_Fixed@B. Its children can be located anywhere, the layout"
& " does
not try to align them
in any way. As opposed to a"
& " @bGtk_Fixed@B, there
is no limit to the size
of a @bGtk_Layout@B"
& "
and it won't
use as much memory as a @bGtk_Fixed@B."
& ASCII.LF
& "The area that
is currently visible
is indicated by two"
& " @bGtk_Alignment@B widgets. It can thus be put directly into a"
& " @bGtk_Scrolled_Window@B widget, as
is the
case in this demo."
& ASCII.LF
& "In this demo, the background
is painted by a callback on the"
& " expose_event,
and thus does
not occupy any memory."
& " The Layout has a size
of 1600 by 128000.";
end Help;
--------------------
-- Expose_Handler --
--------------------
function Expose_Handler (Layout :
access Gtk_Layout_Record'Class;
Event : Gdk_Event_Expose)
return Boolean
is
Area :
constant Gdk_Rectangle := Get_Area (Event);
Imin, Imax : Guint;
Jmin, Jmax : Guint;
begin
Imin := Guint (Area.X) / 10;
Imax := (Guint (Area.X) + Guint (Area.Width) + 9) / 10;
Jmin := Guint (Area.Y) / 10;
Jmax := (Guint (Area.Y) + Guint (Area.Height) + 9) / 10;
Clear_Area (Get_Window (Layout), Area.X, Area.Y, Gint (Area.Width),
Gint (Area.Height));
for I
in Imin .. Imax - 1
loop
for J
in Jmin .. Jmax - 1
loop
if (I + J)
mod 2 /= 0
then
Draw_Rectangle (Get_Bin_Window (Layout),
Get_Black_GC (Get_Style (Layout)),
True,
Gint (10 * I),
Gint (10 * J),
Gint (1 + I
mod 10),
Gint (1 + J
mod 10));
end if;
end loop;
end loop;
return True;
end Expose_Handler;
---------
-- Run --
---------
procedure Run (Frame :
access Gtk.Frame.Gtk_Frame_Record'Class)
is
Scrolled : Gtk_Scrolled_Window;
Layout : Gtk_Layout;
Button : Gtk_Button;
Label : Gtk_Label;
begin
Set_Label (Frame, "Layout");
Gtk_New (Scrolled);
Set_Shadow_Type (Scrolled, Shadow_In);
Add (Frame, Scrolled);
Set_Placement (Scrolled, Corner_Top_Right);
Gtk_New (Layout);
Set_Events (Layout, Exposure_Mask);
Add (Scrolled, Layout);
Set_Step_Increment (Get_Hadjustment (Layout), 10.0);
Set_Step_Increment (Get_Vadjustment (Layout), 10.0);
Event_Cb.Connect (Layout, "expose_event",
Event_Cb.To_Marshaller (Expose_Handler'Access));
Set_Size (Layout, 1600, 128000);
for I
in 0 .. Gint'(15)
loop
for J
in 0 .. Gint'(15)
loop
if (I + J)
mod 2 /= 0
then
Gtk_New (Button, "Button " & Gint'Image (I)
& " " & Gint'Image (J));
Put (Layout, Button, J * 100, I * 100);
else
Gtk_New (Label, "Label " & Gint'Image (I)
& " " & Gint'Image (J));
Put (Layout, Label, J * 100, I * 100);
end if;
end loop;
end loop;
for I
in 16 .. Gint'(1279)
loop
if I
mod 2 /= 0
then
Gtk_New (Button, "Button " & Gint'Image (I) & " 0");
Put (Layout, Button, 0, I * 100);
else
Gtk_New (Label, "Label " & Gint'Image (I) & " 0");
Put (Layout, Label, 0, I * 100);
end if;
end loop;
Show_All (Frame);
end Run;
end Create_Layout;