07年最后一个问题关于字体旋转

Question

比如"中国人民123A万岁"  每个字都要逆时针转90度   textout函数只能对整体进行旋转,达不到我的要求,如果用@字体的话,对数字和字母又没有作用!请问有什么办法实现吗?

Answer 1

Option Explicit
Private Const LF_FACESIZE = 32
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 String
                lfOutPrecision   As Byte
                lfClipPrecision   As Byte
                lfQuality   As Byte
                lfPitchAndFamily   As Byte
                lfFaceName   As Byte
End Type
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) 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 SelectObject Lib "gdi32" (ByVal hDc As Long, ByVal hObject As Long) As LongPrivate Sub Command1_Click()
   Dim lF     As LOGFONT
        With lF
                .lfEscapement = Val(Text1.Text)        '字体角度
                .lfWidth = 5       '字体宽度
                .lfHeight = 19       '字体高度
                .lfCharSet = "宋体"      '打印汉字
                .lfEscapement = 2700 
                .lfOrientation = .lfEscapement
        End With
        Dim Ft     As Long
        Dim tS     As String
        tS = "1111111111111 "
        Ft = CreateFontIndirect(lF)
        SelectObject Picture1.hDc, Ft
        Dim i As Integer
        For i = 1 To Len(tS)
            'Picture1.ForeColor = RGB(Rnd * 255, Rnd * 255, Rnd * 255)
            TextOut Picture1.hDc, 22, 20 + i * lF.lfWidth, tS, 1
        Next i
        DeleteObject Ft
        'Set Picture1.Picture = Picture1.Image
End Sub
一个command,一个picturebox

Answer 2

Option Explicit
Private Const LF_FACESIZE = 32
Private Const DEFAULT_CHARSET = 1Private 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 String
                lfOutPrecision   As Byte
                lfClipPrecision   As Byte
                lfQuality   As Byte
                lfPitchAndFamily   As Byte
                lfFaceName   As Byte
End Type
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) 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 SelectObject Lib "gdi32" (ByVal hDc As Long, ByVal hObject As Long) As Long
Private Sub Command1_Click()
Me.PrintForm
End SubPrivate Sub Command2_Click()
   Dim lF     As LOGFONT
        With lF
                .lfEscapement = Val(Text1.Text)        '字体角度
                .lfWidth = 15     '字体宽度
                .lfHeight = 30    '字体高度
                .lfCharSet = DEFAULT_CHARSET     
                .lfEscapement = 2700
                .lfOrientation = .lfEscapement
        End With
        Dim Ft     As Long
        Dim tS     As String * 255
        Picture1.Cls
'        Picture1.AutoRedraw = True
        tS = "中国人民123A万岁"
        Ft = CreateFontIndirect(lF)
        SelectObject Picture1.hDc, Ft
        Dim i As Integer, l As Long
        Dim s As String
        For i = 1 To Len(tS)
            Picture1.ForeColor = RGB(Rnd * 255, Rnd * 255, Rnd * 255)
            s = Mid(tS, i, 1)
            If Abs(AscW(s)) > 127 Then
                TextOut Picture1.hDc, 50, 40 + l * lF.lfWidth, s, 2
                l = l + 2
            Else
                TextOut Picture1.hDc, 50, 40 + l * lF.lfWidth, s, 1
                l = l + 1
            End If
        Next i
        DeleteObject Ft
'        Set Picture1.Picture = Picture1.Image
End Sub
窗口上放一个command,一个picturebox上面的哪个有点问题！

Answer 3

If Abs(AscW(s)) > 127 Then 
改为If Abs(AscW(s)) > 255 Then

Answer 4

如果楼主认为不符合要求，可以调整textout坐标，如：TextOut Picture1.hDc, 50+ l * lF.lfWidth, 40 , s, 2

Answer 5

textout函数只能对整体进行旋转,达不到我的要求
//
一个一个旋转不就OK了~~~~~