نصب فونت ؟

[mostafa_zamani]

سلام و ارادت خدمت دوستان گرامی

چگونه فونتهای مورد نیاز برنامه تان را نصب می کنید ؟
با روشی ساده و ترجیحا قابل اجرا توسط برنامه .
با تشکر

[rezaTavak]

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



************************************************** ****
*
* INSTALL FONT FROM A DIRECTORY
*
************************************************** ****
#DEFINE HWND_BROADCAST 0xFFFF
#DEFINE WM_FONTCHANGE 0x001D
#DEFINE HKEY_LOCAL_MACHINE 2147483650 && (HKEY) 0x80000002
#DEFINE SECURITY_ACCESS_MASK 983103 && SAM value KEY_ALL_ACCESS




FUNCTION InstallFontDir
LPARAMETERS tcDir

LOCAL laFileList, i, lnNumberFile, lnSuccess, lcFileSkeleton, lcPreDir, lcFontDir, lcCommand
lcExtentions = "FON,FNT,TTF,TTC,FOT,OTF,MMM,PFB,PFM"
lnSuccess = 0
DIMENSION laFileList[1]
lcPreDir = SYS(5)+SYS(2003)
SET DEFAULT TO &tcDir

DECLARE INTEGER AddFontResource IN GDI32.DLL ;
STRING @ lpszFileName
DECLARE INTEGER SendMessage IN USER32.DLL ;
INTEGER hWnd, ;
INTEGER Msg, ;
INTEGER wParameter, ;
INTEGER lParameter
DECLARE INTEGER GetWindowsDirectory IN win32api STRING @lpszSysDir,;
INTEGER iBufLen
DECLARE INTEGER CreateScalableFontResource IN win32api ;
LONG fdwHidden, ;
STRING lpszFontRes, ;
STRING lpszFontFile, ;
STRING lpszCurrentPath
DECLARE INTEGER RemoveFontResource IN win32api ;
STRING lpszFilename
DECLARE LONG GetLastError IN win32api
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


FOR j=1 TO 9
lcFileSkeleton = "*."+SUBSTR(lcExtentions,(j-1)*4+1,3)
lnNumberFile = ADIR(laFileList,lcFileSkeleton)
IF lnNumberFile < 1
LOOP
ENDIF

FOR i=1 TO lnNumberFile
IF InstallFonts(laFileList[i,1]) = .T.
lnSuccess = lnSuccess + 1
ENDIF
NEXT
ENDFOR
SET DEFAULT TO (lcPreDir+"\")
lcFontDir = SPACE(100)
lnLenght = GetWindowsDirectory(@lcFontDir, 100)
lcFontDir = SUBSTR(lcFontDir, 1, lnLenght)+"\FONTS\"
lcCommand = "RUN /1 EXPLORER "+ lcFontDir
&lcCOmmand
RETURN lnSuccess


*******************************************
*InstallFonts
*******************************************


FUNCTION InstallFonts
LPARAMETERS tcFontFilePath
LOCAL lnNumFontsAdded, lcFontDir, lnLenght

lcFontDir = SPACE(100)
lnLenght = GetWindowsDirectory(@lcFontDir, 100)
lcFontDir = SUBSTR(lcFontDir, 1, lnLenght)+"\FONTS\"
lcFileName = SUBSTR(tcFontFilePath,RAT("\",tcFontFilePath)+1)
IF ! FILE(lcFontDir + lcFileName)
COPY FILE (tcFontFilePath) TO (lcFontDir + lcFileName)
ENDIF
lnNumFontsAdded = AddFontResource(lcFontDir + lcFileName)

IF lnNumFontsAdded > 0
* We added fonts, so update the world
=SendMessage(HWND_BROADCAST,WM_FONTCHANGE,0,0)
WAIT WINDOW NOWAIT TIMEOUT 2 "ÝæäÊ "+lcFileName+"äÕÈ ÔÏ"
RETURN .T.
* notifies WinApps about change font table
ELSE
RETURN .F.
* Unable to add font; maybe not a supported format
ENDIF






برنامه فوق یک تابع است که یک فلدر را که در آن فونت است را نصب می‌کند

[mostafa_zamani]

بسیار سپاسگزارم .
تشکر تشکر .