1{ 2 3 This file extracted from the GTK 1.2 tutorial. 4 Section 6.1 5 6 Converted from C to Pascal by Thomas E. Payne 7} 8 program Tut6_1; 9 10{$mode objfpc} 11 12 uses 13 glib,gdk,gtk,sysutils; 14 15 //* Create a new hbox with an image and a label packed into it 16 //* and return the box. */ 17 function xpm_label_box( parent: pGtkWidget; 18 xpm_filename : pchar; 19 label_text : pchar ): pGtkWidget; cdecl; 20 var 21 22 box1, label_,pixmapwid : pGtkWidget; 23 pixmap : pGdkPixmap; 24 mask : pGdkBitmap; 25 style : pGtkStyle; 26 begin 27 //* Create box for xpm and label */ 28 box1 := gtk_hbox_new (FALSE, 0); 29 gtk_container_set_border_width (GTK_CONTAINER (box1), 2); 30 //* Get the style of the button to get the background color. */ 31 style := gtk_widget_get_style(parent); 32 //* Now on to the xpm stuff */ 33 //function gdk_pixmap_create_from_xpm(window:PGdkWindow; 34 //mask:PPGdkBitmap; 35 // transparent_color:PGdkColor; filename:Pgchar):PGdkPixmap; 36 37 pixmap := gdk_pixmap_create_from_xpm (parent^.window, @mask, 38 @style^.bg[GTK_STATE_NORMAL], 39 xpm_filename); 40 pixmapwid := gtk_pixmap_new (pixmap, mask); 41 //* Create a label for the button */ 42 label_ := gtk_label_new (label_text); 43 //* Pack the pixmap and label into the box */ 44 gtk_box_pack_start (GTK_BOX (box1), 45 pixmapwid, FALSE, FALSE, 3); 46 gtk_box_pack_start (GTK_BOX (box1), label_, FALSE, FALSE, 3); 47 gtk_widget_show(pixmapwid); 48 gtk_widget_show(label_); 49 xpm_label_box := box1; 50 end; 51 52 //* Our usual callback function */ 53 procedure callback( widget : pGtkWidget; data : pgpointer );cdecl; 54 begin 55 writeln ('Hello again - '+pchar(data)+' was pressed'); 56 end; 57 58 var 59 //* GtkWidget is the storage type for widgets */ 60 window,button,box1 : pGtkWidget; 61 begin 62 gtk_init (@argc, @argv); 63 //* Create a new window */ 64 window := gtk_window_new (GTK_WINDOW_TOPLEVEL); 65 gtk_window_set_title (GTK_WINDOW (window), 'Pixmap''d Buttons!'); 66 //* It's a good idea to do this for all windows. */ 67 gtk_signal_connect (GTK_OBJECT (window), 'destroy', 68 GTK_SIGNAL_FUNC (@gtk_exit), Nil); 69 gtk_signal_connect (GTK_OBJECT (window), 'delete_event', 70 GTK_SIGNAL_FUNC (@gtk_exit), Nil); 71 //* Sets the border width of the window. */ 72 gtk_container_set_border_width (GTK_CONTAINER (window), 10); 73 gtk_widget_realize(window); 74 //* Create a new button */ 75 button := gtk_button_new (); 76 //* Connect the "clicked" signal of the button to our callback */ 77 gtk_signal_connect (GTK_OBJECT (button), 'clicked', 78 GTK_SIGNAL_FUNC (@callback), pchar('cool button')); 79 //* This calls our box creating function */ 80 box1 := xpm_label_box(window, 'info.xpm', 'cool button'); 81 //* Pack and show all our widgets */ 82 gtk_widget_show(box1); 83 gtk_container_add (GTK_CONTAINER (button), box1); 84 gtk_widget_show(button); 85 gtk_container_add (GTK_CONTAINER (window), button); 86 gtk_widget_show (window); 87 //* Rest in gtk_main and wait for the fun to begin! */ 88 gtk_main (); 89 end. 90