tut6_1.pp 3.3 KB

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