Сделать текстовую строку заполнить прямоугольник

Question

Предположим, я хочу, чтобы строка, скажем "123", заполнила данный прямоугольник, например, так:

Show[Plot[x, {x, 0, 1}], 
     Graphics[{EdgeForm[Thick], Yellow, Rectangle[{.1, .5}, {.4, .9}]}], 
     Graphics[Text[Style["123", Red, Bold, 67], {.1, .5}, {-1, -1}]]]

Но я вручную настроил размер шрифта там(67), чтобы он заполнил прямоугольник.Как бы вы заставили произвольную строку заполнить произвольный прямоугольник?

Answer 1

Я считаю, что это известная трудная проблема.Лучший ответ, который я смог найти , от Джона Фульца.

TextRect[text_, {{left_, bottom_}, {right_, top_}}] := 
 Inset[
  Pane[text, {Scaled[1], Scaled[1]},
   ImageSizeAction -> "ResizeToFit", Alignment -> Center],
  {left, bottom}, {Left, Bottom}, {right - left, top - bottom}]

Show[
 Plot[x, {x, 0, 1}],
 Graphics[{
   {EdgeForm[Thick], Yellow, Rectangle[{.1, .5}, {.4, .9}]},
   TextRect[Style["123", Red, Bold], {{.1, .5}, {.4, .9}}]
 }]
]

Answer 2

Вот альтернативный подход, который преобразует текст в текстуру, которая отображается в многоугольник.Это имеет функцию растягивания текста, чтобы соответствовать области (так как это больше не текст).

Show[Plot[x, {x, 0, 1}], 
   Graphics[{EdgeForm[Thick], Yellow, Rectangle[{.1, .5}, {.4, .9}]}], 
   Graphics[{Texture[ImageData[
      Rasterize[Style["123", Red, Bold], "Image", RasterSize -> 300, 
         Background -> None]]], 
      Polygon[{{0.1, 0.5}, {0.4, 0.5}, {0.4, 0.9}, {0.1, 0.9}}, 
         VertexTextureCoordinates -> {{0, 0}, {1, 0}, {1, 1}, {0, 1}}]}]]

Как функция для более простого сравнения:

(* Render string/style s to fill a rectangle with left/bottom corner {l,b} and 
   right/top corner {r,t}. *)
textrect[s_, {{l_,b_},{r_,t_}}] := Graphics[{
  Texture[ImageData[Rasterize[s, "Image", RasterSize->300, Background->None]]], 
  Polygon[{{l,b}, {r,b}, {r,t}, {l,t}}, 
          VertexTextureCoordinates->{{0,0},{1,0},{1,1},{0,1}}]}]

Answer 3

Предлагаемое решение не работало, когда Plot не было, я использовал опцию PlotRange, чтобы решить ее. Я обернул это в функцию; Непрозрачность, цвет текста и т.д .; следует сделать из вариантов;

textBox[text_, color_, position_: {0, 0}, width_: 2, height_: 1] := 
  Graphics[{
    {
     color, Opacity[.1],
     Rectangle[position, position + {width, height}, 
      RoundingRadius -> 0.1]
     }
    ,
    Inset[
     Pane[text, {Scaled[1], Scaled[1]}, 
      ImageSizeAction -> "ResizeToFit", Alignment -> Center], 
     position, {Left, Bottom}, {width, height}]
    }, PlotRange -> 
    Transpose[{position, position + {width, height}}]];