怎样输出旋转文字？

zhourongbiao 2004-12-07 02:00:40

比如将"二"旋转90度输出成“||”？

...全文

109 6 打赏收藏转发到动态举报

写回复

用AI写文章

6 条回复

切换为时间正序

请发表友善的回复…

发表回复

韧恒 2004-12-07

打赏
举报

唉，分略多一点总是有人顶，一转眼的工夫就被顶到后排了。 ^_^

韧恒 2004-12-07

打赏
举报

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

完整的例子：
http://www.vb99.com/loaddown.asp?tid=1&pathid=7&Filenames=97