VB使用自定义字体

6742 2018-02-05 11:16:49

自己做了一个字库，用两种方法显示，而在RICHTEXTBOX中却无法显示。请教专家!

具体的源程序下载：

https://pan.baidu.com/s/1pMDDtF1

Option Explicit

Private Declare Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFileName As String) As Long



Private Declare Function SendMessageW Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Const EM_REPLACESEL = &HC2

 

Private Declare Function TextOut Lib "gdi32" Alias "TextOutW" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As Long, ByVal nCount As Long) As Long

 

Private Sub Command2_Click()

    Dim str As String

    Me.FontName = "My symbol"

    Me.FontSize = 45

    str = ChrW(&H2021)

    TextOut Me.hdc, 0, 0, StrPtr(str), Len(str)

    Me.Refresh

End Sub



Private Sub Command1_Click()

Dim str As String

RichTextBox1.SelFontName = "My symbol"

str = ChrW(&H2021)

SendMessageW RichTextBox1.hwnd, EM_REPLACESEL, 0, ByVal str '发送按键字符

End Sub



Private Sub Form_Load()

Debug.Print AddFontResource(App.Path & "\My symbol.ttf")

End Sub

...全文

1042 19 打赏收藏转发到动态举报

写回复

用AI写文章

19 条回复

切换为时间正序

请发表友善的回复…

发表回复

6742 2019-11-09

打赏
举报

Private mFont As LogFont Private hFont As long hFont = CreateFontIndirect(mFont) SelectObject me.Hdc, hFont mFont.lfFaceName = "ABC" + Chr$(0) mFont.lfCharSet = SYMBOL_CHARSET DeleteObject hFont

goodafu2 2019-05-04

打赏
举报

我来说说原因，我是通过自己动手才找到原因的： AddFontResource这个API只是把自定义字体加载到内存中，而控件.fontname只能识别系统已经安装的字体名，要使用内存加载的字体，还需要使用其他API：CreateFontIndirect、SelectObject、DeleteObject

goodafu2 2019-05-04

打赏
举报

竟然没有一个人会啊

海鸥软件 2018-03-08

打赏
举报

你自定义字体，选得有这个字体，也就是你能通过fron看到有这个字体，才能引用，或者你在word中如果如果根本就没有加载到这样的字体，肯定你是引用不到的

zdingyun 2018-02-20

打赏
举报

zdingyun 2018-02-20

打赏
举报

打开你安装的Word应用，看看你的所谓My symbol字体是否被加载，并且能在文档中输入和显示。如果能通过，VB就能使用。否则免谈。

6742 2018-02-13

打赏
举报

重新做了一个方案，至于原来的问题还是没有解决。

赵4老师 2018-02-08

打赏
举报

参考以下注册表内容：

