Retrieving the ImagePadding in absolute units

Update

I created a paclet. Install the paclet with

PacletInstall[
    "GraphicsInformation",
    "Site"->"http://raw.githubusercontent.com/carlwoll/GraphicsInformation/master"
]

and then load the paclet with

<<GraphicsInformation`

Use GraphicsInformation instead of graphicsInformation

Original post

Here is my attempt to create a function that returns reliable values for ImagePadding, ImageSize and PlotRange. It is inspired by the efforts of @LLlAMnYP in his answer to 83636 and @AlexeyPopkov in his answer to 18034

The basic idea is use ExportPacket to find out what the FrontEnd computes for these values. Not only is this what Rasterize uses under the hood, it allows one to support Scaled ImageSize settings as well by setting the WindowSize of the Notebook object fed to ExportPacket. For instance, @Heike's answer doesn't fair well when ImageSize->Full is used.

1. ImageSize /ImagePadding - Adding an Annotation wrapper to appropriate Rectangle objects added as an Epilog can be used to determine these values.

2. PlotRange - Rather than using pure function Ticks, I used pure function GridLines. GridLines apply whether Frame/Axes are True or False.

Here is the function:

graphicsInformation[gr_Graphics] := Module[{info},
    info = Flatten @ Reap[
        Rule @@@ ReplaceAll[
            "Regions",
            FrontEndExecute @ ExportPacket[
                toNotebook[gr],
                "BoundingBox",
                Verbose->True
            ]
        ],
        _,
        #1->#2[[1]]&
    ];
    extract[info]
]

toNotebook[gr_] := Notebook[
    {
    Cell[BoxData @ ToBoxes @ instrumentGraphics[gr],
        "Output"
    ]
    },
    WindowSize -> CurrentValue[EvaluationNotebook[], WindowSize],
    Evaluator -> CurrentValue[EvaluationNotebook[], Evaluator]
]

instrumentGraphics[gr_Graphics] := Show[
    gr,
    GridLines -> {sowRange["X"], sowRange["Y"]},
    Epilog -> {
        Annotation[
            Rectangle[Scaled[{0,0}], Scaled[{1,1}]],
            "PlotRange", "Region"
        ],
        Annotation[
            Rectangle[ImageScaled[{0,0}], ImageScaled[{1,1}]],
            "ImageSize", "Region"
        ]
    }
]

sowRange[label_] := Function[Sow[{##}, label]; None]

extract[rules_] := Module[{pr, is, xr, yr},
    {pr, is, xr, yr} = {{"PlotRange", "Region"}, {"ImageSize", "Region"}, "X", "Y"} /. rules;
    {
    "ImagePadding"->Abs[is-pr],
    "ImageSize"->Abs[Subtract@@@is],
    "PlotRangeSize"->Abs[Subtract@@@pr],
    "ImagePaddingSize"->Total[Abs[is-pr],{2}],
    "PlotRange"->{xr,yr}
    }
]

Here are a couple examples:

graphicsInformation @ Plot[
    Sin[x],
    {x, 0, Pi},
    ImagePadding -> {{1.1,2.2}, {3.3,4.4}}
]

{"ImagePadding" -> {{1.1, 2.2}, {3.3, 4.4}}, "ImageSize" -> {360., 228.153}, "PlotRangeSize" -> {356.7, 220.453}, "ImagePaddingSize" -> {3.3, 7.7}, "PlotRange" -> {{-0.0654498, 3.20704}, {-0.0555556, 1.05556}}}

plot = Plot[
    Sin[x],
    {x, 0, Pi},
    ImageSize -> Full,
    ImagePadding -> {{1.1,2.2}, {3.3,4.4}}
];
graphicsInformation[plot]

{"ImagePadding" -> {{1.1, 2.2}, {3.3, 4.4}}, "ImageSize" -> {706., 441.992}, "PlotRangeSize" -> {702.7, 434.292}, "ImagePaddingSize" -> {3.3, 7.7}, "PlotRange" -> {{-0.0654498, 3.20704}, {-0.0555556, 1.05556}}}

Compare to Heike's solution:

heike[g_]:=BorderDimensions@Image[Show[g,LabelStyle->White,Background->White]]
heike[plot]

{{19, 4}, {5, 7}}

One final comment. It is possible to use a single call to ExportPacket to extract graphics information from multiple graphics objects. Since the call to ExportPacket is the most time consuming part of the code, using a single call to ExportPacket will be much quicker than using graphicsInformation on multiple Graphics objects. Here is a version that does this:

Clear[graphicsInformation, extract]
graphicsInformation[gr:{__Graphics}] := Module[{info, res},
    info = Flatten @ Reap[
        Rule @@@ ReplaceAll[
            "Regions",
            FrontEndExecute @ ExportPacket[
                toNotebook[gr],
                "BoundingBox",
                Verbose->True
            ]
        ],
        _,
        #1->#2[[1]]&
    ];
    res = extract[info] /@ Range @ Length @ gr;
    Thread @ Rule[
        {"ImagePadding", "ImageSize", "PlotRangeSize", "ImagePaddingSize", "PlotRange"},
        Thread @ ReplaceAll[
            {"ImagePadding", "ImageSize", "PlotRangeSize", "ImagePaddingSize", "PlotRange"},
            res
        ]
    ]
]
graphicsInformation[gr_Graphics] := Replace[
    graphicsInformation[{gr}],
    Rule[a_, {b_}] :> a -> b,
    {1}
]

toNotebook[gr_] := Notebook[
    {
    Cell[BoxData @ ToBoxes @ instrumentGraphics[gr],
        "Output"
    ]
    },
    WindowSize -> CurrentValue[EvaluationNotebook[], WindowSize],
    Evaluator -> CurrentValue[EvaluationNotebook[], Evaluator]
]

instrumentGraphics[gr:{__Graphics}] := MapThread[
    Show[#1,
        GridLines -> {sowRange["X" -> #2], sowRange["Y" -> #2]},
        Epilog -> {
            Annotation[
                Rectangle[Scaled[{0,0}], Scaled[{1,1}]],
                "PlotRange", #2
            ],
            Annotation[
                Rectangle[ImageScaled[{0,0}], ImageScaled[{1,1}]],
                "ImageSize", #2
            ]
        }
    ]&,
    {gr, Range@Length@gr}
]

instrumentGraphics[gr_Graphics] := instrumentGraphics[{gr}]

sowRange[label_] := Function[Sow[{##}, label]; None]

extract[rules_][k_] := Module[{pr, is, xr, yr},
    {pr, is, xr, yr} = {{"PlotRange",k}, {"ImageSize",k}, "X"->k, "Y"->k} /. rules;
    {
    "ImagePadding"->Abs[is-pr],
    "ImageSize"->Abs[Subtract@@@is],
    "PlotRangeSize"->Abs[Subtract@@@pr],
    "ImagePaddingSize"->Total[Abs[is-pr],{2}],
    "PlotRange"->{xr,yr}
    }
]

This almost works but seems to be 1 point off some of the time

im = Image[Show[g, LabelStyle -> White, Background -> White]];
BorderDimensions[im]

For example for

g = Graphics[Circle[], Frame -> True, FrameLabel -> {"one", "two"}, 
  ImagePadding -> {{35, 20}, {40, 50}}]

The output is

{{35, 19}, {40, 50}}

Edit: more seriously this time, this actually should be helpful.

---

fill = Show[#,
        Epilog -> {
          Black, Rectangle[ImageScaled[{0, 0}], ImageScaled[{1, 1}]],
          Red, Rectangle[Scaled[{0, 0}], Scaled[{1, 1}]]
        }
       ] &;

rle = Part[Length /@ Split @ #, {1, -1}] &;

imgpad[g_] := With[{dat = ImageData[fill @ g]},
  {rle @ dat[[#]], Reverse @ rle @ dat[[All, #2]]} & @@ Quotient[Dimensions @ dat, 2]
]

Usage:

imgpad[graphic]

I don't have the function BorderDimensions but I presume this could be substituted for the part after the fill.