求汉字旋转的控件 or 算法.(100分)

在程序中须生成一幅BMP,有几个汉字成同心圆排列.须把汉字旋转一定
角度后生成图像.有这样的控件 or 算法吗?

drawtext

我这有个FIX的控件,里面有源代码.
寄给你了.

唐:
控件收到,验收后给分.
look:
where can I get drawtext?

唐兄:
看过控件,不知道是不是我没找到.里边有fxlable1,fximage两个控件
这个控件好象只能把图像以不同方式刷新.没有类似把"汉字" 这两个字
旋转10度存成图像这类的功能.或者只旋转汉字,由我在存成图像.若是我
没找到请执教;若不是,我会很伤心的另找控件了.

可以使用API:
function CreateFontIndirect(var LogFont: TLogFont): HFont;

举例:

写字串:ss, 宽:ww, 高:hh, 角度:dd, 坐标xt, yt)

var lfont: TLogFont;

ang := dd * PI / 1800;
with lfont do begin
lfHeight := hh;
lfWidth := ww;
lfEscapement := dd;
lfWeight := pFont.FontWeight;
lfItalic := 0;
lfUnderline := 0;
lfStrikeOut := 0;
lfCharSet := 1;
lfOutPrecision := OUT_TT_PRECIS;
lfClipPrecision:= CLIP_DEFAULT_PRECIS;
lfQuality := PROOF_QUALITY;
lfPitchAndFamily := DEFAULT_PITCH;
StrPCopy(lfFaceName, pFont.FontName);
end;

newFont := CreateFontIndirect(lFont);
oldFont1 := SelectObject(Canvas.Handle, newFont);
TextOut(Canvas.Handle, xt, yt, ss, length(str));
DeleteObject(SelectObject(Canvas.Handle, oldFont1));

API中有LOGFONT结构，其中的LFORIENT？？？？是转一定的角度。
如转90度则LFORIENT=900 。（要*10）；
然后再TEXTOUT到IMGAGE中。

试试如下代码。(来自tqz)
procedure AngleTextOut(CV: TCanvas; const sText: String; x, y, angle:integer);
var
LogFont: TLogFont;
SaveFont: TFont;
begin
SaveFont := TFont.Create;
SaveFont.Assign(CV.Font);
GetObject(SaveFont.Handle, sizeof(TLogFont), @LogFont);
with LogFont do
begin
lfEscapement := angle *10;
lfPitchAndFamily := FIXED_PITCH or FF_DONTCARE;
end; {with}
CV.Font.Handle := CreateFontIndirect(LogFont);
SetBkMode(CV.Handle, TRANSPARENT);
CV.TextOut(x, y, sText);
CV.Font.Assign(SaveFont);
SaveFont.Free;
end;

一个旋转Label的例子！
Unit ALabel;

Interface

Uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

Type
TALabel = class(TLabel)

Private
{ Private declarations }
FAngle : Integer; {Add to the OjectInspector!}
FLayout : TTextLayout; {Remove from ObjectInspector!}
FAlignment : TAlignment; {Remove from ObjectInspector!}
FWordWrap : Boolean; {Remove from ObjectInspector!}

{Strange effects occures when AutoSize = TRUE and
Align = alClient! So I removed the Align property}
FAlign : Integer; {Remove from ObjectInspector!}

{Internal procedures}
Procedure DrawLabelText(Flags : Word); {Label text}
Procedure SetAngle(Value : Integer); {Rotation of label}

Protected
{ Protected declarations }
Procedure Paint; override; {Drawing of the label}

Public
{ Public declarations }
constructor Create(AOwner : TComponent); override;

Published
{ Published declarations }

{Inherited anyway
Property Color;
Property Font;
Property Color;
Property Cursor;
Property DragCursor;
Property DragMode;
Property Enabled;
Property Hint;
Property ParentColor;
Property ParentFont;
Property Font;
Property ShowHint; }

