[Anas Mahmoud]

اخي عبد الهادي وجدت الحل 

ضع الفونتات في الريسورس 

   


وسيقوم الريسورس بتحويلها الى مصفوفه بايتات

اضف مجالات الاسماء التالية 

كود :

Imports System.Drawing.Text
Imports System.Runtime.InteropServices

 
الان نخزن الفونتات من الريسورس في ليست Fonts

وكذلك نقوم بعمل ليست لجلب الفونتات FontFamilies

كود :

   Dim Fonts As New List(Of Byte())({My.Resources.YIKES___,
                                    My.Resources.Caramel_Candy,
                                    My.Resources.Anyk,
                                    My.Resources.Because_I_am_Happy_Regular})

   Dim FontFamilies As New List(Of FontFamily)

نعرف الاجراء الذي يضيف الفونتات من ليست Fonts  الى ليست FontFamilies

باستخدام PrivateFontCollection ايضا ولكنه يقوم بتخزين الفونتات الى الذاكره وجلبها باستخدام AddMemoryFont

كود :

   Sub AddFonts()
       For Each f In Fonts
           Dim pfc As New PrivateFontCollection

           Dim fontData = Marshal.AllocCoTaskMem(f.Length)
           Marshal.Copy(f, 0, fontData, f.Length)
           pfc.AddMemoryFont(fontData, f.Length)

           FontFamilies.Add(pfc.Families(0))
       Next
   End Sub

الان ما علينا فعله في حدث اللود نقوم باستدعاء الاجراء ، وكذلك اسناد الفونتات من الليست 

كود :

   Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
       AddFonts()



       Label1.Font = New Font(FontFamilies(0), 26)
       Label2.Font = New Font(FontFamilies(1), 26)
       Label3.Font = New Font(FontFamilies(2), 26)
       Label4.Font = New Font(FontFamilies(3), 26)



   End Sub

   
ملاحظة هامة : لكي تعمل هذه الطريقة يجب ان تعطل application framework :

   


دائما ما احب التعامل مع المرفقات عندما تكون الملفات المطلوبة غير متغيرة لتريح رأسك من المسارات

المصدر : https://stackoverflow.com/a/36509042/14137871