jhone99请进,还有问题请教

Question

字体太小是字太多的原因,少几个字就好了,那个不是大毛病,可以容忍.
现在的问题是,那两条横线在字少而大的时候,不对称且跟横着那几个字重合.解决问题100分.,全部问题解决后奖励几千分.
分不是问题.

Answer 1

Private Const LF_FACESIZE = 32
Private Const DEFAULT_CHARSET = 1Private 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 CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As LongPrivate 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(0 To LF_FACESIZE - 1) As Byte
End Type'Const PI = 3.14159265359Private Type POINTAPI
    X As Long
    Y As Long
End TypePrivate Const PI As Single = 3.14159265359879
Private Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long
Dim Ptg(9) As POINTAPIPrivate Sub Command1_Click()
    Dim BaseX As Integer, BaseY As Integer
    Dim printX As Integer
    Dim printY As Integer
    Dim printAngle As Integer
    Dim printR As Integer
    Dim printR2 As Integer
    Dim printFontHeight As Single
    Dim printFontWidth As Single
    Dim sngRatio As Single
'    Picture1.AutoRedraw = False
    Picture1.AutoRedraw = True
    Picture1.Cls
    Picture1.ScaleMode = 3
    Picture1.DrawWidth = 1    BaseX = Me.Picture1.ScaleWidth / 2
    BaseY = Me.Picture1.ScaleHeight / 6 * 3
    printR = HScroll1.Value
    sngRatio = 0.3
    printFontWidth = printR * PI / 20 / Len(Text1) * sngRatio '* HScroll1.Value / HScroll1.Max
    printFontHeight = printFontWidth * 2 '* HScroll1.Value / HScroll1.Max
    printR2 = printR + printFontHeight * 10
    
    For i = 0 To Len(Text1) - 1
        printX = BaseX + printR2 * Sin(i * 180 / Len(Text1) * PI / 180 + PI / 180 * 270 + PI / 180 * 180 / Len(Text1) * (1 - sngRatio) / 2)
        printY = BaseY - printR2 * Cos(i * 180 / Len(Text1) * PI / 180 + PI / 180 * 270 + PI / 180 * 180 / Len(Text1) * (1 - sngRatio) / 2)
        printAngle = Int(90 - i * 180 / Len(Text1) - 180 / Len(Text1) / 2)
        Call sub_RevolvePrint(printX, printY, printAngle, Mid(Text1, i + 1, 1), printFontHeight, printFontWidth)
    Next i
    
    Dim sngWidth As Single
    sngWidth = printFontWidth * Len(Text2) * 30 * 1.37
    Call sub_RevolvePrint(BaseX - sngWidth / 2, BaseY + 0.6 * HScroll1.Value - printFontHeight * 20, 0, Text2.Text, printFontHeight, printFontWidth)
    
    Call sub_PrintStar(BaseX, BaseY, printR * 0.2)
'    Picture1.Picture = Picture1.Image
'    Picture1.DrawWidth = 2 '/ HScroll1.Max * HScroll1.Value    Picture1.Line (BaseX - sngWidth / 2 * 1.2, BaseY + 0.66 * HScroll1.Value)-(BaseX + sngWidth / 2 * 1.2, BaseY + 0.664 * HScroll1.Value), vbRed, BF
'     Picture1.DrawWidth = 4 '/ HScroll1.Max * HScroll1.Value    Picture1.Line (BaseX - sngWidth / 2 * 1.2, BaseY + 0.7 * HScroll1.Value)-(BaseX + sngWidth / 2 * 1.2, BaseY + 0.72 * HScroll1.Value), vbRed, BF
   
    Picture1.DrawWidth = 6 '/ HScroll1.Max * HScroll1.Value
    Picture1.Circle (BaseX, BaseY), printR2 * 1.3, vbRed, , 0, 1
    Picture1.DrawWidth = 2 '/ HScroll1.Max * HScroll1.Value
    Picture1.Circle (BaseX, BaseY), printR2 * 1.2, vbRed, , 0, 1    Picture1.Refresh
