VB 在DC环境下更改字体

Question

本帖最后由 bmx565826960 于 2012-11-17 22:25:58 编辑

Answer 1

我的建议是抛弃你目前的方式，采用GDI+来绘制文字，非常简单高效。
http://download.csdn.net/detail/veron_04/4039695

Answer 2

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.14159265358979Private 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 SubPrivate Sub Command1_Click()
    Unload Me
End SubPrivate Sub Form_Load()
    Me.Caption = "文本字符串旋转"
    Command1.Caption = "退出"
    HScroll1.Max = 360
    HScroll1.Min = 0
End SubPrivate 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

Answer 3

http://download.csdn.net/detail/veron_04/4814790