VB 在DC环境下更改字体
--------------------编程问答-------------------- 我的建议是抛弃你目前的方式,采用GDI+来绘制文字,非常简单高效。http://download.csdn.net/detail/veron_04/4039695 --------------------编程问答-------------------- DC环境下创建逻辑字体的实例:
Option Explicit
'Form1上放一个图片框Picture1,一个命令按钮Command1,一个水平滚动条HScroll1
Private Declare Function CreateFont Lib "gdi32.dll" Alias "CreateFontA" (ByVal H As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, ByVal W As Long, ByVal I As Long, ByVal U As Long, ByVal S As Long, ByVal C As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal F As String) As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Const FW_NORMAL As Long = 400
Private Const OEM_CHARSET As Long = 255
Private Const WAngle As Long = 16
Private Const PI As Double = 3.14159265358979
Private Sub DrawRotatedText(ByVal FonthDC As Object, ByVal Txt As String, ByVal X As Single, ByVal Y As Single, ByVal Font_Name As String, ByVal Size As Long, ByVal W As Long, E As Long, ByVal I As Boolean, ByVal U As Boolean, ByVal S As Boolean)
Dim CreatFont As Long, OldFont As Long
'Txt--要显示的字符串
'X --显示字符串位置的X坐标
'Y --显示字符串位置的Y坐标
'Font_Name--显示使用的字体
'Size--字体大小
'W--字体粗细
'E--字体旋转的角度
'I--是否斜体
'U--是否加下划线
'S--是否加删除线
'转换ScaleMode属性的度量单位
Size = (Size * -20) / Screen.TwipsPerPixelY
'建立逻辑字体
CreatFont = CreateFont(Size, 0, E, E, W, I, U, S, OEM_CHARSET, 0, WAngle, 0, 0, Font_Name)
'选入设备环境
OldFont = SelectObject(FonthDC.hdc, CreatFont)
'在指定的位置用指定的颜色和建立的字体显示文本
FonthDC.CurrentX = Picture1.Width / 2
FonthDC.CurrentY = Picture1.Height / 2
FonthDC.ForeColor = RGB(0, 0, 255)
FonthDC.Print Txt
'恢复原设备环境
CreatFont = SelectObject(FonthDC.hdc, OldFont)
'删除所建立的字体对象
DeleteObject CreatFont
End Sub
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Form_Load()
Me.Caption = "文本字符串旋转"
Command1.Caption = "退出"
HScroll1.Max = 360
HScroll1.Min = 0
End Sub
Private Sub HScroll1_Change()
Picture1.Cls
DrawRotatedText Picture1, "Visual basic 6.0", 0, 0, "Times New Roman", 48, FW_NORMAL, PI * HScroll1.Value, True, True, False
End Sub
--------------------编程问答-------------------- http://download.csdn.net/detail/veron_04/4814790
补充:VB , API