[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\RtlQueryRegistryConfig\TrustedTypesKeyList\USR|EUDC|1250]
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\RtlQueryRegistryConfig\TrustedTypesKeyList\USR|EUDC|1251]
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\RtlQueryRegistryConfig\TrustedTypesKeyList\USR|EUDC|1252]
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\RtlQueryRegistryConfig\TrustedTypesKeyList\USR|EUDC|1253]
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\RtlQueryRegistryConfig\TrustedTypesKeyList\USR|EUDC|1254]
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\RtlQueryRegistryConfig\TrustedTypesKeyList\USR|EUDC|1255]
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\RtlQueryRegistryConfig\TrustedTypesKeyList\USR|EUDC|1256]
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\RtlQueryRegistryConfig\TrustedTypesKeyList\USR|EUDC|1257]
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\RtlQueryRegistryConfig\TrustedTypesKeyList\USR|EUDC|1258]
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\RtlQueryRegistryConfig\TrustedTypesKeyList\USR|EUDC|874]
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\RtlQueryRegistryConfig\TrustedTypesKeyList\USR|EUDC|932]
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\RtlQueryRegistryConfig\TrustedTypesKeyList\USR|EUDC|936]
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\RtlQueryRegistryConfig\TrustedTypesKeyList\USR|EUDC|949]
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\RtlQueryRegistryConfig\TrustedTypesKeyList\USR|EUDC|950]
[HKEY_USERS\.DEFAULT\EUDC]
[HKEY_USERS\.DEFAULT\EUDC\932]
"SystemDefaultEUDCFont"="EUDC.TTE"
[HKEY_USERS\.DEFAULT\EUDC\936]
"SystemDefaultEUDCFont"="EUDC.TTE"
[HKEY_USERS\.DEFAULT\EUDC\949]
"SystemDefaultEUDCFont"="EUDC.TTE"
[HKEY_USERS\.DEFAULT\EUDC\950]
"SystemDefaultEUDCFont"="EUDC.TTE"
[HKEY_USERS\S-1-5-19\EUDC]
[HKEY_USERS\S-1-5-19\EUDC\932]
"SystemDefaultEUDCFont"="EUDC.TTE"
[HKEY_USERS\S-1-5-19\EUDC\936]
"SystemDefaultEUDCFont"="EUDC.TTE"
[HKEY_USERS\S-1-5-19\EUDC\949]
"SystemDefaultEUDCFont"="EUDC.TTE"
[HKEY_USERS\S-1-5-19\EUDC\950]
"SystemDefaultEUDCFont"="EUDC.TTE"
[HKEY_USERS\S-1-5-20\EUDC]
[HKEY_USERS\S-1-5-20\EUDC\932]
"SystemDefaultEUDCFont"="EUDC.TTE"
[HKEY_USERS\S-1-5-20\EUDC\936]
"SystemDefaultEUDCFont"="EUDC.TTE"
[HKEY_USERS\S-1-5-20\EUDC\949]
"SystemDefaultEUDCFont"="EUDC.TTE"
[HKEY_USERS\S-1-5-20\EUDC\950]
"SystemDefaultEUDCFont"="EUDC.TTE"
[HKEY_USERS\S-1-5-21-3287820392-1537789725-1580799788-500\EUDC]
[HKEY_USERS\S-1-5-21-3287820392-1537789725-1580799788-500\EUDC\932]
"SystemDefaultEUDCFont"="EUDC.TTE"
[HKEY_USERS\S-1-5-21-3287820392-1537789725-1580799788-500\EUDC\936]
"SystemDefaultEUDCFont"="C:\\WINDOWS\\FONTS\\EUDC.TTE"
[HKEY_USERS\S-1-5-21-3287820392-1537789725-1580799788-500\EUDC\949]
"SystemDefaultEUDCFont"="EUDC.TTE"
[HKEY_USERS\S-1-5-21-3287820392-1537789725-1580799788-500\EUDC\950]
"SystemDefaultEUDCFont"="EUDC.TTE"
[HKEY_USERS\S-1-5-18\EUDC]
[HKEY_USERS\S-1-5-18\EUDC\932]
"SystemDefaultEUDCFont"="EUDC.TTE"
[HKEY_USERS\S-1-5-18\EUDC\936]
"SystemDefaultEUDCFont"="EUDC.TTE"
[HKEY_USERS\S-1-5-18\EUDC\949]
"SystemDefaultEUDCFont"="EUDC.TTE"
[HKEY_USERS\S-1-5-18\EUDC\950]
"SystemDefaultEUDCFont"="EUDC.TTE"

赵4老师 2018-02-08

打赏
举报

仅供参考：

VERSION 5.00
Begin VB.Form Form1
   Caption         =   "EUDCsetup"
   ClientHeight    =   1005
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6165
   LinkTopic       =   "Form1"
   ScaleHeight     =   1005
   ScaleWidth      =   6165
   StartUpPosition =   3  '窗口缺省
   Begin VB.Timer Timer1
      Enabled         =   0 'False
      Interval        =   1000
      Left            =   2520
      Top             =   240
   End
   Begin VB.Label Label1
      Caption         =   "[]"
      BeginProperty Font
         Name            =   "宋体"
         Size            =   24
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1335
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   7335
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim ReturnValue
Dim fontsdir As String
Dim i As Integer

