Держите текст внутри круга - PullRequest
Новая
       2

Держите текст внутри круга

2 голосов
/ 20 апреля 2011

Я использую Delphi, у меня есть текст, и я хочу поместить его в крикле, с помощью чего я хочу уменьшить шрифт текста, чтобы держать его в кругу, я знаю код того, как держать его в прямоугольник, но я немного путаюсь с математической функцией, которая позволяет мне держать его в кругу вот код прямоугольника, который я получил от серфинга в интернете 

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;

}

1 Ответ

2 голосов
/ 20 апреля 2011

Я бы адаптировал код для прямоугольника так: 

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;

Размер полученного шрифта указан на холсте.

...