PDA

View Full Version : نصب فونت با استفاده از کد نویسی و api



kia1349
سه شنبه 08 اردیبهشت 1383, 07:04 صبح
به این دو روش دقت کنید
1-


*-----------------------------------------------------------------------------------------------------------
*-----------------------------------------------------------------------------------------------------------
*-----------------------------------------------------------------------------------------------------------
*----------------------------------------------------------------------------------------------------------
*-- 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

2-


*-----------------------------------------------------------------------------------------------------------
*-----------------------------------------------------------------------------------------------------------
*-----------------------------------------------------------------------------------------------------------
*-----------------------------------------------------------------------------------------------------------


DECLARE INTEGER AddFontResource IN GDI32.DLL ;
STRING @ lpszFileName
DECLARE INTEGER SendMessage IN USER32.DLL ;
INTEGER hWnd, ;
INTEGER Msg, ;
INTEGER wParameter, ;
INTEGER lParameter
#DEFINE HWND_BROADCAST 0xFFFF
#DEFINE WM_FONTCHANGE 0x001D
LOCAL nNumFontsAdded
cMyFontFilePath = 'C:\FONTS\MyFONT.TTF' && or whatever
nNumFontsAdded=AddFontResource(cMyFontFilePath)
IF nNumFontsAdded > 0
* We added fonts, so update the world
=SendMessage(HWND_BROADCAST,WM_FONTCHANGE,0,0)
* notifies WinApps about change font table
ELSE
* Unable to add font; maybe not a supported format
ENDIF

*AddFontResource works with .FON, .FNT, .TTF, .TTC, .FOT, .OTF, .MMM, .PFB and .PFM files; the MSDN docs on AddFontResource spell out the details well.

*PS - you'll need to add error trapping, etc. on your own. It's preferable to use an installer program (I like InstallShield) but it can be done. New font files shpould be copied to the Windows FONT directory; this can be easily located using the Windows Scripting Host's Wscript.Shell Object, which has a SpecialFolders collection. You can get the directory using the WSH as follows:

*LOCAL oWSH, cFontPath
*oWSH=CREATEOBJ('Wscript.Shell')
*cFontPath = oWSH.SpecialFolders('FONTS')

Mohammad_Mnt
سه شنبه 08 اردیبهشت 1383, 08:27 صبح
:heart:

binyaz2003
سه شنبه 08 اردیبهشت 1383, 08:47 صبح
:o :خیلی متعجب: :shock: :lol: :تشویق:

naderigh
یک شنبه 06 اسفند 1385, 07:21 صبح
آقا این دو راه خطا میگیرد

rezaTavak
یک شنبه 06 اسفند 1385, 08:54 صبح
بدلیل اینکه در html کاراکترهای < , > و برخی دیگر مستقیم نمایش داده نمی شود و از کد آنها یا مثلا &lt; استفاده می شود اینجا هم با عث شده که خط اول و آخر مشکل دار شود.

با اجازه استاد حیدری کیا ویرایش میکنم.

naderigh
یک شنبه 06 اسفند 1385, 10:15 صبح
آقا بسیار متشکرم
ولی فونت مورد نظرم نصب نمیگردد البته جهت اطلاع عرض کنم که در قسمت font ویندوز نیز نمیشود فونت جدیدی نصب کرد قسمت مربوطه در منوی file نیست

rezaTavak
یک شنبه 06 اسفند 1385, 14:57 عصر
خب اگر اونجا نشه هیچ جا هم نمیشه.

naderigh
دوشنبه 07 اسفند 1385, 07:24 صبح
آقا راه حلی برای این قضیه هست که بشود install new font در منوی file قسمت font را فعال نمود

rezaTavak
دوشنبه 07 اسفند 1385, 15:20 عصر
نمی دانم اما:

با کپی فایلها به شاخه windir/fonts و باز کردن 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 "&#221;&#230;&#228;&#202; "+lcFileName+"&#228;&#213;&#200; &#212;&#207;"
RETURN .T.
* notifies WinApps about change font table
ELSE
RETURN .F.
* Unable to add font; maybe not a supported format
ENDIF