{Skip Layout, WordWrap, Align and Alignment from
the ObjectInspector by making them read-only}
Property Align : Integer read FAlign;
Property WordWrap : Boolean read FWordWrap;
Property Layout : TTextLayout read FLayout;
Property Alignment : TAlignment read FAlignment;

{The new propertie for ALabel!}
Property Angle : Integer read FAngle write SetAngle
default 0;
{Setting the default for Angle doesn't work here...}
End;

Procedure Register; {Hello!}

Implementation

{----------------------------------------------------------------------}
Procedure TALabel.SetAngle(Value : Integer);

Begin
If Value <> FAngle then
Begin
{Set angle between 0 and 3599}
If Value < 0 then
Repeat
Value := Value + 3600;
Until Value >= 0;
If Value >= 3600 then
Repeat
Value := Value - 3600;
Until Value < 3600;
FAngle := Value; {Update the angle in the ObjectInspector}
Invalidate; {Update label}
End;
End;
{----------------------------------------------------------------------}
Procedure TALabel.DrawLabelText(Flags : Word);

Var
Text : Array[0..255] of Char;
LogFont,NewLogFont : TLogFont;
NewFont,OldFont : HFont;
L : Byte;
MRect : TRect;
TextX,TextY : Integer;
Phi : Real;

Begin
{Delphi automatically fills the text: 'ALabel#' in here.
# is a number starting from '1'}
GetTextBuf(Text,SizeOf(Text));

If (Flags and DT_CALCRECT <> 0) and
((Text[0] = #0) or ShowAccelChar and
(Text[0] = '&amp;') and (Text[1] = #0)) then
StrCopy(Text,' ');
{I assume that this statement corrects the length of
the string if an accelerator character is used, but
I don't ask me how it works}

If not ShowAccelChar then
Flags := Flags or DT_NOPREFIX;
{Don't ask me what DT_NOPREFIX means}

L := StrLen(Text);

{Create the rotated font}
Canvas.Font := Font;
GetObject(Font.Handle,SizeOf(TLogFont),@LogFont);
NewLogFont := LogFont;

MRect := ClientRect;
NewLogFont.lfEscapement := FAngle; {Set rotation}
NewFont := CreateFontIndirect(NewLogFont);
OldFont := SelectObject(Canvas.Font.Handle,NewFont);
DeleteObject(OldFont);
Canvas.Font.Handle := NewFont; {The new font is ready!}

Phi := FAngle * Pi / 1800; {DegToRad for Pascal}

{If AutoSize = FALSE then calculate where the text
should begin in the label}
If AutoSize = False then
Begin
TextX := Trunc(0.5 * ClientWidth -
0.5 * Canvas.TextWidth(Text) * cos(Phi) -
0.5 * Canvas.TextHeight(Text) * sin(Phi));
TextY := Trunc(0.5 * ClientHeight -
0.5 * Canvas.TextHeight(Text) * cos(Phi) +
0.5 * Canvas.TextWidth(Text) * sin(Phi));
End;

{If AutoSize = TRUE then calculate the labelsize and
were the text should begin in the label}
If AutoSize = True then
Begin
{Calculate optimum labelsize first}
ClientWidth := 4 + Trunc(Canvas.TextWidth(Text) * Abs(cos(Phi)) +
Canvas.TextHeight(Text)*Abs(sin(Phi)));
ClientHeight := 4 + Trunc(Canvas.TextHeight(Text) * Abs(cos(Phi)) +
Canvas.TextWidth(Text) * Abs(sin(Phi)));

{Calculate X offset of text}
TextX := 2;
If (FAngle > 900) and (FAngle < 2700) then
TextX := TextX + Trunc( Canvas.TextWidth(Text) * Abs(cos(Phi)) );
If (FAngle > 1800) then
TextX := TextX + Trunc(Canvas.TextHeight(Text) * Abs(sin(Phi)) );

{Calculate Y offset of text}
TextY := 2;
If FAngle < 1800 then
TextY := TextY + Trunc(Canvas.TextWidth(Text) * Abs(sin(Phi)) );
If (FAngle > 900) and (FAngle < 2700) then
TextY := TextY + Trunc( Canvas.TextHeight(Text) * Abs(cos(Phi)) );

{Finally ready calculating! Relief...}
End;

{Place the text in the label}
Canvas.TextOut(TextX,TextY,Text);
{
Canvas.TextRect(MRect,TextX,TextY,Text);
does exactly the same
}
End;
{----------------------------------------------------------------------}
Procedure TALabel.Paint;

Const
Alignments : array[TAlignment] of Word = (DT_LEFT,DT_RIGHT,DT_CENTER);
{Don't ask me why}

Var
MRect : TRect;

Begin
With Canvas do
Begin
If not Transparent then
Begin
Brush.Color := Self.Color;
Brush.Style := bsSolid;
FillRect(ClientRect);
{ClientRect = Rect(Client.Left, Client.Top,
Client.Right, Client.Bottom}
End;

Brush.Style := bsClear;
MRect := Rect(0,0,ClientWidth,ClientHeight);

DrawLabelText({MRect,}(DT_EXPANDTABS or DT_WORDBREAK) or
Alignments[Alignment]);
{Don't aks me what DT_XXXXXXX means}
End;
End;
{----------------------------------------------------------------------}
Procedure Register;

Begin
RegisterComponents('Waiss', [TALabel]);
End;
{----------------------------------------------------------------------}
constructor TALabel.Create(AOwner:TComponent);

Begin
Inherited Create(AOwner);
FAngle := 0; {To start with}

Font.Name := 'Arial';
{Doesn't work with MS Sans Serif for some reason...}

inherited Layout := tlTop; {Skip}

inherited Alignment := taLeftJustify;
{Is already done in the code}

inherited WordWrap := False; {Skip}

inherited Align := alNone;
{Is already done in the code}
{A conflict occures when Align = alClient and AutoSize = TRUE!}
End;
{----------------------------------------------------------------------}
End.
{======================================================================}

hi there,
可以按下列做法实现:
1. 根据汉字的个数分别算出每个字在圆或圆弧上的分点, 及其相应角度
2. 把每一个汉字当作一个字符串, 用下面的过程画出来
procedure TMyControl.AngleTextOut(
tp: TPoint; //字的上中点
Txt: string; //汉字
Angle: integer); //角度
var
LogRec: TLOGFONT;
OldFont, NewFont: HFONT;
TextSize: TSize;
TxtHeight: integer;
dx: real;
begin
GetObject(Canvas.Font.Handle, SizeOf(LogRec), @LogRec);
with LogRec do
begin
lfWidth := 0;
lfEscapement := Angle*10;
lfOrientation := Angle*10;
//lfCharSet := GB2312_CharSet;
//lfOutPrecision := OUT_TT_ONLY_PRECIS;
//lfClipPrecision:=Clip_default_precis;
//lfQuality := DRAFT_QUALITY;
lfPitchAndFamily := default_pitch;
end;
NewFont := CreateFontIndirect(LogRec);
OldFont := SelectObject(fCanvas.Handle,NewFont);
TextSize := Canvas.TextExtent(Txt);
//转换圆的分点到字的左上角
dx := TextSize.cx / 2;
tp.X:=Round(tp.x-dx*Cos(Angle*pi/180));
tp.Y:=Round(tp.y+dx*Sin(Angle*pi/180));
//SetTextAlign(Canvas.handle,TA_BaseLine);//若tp为字下中点,否则上中
Canvas.TextOut(tp.X, tp.Y, txt);
NewFont := SelectObject(fCanvas.Handle,OldFont);
DeleteObject(NewFont);
end;
此段代码没经过测试, Cos,Sin的正负号可能有问题, 试一下就知道了

一个蠢办法：读入汉字的点阵信息，重画点阵，Dos下的方法。

jiangtao 的程序 pass
huizhang 的程序 只能旋转 90,180,270 360. ?

1stClass

http://www.truevcl.com