Controlling the Rasterize[] width for notebook-related expressions

Question

Update Mr Wizard's answer gives pixel-perfect results, but it is Windows-only and destroys the clipboard contents. My answer should work on any platform, but it's less precise: e.g. it omits In/Out labels. It does allow setting the rasterization width though.

---

This problem came up when I was trying to make a preview window for an image uploader (see the end of that answer).

I would like to create a palette button that will upload the current notebook selection as an image. Before uploading, I would like to show a preview of the image, to reduce the chance of something going awry before contacting the server.

This is what I have so far (includes only the preview code, not the uploader):

button = Button[
  "Preview",
  Module[
    {expr = NotebookRead@InputNotebook[]}, 
    If[expr =!= {},
      With[{img = Rasterize[expr]},
        MessageDialog[
          Column[{"Would you like to perform the action?", img}], 
          {"Do it!" :> doIt[img], "Cancel" :> Null}
        ]
      ]
    ]
  ]
]

^{In case you are wondering why I used a nested With inside the Module instead of making img a module-variable too: it's because by the time doIt[img] is evaluated, the local module variables will have been cleared, so I need to substitute the rasterized expression directly into the doIt function,}

This button works (more or less). You can try it by creating a graphic in the same notebook (e.g. Graphics[Circle[]]), selecting it using a single click, then clicking the Preview button.

However, if I put it in a palette using CreatePalette[button], then the rasterization will happen for the window-width of the palette, and I get something like this:

How can I control the width of rasterization, or more generally, how can I create a preview dialog for the uploader that avoids this issue?

For an additional improvement, it would be nice to be able to size the message window so it fits the preview image (and still shows the button: the button disappears with WindowSize -> All).

---

Answers

Mr. Wizard's suggestion:

button = Button[
  "Preview", (FrontEndExecute[
    FrontEndToken[FrontEnd`SelectedNotebook[], "CopySpecial", "MGF"]];
    MessageDialog[
    First@Cases[NotebookGet@ClipboardNotebook[], 
      RasterBox[data_, ___] :> 
       Image[data, "Byte", ColorSpace -> "RGB", Magnification -> 1], 
      Infinity]])]

CreatePalette[button]

Problems: It (probably) only works on Windows, and it destroys the clipboard contents.

Answer 1

I managed to do this by copying the selection to a new notebook, rasterizing the full notebook, then closing it.

CreatePalette@Button["Preview",
  Module[{target},
   target = 
    CreateDocument[{}, WindowSelected -> False, Visible -> False];
   NotebookWrite[target, NotebookRead[SelectedNotebook[]]];
   CreateDialog[{Rasterize[target], DefaultButton[]}];
   NotebookClose[target]
   ]
  ]

The WindowSize -> 500 option can be added to CreateDocument to set the rasterization width to 500 pixels.

---

Note some disadvantages (advantages in some cases) of this method compared to copying as bitmap:

• Custom styles are lost
• In/Out labels are lost
• Notebook magnification value is lost

If there's a need, some of these can be remedied by explicitly transferring some notebook options from the SelectedNotebook to the newly created one.