[GtkAda] Image de fond pour un canvas avec Gtkada

Image de fond pour un canvas avec Gtkada [GtkAda] - Ada - Programmation

Marsh Posté le 14-08-2011 à 17:21:05    

Bonjour, je souhaiterais mettre une image de fond à un canvas avec Gtk.
Alors j'ai pris l'exemple de Gtkada : http://src.gnu-darwin.org/ports/x1 [...] canvas.adb
 
Mais la procédure Draw_Background n'est référencer nulle part ailleurs que pour sa déclaration. Alors du coup j'ai des difficulté à comprendre.
 
J'ai fait ceci Mais ça marche pas.
 
Spécifications :

Code :
  1. with Gtk.Window;                         use Gtk.Window;
  2. with Gtk.Box;                            use Gtk.Box;
  3. with Gtk.Menu_Bar;                       use Gtk.Menu_Bar;
  4. with Gtk.Menu;                           use Gtk.Menu;
  5. with Gtk.Menu_Item;                      use Gtk.Menu_Item;
  6. with Gtk.Label;                          use Gtk.Label;
  7.  
  8. with Gtk.Frame;                          use Gtk.Frame;
  9. with Gtk.Scrolled_Window;                use Gtk.Scrolled_Window;
  10. with Gtkada.Canvas;                      use Gtkada.Canvas;
  11. with Gdk.Pixbuf;                         use Gdk.Pixbuf;
  12. with Gtk.Status_Bar;                     use Gtk.Status_Bar;
  13.  
  14. with Ada.Calendar;                       use Ada.Calendar;
  15.  
  16. package Idl.Main_Window is
  17.  
  18.   type Main_Window_Type;
  19.   task type Idl_Process(Main_Window : access Main_Window_Type) is
  20.      entry Halt;
  21.   end Idl_Process;
  22.  
  23.   type Main_Window_Type is limited
  24.     record
  25.        Master                     : Gtk_Window;
  26.        Main_Vbox                  : Gtk_Vbox;
  27.        Menu_Hbox                  : Gtk_Hbox;
  28.        Main_Menu_bar              : Gtk_Menu_Bar;
  29.        File_Menu                  : Gtk_Menu;
  30.        File_Menu_Item             : Gtk_Menu_Item;
  31.        Exit_Menu_Item             : Gtk_Menu_Item;
  32.        Background_Menu            : Gtk_Menu;
  33.        Background_Menu_item       : Gtk_Menu_item;
  34.        Set_Background             : Gtk_Menu_Item;
  35.        Unset_Background           : Gtk_Menu_Item;
  36.  
  37.        Date                       : Gtk_Label;
  38.  
  39.        Main_Frame                 : Gtk_Frame;
  40.        Scrolled                   : Gtk_Scrolled_Window;
  41.        Canvas                     : Interactive_Canvas;
  42.        Background                 : Gdk_Pixbuf;
  43.  
  44.        Status_Bar                 : Gtk_Status_Bar;
  45.        Idl                        : Idl_Process(Main_Window_Type'Access);
  46.     end record;
  47.  
  48.   type Main_Window_Access is access all Main_Window_Type;
  49.  
  50.   procedure Initialize(Main_Window : in out Main_Window_Access);
  51. end Idl.Main_Window;


 
Implémentation :

Code :
  1. with Gtk.Main;
  2. with Gtk.Rc;
  3. with Gtk.Enums;                          use Gtk.Enums;
  4. with Gtk.Dialog;                         use Gtk.Dialog;
  5. with Gtk.Stock;                          use Gtk.Stock;
  6. with Gtk.Widget;                         use Gtk.Widget;
  7. with Gtk.Handlers;                       use Gtk.Handlers;
  8.  
  9. with Gdk.Rectangle;                      use Gdk.Rectangle;
  10. with Glib;                               use Glib;
  11. with Gtk.Style;                          use Gtk.Style;
  12. with Gdk.Drawable;                       use Gdk.Drawable;
  13. with Glib.Error;                         use Glib.Error;
  14.  
  15. with Dates;                              use Dates;
  16.  
  17. pragma Elaborate_All (Gtk.Handlers);
  18.  
  19. package body Idl.Main_Window is
  20.  
  21.  
  22.  
  23.   -- Main quit Callback
  24.  
  25.   procedure Main_Quit
  26.     (widget : access Gtk_Widget_Record'class;
  27.      Main_Window : in Main_Window_Access) is
  28.      Dialog : Gtk.Dialog.Gtk_Dialog;
  29.      Yes    : Gtk.Widget.Gtk_Widget;
  30.      No     : Gtk.Widget.Gtk_Widget;
  31.      Help   : Gtk.Widget.Gtk_Widget;
  32.   begin
  33.  
  34.      loop
  35.         Gtk.Dialog.Gtk_New(Dialog, "Quit ?", Main_Window.Master, Gtk.dialog.modal);
  36.         Yes := Gtk.Dialog.Add_Button(Dialog, "Yes", Gtk.Dialog.Gtk_Response_Yes);
  37.         No := Gtk.Dialog.Add_Button(Dialog, "No", Gtk.Dialog.Gtk_Response_No);
  38.         Help := Gtk.Dialog.Add_Button(Dialog, "Help", Gtk.Dialog.Gtk_Response_Help);
  39.         case Gtk.Dialog.Run(Dialog) is
  40.            when Gtk.Dialog.Gtk_Response_Yes    =>
  41.               Main_Window.Idl.Halt;
  42.               Gtk.Dialog.Destroy(Dialog);
  43.               Gtk.Main.Gtk_Exit (0);
  44.               exit;
  45.            when Gtk.Dialog.Gtk_Response_No     =>
  46.               Gtk.Dialog.Destroy(Dialog);
  47.               exit;
  48.            when Gtk.Dialog.Gtk_Response_Help   =>
  49.               Gtk.Dialog.Destroy(Dialog);
  50.            when others =>
  51.               Gtk.Dialog.Destroy(Dialog);
  52.         end case;
  53.      end loop;
  54.   end Main_Quit;
  55.  
  56.   -- Main drestroy Callback
  57.  
  58.   function Main_Destroy
  59.     (widget : access Gtk_Widget_Record'class;
  60.      Main_Window : in Main_Window_Access) return Boolean is
  61.      Dialog : Gtk.Dialog.Gtk_Dialog;
  62.      Yes    : Gtk.Widget.Gtk_Widget;
  63.      No     : Gtk.Widget.Gtk_Widget;
  64.      Help   : Gtk.Widget.Gtk_Widget;
  65.   begin
  66.  
  67.      loop
  68.         Gtk.Dialog.Gtk_New(Dialog, "Quit ?", Main_Window.Master, Gtk.dialog.modal);
  69.         Yes := Gtk.Dialog.Add_Button(Dialog, "Yes", Gtk.Dialog.Gtk_Response_Yes);
  70.         No := Gtk.Dialog.Add_Button(Dialog, "No", Gtk.Dialog.Gtk_Response_No);
  71.         Help := Gtk.Dialog.Add_Button(Dialog, "Help", Gtk.Dialog.Gtk_Response_Help);
  72.         case Gtk.Dialog.Run(Dialog) is
  73.            when Gtk.Dialog.Gtk_Response_Yes    =>
  74.               Gtk.Dialog.Destroy(Dialog);
  75.               Main_Window.Idl.Halt;
  76.               Gtk.Main.Gtk_Exit (0);
  77.               return False;
  78.            when Gtk.Dialog.Gtk_Response_No     =>
  79.               Gtk.Dialog.Destroy(Dialog);
  80.               return True;
  81.            when Gtk.Dialog.Gtk_Response_Help   =>
  82.               Gtk.Dialog.Destroy(Dialog);
  83.            when others =>
  84.               Gtk.Dialog.Destroy(Dialog);
  85.         end case;
  86.      end loop;
  87.   end Main_Destroy;
  88.  
  89.  
  90.   task body Idl_Process is
  91.  
  92.      Status, End_Of_Task : Boolean := False;
  93.  
  94.  
  95.  
  96.  
  97.   begin
  98.      while not End_Of_Task loop
  99.         select
  100.            accept Halt do
  101.               End_Of_Task := True;
  102.            end Halt;
  103.         else
  104.            null;
  105.         end select;
  106.      end loop;
  107.   end Idl_Process;
  108.  
  109.  
  110.   function UpDate(Main_Window : Main_Window_Access) return Boolean is
  111.   begin
  112.      Set_Label(Main_Window.Date,  Long_Time2string(clock));
  113.      Queue_draw(Main_Window.date);
  114.      return True;
  115.   end UpDate;
  116.  
  117.   procedure Draw_Background
  118.     (Main_Window        : in Main_Window_access;
  119.      Screen_Rect   : Gdk.Rectangle.Gdk_Rectangle)
  120.   is
  121.      X_Left : constant Glib.Gint := Left_World_Coordinates (Main_Window.Canvas);
  122.      Y_Top  : constant Glib.Gint := Top_World_Coordinates (Main_Window.Canvas);
  123.   begin
  124.      if Main_Window.Background /= null then
  125.         --  This is slightly complex, since we need to properly handle zooming
  126.         --  and tiling.
  127.         declare
  128.            X, Y, W, H, Ys : Gint;
  129.            Xs : Gint := Screen_Rect.X;
  130.            Bw : constant Gint := Get_Width (Main_Window.Background)
  131.              * Gint (Get_Zoom (Main_Window.Canvas)) / 100;
  132.            Bh : constant Gint := Get_Height (Main_Window.Background)
  133.              * Gint (Get_Zoom (Main_Window.Canvas)) / 100;
  134.            Scaled : Gdk_Pixbuf := Main_Window.Background;
  135.         begin
  136.            --  A real application would cache this scaled pixmap, and update
  137.            --  the cache when the "zoomed" signal is emitted.
  138.            if Get_Zoom (Main_Window.Canvas) /= 100 then
  139.               Scaled := Scale_Simple (Main_Window.Background, Bw, Bh);
  140.            end if;
  141.  
  142.            while Xs < Screen_Rect.X + Screen_Rect.Width loop
  143.               Ys := Screen_Rect.Y;
  144.               X := (X_Left + Xs) mod Bw;
  145.               W := Gint'Min (Screen_Rect.Width + Screen_Rect.X - Xs, Bw - X);
  146.  
  147.               while Ys < Screen_Rect.Y + Screen_Rect.Height loop
  148.                  Y := (Y_Top  + Ys) mod Bh;
  149.                  H := Gint'Min
  150.                    (Screen_Rect.Height + Screen_Rect.Y - Ys, Bh - Y);
  151.  
  152.                  Render_To_Drawable
  153.                    (Pixbuf       => Scaled,
  154.                     Drawable     => Get_Window (Main_Window.Canvas),
  155.                     Gc           => Get_Black_GC (Get_Style (Main_Window.Canvas)),
  156.                     Src_X        => X,
  157.                     Src_Y        => Y,
  158.                     Dest_X       => Xs,
  159.                     Dest_Y       => Ys,
  160.                     Width        => W,
  161.                     Height       => H);
  162.                  Ys := Ys + H;
  163.               end loop;
  164.               Xs := Xs + W;
  165.            end loop;
  166.  
  167.            if Get_Zoom (Main_Window.Canvas) /= 100 then
  168.               Unref (Scaled);
  169.            end if;
  170.         end;
  171.  
  172.      else
  173.         Draw_Rectangle
  174.           (Get_Window (Main_Window.Canvas),
  175.            Get_Background_GC (Get_Style (Main_Window.Canvas), State_Normal),
  176.            Filled => True,
  177.            X      => Screen_Rect.X,
  178.            Y      => Screen_Rect.Y,
  179.            Width  => Gint (Screen_Rect.Width),
  180.            Height => Gint (Screen_Rect.Height));
  181.      end if;
  182.  
  183.   end Draw_Background;
  184.  
  185.  
  186.   procedure Set_Background(Widget : access Gtk_Widget_Record'Class;
  187.      Main_window  : Main_Window_access)
  188.   is
  189.      Error : GError;
  190.   begin
  191.      Gdk_New_From_File
  192.        (Main_Window.Background,
  193.         Filename => "background.jpg",
  194.         Error    => Error);
  195.      --Canvas.Grid_GC := Get_White_GC (Get_Style (Canvas));
  196.      Refresh_Canvas (Main_Window.Canvas);
  197.   end Set_Background;
  198.  
  199.   procedure Unset_Background(Widget : access Gtk_Widget_Record'Class;
  200.      Main_window  : Main_Window_access)
  201.   is
  202.   begin
  203.      if Main_window.Background /= null then
  204.         Unref (Main_window.Background);
  205.         Main_window.Background := null;
  206.      end if;
  207.      --Canvas.Grid_GC := Get_Black_GC (Get_Style (Canvas));
  208.      Refresh_Canvas (Main_Window.Canvas);
  209.   end Unset_Background;
  210.  
  211.  
  212.   package Main_Handlers is new Gtk.Handlers.User_Callback(Gtk.Widget.Gtk_Widget_Record, Main_Window_Access);
  213.   package Main_Return_Handlers is new Gtk.Handlers.User_Return_Callback(Gtk.Widget.Gtk_Widget_Record, Boolean,Main_Window_Access);
  214.  
  215.   package Date_Timeout is new Gtk.Main.Timeout(Main_Window_Access);
  216.  
  217.  
  218.   procedure Initialize(Main_Window : in out Main_Window_Access) is
  219.      Timeout_Id : Gtk.Main.Timeout_Handler_Id;
  220.   begin
  221.  
  222.      -- Initialize main window.
  223.  
  224.      Main_Window := new Main_Window_Type;
  225.      Gtk_New(Main_Window.Master);
  226.      Set_Default_Size(Main_Window.Master, 1024, 768);
  227.      Set_Title(Main_Window.Master,"Idl-Project 2012" );
  228.      Set_Position(Main_Window.Master, Win_Pos_Center);
  229.  
  230.      -- Initialize main menu.
  231.  
  232.      Gtk_New_Hbox(Main_Window.Menu_Hbox);
  233.      Gtk_New(Main_Window.Main_Menu_Bar);
  234.      Gtk_New(Main_Window.File_Menu);
  235.      Gtk_New(Main_Window.File_Menu_Item, "Fichier" );
  236.      Gtk_New(Main_Window.Exit_Menu_Item, "Quitter" );
  237.      -- Initialize Background menu.
  238.      Gtk_New(Main_Window.background_Menu);
  239.      Gtk_New(Main_Window.Background_Menu_Item, "Carte" );
  240.      Gtk_New(Main_Window.Set_background, "Afficher" );
  241.      Gtk_New(Main_Window.Unset_background, "Effacer" );
  242.  
  243.  
  244.      -- Initialize date label.
  245.      Gtk_New(Main_Window.Date, "no clock" );
  246.      -- Assembling Main Menu.
  247.  
  248.      Set_Submenu(Main_Window.File_Menu_Item, Main_Window.File_Menu);
  249.      Append(Main_Window.File_Menu, Main_Window.Exit_Menu_Item);
  250.      Append(Main_Window.Main_Menu_Bar, Main_Window.File_Menu_Item);
  251.  
  252.      Set_Submenu(Main_Window.Background_Menu_Item, Main_Window.Background_Menu);
  253.      Append(Main_Window.Background_Menu, Main_Window.Set_background);
  254.      Append(Main_Window.Background_Menu, Main_Window.Unset_background);
  255.      Append(Main_Window.Main_Menu_Bar, Main_Window.Background_Menu_item);
  256.  
  257.      Pack_Start(Main_Window.Menu_Hbox, Main_Window.Main_Menu_Bar, False, False, 0);
  258.  
  259.      -- Assembing Date label
  260.  
  261.      Pack_Start(Main_Window.Menu_Hbox, Main_Window.Date, True, False, 0);
  262.  
  263.      -- initialize Main Vbox.
  264.  
  265.      Gtk_New_Vbox(Main_Window.Main_Vbox);
  266.  
  267.  
  268.      -- Initialize Main Frame.
  269.  
  270.      Gtk_New(Main_Window.Main_Frame);
  271.  
  272.      -- Initialize Scrolled Window
  273.      Gtk_New(Main_Window.Scrolled);
  274.  
  275.      -- Initialize Canvas
  276.      Gtk_New(Main_Window.Canvas);
  277.  
  278.      -- Initialize background.
  279.  
  280.      Main_handlers.Connect(Main_Window.Set_Background, "activate",
  281.                            Main_handlers.To_Marshaller (Set_Background'Access),
  282.                            Main_window);
  283.  
  284.      Main_handlers.Connect(Main_Window.Unset_Background, "activate",
  285.                            Main_handlers.To_Marshaller (Unset_Background'Access),
  286.                            Main_window);
  287.  
  288.      Align_On_Grid (Main_Window.Canvas, False);
  289.  
  290.  
  291.      -- Assembling Canvas to Main frame with scrolled.
  292.      Add (Main_Window.Scrolled, Main_Window.Canvas);
  293.      Add(Main_Window.Main_Frame, Main_Window.Scrolled);
  294.  
  295.      -- Initialize Status Bar.
  296.  
  297.      Gtk_New(Main_Window.Status_Bar);
  298.  
  299.      -- Asembling Main Vbox.
  300.  
  301.      Pack_Start(Main_Window.Main_Vbox, Main_Window.Menu_Hbox, False, False, 0);
  302.      Pack_Start(Main_Window.Main_Vbox, Main_Window.Main_Frame, True, True, 0);
  303.      Pack_Start(Main_Window.Main_Vbox, Main_Window.Status_Bar, False, False, 0);
  304.  
  305.      -- Add Vbox to Main Window.
  306.      Add(Main_Window.Master, Main_Window.Main_Vbox);
  307.  
  308.      -- Realize Canvas.
  309.      Realize (Main_Window.Canvas);
  310.  
  311.      -- Gtimer_Add date label.
  312.  
  313.      Timeout_Id := Date_Timeout.Add(1000, Update'Access, Main_Window);
  314.  
  315.      -- Attach Callback.
  316.  
  317.      Main_handlers.Connect
  318.        (Main_Window.Exit_Menu_Item, "activate", Main_handlers.To_Marshaller (Main_Quit'access), Main_Window);
  319.  
  320.      Main_Return_Handlers.Connect
  321.        (Main_Window.Master, "delete_event", Main_Return_Handlers.To_Marshaller (Main_destroy'access), Main_Window);
  322.  
  323.      Show_All(Main_Window.Master);
  324.   end Initialize;
  325.  
  326. begin
  327.  
  328.   Gtk.Main.Init;
  329.   Gtk.Rc.Parse("./gtkrc.rc" );
  330. end Idl.Main_Window;


 
J'ai beau cliquer sur Set_Background rien ne ce passe.
Alors que le test gtk fonctionne, mais comment ?

Reply

Marsh Posté le 14-08-2011 à 17:21:05   

Reply

Marsh Posté le 14-08-2011 à 18:18:04    

Re-,
 
J'ai trouvé, en fait Draw_Background est une procédure surcharger de gtkada-canvas.
Il faut dériver le widget canvas de Interactive_Canvas_Record.
 
Merci.
 

Reply

Marsh Posté le 15-08-2011 à 05:20:57    

Bonjour,
 
Je cherche comment fixer le canevas dans ma fenêtre si c'est possible....
C'est à dire que lorsque je déplace un objet sur la droite ou la gauche, le canevas ne doit pas glisser.
Si vous avez un tuyau, je suis preneur.
Merci.

Message cité 1 fois
Message édité par Profil supprimé le 15-08-2011 à 05:22:08
Reply

Marsh Posté le 17-08-2011 à 13:29:29    


 
Bonjour, bonjour à tous,  
Je viens pour réitérer ma question précédente, et en poser une nouvelle.
 
Comment obtenir une zone de scrolling adapté au zoom que j'applique à mon canevas ?
Pour le moment, au zoom avant j'ai une fourchette de scrolling qui apparaît mais impossible atteindre la partie droite de mon canevas.
 
Merci pour votre aide, s'il vous plaît.
 
 
Edit : Autre chose...
Si j'utilise la fonction Set_Auto_Layout(Canvas, False) je ne peut pas déplacer mes item, mais j'ai du scroll qui apparaît au zoom.
Seulement je voudrait fixer Auto_Layout à True, mais là, plus de scroll.
(C'est lourd)


Message édité par Profil supprimé le 17-08-2011 à 13:47:18
Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed