rielzhou 发表于 2006-12-21 20:34:00

在vba中如何获取所有字体!

<p>怎样才能在窗体的复合框中显示系统和CAD中所有的字体啊??</p><p></p><p dir="ltr" style="MARGIN-RIGHT: 0px;">谢谢各位!!!!</p>

rielzhou 发表于 2006-12-25 13:10:00

<p>怎么没有人回答我呢??</p><p></p><p>真是伤心啊</p><p></p><p>难道就没有一位高手愿意帮忙吗?</p>

mccad 发表于 2006-12-25 13:40:00

需要得到字体所在的目录，读取所有文件名并进行判断。

rielzhou 发表于 2006-12-26 12:48:00

<p>具体怎么操作啊?</p><p>如何读取字体文体啊?</p>

rielzhou 发表于 2006-12-26 12:50:00

<p>能不能给一段示例代码啊?</p>

青青20 发表于 2006-12-26 14:11:00

<p>在autocad vba 二次开发教程第五章有一个类似的例子:(下面是部分)</p><p>Option Explicit</p><p>' 获得SHX字体<br/>Public Function GetShxFont(ByVal bBigFont As Boolean) As Variant<br/>&nbsp;&nbsp;&nbsp; Dim strFontFileName() As String&nbsp;&nbsp;&nbsp;&nbsp; ' 所有字体名称的数组<br/>&nbsp;&nbsp;&nbsp; Dim strFontPath() As String&nbsp;&nbsp;&nbsp;&nbsp; ' AutoCAD的字体文件路径<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; ' 获得所有的支持文件路径<br/>&nbsp;&nbsp;&nbsp; strFontPath = Split(ThisDrawing.Application.Preferences.Files, ";")<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; ' 遍历所有的支持文件路径<br/>&nbsp;&nbsp;&nbsp; Dim i As Integer<br/>&nbsp;&nbsp;&nbsp; Dim bFirst As Boolean&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' 是否是第一次查找该文件夹<br/>&nbsp;&nbsp;&nbsp; Dim strFont As String&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' 字体文件名称<br/>&nbsp;&nbsp;&nbsp; Dim strTemp As String&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' 读取到的字体文件的一行<br/>&nbsp;&nbsp;&nbsp; Dim intCount As Integer&nbsp;&nbsp;&nbsp;&nbsp; ' 字体数组的维数<br/>&nbsp;&nbsp;&nbsp; Dim strFontFile As String&nbsp;&nbsp; ' 字体文件的位置<br/>&nbsp;&nbsp;&nbsp; intCount = -1<br/>&nbsp;&nbsp;&nbsp; For i = 0 To UBound(strFontPath)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; bFirst = True<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' 确保最后一个字符是"\"<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; strFontPath(i) = IIf(Right(strFontPath(i), 1) = "\", strFontPath(i), strFontPath(i) &amp; "\")<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Do<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If bFirst Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; strFont = Dir(strFontPath(i) &amp; "*.shx")<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; bFirst = False<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Else<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; strFont = Dir<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If Len(strFont) &lt;&gt; 0 Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' 打开字体文件<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; strFontFile = strFontPath(i) &amp; strFont<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Open strFontFile For Input As #1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Line Input #1, strTemp<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Close #1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' 判断字体的类型<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If bBigFont Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If Mid(strTemp, 12, 7) = "bigfont" Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; intCount = intCount + 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ReDim Preserve strFontFileName(intCount)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; strFontFileName(intCount) = strFont<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Else<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If Mid(strTemp, 12, 7) = "unifont" Or Mid(strTemp, 12, 6) = "shapes" Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; intCount = intCount + 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ReDim Preserve strFontFileName(intCount)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; strFontFileName(intCount) = strFont<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Else<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Exit Do<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Loop<br/>&nbsp;&nbsp;&nbsp; Next i<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; GetShxFont = strFontFileName<br/>End Function<br/></p>

rielzhou 发表于 2006-12-27 22:49:00

<p>多谢楼上的大侠!!!</p><p>不过有个新的问题</p><p>我获取了字体文件之后只能得到字体文件的名称,而无法得到字体的名称</p><p>请大侠再指点迷津</p><p>感激不尽</p>
页: [1]
查看完整版本: 在vba中如何获取所有字体!