27-10-13, 04:00 PM
27-10-13, 10:35 PM
جلب كل الخطوط الموجوده عندك على الجهاز وعرضها في لست بكس :
وبعدها أبحث في اللست وشوف حل لمشكلتك
كود :
Dim allFonts As New Drawing.Text.InstalledFontCollection
Dim fontFamilies() As FontFamily = allFonts.Families()
For Each Fnt In allFonts.Families
ListFonts.Items.Add(Fnt)
Nextوبعدها أبحث في اللست وشوف حل لمشكلتك
28-10-13, 02:48 AM
جزاك الله خيرا
باقى الان طريقة تثبيت الخط على الجهاز
لقيت الكود ده لكنه ملخبط شويه
باقى الان طريقة تثبيت الخط على الجهاز
لقيت الكود ده لكنه ملخبط شويه
كود :
<DllImport("gdi32")> _
Public Shared Function AddFontResource(ByVal lpFileName As String) As Integer
End Function
<DllImport("user32.dll")> _
Public Shared Function SendMessage(ByVal hWnd As Integer, ByVal Msg As UInteger, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
End Function
<DllImport("kernel32.dll", SetLastError:=True)> _
Shared Function WriteProfileString(ByVal lpszSection As String, ByVal lpszKeyName As String, ByVal lpszString As String) As Integer
End Function
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim Ret As Integer
Dim Res As Integer
Dim FontPath As String
Const WM_FONTCHANGE As Integer = &H1D
Const HWND_BROADCAST As Integer = &HFFFF
FontPath = WinFontDir & "\" & FontFileName
Ret = AddFontResource(FontPath)
Res = SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0)
Ret = WriteProfileString("fonts", FontName & " (TrueType)", FontFileName)
End Sub