الفريق العربي للبرمجةأرشيف المنتديات · 2000 – 2023
نسخة أرشيفية للقراءة فقط — التسجيل والمشاركة مغلقان، والمحتوى محفوظ كما كان.

كيف يتم اضافة خطوط

بدأه M-Man في 5 يوليو 2011 · 8 رد · 1,149 مشاهدة · في قواعد بيانات Visual FoxPro
مشاركة: واتساب X فيسبوك تيليجرام
#1 صاحب الموضوع

السلام عليكم

هل استطيع اضافة Font الى البروجكت في الفيجول فوكس برو

يعني اني عملت برنامج واخترت laibel وغيرت نوع الخط عند نقل البرنامج الى غير حاسبة لاتحتوي على نفس الخطوط تضهر بشكل "شخابيط"

فهل استطيع ان اضيف الخطوط الى البرنامج

وجعله الله في ميزان حسناتكم

#2

وعليكم السلام

كنت شايله لعوزة، بس ما استخدمته - يعني غير مجرب

*-- Code begins here
   CLEAR DLLS

   PRIVATE iRetVal, iLastError
   PRIVATE sFontDir, sSourceDir, sFontFileName, sFOTFile
   PRIVATE sWinDir, iBufLen
   iRetVal = 0

   ***** Code to customize with actual file names and locations.
   *-- .TTF file path.
   sSourceDir = "C:\TEMP\"

   *-- .TTF file name.
   sFontFileName = "TestFont.TTF"

   *-- Font description (as it will appear in Control Panel).
   sFontName = "My Test Font" + " (TrueType)"
   ******************** End of code to customize *****

   DECLARE INTEGER CreateScalableFontResource IN win32api ;
     LONG fdwHidden, ;
     STRING lpszFontRes, ;
     STRING lpszFontFile, ;
     STRING lpszCurrentPath

   DECLARE INTEGER AddFontResource IN win32api ;
       STRING lpszFilename

   DECLARE INTEGER RemoveFontResource IN win32api ;
       STRING lpszFilename

   DECLARE LONG GetLastError IN win32api

   DECLARE INTEGER GetWindowsDirectory IN win32api STRING @lpszSysDir,;
     INTEGER iBufLen

   #DEFINE WM_FONTCHANGE   29 && 0x001D
   #DEFINE HWND_BROADCAST  65535 && 0xffff

   DECLARE LONG SendMessage IN win32api ;
       LONG hWnd, INTEGER Msg, LONG wParam, INTEGER lParam

   #DEFINE HKEY_LOCAL_MACHINE 2147483650   && (HKEY) 0x80000002
   #DEFINE SECURITY_ACCESS_MASK 983103     && SAM value KEY_ALL_ACCESS

   DECLARE RegCreateKeyEx IN ADVAPI32.DLL ;
      INTEGER, STRING, INTEGER, STRING, INTEGER, INTEGER, ;
           INTEGER, INTEGER @, INTEGER @

   DECLARE RegSetValueEx IN ADVAPI32.DLL;
           INTEGER, STRING, INTEGER, INTEGER, STRING, INTEGER

   DECLARE RegCloseKey IN ADVAPI32.DLL INTEGER

   *-- Fonts folder path.
   *-- Use the GetWindowsDirectory API function to determine
   *-- where the Fonts directory is located.
   sWinDir = SPACE(50)  && Allocate the buffer to hold the directory name.
   iBufLen = 50         && Pass the size of the buffer.
   iRetVal = GetWindowsDirectory(@sWinDir, iBufLen)

   *-- iRetVal holds the length of the returned string.
   *-- Since the string is null-terminated, we need to
   *-- snip the null off.
   sWinDir = SUBSTR(sWinDir, 1, iRetVal)
   sFontDir = sWinDir + "\FONTS\"

   *-- Get .FOT file name.
   sFOTFile  = sFontDir + LEFT(sFontFileName, ;
     LEN(sFontFileName) - 4) + ".FOT"

   *-- Copy to Fonts folder.
   COPY FILE (sSourceDir + sFontFileName) TO ;
     (sFontDir + sFontFileName)

   *-- Create the font.
   iRetVal = ;
     CreateScalableFontResource(0, sFOTFile, sFontFileName, sFontDir)
   IF iRetVal = 0 THEN
       iLastError = GetLastError ()
       IF iLastError = 80
          MESSAGEBOX("Font file " + sFontDir + sFontFileName + ;
          "already exists.")
       ELSE
           MESSAGEBOX("Error " + STR (iLastError))
       ENDIF
      RETURN
   ENDIF

   *-- Add the font to the system font table.
   iRetVal = AddFontResource (sFOTFile)
   IF iRetVal = 0 THEN
       iLastError = GetLastError ()
       IF iLastError = 87 THEN
           MESSAGEBOX("Incorrect Parameter")
       ELSE
           MESSAGEBOX("Error " + STR (iLastError))
       ENDIF
      RETURN
   ENDIF

   *-- Make the font persistent across reboots.
   STORE 0 TO iResult, iDisplay
   iRetVal = RegCreateKeyEx(HKEY_LOCAL_MACHINE, ;
     "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts", 0, "REG_SZ", ;
     0, SECURITY_ACCESS_MASK, 0, @iResult, ;
     @iDisplay) && Returns .T. if successful

   *-- Uncomment the following lines to display information
   *!*   *-- about the results of the function call.
   *!*      WAIT WINDOW STR(iResult)   && Returns the key handle
   *!*      WAIT WINDOW STR(iDisplay)  && Returns one of 2 values:
   *!*                                 && REG_CREATE_NEW_KEY = 1
   *!*                                 && REG_OPENED_EXISTING_KEY = 2

   iRetVal = RegSetValueEx(iResult, sFontName, 0, 1, sFontFileName, 13)

   *-- Close the key.  Don't keep it open longer than necessary.
   iRetVal = RegCloseKey(iResult)

   *-- Notify all the other application a new font has been added.
   iRetVal = SendMessage (HWND_BROADCAST, WM_FONTCHANGE, 0, 0)
   IF iRetVal = 0 THEN
       iLastError = GetLastError ()
           MESSAGEBOX("Error " + STR (iLastError))
      RETURN
   ENDIF

   ERASE (sFOTFile)
   *-- Code ends here

