Thực hiện một chuỗi văn bản điền vào một hình chữ nhật

Question

Giả sử tôi muốn có một chuỗi, nói "123", để điền vào một hình chữ nhật được đưa ra, như vậy:

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}]]] 

Nhưng tôi trao chỉnh cỡ chữ ở đó (67) để nó lấp đầy hình chữ nhật. Làm thế nào bạn tạo một chuỗi tùy ý lấp đầy một hình chữ nhật tùy ý?

Answer 1

Tôi tin rằng đây là một vấn đề khó biết. Câu trả lời tốt nhất mà tôi có thể tìm thấy is from John Fultz.

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

Dưới đây là một cách tiếp cận thay thế có thể chuyển đổi các văn bản để một kết cấu đó được ánh xạ tới một đa giác. Này có các tính năng của kéo dài văn bản để phù hợp với khu vực

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}}]}]] 

Là một chức năng để so sánh dễ dàng hơn (vì nó không thực sự văn bản nữa.):

(* 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

Các giải pháp đề nghị không hoạt động khi Lô đất không có ở đó, tôi đã sử dụng tùy chọn PlotRange để giải quyết nó. Tôi bọc nó trong một chức năng; Độ mờ, màu văn bản, v.v. nên được đưa vào các lựa chọn;

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}}]];