End SubPrivate Sub sub_RevolvePrint(ByVal sigCurrentX As Single, ByVal sigCurrentY As Single _
           , ByVal intAngle As Integer, ByVal strPrint As String _
           , ByVal intFontHeight As Single, ByVal intFontWidth As Single)
           
    Dim TFont As LOGFONT
    Dim hOldFont As Long, hFont As Long
    
    With TFont
        .lfHeight = intFontHeight * 20 '/ Screen.TwipsPerPixelY
        .lfWidth = intFontWidth * 20 '/ Screen.TwipsPerPixelX
        .lfEscapement = intAngle * 10
        .lfWeight = 700
        .lfCharSet = DEFAULT_CHARSET
    End With
    
    hFont = CreateFontIndirect(TFont)
    hOldFont = SelectObject(Me.Picture1.hdc, hFont)
    
    
    With Me.Picture1
'        .AutoRedraw = False
'        .Cls
        .CurrentX = sigCurrentX
        .CurrentY = sigCurrentY
    End With
    
    Picture1.Print strPrint    SelectObject Me.Picture1.hdc, hOldFont
    DeleteObject hFont
    
'    Picture1.RefreshEnd Sub
'要一个按钮一个pictureboxPrivate Sub sub_PrintStar(ByVal sigCurrentX As Single, ByVal sigCurrentY As Single _
                  , ByVal intPrintR As Integer)
    Dim tri(2) As POINTAPI
    Dim a As Single, nA As Single
    Dim rA As Single, rB As Single
    Dim cX As Long, cY As Long
    cX = sigCurrentX
    cY = sigCurrentY
    rA = intPrintR
    rB = rA * (Sin(18 * PI / 180) / Sin(126 * PI / 180))
    a = 36 * PI / 180    tri(0).X = 0: tri(0).Y = -rA
    tri(1).X = -rB * Sin(a): tri(1).Y = -Cos(a) * rB
    tri(2).X = rB * Sin(a): tri(2).Y = -Cos(a) * rB    Dim i As Integer, j As Integer
    Dim t(2) As POINTAPI
    Dim c(4) As Long
'    c(0) = vbRed
'    c(1) = vbBlue
'    c(2) = vbYellow
'    c(3) = vbGreen
'    c(4) = RGB(255, 0, 255)
    c(0) = vbRed
    c(1) = vbRed
    c(2) = vbRed
    c(3) = vbRed
    c(4) = vbRed
    For i = 0 To 4
        nA = 2 * PI / 5 * i
        For j = 0 To 2
          t(j).X = tri(j).X * Cos(nA) + tri(j).Y * Sin(nA) + cX
          t(j).Y = -tri(j).X * Sin(nA) + tri(j).Y * Cos(nA) + cY
        Next j
        Ptg(i + 5) = t(0)
        Ptg(i) = t(1)        drawPoly t, c(i)
    Next i    drawPoly Ptg, vbRed, 5
End SubPrivate Sub drawPoly(p() As POINTAPI, Optional ByVal fillCol As Long, Optional ByVal nC As Long = 3)
    Picture1.FillStyle = 0
    Picture1.FillColor = fillCol
    Polygon Picture1.hdc, p(0), nC
End SubPrivate Sub Form_Load()
Picture1.BackColor = vbWhite
Picture1.ForeColor = vbRed
    Text1.Text = "中国人民共和国水电部节水办公室"
    Text2.Text = "灌水专用章"    HScroll1.Value = 100
    HScroll1.SmallChange = 2
    HScroll1.LargeChange = 20
    HScroll1.Min = 50
    HScroll1.Max = 150
End SubPrivate Sub HScroll1_Change()
    Command1_Click
    Label1.Caption = HScroll1.Value
End SubPrivate Sub HScroll1_Scroll()
    Command1_Click
End Sub