كم فكرت وحاولت أن أعاين الخطوط بطرق غير مملة، كالطرق المتوفرة في مستعرض الخطوط في الويندوز، بجملته المملة التي لا تتغير، والتي تخبرني عن الكلب الذي قفز.
ماذا عن معاينة الخطوط باللغة العربية وبجملة أطول من هذه الجملة، مع إمكانية تغيير حجم خط المعاينة؟
لجأت إلى برنامج مايكروسوفت وورد كثيراً لحل هذه المشكلة بالطرق التقليدية، ولكن في كل مرة كان عليً أن أركب الخط في مجلد الخطوط ثم أبحث عنه في قائمة الخطوط، إلى آخر هذه الخطوات التي أصابتني بالملل.
وأخيراً وجدت الحل، وذلك عن طريق دوال ال API التي دائماً ما تحل لي كل مشاكلي، والتي يحتاج الواحد منا دائماً أن يضع يده على بداية طريق الحل، ثم يطلق لرجليه العنان بعد ذلك في التفنن والتزيين.
ولكي لا أطيل عليكم (وإن كنت قد أطلت فعلاً، ولو أنه كان بإمكانكم تخطي هذه المقدمة، وعلى كل، الله يعوض عليكم)، دعوني أبدأ الموضوع.
الموضوع ببساطة أن الدالة المشكورة CreateScalableFontResource يمكنها إنشاء ملف مرجع Resource مؤقت للخط المطلوب، قابل للقياس (أي معرفة مكان إي بيان مخزن بداخله عن طريق معرفة عدد بايتات كل بيان)، وهذا لا يكلفك سوى وسيطتين فقط للدالة هما: اسم الملف المؤقت، واسم ملف الخط، بعدها يمكنك فتح هذا الملف (برمجياً بالطبع، وليس عن طريق المفكرة Notepad)، ومعرفة اسم الخط Face Name، الذي طالما استعصى عليًّ، وذلك عن طريق معرفة رقم البايت الذي يبدأ منه هذا الاسم، واستخراجه من مخبئه.
وهذه هي الدالة، سارع بإضافتها إلى قسم التصريحات العامة General للنموذج:
Private Declare Function CreateScalableFontResource Lib "gdi32" Alias "CreateScalableFontResourceA" (ByVal fHidden As Long, ByVal lpszResourceFile As String, ByVal lpszFontFile As String, ByVal lpszCurrentPath As String) As Long
والآن جاء دور الدالة التي سوف نستخدمها لإنشاء ملف المرجع للخط، واستخراج اسم الخط، تمهيداً لا ستخدامه فيما بعد في خاصية FontName لأي أداة نريدها (يجب أن تدعم الأداة هذه الخاصية بالطبع)
وهذه هي الدالة:
Public Function bGetFontName(ByVal strFileName As String, ByRef strFontName As String) As Boolean Dim hFile As Integer Dim Buffer As String Dim strTempName As String Dim iPos As Integer strTempName = App.Path & "\~TEMP.FOT" If CreateScalableFontResource(1, strTempName, strFileName, vbNullString) Then hFile = FreeFile Open strTempName For Binary Access Read As hFile Buffer = Space(LOF(hFile)) Get hFile, , Buffer iPos = InStr(Buffer, "FONTRES:") + 8 strFontName = Mid(Buffer, iPos, InStr(iPos, Buffer, vbNullChar) - iPos) Close hFile Kill strTempName bGetFontName = True End If End Function
والآن لم يعد هناك شيء يحتاج للشرح، فدعونا نعاين المثال الموجود بالمرفقات، والذي لا يتعدى وزنه 10 كيلوبايت، وهذه هي صورته:
وهذا هو المشروع:
وأتمنى أن يعجبكم موضوعي
مع خالص تحياتي
من موضوعاتي في المنتدى:
تخزين الملفات في قاعدة البيانات
الحصول على خصائص الحقول في قاعدة بيانات أكسس