المصدر MSDN

مع التحية

أستغفر الله العظيم و أتوب إليه

#3
Shadowz كتب:

وعليكم السلام

كنت شايله لعوزة، بس ما استخدمته - يعني غير مجرب

*-- Code begins here
   CLEAR DLLS

   PRIVATE iRetVal, iLastError
   PRIVATE sFontDir, sSourceDir, sFontFileName, sFOTFile
   PRIVATE sWinDir, iBufLen
   iRetVal = 0

   ***** Code to customize with actual file names and locations.
   *-- .TTF file path.
   sSourceDir = "C:\TEMP\"

   *-- .TTF file name.
   sFontFileName = "TestFont.TTF"

   *-- Font description (as it will appear in Control Panel).
   sFontName = "My Test Font" + " (TrueType)"
   ******************** End of code to customize *****

   DECLARE INTEGER CreateScalableFontResource IN win32api ;
 	LONG fdwHidden, ;
 	STRING lpszFontRes, ;
 	STRING lpszFontFile, ;
 	STRING lpszCurrentPath

   DECLARE INTEGER AddFontResource IN win32api ;
   	STRING lpszFilename

   DECLARE INTEGER RemoveFontResource IN win32api ;
   	STRING lpszFilename

   DECLARE LONG GetLastError IN win32api

   DECLARE INTEGER GetWindowsDirectory IN win32api STRING @lpszSysDir,;
 	INTEGER iBufLen

   #DEFINE WM_FONTCHANGE   29 && 0x001D
   #DEFINE HWND_BROADCAST  65535 && 0xffff

   DECLARE LONG SendMessage IN win32api ;
   	LONG hWnd, INTEGER Msg, LONG wParam, INTEGER lParam

   #DEFINE HKEY_LOCAL_MACHINE 2147483650   && (HKEY) 0x80000002
   #DEFINE SECURITY_ACCESS_MASK 983103 	&& SAM value KEY_ALL_ACCESS

   DECLARE RegCreateKeyEx IN ADVAPI32.DLL ;
      INTEGER, STRING, INTEGER, STRING, INTEGER, INTEGER, ;
       	INTEGER, INTEGER @, INTEGER @

   DECLARE RegSetValueEx IN ADVAPI32.DLL;
       	INTEGER, STRING, INTEGER, INTEGER, STRING, INTEGER

   DECLARE RegCloseKey IN ADVAPI32.DLL INTEGER

   *-- Fonts folder path.
   *-- Use the GetWindowsDirectory API function to determine
   *-- where the Fonts directory is located.
   sWinDir = SPACE(50)  && Allocate the buffer to hold the directory name.
   iBufLen = 50     	&& Pass the size of the buffer.
   iRetVal = GetWindowsDirectory(@sWinDir, iBufLen)

   *-- iRetVal holds the length of the returned string.
   *-- Since the string is null-terminated, we need to
   *-- snip the null off.
   sWinDir = SUBSTR(sWinDir, 1, iRetVal)
   sFontDir = sWinDir + "\FONTS\"

   *-- Get .FOT file name.
   sFOTFile  = sFontDir + LEFT(sFontFileName, ;
 	LEN(sFontFileName) - 4) + ".FOT"

   *-- Copy to Fonts folder.
   COPY FILE (sSourceDir + sFontFileName) TO ;
 	(sFontDir + sFontFileName)

   *-- Create the font.
   iRetVal = ;
 	CreateScalableFontResource(0, sFOTFile, sFontFileName, sFontDir)
   IF iRetVal = 0 THEN
   	iLastError = GetLastError ()
   	IF iLastError = 80
          MESSAGEBOX("Font file " + sFontDir + sFontFileName + ;
          "already exists.")
   	ELSE
       	MESSAGEBOX("Error " + STR (iLastError))
   	ENDIF
      RETURN
   ENDIF

   *-- Add the font to the system font table.
   iRetVal = AddFontResource (sFOTFile)
   IF iRetVal = 0 THEN
   	iLastError = GetLastError ()
   	IF iLastError = 87 THEN
       	MESSAGEBOX("Incorrect Parameter")
   	ELSE
       	MESSAGEBOX("Error " + STR (iLastError))
   	ENDIF
      RETURN
   ENDIF

   *-- Make the font persistent across reboots.
   STORE 0 TO iResult, iDisplay
   iRetVal = RegCreateKeyEx(HKEY_LOCAL_MACHINE, ;
 	"SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts", 0, "REG_SZ", ;
 	0, SECURITY_ACCESS_MASK, 0, @iResult, ;
 	@iDisplay) && Returns .T. if successful

   *-- Uncomment the following lines to display information
   *!*   *-- about the results of the function call.
   *!*      WAIT WINDOW STR(iResult)   && Returns the key handle
   *!*      WAIT WINDOW STR(iDisplay)  && Returns one of 2 values:
   *!*                             	&& REG_CREATE_NEW_KEY = 1
   *!*                             	&& REG_OPENED_EXISTING_KEY = 2

   iRetVal = RegSetValueEx(iResult, sFontName, 0, 1, sFontFileName, 13)

   *-- Close the key.  Don't keep it open longer than necessary.
   iRetVal = RegCloseKey(iResult)

   *-- Notify all the other application a new font has been added.
   iRetVal = SendMessage (HWND_BROADCAST, WM_FONTCHANGE, 0, 0)
   IF iRetVal = 0 THEN
   	iLastError = GetLastError ()
       	MESSAGEBOX("Error " + STR (iLastError))
      RETURN
   ENDIF

   ERASE (sFOTFile)
   *-- Code ends here

