有没有可以实现文字竖排功能的API？？

Question

要求在Picturebox上实现文字竖排的功能，并且能够实现不同的对齐方式（垂直和水平对齐方式，一共9种组合）。
注：不是文字旋转，而是古文版式那种竖排效果。
举个例子，下边是垂直居中和水平居中的效果： -------------------------
|         一五            | 
|         二六九          |
|         三七十          |
|         四八            |
 -------------------------

Answer 1

狂晕，怎么还在问啊？
不是告诉你算坐标吗？算好坐标，用.print方法输出文字就可以了，
TextWidth方法得到字符串的宽度
TextHeight方法得到字符串的高度文字=>图形？
API函数不可能有这么具体的功能的，要你自己去实现的，老大！

Answer 2

算好坐标，用.print方法输出文字就可以了
-----------------------------------------------------------
算坐标好算啊，但是要怎么算？？一个字符一个字符地算，还是字符串作为整体算？？
还有就是那种尾列与其它列不对齐的情况怎么处理？？
print方法怎么输出文字到指定坐标上？？好像只有print方法后边只是跟一个字符串啊，坐标怎么确定？？

Answer 3

文字=>图形？
---------------------------------------------------------
原来的文字横排的程序就是用API函数DrawText画出来的。

Answer 4

//算坐标好算啊，但是要怎么算？？一个字符一个字符地算，还是字符串作为整体算？？
不知道怎么算还说好算?
一般情况下，每行字符串作为整体算；
特殊情况比如“尾列与其它列不对齐”就要分单个字符处理了//print方法怎么输出文字到指定坐标上？？好像只有print方法后边只是跟一个字符串啊，坐标怎么确定？？'设置字体
Picture1.FontSize = 9
Picture1.FontName = "宋体"'设置当前坐标(以缇为单位)
Picture1.CurrentX = x
Picture1.CurrentY = yPicture1.Print string1

Answer 5

宽度和高度确定，可以得到中心坐标；
根据总行数和总列数，可以得到文本左上角的坐标(中心坐标减去二分之一文本总长度、宽度)
TextWidth方法得到字符串的宽度
TextHeight方法得到字符串的高度
第N行的Y坐标用左上角的坐标加上.TextHeight * (N-1)如果最后一列为奇数，另外处理，算坐标方法同上

Answer 6

模块：
Option Explicit
#If Win32 Then
    Type LOGFONT_TYPE
          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 As String * 32
    End Type
    Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT_TYPE) As Long
#Else
    Type LOGFONT_TYPE
        lfHeight As Integer
        lfWidth As Integer
        lfEscapement As Integer
        lfOrientation As Integer
        lfWeight As Integer
        lfItalic As String * 1
        lfUnderline As String * 1
        lfStrikeOut As String * 1
        lfCharSet As String * 1
        lfOutPrecision As String * 1
        lfClipPrecision As String * 1
        lfQuality As String * 1
        lfPitchAndFamily As String * 1
        lffacename As String * 32
    End Type
    Declare Function CreateFontIndirect Lib "GDI" (lpLogFont As Any) As Integer
#End If
#If Win32 Then
    Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
    Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
#Else
    Declare Function SelectObject Lib "GDI" (ByVal hdc As Integer, ByVal hObject As Integer) As Integer
    Declare Function DeleteObject Lib "GDI" (ByVal hObject As Integer) As Integer
#End IfPublic Sub DegreesToXY(CenterX As Long, CenterY As Long, degree As Double, radiusX As Long, radiusY As Long, X As Long, Y As Long)
Dim convert As Double    convert = 3.141593 / 180
    X = CenterX - (Sin(-degree * convert) * radiusX)
    Y = CenterY - (Sin((90 + (degree)) * convert) * radiusY)End SubPublic Sub RotateText(Degrees As Integer, obj As Object, fontname As String, Fontsize As Single, X As Integer, Y As Integer, Caption As String)
Dim RotateFont As LOGFONT_TYPE
Dim CurFont As Integer, rFont As Integer, foo As IntegerRotateFont.lfEscapement = Degrees * 10
RotateFont.lffacename = fontname & Chr$(0)
If obj.FontBold Then
    RotateFont.lfWeight = 800
Else
    RotateFont.lfWeight = 400
