....要用到API....
[CODE]Private Const LF_FACESIZE = 32 ' 最长的字体名称
Private Const SYSTEM_FONT = 13
Private Const VARIABLE_PITCH = 2 ' 字体族
Private Const FF_DONTCARE = 0 '
Private Const FF_ROMAN = 16 ' 字体宽度可变,Times Roman, Century ' Schoolbook等
Private Const FF_SWISS = 32 ' 宽度可变,带衬线,如Helvetica, Swiss等
Private Const FF_MODERN = 48 ' 具有规定的宽度,衬线可有可无,
' 如Pica, Elite, Courier等等.
Private Const FF_SCRIPT = 64 ' 手写体,如Cursive
Private Const FF_DECORATIVE = 80 ' 特殊字体,如Old English
'/*********************/
'/* 2. 类型声明部分 */
'/*********************/
Private Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName(LF_FACESIZE) As Byte
End Type
'/*********************/
'/* 4. 函数声明部分 */
'/*********************/
Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Private Declare Function GDIGetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
'******************************************
' hDestDC: 显示文字的控件句柄
' Text: 要显示的文字
' x, y: 显示文字的位置
' LineAngle: 角度
'******************************************
Private Sub RotPrint(ByVal hDestDC As Long, Text As String, x As Long, y As Long, LineAngle As Long)
Dim hFont As Long, hOldFont As Long, r As Long
Dim Font As LOGFONT
hOldFont = SelectObject(hDestDC, GetStockObject(SYSTEM_FONT))
GDIGetObject hOldFont, Len(Font), Font
' 填充LOGFONT结构
Font.lfEscapement = LineAngle
Font.lfPitchAndFamily = VARIABLE_PITCH Or FF_DONTCARE
' 创建字体
hFont = CreateFontIndirect(Font)
' 选择旋转字体
r = SelectObject(hDestDC, hFont)
' 显示字体
TextOut hDestDC, x, y, Text, lstrlen(Text)
' 恢复原字体
hFont = SelectObject(hDestDC, hOldFont)
' 删除创建的字体
DeleteObject hFont
End Sub
' 绘制
Private Sub Form_Paint()
Dim nAngle As Long
Cls
For nAngle = 20 To 90 Step 10
ForeColor = QBColor(nAngle / 10 - 2)
RotPrint hdc, VBCSTEXT, 10, 290, nAngle * 10
Next
End Sub [/CODE]