Color degrades when using Copy As Bitmap

Question

I have discovered a problem that affects my use of Mathematica. When I use the menu command Edit > Copy As > Bitmap the colors in the copy are subtly degraded. To make this more apparent I copied and pasted repeatedly with the following result:

This is a major problem as I have been assuming that Copy As > Bitmap was a lossless operation.

Is there an explanation for this behavior? Is there a better work-around than using Print Scrn, pasting, and cropping? Which versions and platforms are affected?

I am using Mathematica 10.1 under Windows 7.

---

Update

• Following both Oleksandr's comments Alexey's analysis I removed any profile associated with my monitor from the Windows Color Management dialog, and repeated the experiment (using Alexey's code).

• Now the last copy is visually identical to the original, confirming that this is a problem with how Mathematica handles monitor profiles.

• Notably the LUT for my calibration profile is still loaded into my graphics card (it was loaded at start-up by the utility ColorVisionStartup). This means that it is possible to have both calibration and verbatim copying in Mathematica; the problem entirely separate.

• Un-associating the monitor profile in Color Management after the LUT is loaded is a viable work-around, but quite inconvenient and prone to error as one would need to remember to re-associate the profile before restarting Windows.

Answer 1

UPDATE from 06.11.2015

Since writing the original answer I installed updates for my Windows 7 x64. Now the original bug isn't there anymore but there still persists more fundamental bug which I observe in versions 8.0.4, 9.0.1, 10.0.1, 10.2 and 10.3 installed on the same system. This bug becomes evident when you look at the plots of horizontal channel intensity values generated by the code in the original answer. Below is output from version 10.3:

---

Original answer

I'm also on Windows 7 x64 and observe the same problem with Mathematica 10.2.

Here is a demonstration of what happens on the level of channel values. It supports Oleksandr's supposition that we have a color management issue here.

In a new Notebook I generate an image:

Image[ConstantArray[Range[0, 1, .001], {40}]]

Then I programmatically copy it as Bitmap, paste below the original and save the clipboard content in lst (the following code should be evaluated in a Cell placed after the output generated by the above code):

lst = Table[SelectionMove[EvaluationNotebook[], Before, EvaluationCell];
   SelectionMove[EvaluationNotebook[], Previous, CellContents];
   FrontEndTokenExecute[EvaluationNotebook[], "CopySpecial", "MGF"];
   SelectionMove[EvaluationNotebook[], After, Cell, 1];
   FrontEndTokenExecute[EvaluationNotebook[], "Paste"];
   NotebookGet[ClipboardNotebook[]], {20}];

Here is how my Notebook looks afterwards:

Now I extract horizontal channel values for successive images and plot them separately for every channel:

channelData = 
  ImageData[ToExpression[#[[1, 1, 1, 1]]], Automatic, Interleaving -> False][[All, 
      20]] & /@ lst;
Column[ListLinePlot[channelData[[All, #]], PlotRange -> All, 
    PlotLabel -> {"Red", "Green", "Blue"}[[#]], ImageSize -> 700] & /@ {1, 2, 3}]

Indeed it looks like some color transformation is applied to image when you copy it as Bitmap which results in color degradation mainly due to clipping off color values after conversion and also due to rounding off errors.

I suppose that the FrontEnd relies upon some Windows functionality for rendering of an expression when you copy it as Bitmap. And even when what you copy is already an Image, FrontEnd nevertheless handles it the same way.

---

The only workaround I can suggest is do not rely upon FrontEndTokens for rasterization and use Rasterize instead. Just for completeness, this answer demonstrates why we should not rely upon FrontEndTokens even for exporting.

---

Workaround

In the comment William points to the thread which contains .NET-based solution allowing to copy graphics into clipboard already in compressed PNG format with highest quality currently available in Mathematica. For your particular application the solution by Todd Gayley can be modified as follows (the following respects the styles of the selected Notebook):

Needs["NETLink`"]

CopyAsPNG[g_, opts : OptionsPattern[]] := 
  CopyAsPNG[Rasterize[Style[g, Options[SelectedNotebook[]]], "Image", opts]];
CopyAsPNG[i_Image] := Module[{png, strm, dataObject}, InstallNET[];
  png = ExportString[i, "PNG"];
  NETBlock[strm = NETNew["System.IO.MemoryStream", ToCharacterCode[png]];
   dataObject = NETNew["System.Windows.Forms.DataObject"];
   dataObject@SetData["PNG", strm];
   LoadNETType["System.Windows.Forms.Clipboard"];
   Clipboard`SetDataObject[dataObject]]]

Checking:

ColorData["VisibleSpectrum", "Panel"] // CopyAsPNG
Paste[]