End If
RotateFont.lfHeight = (Fontsize * -20) / Screen.TwipsPerPixelY
rFont = CreateFontIndirect(RotateFont)
CurFont = SelectObject(obj.hdc, rFont)obj.CurrentX = X
obj.CurrentY = Y
obj.Print Caption'Restore
foo = SelectObject(obj.hdc, CurFont)
foo = DeleteObject(rFont)End Sub
Public Sub TextCircle(obj As Object, txt As String, X As Long, Y As Long, radius As Long, startdegree As Double)
Dim foo As Integer, TxtX As Long, TxtY As Long, checkit As Integer
Dim twipsperdegree As Long, wrktxt As String, wrklet As String, degreexy As Double, degree As Double
twipsperdegree = (radius * 3.14159 * 2) / 360
If startdegree < 0 Then
    Select Case startdegree
    Case -1
        startdegree = Int(360 - (((obj.TextWidth(txt)) / twipsperdegree) / 2))
    Case -2
        radius = (obj.TextWidth(txt) / 2) / 3.14159
        twipsperdegree = (radius * 3.14159 * 2) / 360
    End Select
End If
For foo = 1 To Len(txt)
    wrklet = Mid$(txt, foo, 1)
    degreexy = (obj.TextWidth(wrktxt)) / twipsperdegree + startdegree
    DegreesToXY X, Y, degreexy, radius, radius, TxtX, TxtY
    degree = (obj.TextWidth(wrktxt) + 0.5 * obj.TextWidth(wrklet)) / twipsperdegree + startdegree
    RotateText 360 - degree, obj, obj.fontname, obj.Fontsize, (TxtX), (TxtY), wrklet
    wrktxt = wrktxt & wrklet
Next foo
End Subform1：
Option ExplicitPrivate Sub Command1_Click()
Dim foo As Integer
Picture1.Cls
For foo = 0 To 360 Step 45
  Picture1.Refresh
  'Picture1.Cls
  RotateText foo, Picture1, "Arial", 24, 2400, 2400, "     Visual Basic"
  DoEvents
Next fooEnd SubPrivate Sub Command2_Click()
Dim foo As Integer
Picture1.Cls
Picture1.fontname = "arial"
Picture1.Fontsize = 8For foo = 0 To 3
    RotateText 270, Picture1, "Arial", 8, Picture1.ScaleWidth, foo * Picture1.TextWidth("Visual Basic   "), " Visual Basic"
Next foo
End SubPrivate Sub Command3_Click(index As Integer)
Picture1.Cls
Select Case index
Case 0 'center on top: degree = -1
    Picture1.fontname = "arial"
    Picture1.Fontsize = 40
    Picture1.FontBold = True
    TextCircle Picture1, "Visual Basic", Picture1.ScaleWidth / 2, Picture1.ScaleHeight, Picture1.ScaleHeight * 0.8, -1
Case 1 'adjust circle size to fit text length: degree = -2
    Picture1.fontname = "arial"
    Picture1.Fontsize = 12
    Picture1.FontBold = True
    TextCircle Picture1, "VBPJ Visual Basic Programmer's Journal  VBPJ Visual Basic Programmer's Journal ", Picture1.ScaleWidth / 2, Picture1.ScaleHeight / 2, Picture1.ScaleHeight * 0.3, -2
Case 2 'start at point: degree = 0 to 360
    Picture1.fontname = "arial"
    Picture1.Fontsize = 12
    Picture1.FontBold = True
    TextCircle Picture1, "VBPJ Visual Basic Programmer's Journal  VBPJ Visual Basic Programmer's Journal VBPJ Visual Basic Programmer's Journal  VBPJ Visual Basic Programmer's ", Picture1.ScaleWidth / 2, Picture1.ScaleHeight / 2, Picture1.ScaleHeight * 0.5, 90End SelectEnd SubPrivate Sub Form_Load()
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
End Sub

Answer 7

to Zezese(蓝酷云) :这套代码我这里也有，不知道在你机器上能不能正常运行？？
不过我运行的时候，会在RotateText方法中出"Over flow"的错误，就在下边那句代码上出错。rFont = CreateFontIndirect(RotateFont)我觉得是lffacename As String * 32 这里造成的，不知道是不是，该怎么改才能正常运行？？
而且我觉得这段代码应该也是实现的字体旋转，而非字体竖排因为没见效果，不好下结论。。

Answer 8

to  viena(维也纳nn-实心木头人) ：谢谢了。。
原来我对Picturebox的CurrentX和CurrentY属性一直理解错误。。我去把原来的帖子结了，这个帖子先留着。看看还有没有其他比较直接的方法~~~~毕竟原来的程序是把字符串作为一个整体，用DrawText画出来的现在改成直接print，不知道能不能整合到原来的系统中去