2

信息：我使用 Ada 作为编程语言，Windowing 软件是 Gtk 和 GtkAda。

我的绘图区域有时不适合我的窗口，即使我使用全屏也不适合。因此我需要有一个滚动区域。我使用随附的代码来获得这样的窗口，但滚动条始终无法移动，因此无法看到我的绘图的一部分。我必须在我的程序中添加什么，在运行的程序中必须更改滚动条的范围时我必须做什么？

    Gtk_New (MainWindow.Scrolledwindow);
    Set_Policy (MainWindow.Scrolledwindow, Policy_Always, Policy_Always);
    Set_Shadow_Type (MainWindow.Scrolledwindow, Shadow_None);
    Set_Placement (MainWindow.Scrolledwindow, Corner_Top_Left);
    Gtk_New (MainWindow.View_Port);
    Gtk_New (MainWindow.DrawingArea);
    MainWindow.Scrolledwindow.Add(MainWindow.View_Port);
    MainWindow.View_Port.Add(MainWindow.DrawingArea);
    Pack_Start
      (MainWindow.Main_Box1,
       MainWindow.Scrolledwindow,
       Expand  => True,
       Fill    => True,
       Padding => 0);
4

1 回答 1

2

我认为您可以省略视口小部件并仅用一个框替换它。正如@lb90 所说，您可以使用Set_Size_Request. 这似乎可以解决问题：

主文件

with Gtk.Main;
with Demo.Main_Window;

procedure Main is
   use Demo.Main_Window;
   Main_Window : Demo_Main_Window;
begin
   Gtk.Main.Init;
   Gtk_New (Main_Window);
   Gtk.Main.Main;
end Main;

演示广告

package Demo is

end Demo;

演示-main_window.ads

with Glib; use Glib;

with Gtk.Window;
with Gtk.Scrolled_Window;
with Gtk.Box;
with Gtk.Drawing_Area;

package Demo.Main_Window is

   type Demo_Main_Window_Record is new Gtk.Window.Gtk_Window_Record with private;
   type Demo_Main_Window is access all Demo_Main_Window_Record'Class;

   ------------------
   -- Constructors --
   ------------------

   procedure Gtk_New
     (Main_Window : out Demo_Main_Window);
   procedure Initialize
     (Main_Window : not null access Demo_Main_Window_Record'Class);

private

   use Gtk.Scrolled_Window;
   use Gtk.Box;
   use Gtk.Drawing_Area;

   Window_Width  : constant Gint := 640;
   Window_Height : constant Gint := 480;

   Draw_Area_Width  : constant Gint := 1000;
   Draw_Area_Height : constant Gint := 1000;

   type Demo_Main_Window_Record is
     new Gtk.Window.Gtk_Window_Record with
      record
         SW : Gtk_Scrolled_Window;
         VB : Gtk_Vbox;
         DA : Gtk_Drawing_Area;
      end record;

end Demo.Main_Window;

演示-main_window.adb

with Glib; use Glib;

with Gtk.Main;
with Gtk.Widget;
with Gtk.Window;
with Gtk.Enums;
with Gtk.Adjustment;

with Cairo;

package body Demo.Main_Window is

   procedure Destroy_Event_Callback
     (Widget : access Gtk.Widget.Gtk_Widget_Record'Class);

   function Draw_Event_Callback
     (Self : access Gtk.Widget.Gtk_Widget_Record'Class;
      Cr   : Cairo.Cairo_Context) return Boolean;

   -------------
   -- Gtk_New --
   -------------

   procedure Gtk_New (Main_Window : out Demo_Main_Window) is
   begin
      Main_Window := new Demo_Main_Window_Record;
      Demo.Main_Window.Initialize (Main_Window);
   end Gtk_New;

   ----------------
   -- Initialize --
   ----------------

   procedure Initialize
     (Main_Window : not null access Demo_Main_Window_Record'Class)
   is      
   begin

      Gtk.Window.Initialize (Main_Window);

      --  Setup window
      Main_Window.Set_Title ("Demo");
      Main_Window.Set_Size_Request (Window_Width, Window_Height);
      Main_Window.Set_Resizable (False);

      Main_Window.On_Destroy (Destroy_Event_Callback'Access);

      --  Add controls
      Gtk_New (Main_Window.SW);
      Gtk_New_Vbox (Main_Window.VB);
      Gtk_New (Main_Window.DA);

      Main_Window.SW.Set_Policy
        (Hscrollbar_Policy => Gtk.Enums.Policy_Always,
         Vscrollbar_Policy => Gtk.Enums.Policy_Always);

      Main_Window.DA.Set_Size_Request (Draw_Area_Width, Draw_Area_Height);
      Main_Window.DA.On_Draw (Draw_Event_Callback'Access);

      Main_Window.VB.Pack_Start (Main_Window.DA, True, True, 0);
      Main_Window.SW.Add (Main_Window.VB);
      Main_Window.Add (Main_Window.SW);      

      --  Show the window.
      Main_Window.Show_All;

   end Initialize;

   ----------------------------
   -- Destroy_Event_Callback --
   ----------------------------

   procedure Destroy_Event_Callback
     (Widget : access Gtk.Widget.Gtk_Widget_Record'Class)
   is
   begin
      Gtk.Main.Main_Quit;
   end Destroy_Event_Callback;

   -------------------------
   -- Draw_Event_Callback --
   -------------------------

   function Draw_Event_Callback
     (Self : access Gtk.Widget.Gtk_Widget_Record'Class;
      Cr   : Cairo.Cairo_Context) return Boolean
   is

      --  Draw some rectangles. This function is not optimal in terms of 
      --  performance as everything is being redrawn, including the non 
      --  visible parts, but it's OK (I think) for the demo.

      Num_X : constant Gint := 20;
      Num_Y : constant Gint := 20;  

      Ratio : constant Gdouble := 0.8;            

      Dx : constant GDouble := GDouble (Self.Get_Allocated_Width  / Num_X);
      Dy : constant GDouble := GDouble (Self.Get_Allocated_Height / Num_Y);

      --  Or, alternatively (same outcome)
      --    Dx : constant GDouble := GDouble (Draw_Area_Width  / Num_X);
      --    Dy : constant GDouble := GDouble (Draw_Area_Height / Num_Y);

   begin

      for X in 0 .. Num_X - 1 loop
         for Y in 0 .. Num_Y - 1 loop

            Cairo.Set_Source_RGB 
              (Cr    => Cr,
               Red   => GDouble (X)     / GDouble (Num_X),
               Green => GDouble (X * Y) / GDouble (Num_X * Num_Y),
               Blue  => GDouble (Y)     / GDouble (Num_Y));

            Cairo.Rectangle
              (Cr     => Cr,
               X      => Dx * (GDouble (X) + 0.5 * (1.0 - Ratio)),
               Y      => Dy * (GDouble (Y) + 0.5 * (1.0 - Ratio)),
               Width  => Dx * Ratio,
               Height => Dy * Ratio);

            Cairo.Fill (Cr);

         end loop;
      end loop;

      return True;   -- GDK_EVENT_STOP, do not propagate event to parent.

   end Draw_Event_Callback;

end Demo.Main_Window;
于 2019-12-30T14:59:33.477 回答