1----------------------------------------------------------------------- 2-- GtkAda - Ada95 binding for the Gimp Toolkit -- 3-- -- 4-- Copyright (C) 1998-1999 -- 5-- Emmanuel Briot, Joel Brobecker and Arnaud Charlet -- 6-- Copyright 2000-2006 AdaCore -- 7-- -- 8-- This library is free software; you can redistribute it and/or -- 9-- modify it under the terms of the GNU General Public -- 10-- License as published by the Free Software Foundation; either -- 11-- version 2 of the License, or (at your option) any later version. -- 12-- -- 13-- This library is distributed in the hope that it will be useful, -- 14-- but WITHOUT ANY WARRANTY; without even the implied warranty of -- 15-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- 16-- General Public License for more details. -- 17-- -- 18-- You should have received a copy of the GNU General Public -- 19-- License along with this library; if not, write to the -- 20-- Free Software Foundation, Inc., 59 Temple Place - Suite 330, -- 21-- Boston, MA 02111-1307, USA. -- 22-- -- 23-- As a special exception, if other files instantiate generics from -- 24-- this unit, or you link this unit with other files to produce an -- 25-- executable, this unit does not by itself cause the resulting -- 26-- executable to be covered by the GNU General Public License. This -- 27-- exception does not however invalidate any other reasons why the -- 28-- executable file might be covered by the GNU Public License. -- 29----------------------------------------------------------------------- 30 31 32with Gdk.Bitmap; use Gdk.Bitmap; 33with Gdk.Color; use Gdk.Color; 34with Gdk.Pixmap; use Gdk.Pixmap; 35with Gtk.Enums; use Gtk.Enums; 36with Gtk.GEntry; use Gtk.GEntry; 37with Gtk.Handlers; use Gtk.Handlers; 38with Gtk.Image; use Gtk.Image; 39with Gtk.Separator_Tool_Item; use Gtk.Separator_Tool_Item; 40with Gtk.Tool_Button; use Gtk.Tool_Button; 41with Gtk.Tool_Item; use Gtk.Tool_Item; 42with Gtk.Tooltips; use Gtk.Tooltips; 43with Gtk.Widget; use Gtk.Widget; 44with Gtk; use Gtk; 45 46package body Create_Toolbar is 47 48 package Toolbar_Cb is new Handlers.Callback (Gtk_Toolbar_Record); 49 50 ---------- 51 -- Help -- 52 ---------- 53 54 function Help return String is 55 begin 56 return "A @bGtk_Toolbar@B is a set of buttons. Each button is can be" 57 & " represented both as a text or an icon, or even both. A tooltip" 58 & " is automatically created for each button." & ASCII.LF 59 & "The following two signals are defined:" & ASCII.LF 60 & " - ""orientation_changed"": the widget was re-oriented." 61 & ASCII.LF 62 & " - ""style_changed"": a new style was selected." & ASCII.LF 63 & ASCII.LF 64 & "It is worth noting that the toolbar can basically contain any type" 65 & " of widget, not only buttons. In this demo, we have added a " 66 & " @bGtk_Entry@B widget in the middle."; 67 end Help; 68 69 ---------------- 70 -- New_Pixmap -- 71 ---------------- 72 73 function New_Pixmap (Filename : in String; 74 Window : in Gdk_Window; 75 Background : in Gdk_Color) 76 return Gtk_Widget 77 is 78 Pixmap : Gdk_Pixmap; 79 Mask : Gdk_Bitmap; 80 GtkPixmap : Gtk_Image; 81 begin 82 Create_From_Xpm (Pixmap, Window, Mask, Background, Filename); 83 Gtk_New (GtkPixmap, Pixmap, Mask); 84 return Gtk_Widget (GtkPixmap); 85 end New_Pixmap; 86 87 -------------------- 88 -- Set_Horizontal -- 89 -------------------- 90 91 procedure Set_Horizontal (Toolbar : access Gtk_Toolbar_Record'Class) is 92 begin 93 Set_Orientation (Toolbar, Orientation_Horizontal); 94 end Set_Horizontal; 95 96 ------------------ 97 -- Set_Vertical -- 98 ------------------ 99 100 procedure Set_Vertical (Toolbar : access Gtk_Toolbar_Record'Class) is 101 begin 102 Set_Orientation (Toolbar, Orientation_Vertical); 103 end Set_Vertical; 104 105 --------------- 106 -- Set_Icons -- 107 --------------- 108 109 procedure Set_Icons (Toolbar : access Gtk_Toolbar_Record'Class) is 110 begin 111 Set_Style (Toolbar, Toolbar_Icons); 112 end Set_Icons; 113 114 -------------- 115 -- Set_Text -- 116 -------------- 117 118 procedure Set_Text (Toolbar : access Gtk_Toolbar_Record'Class) is 119 begin 120 Set_Style (Toolbar, Toolbar_Text); 121 end Set_Text; 122 123 -------------- 124 -- Set_Both -- 125 -------------- 126 127 procedure Set_Both (Toolbar : access Gtk_Toolbar_Record'Class) is 128 begin 129 Set_Style (Toolbar, Toolbar_Both); 130 end Set_Both; 131 132 --------------------- 133 -- Set_Small_Space -- 134 --------------------- 135 136 procedure Set_Small_Space (Toolbar : access Gtk_Toolbar_Record'Class) is 137 pragma Warnings (Off, Toolbar); 138 begin 139 -- Set_Space_Size (Toolbar, 5); 140 null; 141 end Set_Small_Space; 142 143 ------------------- 144 -- Set_Big_Space -- 145 ------------------- 146 147 procedure Set_Big_Space (Toolbar : access Gtk_Toolbar_Record'Class) is 148 pragma Warnings (Off, Toolbar); 149 begin 150 -- Set_Space_Size (Toolbar, 10); 151 null; 152 end Set_Big_Space; 153 154 ---------------- 155 -- Set_Enable -- 156 ---------------- 157 158 procedure Set_Enable (Toolbar : access Gtk_Toolbar_Record'Class) is 159 begin 160 Set_Tooltips (Toolbar, True); 161 end Set_Enable; 162 163 ----------------- 164 -- Set_Disable -- 165 ----------------- 166 167 procedure Set_Disable (Toolbar : access Gtk_Toolbar_Record'Class) is 168 begin 169 Set_Tooltips (Toolbar, False); 170 end Set_Disable; 171 172 ------------- 173 -- Borders -- 174 ------------- 175 176 procedure Borders (Toolbar : access Gtk_Toolbar_Record'Class) is 177 pragma Warnings (Off, Toolbar); 178 begin 179 -- Set_Button_Relief (Toolbar, Relief_Normal); 180 null; 181 end Borders; 182 183 ---------------- 184 -- Borderless -- 185 ---------------- 186 187 procedure Borderless (Toolbar : access Gtk_Toolbar_Record'Class) is 188 pragma Warnings (Off, Toolbar); 189 begin 190 -- Set_Button_Relief (Toolbar, Relief_None); 191 null; 192 end Borderless; 193 194 ----------------------- 195 -- Space_Style_Empty -- 196 ----------------------- 197 198 procedure Space_Style_Empty (Toolbar : access Gtk_Toolbar_Record'Class) is 199 pragma Warnings (Off, Toolbar); 200 begin 201 -- Set_Space_Style (Toolbar, Toolbar_Space_Empty); 202 null; 203 end Space_Style_Empty; 204 205 ---------------------- 206 -- Space_Style_Line -- 207 ---------------------- 208 209 procedure Space_Style_Line (Toolbar : access Gtk_Toolbar_Record'Class) is 210 pragma Warnings (Off, Toolbar); 211 begin 212 -- Set_Space_Style (Toolbar, Toolbar_Space_Line); 213 null; 214 end Space_Style_Line; 215 216 ------------------ 217 -- Make_Toolbar -- 218 ------------------ 219 220 procedure Make_Toolbar (Toolbar : out Gtk_Toolbar; 221 Toplevel : in Gdk_Window; 222 Style : in Gtk_Style; 223 With_Entry : in Boolean := False) 224 is 225 The_Entry : Gtk_Entry; 226 Button : Gtk_Tool_Button; 227 Tooltips : Gtk_Tooltips; 228 Separator : Gtk_Separator_Tool_Item; 229 Item : Gtk_Tool_Item; 230 Bg : constant Gdk_Color := Get_Bg (Style, State_Normal); 231 232 begin 233 Gtk_New (Toolbar); 234 Set_Orientation (Toolbar, Orientation_Horizontal); 235 Set_Style (Toolbar, Toolbar_Both); 236 Gtk_New (Tooltips); 237 238 Gtk_New (Button, New_Pixmap ("test.xpm", Toplevel, Bg), "Horizontal"); 239 Set_Tooltip (Button, Tooltips, "Horizontal toolbar layout"); 240 Insert (Toolbar, Button); 241 Toolbar_Cb.Object_Connect 242 (Button, "clicked", 243 Toolbar_Cb.To_Marshaller (Set_Horizontal'Access), 244 Slot_Object => Toolbar); 245 246 Gtk_New (Button, New_Pixmap ("test.xpm", Toplevel, Bg), "Vertical"); 247 Set_Tooltip (Button, Tooltips, "Vertical toolbar layout"); 248 Insert (Toolbar, Button); 249 Toolbar_Cb.Object_Connect 250 (Button, "clicked", 251 Toolbar_Cb.To_Marshaller (Set_Vertical'Access), 252 Slot_Object => Toolbar); 253 254 Gtk_New (Separator); 255 Insert (Toolbar, Separator); 256 257 Gtk_New (Button, New_Pixmap ("test.xpm", Toplevel, Bg), "Icons"); 258 Set_Tooltip (Button, Tooltips, "Only show toolbar icons"); 259 Insert (Toolbar, Button); 260 Toolbar_Cb.Object_Connect 261 (Button, "clicked", 262 Toolbar_Cb.To_Marshaller (Set_Icons'Access), 263 Slot_Object => Toolbar); 264 265 Gtk_New (Button, New_Pixmap ("test.xpm", Toplevel, Bg), "Text"); 266 Set_Tooltip (Button, Tooltips, "Only show toolbar text"); 267 Insert (Toolbar, Button); 268 Toolbar_Cb.Object_Connect 269 (Button, "clicked", 270 Toolbar_Cb.To_Marshaller (Set_Text'Access), 271 Slot_Object => Toolbar); 272 273 Gtk_New (Button, New_Pixmap ("test.xpm", Toplevel, Bg), "Both"); 274 Set_Tooltip (Button, Tooltips, "Show toolbar icons and text"); 275 Insert (Toolbar, Button); 276 Toolbar_Cb.Object_Connect 277 (Button, "clicked", 278 Toolbar_Cb.To_Marshaller (Set_Both'Access), 279 Slot_Object => Toolbar); 280 281 Gtk_New (Separator); 282 Insert (Toolbar, Separator); 283 284 if With_Entry then 285 Gtk_New (Item); 286 Insert (Toolbar, Item); 287 288 Gtk_New (The_Entry); 289 Show (The_Entry); 290 Add (Item, The_Entry); 291 292 Gtk_New (Separator); 293 Insert (Toolbar, Separator); 294 end if; 295 296 Gtk_New (Button, New_Pixmap ("test.xpm", Toplevel, Bg), "Small"); 297 Set_Tooltip (Button, Tooltips, "Use small spaces", "Toolbar/Small"); 298 Insert (Toolbar, Button); 299 Toolbar_Cb.Object_Connect 300 (Button, "clicked", 301 Toolbar_Cb.To_Marshaller (Set_Small_Space'Access), 302 Slot_Object => Toolbar); 303 304 Gtk_New (Button, New_Pixmap ("test.xpm", Toplevel, Bg), "Big"); 305 Set_Tooltip (Button, Tooltips, "Use big spaces", "Toolbar/Big"); 306 Insert (Toolbar, Button); 307 Toolbar_Cb.Object_Connect 308 (Button, "clicked", Toolbar_Cb.To_Marshaller (Set_Big_Space'Access), 309 Slot_Object => Toolbar); 310 311 Gtk_New (Separator); 312 Insert (Toolbar, Separator); 313 314 Gtk_New (Button, New_Pixmap ("test.xpm", Toplevel, Bg), "Enable"); 315 Set_Tooltip (Button, Tooltips, "Enable tooltips"); 316 Insert (Toolbar, Button); 317 Toolbar_Cb.Object_Connect 318 (Button, 319 "clicked", Toolbar_Cb.To_Marshaller (Set_Enable'Access), 320 Slot_Object => Toolbar); 321 322 Gtk_New (Button, New_Pixmap ("test.xpm", Toplevel, Bg), "Disable"); 323 Set_Tooltip (Button, Tooltips, "Disable tooltips"); 324 Insert (Toolbar, Button); 325 Toolbar_Cb.Object_Connect 326 (Button, 327 "clicked", Toolbar_Cb.To_Marshaller (Set_Disable'Access), 328 Slot_Object => Toolbar); 329 330 Gtk_New (Separator); 331 Insert (Toolbar, Separator); 332 333 Gtk_New (Button, New_Pixmap ("test.xpm", Toplevel, Bg), "Borders"); 334 Set_Tooltip (Button, Tooltips, "Show borders"); 335 Insert (Toolbar, Button); 336 Toolbar_Cb.Object_Connect 337 (Button, 338 "clicked", Toolbar_Cb.To_Marshaller (Borders'Access), 339 Slot_Object => Toolbar); 340 341 Gtk_New (Button, New_Pixmap ("test.xpm", Toplevel, Bg), "Borderless"); 342 Set_Tooltip (Button, Tooltips, "Hide borders"); 343 Insert (Toolbar, Button); 344 Toolbar_Cb.Object_Connect 345 (Button, 346 "clicked", Toolbar_Cb.To_Marshaller (Borderless'Access), 347 Slot_Object => Toolbar); 348 349 Gtk_New (Separator); 350 Insert (Toolbar, Separator); 351 352 Gtk_New (Button, New_Pixmap ("test.xpm", Toplevel, Bg), "Empty"); 353 Set_Tooltip (Button, Tooltips, "Empty spaces"); 354 Insert (Toolbar, Button); 355 Toolbar_Cb.Object_Connect 356 (Button, 357 "clicked", Toolbar_Cb.To_Marshaller (Space_Style_Empty'Access), 358 Slot_Object => Toolbar); 359 360 Gtk_New (Button, New_Pixmap ("test.xpm", Toplevel, Bg), "Lines"); 361 Set_Tooltip (Button, Tooltips, "Lines in spaces"); 362 Insert (Toolbar, Button); 363 Toolbar_Cb.Object_Connect 364 (Button, 365 "clicked", Toolbar_Cb.To_Marshaller (Space_Style_Line'Access), 366 Slot_Object => Toolbar); 367 368 end Make_Toolbar; 369 370 procedure Run (Frame : access Gtk.Frame.Gtk_Frame_Record'Class) is 371 Toolbar : Gtk_Toolbar; 372 373 begin 374 Set_Label (Frame, "Toolbar"); 375 Make_Toolbar (Toolbar, Get_Window (Frame), Get_Style (Frame), True); 376 Set_Orientation (Toolbar, Orientation_Vertical); 377 Add (Frame, Toolbar); 378 379 Show_All (Frame); 380 end Run; 381 382end Create_Toolbar; 383 384