Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2007
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2007

[Date Index] [Thread Index] [Author Index]

Search the Archive

Quick and dirty Zooming tool

  • To: mathgroup at smc.vnet.net
  • Subject: [mg78322] Quick and dirty Zooming tool
  • From: Guy lamouche <nopublicemail at nopublicemail.com>
  • Date: Thu, 28 Jun 2007 04:27:49 -0400 (EDT)

Here is a "dirty programming" version of a zooming tool. It is not nice, could be 
better designed, but it works. It is a modification of the very nice tool from Ingolf 
Dahl (thanks!!!) that introduces locators whose coordinates can be copied and which 
shows some programming possibilities that are very interesting (BTW, where do we find 
the documentation for DynamicModuleBox and LocatorPaneBox? These look useful!). I 
modified it to automatically put two locators at the corners of the graphic, to zoom 
within locators and introduce two new locators on the new graphic, and to unzoom to the 
original graphic. I left the copy locator part because it can be useful (at least, I 
need it...). 
Many things are not nice:
-I had to introduce a Global variable called uNZOOM to store the original graphics. 
-I redraw the zoomed graphics twice, once without locators and then with locators (I 
had no time to find out how to do it in one shot). 
-I don't draw a rectangle to show the region to be zoomed. 
-Robustness is not tested (wrote it this morning and played with it only a little).

All these could be improved, but I needed a working version quickly. Maybe somebody 
have ideas for a more efficient and robust version.



CreatePalette[Column[{
    Button["Add LocatorPane",
     SelectionMove[InputNotebook[], All, CellContents];
     Global`uNZOOM = NotebookRead[InputNotebook[]];
     NotebookWrite[InputNotebook[],
      (DynamicModuleBox[
          {$CellContext`pts$$ = (PlotRange /. 
               AbsoluteOptions[ToExpression[#]])\[Transpose]},
          
          LocatorPaneBox[Dynamic[$CellContext`pts$$], #, 
           LocatorAutoCreate -> False],
          DynamicModuleValues :> {}]) &@NotebookRead[InputNotebook[]]
      ]
     ],
    Button["Zoom within Locators",
     SelectionMove[InputNotebook[], All, CellContents];
     Module[{b},
      b = NotebookRead[InputNotebook[]];
      If[And[Length[b] >= 3, MatchQ[b[[2]], _LocatorPaneBox]],
       NotebookWrite[InputNotebook[],
        ToBoxes[
         Show[ToExpression[b[[2, 2]]], 
          PlotRange -> 
           Sort /@ (ToExpression[b[[1, 1]]]\[Transpose])]]
        ];
       NotebookWrite[InputNotebook[], (DynamicModuleBox[
            {$CellContext`pts$$ = (PlotRange /. 
                 AbsoluteOptions[ToExpression[#]])\[Transpose]},
            
            LocatorPaneBox[Dynamic[$CellContext`pts$$], #, 
             LocatorAutoCreate -> False],
            DynamicModuleValues :> {}]) &@
         NotebookRead[InputNotebook[]]]
       ]
      ]
     ],
    Button["Copy locator positions",
     SelectionMove[InputNotebook[], All, Cell];
     FrontEndExecute[FrontEndToken["Copy"]];
     SelectionMove[InputNotebook[], All, CellContents];
     Module[{b},
      b = NotebookRead[InputNotebook[]];
      If[And[Length[b] >= 3, MatchQ[b[[2]], _LocatorPaneBox]],
       b = b[[1, 1]];
       $LocatorPositions = b;
       SelectionMove[ClipboardNotebook[], All, Notebook];
       NotebookWrite[ClipboardNotebook[], ToBoxes[b], All];
       SelectionMove[ClipboardNotebook[], All, Notebook]]
      ]
     ],
    Button["UnZoom",
     SelectionMove[InputNotebook[], All, Cell];
     NotebookWrite[InputNotebook[], Global`uNZOOM]
     ],
    Dynamic[MousePosition["Graphics"]]
    }],
  WindowTitle -> "Zooming Tool"];

Cordially.

Guy Lamouche


  • Prev by Date: Re: Maximize with Integer constraints
  • Next by Date: Re: Re: Re: problem with Pick
  • Previous by thread: Background color for plot area (not whole graphic) and white
  • Next by thread: Problems with DrawGraphics and Mathematica 6.0?