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