New display format needed: "drag box"

Question

I want to create a new display type, especially for numbers or text, but potentially for arbitrary objects as well. I want a "drag box" where not all of the number (object) is visible, but dragging left and right on the object itself slides it left and right (or in a generalized form both x and y).

No scroll bars should be visible, and it should be tightly integrated much like Framed so that it can be used in different places without difficulty.

In Chat Szabolcs showed how to get the basic functionality. However, there are problems with this implementation as he notes:

1. the N[Pi,100] shouldn't be recalculated constantly

2. ... Dynamic doesn't work inside the ScrollPosition setting ...

3. when the mouse leaves the region, it stops working, and for good usability it shouldn't

I don't observe #3 on my system (Win7/mma7) but I do note another problem: Dragging the text left (looking at the least significant digits) it is possible to drag the object completely out of frame. Dragging it right does not move it out of frame but causes a memory of the drag such that it appears "stuck" when you start dragging left, though it eventually moves.

• How can this function be implemented most efficiently and flexibly?

• Can it be made to work inside a Text object the way Frame does?

Answer 1

Here's a more robust version of Rojo's answer:

BeginPackage["DragPane`"];
DragPane::usage = "implements a draggable Pane";
BeginPackage["`Package`"];
DragPaneDynamicModule::usage = "the dynamic module used by DragPane";
EndPackage[];
Begin["`Private`"];
Options[DragPaneDynamicModule] =
  Join[
   Options[Pane],
   {
    AutoAction -> False
    }
   ];
