请问哪位知道,怎样在VB中获取系统的字体编码,谢谢!

Question

请问哪位知道,怎样在VB中获取系统的字体编码,谢谢!

Answer 1

Function FontCheck(Idx) As Boolean 
'這個Function用來檢查字型載入是否發生錯誤 
On Error GoTo DowithErrorPicture1.FontName = Screen.Fonts(Idx) 
FontCheck = True 
Exit Function
DowithError: 
FontCheck = False 
End Function 
Private Sub Form_Load() 
'Picture1.AutoRedraw要設為 True 喔!! 
Dim NullPic As New StdPicture 
'要用來清除Picture1的圖片內容用 
Idx = 0 
Cdx = 0 
Do Until Idx = Screen.FontCount 
If FontCheck(Idx) = True Then 
Picture1.Picture = NullPic 
Picture1.Picture = Picture1.Image 
'上面兩段是要把Picture1清空 
Picture1.CurrentY = 0 
Picture1.FontSize = 18 
Picture1.FontName = Screen.Fonts(Idx) 
'把Picture1的字型設定成螢幕字型裡的第 Idx 個 
Picture1.Print Screen.Fonts(Idx) 
Picture1.Picture = Picture1.Image 
ImageList1.ListImages.Add Cdx + 1, "P" & CStr(Cdx + 1), Picture1.Picture 
'把圖片與字型名稱加到ImageList裡 
Cdx = Cdx + 1 
End If 
Idx = Idx + 1 
Loop 
Set ImageCombo1.ImageList = ImageList1 
'設定ImageCombo1使用ImageList裡的圖片 
For Idx = 1 To ImageList1.ListImages.Count 
ImageCombo1.ComboItems.Add , , Screen.Fonts(Idx - 1), "P" & CStr(Idx) 
If ImageCombo1.ComboItems(Idx).Text = Me.FontName Then RecIdx = Idx 
'檢查目前的字型是否為表單字型，若是，則記下索引位置 
Next 
ImageCombo1.ComboItems(RecIdx).Selected = True 
'再把預設值設成表單字型 
End Sub

Answer 2

上面也是imagecombol的用法楼主下次不要发三帖，转到控件版面吧

Answer 3

运行时改变字体的操作方法  
虽然有上述选项，这些解决方法仍有限制。下面的示例是应用程序在运行时，使用全局解决方法改变其中的字体。下面的代码可在  Windows  的任何语言版本上运行，它决定驻留在系统中的字体，应用程序将在该系统下运行，将适当的字体应用到参数中指定的  Font  对象。  
 
Private  Const  DEFAULT_CHARSET  =  1  
Private  Const  SYMBOL_CHARSET  =  2  
Private  Const  SHIFTJIS_CHARSET  =  128  
Private  Const  HANGEUL_CHARSET  =  129  
Private  Const  CHINESEBIG5_CHARSET  =  136  
Private  Const  CHINESESIMPLIFIED_CHARSET  =  134  
Private  Declare  Function  GetUserDefaultLCID  Lib  "kernel32"  ()  As  Long  
 
Public  Sub  SetProperFont(obj  As  Object)  
       On  Error  GoTo  ErrorSetProperFont  
       Select  Case  GetUserDefaultLCID  
       Case  &H404  '  繁体中文  
               obj.Charset  =  CHINESEBIG5_CHARSET  
               obj.Name  =  ChrW(&H65B0)  +  ChrW(&H7D30)  +  ChrW(&H660E)  _  
                 +  ChrW(&H9AD4)      'New  Ming-Li  
               obj.Size  =  9  
       Case  &H411  '  日语  
               obj.Charset  =  SHIFTJIS_CHARSET  
               obj.Name  =  ChrW(&HFF2D)  +  ChrW(&HFF33)  +  ChrW(&H20)  +  _  
                 ChrW(&HFF30)  +  ChrW(&H30B4)  +  ChrW(&H30B7)  +  ChrW(&H30C3)  +  _  
                 ChrW(&H30AF)  
               obj.Size  =  9  
       Case  &H412  '朝鲜  UserLCID  
               obj.Charset  =  HANGEUL_CHARSET  
               obj.Name  =  ChrW(&HAD74)  +  ChrW(&HB9BC)  
               obj.Size  =  9  
       Case  &H804  '  简体中文  
               obj.Charset  =  CHINESESIMPLIFIED_CHARSET  
               obj.Name  =  ChrW(&H5B8B)  +  ChrW(&H4F53)  
               obj.Size  =  9  
       Case  Else      '  其他国家/地区  
               obj.Charset  =  DEFAULT_CHARSET  
               obj.Name  =  ""      '  获得缺省  UI  字体。  
               obj.Size  =  8  
       End  Select  
       Exit  Sub  
ErrorSetProperFont:  
       Err.Number  =  Err  
也可更改这个简单的示例代码将字体应用到其它字体设置上，如打印选项。  具体见：http://community.csdn.net/Expert/FAQ/FAQ_Index.asp?id=195508