خواندن فونت از کنار برنامه

[amirxbest]

سلام دوستان منمیخواستم تو برنامم از فونت iran nastealigh استفاده کنم.حالا اگه روسیستم کاربر این فونت نباشه مشکل پیش میاد میخواستم ببینم چجور میتونم برنامهفونت رو از کنار خودش بخونه یا اون فونت رو رو سیستم طرف نصب کنه.به هر حال هر کدوم از این روشها کارم رو راه می اندازه.
ممنون

 

[the_king]

سلام دوستان منمیخواستم تو برنامم از فونت iran nastealigh استفاده کنم.حالا اگه روسیستم کاربر این فونت نباشه مشکل پیش میاد میخواستم ببینم چجور میتونم برنامهفونت رو از کنار خودش بخونه یا اون فونت رو رو سیستم طرف نصب کنه.به هر حال هر کدوم از این روشها کارم رو راه می اندازه.
ممنون

فونت مورد نظر رو در پوشه ای که الان کد های پروژه تون هست و بعدا قراره فایل exe برنامه تون قرار بگیره کپی کنید.
با اجرا کردن کد زیر فایل فرضی sample.ttf فراخوانی میشه و در لیست فونت ها قرار می گیره و در برنامه تون
قابل استفاده است :

Option Explicit

Private Const HWND_BROADCAST As Long = &HFFFF&
Private Const WM_FONTCHANGE As Long = &H1D

Private Declare Function PathFileExists Lib "shlwapi.dll" Alias "PathFileExistsA" (ByVal pszPath As String) As Long
Private Declare Function AddFontResource Lib "gdi32.dll" Alias "AddFontResourceA" (ByVal lpFileName As String) As Long
Private Declare Function RemoveFontResource Lib "gdi32.dll" Alias "RemoveFontResourceA" (ByVal lpFileName As String) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long

Private fontPath As String

Private Sub Form_Initialize()
    fontPath = App.Path & IIf(Right(App.Path, 1) = "\", "", "\") & "sample.ttf"
    If PathFileExists(fontPath) = 0 Then
        MsgBox "This font not found :" & vbNewLine & fontPath
    Else
        AddFontResource fontPath
        SendMessage HWND_BROADCAST, WM_FONTCHANGE, 0, ByVal 0&
    End If
End Sub

وقتی هم که اجرای برنامه تون خاتمه پیدا می کنه از لیست فونت ها خارج میشه :

Private Sub Form_Unload(Cancel As Integer)
    If PathFileExists(fontPath) <> 0 Then
        RemoveFontResource fontPath
        SendMessage HWND_BROADCAST, WM_FONTCHANGE, 0, ByVal 0&
    End If
End Sub