DragPaneDynamicModule[
   exp_,
   {width_, height_},
   ops : OptionsPattern[]
   ] :=
  With[
   {
    boxSize =
     {#[[1]], 3 + Total@#[[2 ;;]]} &@First@
       FrontEndExecute@
        GetBoundingBoxSizePacket[
         Cell[BoxData[ToBoxes[exp]],
          "Output",
          PageWidth -> \[Infinity],
          ShowCellBracket -> False,
           CellMargins -> {{0, 0}, {0, 0}}
          ]
         ]
    },
   DynamicModule[
    {
     scrollX = 0., scrollY = 0.,
     maxWidth =
      If[! NumericQ@width,
       boxSize[[1]],
       Max@{boxSize[[1]], width}
       ],
     boxWidth =
      If[! NumericQ@width, Min@{boxSize[[1]], 360} , width],
      maxHeight =
      If[! NumericQ@height,
       boxSize[[2]],
       Max@{boxSize[[2]], height}
       ],
     boxHeight =
      If[! NumericQ@height, Min@{boxSize[[2]], 360} , height],
     setXScroll,
     setYScroll,
     getXScroll,
     getYScroll,
     scrolling = False,
     refWidth, refX,
     refHeight, refY
     },
    Pane[
     EventHandler[
       Pane[
        Pane[exp, 2*boxSize, Alignment -> {Left, Top}],
        Full,
        ScrollPosition :>
         Dynamic[
          If[
           TrueQ[scrolling],
           {
            setXScroll[],
            setYScroll[]
            },
           {scrollX, scrollY}
           ],
          Function[
           scrollX =
            Clip[#[[1]], {0., Max@{maxWidth - boxWidth, 0.}}];
           scrollY =
            Clip[#[[2]], {0., Max@{maxHeight - boxHeight, 0.}}];
           ],
          TrackedSymbols :> {scrollX, scrollY}
          ],
         Alignment -> {Left, Top}
        ],
       {
        If[TrueQ@OptionValue[AutoAction],
          "MouseEntered",
          "MouseDown"
          ] :>
         (
          refX = scrollX;
          refY = scrollY;
          {refWidth, refHeight} = MousePosition["ScreenAbsolute"];
          scrolling = True
          ),
        If[TrueQ@OptionValue[AutoAction],
          "MouseMoved",
          "MouseDragged"
          ] :>
         (
          If[! AllTrue[{refWidth, refHeight}, NumericQ],
           refX = scrollX;
           refY = scrollY;
           {refWidth, refHeight} = MousePosition["ScreenAbsolute"];
           scrolling = True
           ];
          setXScroll[];
          ),
        If[TrueQ@OptionValue[AutoAction],
          "MouseExited",
          "MouseUp"
          ] :>
         (
          scrolling = False;
          setXScroll[];
          setYScroll[];
          Clear[refWidth, refHeight, refX, refY];
          )
        }
       ] // MouseAppearance[#, "PanView"] &,
     FilterRules[
      {
       ImageSize ->
        Dynamic[{boxWidth, boxHeight}],
       ops
       },
      Options[Pane]
      ]
     ],
    Initialization :>
     {
      getXScroll[x_] :=
       Clip[
        refX + refWidth - x,
        {0., Max@{maxWidth - boxWidth, 0.}}
        ];
      getXScroll[] :=

       getXScroll[First@MousePosition["ScreenAbsolute"]],
      setXScroll[x___] :=
       scrollX = getXScroll[x],
      getYScroll[y_] :=
       Clip[
        refY + refHeight - y,
        {0., Max@{maxHeight - boxHeight, 0.}}
        ];
      getYScroll[] :=

       getYScroll[Last@MousePosition["ScreenAbsolute"]],
      setYScroll[y___] :=
       scrollY = getYScroll[y]
      }
    ]
   ];

Options[DragPane] =
  Options[DragPaneDynamicModule];
DragPane[
   exp_,
   w : _?NumericQ | Automatic,
   ops : OptionsPattern[]
   ] :=
  DragPane[exp, {w, Automatic}, ops];
DragPane[
   exp_,
   ops : OptionsPattern[]
   ] :=
  DragPane[exp,
    OptionValue[ImageSize],
   ops
   ];
Format[dp : 
    DragPane[exp_, {width_, height_}, ops : OptionsPattern[]], 
   StandardForm] :=
  Interpretation[
   DragPaneDynamicModule[exp, {width, height}, ops],
   dp
   ];
End[];
EndPackage[]

1. The scrolling is more stable
2. It only displays as the scrollable form. That is, its expression form remains DragPane.
3. It supports scrolling in y as well, but only if there's space
4. It can take AppearanceElements -> "ResizeArea"
5. I added AutoAction as a bit of a joke

Here's a good example:

DragPane[
 ImageResize[ExampleData[{"TestImage", "Mandrill"}],
  Scaled[2]
  ]
 ]

Answer 2

I'm not sure I understood the concerns, so let me know how this works. The N[Pi , 50] isn't recalculated since Dragger doesn't have the attributes HoldFirst or family. Seems it can be dragged anywhere. And I don't know about the rest.

Dragger[exp_, size_] :=
 With[{maxsize = 
    First[ImageSize /. Options[Rasterize@exp, ImageSize]] - 0.95 size},
   DynamicModule[{x = 0., b = False, ref}, 
   MouseAppearance[
    EventHandler[
     Pane[Pane[exp, 100000], ImageSize -> size, 
      ScrollPosition :> 
       Dynamic[{If[b, 
          Clip[x + ref - First@MousePosition["ScreenAbsolute"], {0., 
            maxsize}], x], 0.}, 
        Null &]], {"MouseDown" :> (ref = 
         First@MousePosition["ScreenAbsolute"]; b = True), 
      "MouseUp" :> (b = False;
        x = 
         Clip[x + ref - First@MousePosition["ScreenAbsolute"], {0., 
           maxsize}])}], "FrameLRResize"]]]

I thought this would be inefficient in that it would update for every change in MousePosition, so I was ready to wrap a Refresh such as If[b, Refresh[..., UpdateInterval:>0.05]..., but in my tests it is smarter than I thought and doesn't try to update when b is False

So you should run Dragger[N[Pi, 50], 100] to test it

Answer 3

In versions 10.4+, you can use DynamicImage:

img = ImageResize[ExampleData[{"TestImage", "Mandrill"}], Scaled[2]];

DynamicImage[img, ImageSize -> 200, ZoomFactor -> .5, 
   ZoomCenter -> {Left, Top}, AppearanceElements -> {"Pan"}]