أرجو المساعدة في Embedded Resources (Font)

جرب الكود التالي وخبرنا شو بيصير معك

	Public Function GetFont(ByVal FontResource() As String) As _
	  Drawing.Text.PrivateFontCollection
		'Get the namespace of the application
		Dim NameSpc As String = _
		  Reflection.Assembly.GetExecutingAssembly().GetName().Name.ToString()
		Dim FntStrm As IO.Stream
		Dim FntFC As New Drawing.Text.PrivateFontCollection()
		Dim i As Integer
		For i = 0 To FontResource.GetUpperBound(0)
			'Get the resource stream area where the font is located
			FntStrm = _
			  Reflection.Assembly.GetExecutingAssembly().GetManifestResourceStream( _
			  NameSpc + "." + FontResource(i))

			'Load the font off the stream into a byte array
			Dim ByteStrm(CType(FntStrm.Length, Integer)) As Byte
			FntStrm.Read(ByteStrm, 0, Int(CType(FntStrm.Length, Integer)))
			'Allocate some memory on the global heap
			Dim FntPtr As IntPtr = _
			  Runtime.InteropServices.Marshal.AllocHGlobal( _
			  Runtime.InteropServices.Marshal.SizeOf(GetType(Byte)) * _
			  ByteStrm.Length)
			'Copy the byte array holding the font into the allocated memory.
			Runtime.InteropServices.Marshal.Copy(ByteStrm, 0, _
			  FntPtr, ByteStrm.Length)
			'Add the font to the PrivateFontCollection
			FntFC.AddMemoryFont(FntPtr, ByteStrm.Length)
			Dim pcFonts As Int32
			pcFonts = 1
			AddFontMemResourceEx(FntPtr, ByteStrm.Length, 0, pcFonts)
			'Free the memory
			Runtime.InteropServices.Marshal.FreeHGlobal(FntPtr)
		Next
		Return FntFC
	End Function

ملاحظة الكود منقول ولم أجربه لعدم توفر بيئة تطوير بين يدي في وقت كتابة هذا الرد

مشكور اخي samerselo على الرد

فعلا الكود شغال 100 على 100 الف شكر ويسلم هالايدين

ملاحظة : انا حذفت السطر : AddFontMemResourceEx(FntPtr, ByteStrm.Length, 0, pcFonts) لاني اعتقد انو زايد <--(عامل حالي خبير)

وعشان تعم الفائدة وللي يواجهون نفس مشكلتي ... هذه طريقة استدعاء هذي الدالة :

	Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim PrivateFonts As New PrivateFontCollection()
		Dim MyFontArray(5) As String
		MyFontArray(0) = "HandWriting.ttf"
		MyFontArray(1) = my 2 font name
.
.
.

		PrivateFonts = GetFont(MyFontArray)
		Dim myfont As New Font(PrivateFonts.Families(0), 20, FontStyle.Regular, GraphicsUnit.Pixel)


	End Sub

الف شكر مره ثانيه اخي ونشالله انو منستفيد منك كمان لقدام

تحياتي

SomeOne164 كتب:

مشكور اخي samerselo على الرد

فعلا الكود شغال 100 على 100 الف شكر ويسلم هالايدين

ملاحظة : انا حذفت السطر : AddFontMemResourceEx(FntPtr, ByteStrm.Length, 0, pcFonts) لاني اعتقد انو زايد

يسعدني أن الكود اشتغل معك ولكن عندي كم تساؤل:

هل قمت بدراسة الكود بشكل جيد قبل حذف السطر؟؟؟

وهل بقي الإجراء يعمل بشكل جيد بعد أن قمت بحذف ذلك السطر؟؟؟؟

وكيف قررت أنو زايد ؟؟؟

samerselo كتب:

يسعدني أن الكود اشتغل معك ولكن عندي كم تساؤل:

هل قمت بدراسة الكود بشكل جيد قبل حذف السطر؟؟؟

وهل بقي الإجراء يعمل بشكل جيد بعد أن قمت بحذف ذلك السطر؟؟؟؟

وكيف قررت أنو زايد ؟؟؟

مرحبا اخي samerselo

بالنسبة للسطر الذي حذفتة فوظيفتة كالتالي (حسب ما فهمت) :

اضافة الخط (الذي اضفته لمشروعي) الى الخطوط الموجودة في الحاسوب (اي في نطاق المشروع فقط وليس اضافة فعليه)

اي انه على فرض ان اسم الخط HandWriting.ttf

يمكنني ان استعمله على هذا النحو :

Text2.Font = New Font("Jennifer's Hand Writing", 20, FontStyle.Bold)

بينما اذا لم استعملة فهو لن يضاف الى قائمة الخطوط ولكن هذا لا يعني انه غير موجود..اذ انه موجود بشكل مستقل والداله تعيد مؤشر له ويمكن استعماله على هذا النحو:

Dim PrivateFonts As New PrivateFontCollection()
Dim strarray(5) As String
		strarray(0) = "HandWriting.ttf"
		PrivateFonts = GetFont(strarray)
	 MyFontFamily = PrivateFonts.Families(0)
		Text2.Font = New Font(MyFontFamily, 20, FontStyle.Regular, GraphicsUnit.Pixel)

ملاحظة:

في حين الرغبة باستعمال الداله AddFontMemResourceEx

يجب اضافة التالي :

Private Declare Auto Function AddFontMemResourceEx Lib "Gdi32.dll" _
	(ByVal pbFont As IntPtr, ByVal cbFont As Integer, _
	ByVal pdv As Integer, ByRef pcFonts As Integer) As IntPtr

ولا اعلم ما المقصود به !!

مشكور اخي samerselo مره ثانيه على المرور

SomeOne164 كتب:

في حين الرغبة باستعمال الداله AddFontMemResourceEx

يجب اضافة التالي :

Private Declare Auto Function AddFontMemResourceEx Lib "Gdi32.dll" _
	(ByVal pbFont As IntPtr, ByVal cbFont As Integer, _
	ByVal pdv As Integer, ByRef pcFonts As Integer) As IntPtr

ولا اعلم ما المقصود به !!

مشكور اخي samerselo مره ثانيه على المرور

الداله AddFontMemResourceEx هي من أوامر الويندوز Windows API وهي موجودة في المكتبة GDI32 والسطر الذي وضعته هو تعريف هذه الدالة حتى يمكن استخدامها من ضمن برنامجك - عبارة declare -

و عمل الداله AddFontMemResourceEx هو إضافة مصدر ملف خطوط موجود في الذاكرة إلى النظام

وهي تأخذ أربعة بارامترات كما ترى في التعريف

pbFont

مؤشر إلى مصدر الخط

cbFont

عدد البياتات التي يشير إليها pbFont

pdv

متروك للاستخدام المستقبلي يجب أن يكون صفر 0

pcFonts

مؤشر إلى متغير يحمل عدد الخطوط المثبتة

وإن نجحت الدالة تعيد قيمة هي مقبض Handle للخط الذي تم تثبيته وإن لم تنجح تعيد الصفر

مشكور على المعلومات القيمة

وعلى مجهودك معي

تحياتي