1(* Application main window 2 * 3 * Demonstrates a typical application window, with menubar, toolbar, statusbar. 4 *) 5 6var 7 appwindow_registered : gboolean; 8 9procedure menuitem_cb (callback_data : gpointer; 10 callback_action : guint; 11 widget : PGtkWidget);cdecl; 12var 13 dialog : PGtkWidget; 14 15 16begin 17 dialog := gtk_message_dialog_new (GTK_WINDOW (callback_data), 18 GTK_DIALOG_DESTROY_WITH_PARENT, 19 GTK_MESSAGE_INFO, 20 GTK_BUTTONS_CLOSE, 21 'You selected or toggled the menu item: "%s"', 22 [gtk_item_factory_path_from_widget (widget)]); 23 24 // Close dialog on user response 25 g_signal_connect (G_OBJECT (dialog), 26 'response', 27 G_CALLBACK (@gtk_widget_destroy), 28 NULL); 29 30 gtk_widget_show (dialog); 31end; 32 33 34 35procedure toolbar_cb (button : PGtkWidget; 36 data : gpointer); cdecl; 37var 38 dialog: PGtkWidget; 39begin 40 41 dialog := gtk_message_dialog_new (GTK_WINDOW (data), 42 GTK_DIALOG_DESTROY_WITH_PARENT, 43 GTK_MESSAGE_INFO, 44 GTK_BUTTONS_CLOSE, 45 'You selected a toolbar button'); 46 47 (* Close dialog on user response *) 48 g_signal_connect (G_OBJECT (dialog), 49 'response', 50 G_CALLBACK (@gtk_widget_destroy), 51 NULL); 52 53 gtk_widget_show (dialog); 54end; 55 56const 57 58 menu_items : array [1..18] of TGtkItemFactoryEntry = ( 59 ( path: '/_File'; accelerator: NULL; callback: nil; 60 callback_action: 0; item_type : '<Branch>'; extra_data: NULL), 61 62 ( path: '/File/_New'; accelerator: '<control>N' ; callback: TGtkItemfactoryCallback(@menuitem_cb); 63 callback_action: 0; item_type : '<StockItem>'; extra_data: NULL{GTK_STOCK_NEW}), 64 65 ( path: '/File/_Open'; accelerator: '<control>O' ; callback: TGtkItemfactoryCallback(@menuitem_cb); 66 callback_action: 0; item_type : '<StockItem>'; extra_data: NULL {GTK_STOCK_OPEN}), 67 68 ( path: '/File/_Save'; accelerator: '<control>S' ; callback: TGtkItemfactoryCallback(@menuitem_cb); 69 callback_action: 0; item_type : '<StockItem>'; extra_data: NULL {GTK_STOCK_SAVE}), 70 71 ( path: '/File/Save _As'; accelerator: NULL ; callback: TGtkItemfactoryCallback(@menuitem_cb); 72 callback_action: 0; item_type : '<StockItem>'; extra_data: NULL {GTK_STOCK_SAVE_AS}), 73 74 ( path: '/File/sep1'; accelerator: NULL; callback: TGtkItemfactoryCallback(@menuitem_cb); 75 callback_action: 0; item_type : '<Separator>'; extra_data: NULL), 76 77 ( path: '/File/_Quit'; accelerator: '<control>Q' ; callback: TGtkItemfactoryCallback(@menuitem_cb); 78 callback_action: 0; item_type : '<StockItem>'; extra_data: NULL), 79 80 ( path: '/Preferences'; accelerator: NULL ; callback: nil; 81 callback_action: 0; item_type : '<Branch>'; extra_data: NULL), 82 83 ( path: '/Preferences/_Color'; accelerator: NULL ; callback: nil; 84 callback_action: 0; item_type : '<Branch>'; extra_data: NULL), 85 86 ( path: '/Preferences/Color/_Red'; accelerator: NULL ; callback: TGtkItemfactoryCallback(@menuitem_cb); 87 callback_action: 0; item_type : '<RadioItem>'; extra_data: NULL), 88 89 ( path: '/Preferences/Color/_Green'; accelerator: NULL ; callback: TGtkItemfactoryCallback(@menuitem_cb); 90 callback_action: 0; item_type : '/Preferences/Color/Red'; extra_data: NULL), 91 92 ( path: '/Preferences/Color/_Blue'; accelerator: NULL ; callback: TGtkItemfactoryCallback(@menuitem_cb); 93 callback_action: 0; item_type : '/Preferences/Color/Red'; extra_data: NULL), 94 95 ( path: '/Preferences/_Shape'; accelerator: NULL ; callback: nil; 96 callback_action: 0; item_type : '<Branch>'; extra_data: NULL), 97 98 ( path: '/Preferences/Shape/_Square'; accelerator: NULL ; callback: TGtkItemfactoryCallback(@menuitem_cb); 99 callback_action: 0; item_type : '<RadioItem>'; extra_data: NULL), 100 101 ( path: '/Preferences/Shape/_Rectangle'; accelerator: NULL ; callback: TGtkItemfactoryCallback(@menuitem_cb); 102 callback_action: 0; item_type : '/Preferences/Shape/Square'; extra_data: NULL), 103 104 ( path: '/Preferences/Shape/_Oval'; accelerator: NULL ; callback: TGtkItemfactoryCallback(@menuitem_cb); 105 callback_action: 0; item_type : '/Preferences/Shape/Rectangle'; extra_data: NULL), 106 107 108 (* If you wanted this to be right justified you would use "<LastBranch>", not "<Branch>". 109 * Right justified help menu items are generally considered a bad idea now days. 110 *) 111 112 ( path: '/_Help'; accelerator: NULL ; callback: nil; 113 callback_action: 0; item_type : '<Branch>'; extra_data: NULL), 114 115 ( path: '/Help/_About'; accelerator: NULL ; callback: nil; 116 callback_action: 0; item_type : NULL; extra_data: NULL) 117 118 ); 119 120 121var 122 application_window : PGtkWidget; // global variable (originally called window) 123 124 125 126(* This function registers our custom toolbar icons, so they can be themed. 127 * 128 * It's totally optional to do this, you could just manually insert icons 129 * and have them not be themeable, especially if you never expect people 130 * to theme your app. 131 *) 132 133const 134 items :array [1..1] of TGtkStockItem = ( 135 ( stock_id: 'demo-gtk-logo'; _label: '_GTK!'; 136 modifier: 0; keyval: 0; translation_domain : NULL) 137 ); 138 139procedure register_stock_icons; 140 141var 142 pixbuf : PGdkPixbuf; 143 factory : PGtkIconFactory; 144 filename : pgchar; 145 146 icon_set : PGtkIconSet; 147 transparent : PGdkPixbuf; 148 149begin 150 if not appwindow_registered then 151 begin 152 appwindow_registered := TRUE; 153 154 (* Register our stock items *) 155 gtk_stock_add (@items[1], high(items)); 156 157 (* Add our custom icon factory to the list of defaults *) 158 factory := gtk_icon_factory_new (); 159 gtk_icon_factory_add_default (factory); 160 161 (* demo_find_file() looks in the the current directory first, 162 * so you can run gtk-demo without installing GTK, then looks 163 * in the location where the file is installed. 164 *) 165 pixbuf := NULL; 166 filename := demo_find_file ('gtk-logo-rgb.gif', NULL); 167 168 if filename <> NULL then begin 169 pixbuf := gdk_pixbuf_new_from_file (filename, NULL); 170 g_free (filename); 171 end; 172 173 (* Register icon to accompany stock item *) 174 if pixbuf <> NULL then 175 begin 176 (* The gtk-logo-rgb icon has a white background, make it transparent *) 177 transparent := gdk_pixbuf_add_alpha (pixbuf, TRUE, $ff, $ff, $ff); 178 179 icon_set := gtk_icon_set_new_from_pixbuf (transparent); 180 gtk_icon_factory_add (factory, 'demo-gtk-logo', icon_set); 181 gtk_icon_set_unref (icon_set); 182 g_object_unref (G_OBJECT (pixbuf)); 183 g_object_unref (G_OBJECT (transparent)); 184 end 185 else 186 g_warning ('failed to load GTK logo for toolbar'); 187 188 (* Drop our reference to the factory, GTK will hold a reference. *) 189 g_object_unref (G_OBJECT (factory)); 190 end; 191end; 192 193procedure update_statusbar ( buffer : PGtkTextBuffer; 194 statusbar : PGtkStatusbar); 195var 196 msg : pgchar; 197 row, 198 col : gint; 199 count : gint; 200 iter : TGtkTextIter; 201 202begin 203 204 gtk_statusbar_pop (statusbar, 0); (* clear any previous message, underflow is allowed *) 205 206 count := gtk_text_buffer_get_char_count (buffer); 207 208 gtk_text_buffer_get_iter_at_mark (buffer, 209 @iter, 210 gtk_text_buffer_get_insert (buffer)); 211 212 row := gtk_text_iter_get_line (@iter); 213 col := gtk_text_iter_get_line_offset (@iter); 214 215 msg := g_strdup_printf ('Cursor at row %d column %d - %d chars in document', 216 [row, col, count]); 217 218 gtk_statusbar_push (statusbar, 0, msg); 219 220 g_free (msg); 221end; 222 223procedure mark_set_callback (buffer : PGtkTextBuffer; 224 new_location : PGtkTextIter; 225 mark : PGtkTextMark; 226 data : gpointer); cdecl; 227begin 228 update_statusbar (buffer, GTK_STATUSBAR (data)); 229end; 230 231function do_appwindow : PGtkWidget; 232var 233 table, 234 toolbar, 235 statusbar, 236 contents, 237 sw : PGtkWidget; 238 239 buffer : PGtkTextBuffer; 240 accel_group : PGtkAccelGroup; 241 item_factory : PGtkItemFactory; 242 243begin 244 if application_window = NULL then 245 begin 246 register_stock_icons (); 247 248 (* Create the toplevel window 249 *) 250 251 application_window := gtk_window_new (GTK_WINDOW_TOPLEVEL); 252 gtk_window_set_title (GTK_WINDOW (application_window ), 'Application Window'); 253 254 255 (* NULL window variable when window is closed *) 256 g_signal_connect (G_OBJECT (application_window ), 'destroy', 257 G_CALLBACK (@gtk_widget_destroyed), 258 @application_window ); 259 260 table := gtk_table_new (1, 4, FALSE); 261 262 gtk_container_add (GTK_CONTAINER (application_window ), table); 263 264 (* Create the menubar 265 *) 266 267 accel_group := gtk_accel_group_new (); 268 gtk_window_add_accel_group (GTK_WINDOW (application_window), accel_group); 269 g_object_unref (accel_group); 270 271 item_factory := gtk_item_factory_new (GTK_TYPE_MENU_BAR, '<main>', accel_group); 272 273 (* Set up item factory to go away with the window *) 274 g_object_ref (item_factory); 275 gtk_object_sink (GTK_OBJECT (item_factory)); 276 g_object_set_data_full (G_OBJECT (application_window ), 277 '<main>', 278 item_factory, 279 TGDestroyNotify (@g_object_unref)); 280 281 (* create menu items *) 282 menu_items[2].extra_data:=PChar(GTK_STOCK_NEW); 283 menu_items[3].extra_data:=PChar(GTK_STOCK_OPEN); 284 menu_items[4].extra_data:=PChar(GTK_STOCK_SAVE); 285 menu_items[5].extra_data:=PChar(GTK_STOCK_SAVE_AS); 286 menu_items[7].extra_data:=PChar(GTK_STOCK_QUIT); 287 288 gtk_item_factory_create_items (item_factory, high (menu_items), 289 @menu_items[1], application_window ); 290 291 gtk_table_attach (GTK_TABLE (table), 292 gtk_item_factory_get_widget (item_factory, '<main>'), 293 (* X direction *) (* Y direction *) 294 0, 1, 0, 1, 295 GTK_EXPAND or GTK_FILL, 0, 296 0, 0); 297 298 (* Create the toolbar 299 *) 300 toolbar := gtk_toolbar_new (); 301 302 gtk_toolbar_insert_stock (GTK_TOOLBAR (toolbar), 303 GTK_STOCK_OPEN, 304 'This is a demo button with an ''open'' icon', 305 NULL, 306 G_CALLBACK (@toolbar_cb), 307 application_window , (* user data for callback *) 308 -1); (* -1 means "append" *) 309 310 gtk_toolbar_insert_stock (GTK_TOOLBAR (toolbar), 311 GTK_STOCK_QUIT, 312 'This is a demo button with a ''quit'' icon', 313 NULL, 314 G_CALLBACK (@toolbar_cb), 315 application_window , (* user data for callback *) 316 -1); (* -1 means "append" *) 317 318 gtk_toolbar_append_space (GTK_TOOLBAR (toolbar)); 319 gtk_toolbar_insert_stock (GTK_TOOLBAR (toolbar), 320 'demo-gtk-logo', 321 'This is a demo button with a ''gtk'' icon', 322 NULL, 323 G_CALLBACK (@toolbar_cb), 324 application_window , (* user data for callback *) 325 -1); (* -1 means "append" *) 326 327 gtk_table_attach (GTK_TABLE (table), 328 toolbar, 329 (* X direction *) (* Y direction *) 330 0, 1, 1, 2, 331 GTK_EXPAND or GTK_FILL, 0, 332 0, 0); 333 334 (* Create document 335 *) 336 337 sw := gtk_scrolled_window_new (NULL, NULL); 338 339 gtk_scrolled_window_set_policy (GTK_SCROLLED_WINDOW (sw), 340 GTK_POLICY_AUTOMATIC, 341 GTK_POLICY_AUTOMATIC); 342 343 gtk_scrolled_window_set_shadow_type (GTK_SCROLLED_WINDOW (sw), 344 GTK_SHADOW_IN); 345 346 gtk_table_attach (GTK_TABLE (table), 347 sw, 348 (* X direction *) (* Y direction *) 349 0, 1, 2, 3, 350 GTK_EXPAND or GTK_FILL, GTK_EXPAND or GTK_FILL, 351 0, 0); 352 353 gtk_window_set_default_size (GTK_WINDOW (application_window ), 354 200, 200); 355 356 contents := gtk_text_view_new (); 357 358 gtk_container_add (GTK_CONTAINER (sw), 359 contents); 360 361 (* Create statusbar *) 362 363 statusbar := gtk_statusbar_new (); 364 gtk_table_attach (GTK_TABLE (table), 365 statusbar, 366 (* X direction *) (* Y direction *) 367 0, 1, 3, 4, 368 GTK_EXPAND or GTK_FILL, 0, 369 0, 0); 370 371 (* Show text widget info in the statusbar *) 372 buffer := gtk_text_view_get_buffer (GTK_TEXT_VIEW (contents)); 373 374 g_signal_connect_object (buffer, 375 'changed', 376 G_CALLBACK (@update_statusbar), 377 statusbar, 378 0); 379 380 g_signal_connect_object (buffer, 381 'mark_set', (* cursor moved *) 382 G_CALLBACK (@mark_set_callback), 383 statusbar, 384 0); 385 386 update_statusbar (buffer, GTK_STATUSBAR (statusbar)); 387 end; 388 389 if not (GTK_WIDGET_VISIBLE (application_window )) then 390 gtk_widget_show_all (application_window ) 391 else begin 392 gtk_widget_destroy (application_window); 393 application_window := NULL; 394 end; 395 396 do_appwindow := application_window ; 397end; 398 399 400
