旋转字体(2)

ScaleWidth = 292
Top = 1155
Width = 4500
Begin CommonDialog CMDialog1
Flags = 257
Left = 0
Top = 0
End
Begin Menu mnuOption
Caption = "选择(&O)"
Begin Menu mnuFont
Caption = "字体(&F)..."
Shortcut = ^F
End
Begin Menu mnuS1
Caption = "-"
End
Begin Menu mnuExit
Caption = "退出(&X)"
Shortcut = ^X
End
End
End
Option Explicit

Sub Form_Paint ()
Dim nAngle%
Cls
For nAngle% = 20 To 80 Step 10
ForeColor = QBColor(nAngle% / 10 - 2)
RotPrint hDC, "热情技术技巧 旋转字体", 10, 290, nAngle%
Next
End Sub

Sub mnuExit_Click ()
End
End Sub

Sub mnuFont_Click ()
' 初始化对话框控制
CMDialog1.FontName = FontName
CMDialog1.FontSize = FontSize
CMDialog1.FontItalic = FontItalic
CMDialog1.FontBold = FontBold
CMDialog1.FontUnderLine = FontUnderLine
CMDialog1.FontStrikeThru = FontStrikeThru
On Error GoTo ErrHandle
CMDialog1.Action = 4
' 设置窗体的字体属性
FontName = CMDialog1.FontName
FontSize = CMDialog1.FontSize
FontItalic = CMDialog1.FontItalic
FontBold = CMDialog1.FontBold
FontUnderLine = CMDialog1.FontUnderLine
FontStrikeThru = CMDialog1.FontStrikeThru
Refresh
ErrHandle:
End Sub

Sub RotPrint (ByVal hDestDC As Integer, Text$, x As Integer, y As
Integer, LineAngle As Integer)
Dim hFont As Integer, hOldFont As Integer, r%
Dim Font As LOGFONT
hOldFont = SelectObject(hDestDC, GetStockObject(SYSTEM_FONT))
GDIGetObject hOldFont, Len(Font), Font
' 填充LOGFONT结构
Font.lfEscapement = LineAngle * 10 ' 输出字体行与水平页底间的角度(以1/10
度为单位)
' 必须是可变点字体
Font.lfPitchAndFamily = Chr$(VARIABLE_PITCH Or FF_DONTCARE)
' 创建字体
hFont = CreateFontIndirect(Font)
' 选择旋转字体
r% = SelectObject(hDestDC, hFont)
' 显示字体
TextOut hDestDC, x, y, Text$, Len(Text$)
' 恢复原字体
hFont = SelectObject(hDestDC, hOldFont)
' 删除创建的字体
DeleteObject hFont
End Sub

上一篇： VB5.0调用Office97技巧
下一篇： 利用OLE自动化解决ACESS97中文版报表生成器直线不能往下顺延的缺陷

标签：

版权申明：本站文章部分自网络，如有侵权，请联系：west999com@outlook.com
特别注意：本站所有转载文章言论不代表本站观点，本站所提供的摄影照片，插画，设计作品，如需使用，请与原作者联系，版权归原作者所有