お知らせ

電子会議

ライブラリ

パレット

Delphi FAQ検索

Delphi FAQ一覧

サンプル蔵





FDelphi FAQ
16番会議室「玉石混淆みんなで作るSample蔵」に寄せられたサンプル

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

この発言に対し以下のコメントが寄せられています
#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; // フォントのリソース管理はVCLに任せる Canvas.Font.Handle := CreateFontIndirect(NewLf); Canvas.TextOut(X, Y, C); // 描画角度を進める NewAngle := NewAngle + ArcTan( (W + 2 // Round の丸め誤差(?)による文字の重なり防止 // それとも‘I’などのフォント処理にOSのバグがあるのか? ) / 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, ' :FDELPHI'); // 描画の外周と内周に円を描く 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蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。

Copyright 1996-2002 Delphi Users' Forum