المصدر MSDN

مع التحية

مشكور اخي عبد الله شيء جميــل وبارك الله بك

عـــــــراقيٌ أنا





تجمع مبرمجي فيجوال فوكس برو الساحر

 



7521_1180275748.gif

مواضيعي

مشاركاتي

#4

تشكر اخي Shadowz وجاري عملية التجربة على البرنامج

#5

اخي عبدالله جربت الكودات وطبقتها على البرنامج ولكن لايتغير الخط فهل تستطيع تجربته في مثال ولك جزيل الشكر

#6
M-Man كتب:

اخي عبدالله جربت الكودات وطبقتها على البرنامج ولكن لايتغير الخط فهل تستطيع تجربته في مثال ولك جزيل الشكر

لايتغير الخط ؟؟؟ أم لا تجده في ملف الخطوط C:\Windows\Fonts ؟؟؟؟

على كل حال جريت الكود على Windows7 وهو يعمل بشكل طبيعي

مع مراعاة موضوع User Account Control وما يفرضه من حماية لمجلد الـ Fonts

فاذا أردت تنصيبه على Windows7

اعمل ايقاف لـ UAC

من خلال الذهاب الى

Control Panel\All Control Panel Items\User Accounts

واختر منها

Change User Account Control Settings

وقلل الحماية لأدنى حد

