Delphi字符串旋转任意角度

万一的例子

//声明: CreateFontIndirect( const p1: TLogFont {字体结构} ): HFONT; {返回新字体指针} //TLogFont 是 tagLOGFONTA 结构的重定义: tagLOGFONTA = packed record lfHeight: Longint; {字体高度} lfWidth: Longint; {字体平均宽度} lfEscapement: Longint; {角度, 单位是 1/10 度} lfOrientation: Longint; {基线角度} lfWeight: Longint; {粗体, 取值: 0-1000} lfItalic: Byte; {斜体} lfUnderline: Byte; {下划线} lfStrikeOut: Byte; {删除线} lfCharSet: Byte; {字符集} lfOutPrecision: Byte; {输出精度} lfClipPrecision: Byte; {剪裁精度} lfQuality: Byte; {输出质量} lfPitchAndFamily: Byte; {间距及字族} lfFaceName: array[0..LF_FACESIZE - 1] of AnsiChar; {字样名称} end; //例1: procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var FontInfo: TLogFont; {声明字体结构} FH1,FH2: HFONT; {声明字体句柄} const str = '万一的 Delphi 博客'; begin {定义字体特征} FontInfo.lfHeight := 0; {赋值 0, 系统自动给一个值} FontInfo.lfWidth := 0; {赋值 0, 系统自动给一个值} FontInfo.lfEscapement := 0; {无角度} FontInfo.lfWeight := 500; {中等加粗} FontInfo.lfItalic := 0; {非斜体} FontInfo.lfUnderline := 0; {无下划线} FontInfo.lfStrikeOut := 0; {无删除线} FontInfo.lfFaceName := '宋体'; FH1 := CreateFontIndirect(FontInfo); FH2 := SelectObject(Canvas.Handle, FH1); {用 CreateFontIndirect 建立逻辑字体; 用 SelectObject 选人设备; 并返回字体句柄} TextOut(Canvas.Handle, X, Y, str, Length(str)); DeleteObject(FH1); DeleteObject(FH2); end; //一个利用角度的示例: procedure TForm1.FormPaint(Sender: TObject); var FontInfo: TLogFont; FH1,FH2: HFONT; x,y,i: Integer; const str = '万一的 Delphi 博客'; begin FontInfo.lfHeight := 0; FontInfo.lfWidth := 0; FontInfo.lfEscapement := 0; FontInfo.lfWeight := 1000; FontInfo.lfItalic := 0; FontInfo.lfUnderline := 0; FontInfo.lfStrikeOut := 0; FontInfo.lfFaceName := '宋体'; x := ClientWidth div 2; y := ClientHeight div 2; SetBkMode(Canvas.Handle, TRANSPARENT); i := 0; while i<360 do begin FontInfo.lfEscapement := i * 10; FH1 := CreateFontIndirect(FontInfo); FH2 := SelectObject(Canvas.Handle, FH1); TextOut(Canvas.Handle, X, Y, str, Length(str)); Inc(i,10); end; DeleteObject(FH1); DeleteObject(FH2); end;

 

//自己测试的例子

//自己测试的例子 procedure TForm1.RzButton1Click(Sender: TObject); var FontInfo: TLogFont; {声明字体结构} FH1,FH2: HFONT; {声明字体句柄} wstr: string; begin wstr := '0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 '; Canvas.Font.Size := 5; Canvas.brush.color:=$ffffffff; Canvas.font.color:=$1200fff0; {定义字体特征} FontInfo.lfHeight := 0; {赋值 0, 系统自动给一个值} FontInfo.lfWidth := 0; {赋值 0, 系统自动给一个值} FontInfo.lfEscapement := 3150; {无角度} FontInfo.lfWeight := 500; {中等加粗} FontInfo.lfItalic := 0; {非斜体} FontInfo.lfUnderline := 0; {无下划线} FontInfo.lfStrikeOut := 0; {无删除线} FontInfo.lfFaceName := 'Verdana'; FH1 := CreateFontIndirect(FontInfo); while not Application.Terminated do begin FH2 := SelectObject(Canvas.Handle, FH1); {用 CreateFontIndirect 建立逻辑字体; 用 SelectObject 选人设备; 并返回字体句柄} TextOut(Canvas.Handle, 100, 100, pansichar(wstr), Length(wstr)); if wstr = '' then wstr := '1 ' else if wstr[1]=' ' then if wstr[2]='1' then wstr := '0' + wstr else wstr := '1' + wstr else wstr := ' ' + wstr; if length(wstr)>30 then delete(wstr,60,2); sleep(100); Application.ProcessMessages; end; DeleteObject(FH1); DeleteObject(FH2); end;

再来一个：

　procedure TForm1.FormPaint(Sender: TObject); 　　var 　　　FLogFont : tagLogFontA; //逻辑字体--结构体类型 　　　hTempFont, hPrevFont: HFONT; //字体句柄 　　　hTempDC: HDC; //设备描述表或图形设备句柄 　　　TempString: string; //输出的文字 　　begin 　　　FLogFont.lfHeight := 10; //字高 　　　FLogFont.lfWidth := 10; //字宽 　　　FLogFont.lfWeight := 1; //字体笔划粗细程度 　　　FLogFont.lfUnderline := 0; //没有下划线 　　　FLogFont.lfStrikeOut := 0; //没有删除线 　　　FLogFont.lfItalic := 0; //斜体效果否 　　　FLogFont.lfCharSet := GB2312_CHARSET; //字符集 　　　FLogfont.lfEscapement := 450; //倾斜度 　　　FLogFont.lfOrientation := 450; //方向与倾斜度取值同 　　　FLogFont.lfFaceName := '宋体'; //字体名称 　　　//创建逻辑字体 　　　hTempFont := CreateFontIndirect(FLogFont); 　　　TempString := '测试'; 　　　//取得窗口的设备句柄 　　　hTempDC := GetDC(Handle); 　　　//取出窗口设备的当前字体，并替换为新字体 　　　hPrevFont := SelectObject(hTempDC, hTempFont); 　　　//设置设备窗口的文字色彩 　　　SetTextColor(hTempDc, clRed); 　　　//输出文字 　　　TextOut(hTempDc, 200 , 200, PChar(TempString), Length(TempString)); 　　　//恢复原有的字体 　　　SelectObject(hTempDc, hPrevFont); 　　　//删除逻辑字体 　　　DeleteObject(hTempFont); 　　　//释放设备接口 　　　ReleaseDC(Handle, hTempDC); 　　end;