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 Gdk.RGBA; use Gdk.RGBA; 25with Glib; use Glib; 26with Glib.Object; use Glib.Object; 27with Gtk.Box; use Gtk.Box; 28with Gtk.Check_Button; use Gtk.Check_Button; 29with Gtk.Enums; use Gtk.Enums; 30with Gtk.Label; use Gtk.Label; 31with Gtk.Stock; use Gtk.Stock; 32with Gtk.Tooltip; use Gtk.Tooltip; 33with Gtk.Widget; use Gtk.Widget; 34with Gtk.Window; use Gtk.Window; 35with Gtk; use Gtk; 36 37package body Create_Tooltips is 38 39 ---------- 40 -- Help -- 41 ---------- 42 43 function Help return String is 44 begin 45 return "@bGtk_Tooltips@B allow you to provide short help texts to the" 46 & " user. " & ASCII.LF 47 & " Through the @bwidget_entered@B and @bwidget_selected@B signals," 48 & " you can decide to display some extensive help."; 49 end Help; 50 51 ---------------------- 52 -- Query_Tooltip_Cb -- 53 ---------------------- 54 55 function Query_Tooltip_Cb 56 (Check : access Gtk_Widget_Record'Class; 57 X, Y : Gint; 58 Keyboard_Tip : Boolean; 59 Tooltip : not null access GObject_Record'Class) 60 return Boolean 61 is 62 pragma Unreferenced (X, Y, Keyboard_Tip); 63 begin 64 Gtk_Tooltip (Tooltip).Set_Markup 65 ("The text of the widget is <b>""" 66 & Gtk_Check_Button (Check).Get_Label & """</b>"); 67 Gtk_Tooltip (Tooltip).Set_Icon_From_Stock (Stock_Delete, Icon_Size_Menu); 68 return True; 69 end Query_Tooltip_Cb; 70 71 ----------------------------- 72 -- Query_Tooltip_Custom_Cb -- 73 ----------------------------- 74 75 function Query_Tooltip_Custom_Cb 76 (Check : access Gtk_Widget_Record'Class; 77 X, Y : Gint; 78 Keyboard_Tip : Boolean; 79 Tooltip : not null access GObject_Record'Class) 80 return Boolean 81 is 82 pragma Unreferenced (X, Y, Keyboard_Tip, Tooltip); 83 Window : constant Gtk_Window := Gtk_Window (Check.Get_Tooltip_Window); 84 Color : constant Gdk_RGBA := (0.0, 0.0, 1.0, 0.5); 85 begin 86 Window.Override_Background_Color (Gtk_State_Flag_Normal, Color); 87 return True; 88 end Query_Tooltip_Custom_Cb; 89 90 --------- 91 -- Run -- 92 --------- 93 94 procedure Run (Frame : access Gtk.Frame.Gtk_Frame_Record'Class) is 95 Box1 : Gtk_Box; 96 Check : Gtk_Check_Button; 97 Vbox : Gtk_Box; 98 Label : Gtk_Label; 99 Tooltip_Window : Gtk_Window; 100 101 begin 102 Set_Label (Frame, "Tooltips"); 103 Gtk_New_Vbox (Vbox, Homogeneous => False, Spacing => 0); 104 Add (Frame, Vbox); 105 106 Gtk_New_Vbox (Box1, False, 0); 107 Pack_Start (Vbox, Box1, Expand => False, Fill => False); 108 109 -- A check button using the tooltip-markup property 110 111 Gtk_New (Check, "Using the tooltip-markup property"); 112 Box1.Pack_Start (Check, False, False, 0); 113 Check.Set_Tooltip_Text ("Hello, I am a static tooltip."); 114 115 -- A check button using the query-tooltip signal 116 117 Gtk_New (Check, "Using the query-tooltip signal"); 118 Box1.Pack_Start (Check, False, False, 0); 119 Check.Set_Has_Tooltip (True); 120 Check.On_Query_Tooltip (Query_Tooltip_Cb'Access); 121 122 -- A label 123 124 Gtk_New (Label, "A simple label"); 125 Box1.Pack_Start (Label, False, False, 0); 126 Label.Set_Selectable (False); 127 Label.Set_Tooltip_Text ("Label and tooltip"); 128 129 -- A selectable label 130 131 Gtk_New (Label, "A selectable label"); 132 Box1.Pack_Start (Label, False, False, 0); 133 Label.Set_Selectable (True); 134 Label.Set_Tooltip_Text ("<b>Another</b> Label tooltip"); 135 136 -- Another one, with a custom tooltip window 137 138 Gtk_New (Tooltip_Window, Window_Popup); 139 Gtk_New (Label, "in custom tooltip window"); 140 Tooltip_Window.Add (Label); 141 Label.Show; 142 143 Gtk_New (Check, "Using a custom tooltip window"); 144 Box1.Pack_Start (Check, False, False, 0); 145 Check.Set_Tooltip_Window (Tooltip_Window); 146 Check.Set_Has_Tooltip (True); 147 Check.On_Query_Tooltip (Query_Tooltip_Custom_Cb'Access); 148 149 -- An insensitive button 150 151 Gtk_New (Check, "Insensitive button"); 152 Box1.Pack_Start (Check, False, False, 0); 153 Check.Set_Sensitive (False); 154 Check.Set_Tooltip_Text ("Insensitive!"); 155 156 Show_All (Frame); 157 end Run; 158 159end Create_Tooltips; 160