بعد اعادة تشغيل الجهاز...أعتقد ستكون الامور بخير

في جميع الأحول لماذا لا تفكر باستخدام برنامج تنصيب مثل Inno Setup أو غيره

مع التحية

أستغفر الله العظيم و أتوب إليه

#7

السلام عليكم

اشكرك اخي عبدالله بالنسبة لنظام التشغيل فاني استخدم ويندوز 7 ولكن اريد اضيف الخطوط في نفس الفولدر للبرنامج وليس في C:\Windows\Fonts

اي مع البرنامج بحيث عند نقل البرنامج الى حاسبة اخرى لاتحتوي على نفس الخطوط يعمل بشكل جيد

وبصورة اخرى نقوم بتغيير قراءة البرنامج للخطوط من المسار المذكور اعلاه الى مسار نحن نحدده كان يكون فولدر باسم (Font) مع ملفات وفولدرات البرنامج

فهل يمكن هذا وشكرا لك مرة اخرى

#8

M-Man

لا اظن أنك ستتمكن من هذا بأي لغة من اللغات فهي اكيد ليست كالصور والملفات الأخرى

الأفضل نسخها داخل الفولدر المعتمد من قبل الوندوز...وتسجيلها وتعميمها حسب الأصول كما هو موضح في المثال

أما اذا أصريت على الموضوع، بامكانك التفكير بالتالي على سبيل المثال

- وضع نسخة دائمة منها كمرفق مع برنامجك

- عند تشغيل البرنامج الخاص بك اعمل اجراء للتأكد من وجود ملف ما نسميه مثلا Fonts.txt فان كان موجوداً فهذا يعني بأن الخطوط تم تنصيبها سابقاً،

- ان لم يكن موجوداً فقم بتنفيذ الكود السابق ذكره لتنصيب الخطوط في موقعها الافتراضي Windows\Fonts ( حتى تضمن أن الأمور في مسارها الصحيح )

وبعد ذلك قم بانشاء الملف الذي أسميناه Fonts.txt في فولدر برنامجك حتى تتجنب عملية تنصيب الخطوط مرة أخرى

أعتقد بهذه الطريقة، تحقق ما تريد

- الوجود الدائم لملفات الخطوط مع برنامجك

- التنصيب التلقائي للخطوط عند تشغيل البرنامج على الجهاز لأول مرة

- توفير وقت التأكد من وجود الخطوط بالاستدلال من Fonts.txt

اهم شيء حذف ملف الـ Fonts.txt عند نسخ البرنامج لجهاز آخر

هذه فكرة..بسيطة، وأنظر ما قد يخطر على بالك

مع التحية

أستغفر الله العظيم و أتوب إليه

#9

جزاك الله خيرا اخي عبدالله وغفر لك وزادك من خيري الدنيا والآخرة

واسأل الله العلي القدير ان يجعل ذلك في ميزان حسناتك وأن ينفعنا بك انه على ذلك قدير ..

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

ويمكن الرجوع اليه في حالة فرمتة الجهاز تقبلوا تحياتي

مواضيع مشابهة