円内にテキストを保持する

Question

私はテキストを持っていますので、私はそれを輪郭に収めたいのですが、テキストのフォントを減らして円の中に入れたいと思っています。長方形にそれを維持する方法のが、私、私が円 の中でそれを維持することができ数学関数で少し混乱馬はここで私は、インターネットに

double fontSize = 20.0; 
bool bFontFits = false; 

while (bFontFits == false) 
{ 
    m_pCanvas->Font->Size = (int)fontSize; 
    TSize te = m_pCanvas->TextExtent(m_name.c_str()); 
    if (te.cx < (width*0.90)) // Allow a little room on each side 
    { 
     // Calculate the position 
     m_labelOrigin.x = rectX + (width/2.0) - (te.cx/2); 
     m_labelOrigin.y = rectY + (height/2.0) - te.cy/2); 
     m_fontSize = fontSize; 
     bFontFits = true; 
     break; 
    } 
    fontSize -= 1.0; 

}

Answer 1

サーフィンから得た長方形のコードです私は次のような長方形のコードを変更します：

procedure CalcFontSizeRectangle(aCanvas : TCanvas; const aText : string; const aRect : TRect); 
var 
    te : TSize; 
begin 
    aCanvas.Font.Size := 20; 

    while aCanvas.Font.Size > 0 do begin 
    te := aCanvas.TextExtent(aText); 
    if (te.cx < ((aRect.Right-aRect.Left)*0.90)) and (te.cy < ((aRect.Bottom-aRect.Top)*0.90)) then begin 
     break; 
    end; 

    aCanvas.Font.Size := aCanvas.Font.Size - 1; 
    end; 
end; 

、それはこのような円のために働く得るためにそれを少し変更します。

procedure CalcFontSizeCircle(aCanvas : TCanvas; const aText : string; const aDiameter : integer); 
var 
    te : TSize; 
    d : double; 
begin 
    aCanvas.Font.Size := 20; 

    while aCanvas.Font.Size > 0 do begin 
    te := aCanvas.TextExtent(aText); 
    d := sqrt(te.cx * te.cx + te.cy * te.cy); 
    if d < (aDiameter*0.90) then begin 
     break; 
    end; 

    aCanvas.Font.Size := aCanvas.Font.Size - 1; 
    end; 
end; 

結果のフォントサイズはキャンバスです。