Private Sub Form_Load()
On Error Resume Next
    fontsdir = Environ("windir") + "\Fonts"
    Kill fontsdir + "\eudc.tte"
    Kill fontsdir + "\eudc.euf"
    FileCopy App.Path + "\eudc.tte", fontsdir + "\eudc.tte"
    FileCopy App.Path + "\eudc.euf", fontsdir + "\eudc.euf"
    i = 0
    Timer1.Enabled=True
End Sub

Private Sub Timer1_Timer()
    i = i + 1
    If i = 1 Then
        ReturnValue = Shell("eudcedit.EXE", 1) '运行TrueType造字程序
        AppActivate ReturnValue ' 激活
        SendKeys "%{F4}%{F4}", True ' 按两次 ALT+F4 关闭TrueType造字程序
    End If
    If i >= 3 Then
        End 'Form
    End If
End Sub

赵4老师 2018-02-08

打赏
举报

引用 3 楼 zhao4zhong1 的回复:

EDUC

纠正为EUDC

赵4老师 2018-02-07

打赏
举报

“楷体”明显不是自定义字库。

6742 2018-02-07

打赏
举报

对的，“楷体”还是自定义，可以通过，而自定义的不能通过。不知道何原因？

6742 2018-02-06

打赏
举报

如果，我在自定义字库中有 &H4E01，用 str=ChrW(&H4E01) SendMessageW RichTextBox1.hwnd, EM_REPLACESEL, 0, ByVal str '发送按键字符却读取不出来

6742 2018-02-06

打赏
举报


Private Sub Command1_Click()
Dim str As String
RichTextBox1.SelFontName = "楷体"
str = ChrW(&H4E01)
SendMessageW RichTextBox1.hwnd, EM_REPLACESEL, 0, ByVal str '发送按键字符
End Sub

我是说，不用自定义字体，而用系统字体，就可行。

舉杯邀明月 2018-02-05

打赏
举报

你这个，并不是“自定义字体问题”，而是RichTextBox本身的问题！ RichTextBox控件仍然是 ANSI内核的，它并不支持显示“非ANSI字符”，所以你“插入”的那个字符变成了“问号”。你可以看到：在点了Command1按钮之后，紧跟着那个“问号”后面输入英文字母，都是显示“空白”的、输数字则可显示；　而把“光标”点到后面的“宋体”区（那串英文中间、或后面），然后输字母、数字，都能正常显示。这就说明，“字体更换”是生效了的。

脆皮大雪糕 2018-02-05

打赏
举报

没开VB试验（win10装VB简化版没有richedit）用其他字体你那样sendmessage 是能成功的么？总觉得直接传字符串变量有点问题，你试试用字节数组？

舉杯邀明月 2018-02-05

打赏
举报

没看懂你在4楼说的是啥意思。

6742 2018-02-05

打赏
举报

你这个，并不是“自定义字体问题”，而是RichTextBox本身的问题！ RichTextBox控件仍然是 ANSI内核的，它并不支持显示“非ANSI字符”，所以你“插入”的那个字符变成了“问号”。那么，为何 RichTextBox1.SelFontName = "宋体"，或者其他系统字体就能正常？ (注：前边的(&H2021)宋体中没有，也是问号，换成(&H4E00）汉字一，但是在我的字库中也用4E00就显示不了）。

引用 2 楼 Chen8013 的回复:

你这个，并不是“自定义字体问题”，而是RichTextBox本身的问题！ RichTextBox控件仍然是 ANSI内核的，它并不支持显示“非ANSI字符”，所以你“插入”的那个字符变成了“问号”。你可以看到：在点了Command1按钮之后，紧跟着那个“问号”后面输入英文字母，都是显示“空白”的、输数字则可显示；　而把“光标”点到后面的“宋体”区（那串英文中间、或后面），然后输字母、数字，都能正常显示。这就说明，“字体更换”是生效了的。

赵4老师 2018-02-05