I want to set asian font on winxp and win9x. But I dont'w now how to do. Please tell me about it. Thanks in advance
I call from VB, set Menu font

I believe you jment how to install font. Here is the code, I ve got it from somewhere but dont know where.

Option Explicit Private Declare Function GetWindowsDirectory Lib "kernel32" Alias _     "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long Private Declare Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" _     (ByVal lpFileName As String) As Long Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _     (ByRef lpVersionInformation As OSVERSIONINFO) As Long Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _     (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _     ByVal samDesired As Long, phkResult As Long) As Long Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal _     hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, _     lpData As Any, ByVal cbData As Long) As Long Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _     (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _     lParam As Any) As Long Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, _     ByVal dwReserved As Long) As Long      Private Declare Function GetCurrentProcess Lib "kernel32" () As Long Private Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, _     ByVal DesiredAccess As Long, TokenHandle As Long) As Long Private Declare Function LookupPrivilegeValue Lib "advapi32" Alias _     "LookupPrivilegeValueA" (ByVal lpSystemName As String, _     ByVal lpName As String, lpLuid As LUID) As Long Private Declare Function AdjustTokenPrivileges Lib "advapi32" _     (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, _     NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, _     PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long      ' dwPlatformId defines: Private Const HWND_BROADCAST = &HFFFF& Private Const WM_FONTCHANGE = &H1D Private Const MAX_PATH = 255 Private Const HKEY_LOCAL_MACHINE = &H80000002 Private Const KEY_SET_VALUE = &H2 Private Const REG_SZ = 1 ' Unicode null terminated string Private Const EWX_REBOOT = 2 Private Const EWX_FORCE = 4 Private Const TOKEN_ADJUST_PRIVILEGES = &H20 Private Const TOKEN_QUERY = &H8 Private Const SE_PRIVILEGE_ENABLED = &H2 Private Const ANYSIZE_ARRAY = 1 Private Const VER_PLATFORM_WIN32_WINDOWS = 1 Private Const VER_PLATFORM_WIN32_NT = 2 Type LUID     LowPart As Long     HighPart As Long End Type Type LUID_AND_ATTRIBUTES     pLuid As LUID     Attributes As Long End Type Type TOKEN_PRIVILEGES     PrivilegeCount As Long     Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES End Type Private Type OSVERSIONINFO     dwOSVersionInfoSize As Long     dwMajorVersion As Long     dwMinorVersion As Long     dwBuildNumber As Long     dwPlatformId As Long     szCSDVersion As String * 128 ' Maintenance string for PSS usage End Type 'Install font Public Sub AddFont(FileName As String) Dim lResult As Long Dim strFontPath As String Dim strFontname As String Dim hKey As Long Dim FileInfo As WIN32_FIND_DATA Dim strSubKey As String Dim OSInfo As OSVERSIONINFO Dim strNormal As String Dim strBold As String Dim strItalic As String Dim strName As String     'This is the font name and path     strFontPath = Space$(MAX_PATH)     strFontname = FileName     lResult = GetWindowsDirectory(strFontPath, MAX_PATH)     If lResult <> 0 Then Mid$(strFontPath, lResult + 1) = "\Fonts\"     strFontPath = RTrim$(strFontPath)     'This Actually adds the font to the system's available fonts for this windows session     lResult = AddFontResource(strFontPath + strFontname)      If lResult = 0 Then MsgBox "Greska pri instaliranju fontova!!!": End     'Write the registry value to permanently install the font     OSInfo.dwOSVersionInfoSize = Len(OSInfo)     lResult = GetVersionEx(OSInfo)     If lResult = 0 Then MsgBox "Font nije instaliran!!!": End     If OSInfo.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then ' FAT32         strSubKey = "software\microsoft\windows\currentversion\fonts"     ElseIf OSInfo.dwPlatformId = VER_PLATFORM_WIN32_NT Then ' NT system         strSubKey = "software\microsoft\windows nt\currentversion\fonts"     End If          If strFontname = "yhelv.ttf" Then         strName = "Yu Helvetica (TrueType)"     ElseIf strFontname = "yhelvb.ttf" Then         strName = "Yu Helvetica Bold (TrueType)"     ElseIf strFontname = "yhelvi.ttf" Then         strName = "Yu Helvetica Italic (TrueType)"     End If     lResult = RegOpenKeyEx(HKEY_LOCAL_MACHINE, strSubKey, 0, KEY_SET_VALUE, hKey)     lResult = RegSetValueEx(hKey, strName, 0, REG_SZ, _             ByVal strFontname, Len(strFontname))     lResult = RegCloseKey(hKey)     'This call broadcasts a message to let all Top - Level windows know that     'a font change has occured so they can reload their font list     lResult = SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0)     If OSInfo.dwPlatformId = 2 And FileName = "yhelvi.ttf" Then         MsgBox "Restarting windows!"         Call RebootNT         End     End If End Sub 'set the shut down privilege for the current application Private Sub EnableShutDown() Dim hProc As Long Dim hToken As Long Dim mLUID As LUID Dim mPriv As TOKEN_PRIVILEGES Dim mNewPriv As TOKEN_PRIVILEGES     hProc = GetCurrentProcess()     OpenProcessToken hProc, TOKEN_ADJUST_PRIVILEGES + TOKEN_QUERY, hToken     LookupPrivilegeValue "", "SeShutdownPrivilege", mLUID     mPriv.PrivilegeCount = 1     mPriv.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED     mPriv.Privileges(0).pLuid = mLUID     ' enable shutdown privilege for the current application     AdjustTokenPrivileges hToken, False, mPriv, 4 + (12 * mPriv.PrivilegeCount), mNewPriv, 4 + (12 * mNewPriv.PrivilegeCount) End Sub Public Sub RebootNT()     EnableShutDown     ExitWindowsEx EWX_REBOOT + EWX_FORCE, 0 End Sub

You call AddFont sub and pass fonts name.


____________________________
If you find the answer helpful, please mark this topic as solved.

Thanks for your help, but this code cannot run . I'm  sorry

My application can language customize, one is English and other one is Vietnamese, but the app's Menu only can show English language. So , when I choose a vietnamese language , i must set font for Menu in direct Display property on Desktop by hand, so, i want to find a way which can set Menu font automactically in runtime to VNI-Times font and needn't restart my OS . It must effetc immediately when my app is working.
Please read my post carefull.
Thx

I forget
I use Window 2000 adv OS

If you want changes to affect only your app, you would then have to subclass your form, and draw your own menu, which is not an easy task, but the best solution for you.
But, if u r satisfied with changing the system font styles, this will help.

http://www.thevbzone.com/modSysFonts.bas



____________________________
If you find the answer helpful, please mark this topic as solved.

Thx for yr help, I finished my project with the best result

This code worked OK after I took out the unwanted DIM of FileInfo, which referred to an undefined type

(and some of the other bits like the send message to other apps)