2
0

tut6_1.pp 3.2 KB

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