この発言に対し以下のコメントが寄せられています

#01250　河邦 正         さん　RE:円に沿って文字を描画する（修正）







title: 円に沿って文字を描画する

　「円に沿って文字を描画する」ような状況は少ないとは思いますが、
下記はプラスミド（用語説明は省略）の描画と印刷のために作りまし
た。
　「文字の回転描画」の応用編みたいなものです。


// 円に沿って文字を描画する
function TextOutArc(
  Canvas: TCanvas; XCenter, YCenter, Radius: Integer;
  Angle: Extended; Text: WideString): Extended;
var
  I, Len: Integer;
  C: WideChar;
  OldLf, NewLf: LOGFONT;
  H, W, X, Y: Integer;
  NewAngle: Extended;
begin
  // オリジナルのフォント情報を保存
  GetObject(Canvas.Font.Handle, sizeof(OldLf), @OldLf);
  
  H := Canvas.TextHeight(Text);
  
  // 文字ごとの描画情報をリセット
  NewLf := OldLf;
  NewAngle := DegToRad(Angle / 10);
  
  // 一文字ずつ角度を付けて描画
  Len := Length(Text);
  for I := 1 to Len do
  begin
    C := Text[I];
    W := Canvas.TextWidth(C);
    
    // 描画の開始点
    X := XCenter + Round((Radius + H) * Sin(NewAngle)
                 - W / 2 * Cos(NewAngle));
    Y := YCenter - Round((Radius + H) * Cos(NewAngle)
                 + W / 2 * Sin(NewAngle));
    
    // 描画の角度
    NewLf.lfEscapement := -Round(RadToDeg(NewAngle) * 10) mod 3600;
    if NewLf.lfEscapement < 0 then
      Inc(NewLf.lfEscapement, 3600);
    NewLf.lfOrientation := NewLf.lfEscapement;
    
    // フォントのリソース管理はＶＣＬに任せる
    Canvas.Font.Handle := CreateFontIndirect(NewLf);
    
    Canvas.TextOut(X, Y, C);
    
    // 描画角度を進める
    NewAngle := NewAngle +
      ArcTan(
        (W
        + 2 // Round の丸め誤差（？）による文字の重なり防止
            // それとも‘I’などのフォント処理にＯＳのバグがあるのか？
        ) / 2 / Radius) * 2;
  end;
  
  // フォントを元に戻す
  Canvas.Font.Handle := CreateFontIndirect(OldLf);
  
  // 描画した角度を返す（3600/周）
  Result := RadToDeg(NewAngle) * 10 - Angle;
end;


// TForm.OnPaint イベントハンドラの例
procedure TForm1.FormPaint(Sender: TObject);
var
  R, H: Integer;
  Angle: Extended;
begin
  // OnPaint イベントハンドラに限れば塗りつぶす必要なし
  Canvas.Brush.Color := Color;
  Canvas.FillRect(ClientRect);
  
  Canvas.Font.Size := 36;
  R := 100;
  Angle := 0;
  
  H := abs(Canvas.Font.Height);
  Canvas.Brush.Style := bsClear;
  
  Angle := Angle +
    TextOutArc(
      Canvas,
      R + H,
      R + H,
      R,
      Angle,
      'pBI119');
  
  TextOutArc(
    Canvas,
    R + H,
    R + H,
    R,
    Angle,
    ' ：ＦＤＥＬＰＨＩ');
  
  // 描画の外周と内周に円を描く
  Canvas.Ellipse(0, 0, (R + H) * 2, (R + H) * 2);
  Canvas.Ellipse(H, H, H + R * 2, H + R * 2);
end;


　関数名が 〜Arc となっていますが、楕円に沿って描くわけではない
ので厳密には Arc ではないですね。ご愛嬌ということで許してくださ
い。

2000/05/09、河邦 正（GCC02240@nifty.com）
（http://member.nifty.ne.jp/kht0000/、NIFTY外へ私作Componentの
公開用）

Original document by 河邦 正         氏 ID:(GCC02240)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。