Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Add fonts to windows from VFP apps
Message
From
08/01/2003 23:06:03
 
General information
Forum:
Visual FoxPro
Category:
Windows API functions
Miscellaneous
Thread ID:
00738923
Message ID:
00739678
Views:
125
So sory, I forgot it. I post my code again. UDF is a user define functions I make in VB6. I need add 12 fonts (Vietnamese font).

*-- Add font to windows to print reports
#define HWND_BROADCAST 65535
#define WM_FONTCHANGE 29

Declare INTEGER CreateScalableFontResource IN GDI32.DLL ;
INTEGER fHidden, ;
STRING @lpszResourceFile, ;
STRING @lpszFontFile, ;
STRING @lpszCurrentPath

Declare Integer AddFontResource in gdi32 ;
String lpFileName

DECLARE INTEGER SendMessage IN user32 ;
INTEGER hWnd,;
INTEGER Msg,;
INTEGER wParam,;
INTEGER lParam

if adir(aFonts,[c:\temp\fonts\*.ttf]) > 0
*-- Add font to windows system
for i = 1 to alen(aFonts,1)
copy file ([c:\temp\fonts\]+aFonts[i,1]) to ([c:\windows\fonts\]+aFonts[i,1])

if file([c:\windows\fonts\]+juststem(aFonts[i,1])+[.fot])
delete file ([c:\windows\fonts\]+juststem(aFonts[i,1])+[.fot])
endif

= CreateScalableFontResource(0,[c:\windows\fonts\]+juststem(aFonts[i,1])+[.fot],[c:\temp\fonts\]+aFonts[i,1],[c:\windows\fonts])
= AddFontResource([c:\temp\fonts\]+aFonts[i,1])
= SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0)
endfor
endif

oreg = createobject('udf.registry')
cVersion = os(1)

*-- Make key to registry to permenent install fonts
if type('oReg') = 'O'
do case
case 'Windows 4.' $ cVersion && Windows 9x
WITH oReg
.ClassKey = -2147483646
.SecTionKey = [SOFTWARE\Microsoft\Windows\CurrentVersion\Fonts]
IF .KeyExists
.ValueKey = [.VnArial (TrueType)]
.valuetype = 1
.value = [VNARIAL.TTF]
.createkey

.ValueKey = [.VnArial Bold (TrueType)]
.valuetype = 1
.value = [VNARIALB.TTF]
.createkey

.ValueKey = [.VnArial Bold Italic (TrueType)]
.valuetype = 1
.value = [VNARIABI.TTF]
.createkey

.ValueKey = [.VnArial Italic (TrueType)]
.valuetype = 1
.value = [VNARIALI.TTF]
.createkey

.ValueKey = [.VnArial Narrow (TrueType)]
.valuetype = 1
.value = [VNARIALN.TTF]
.createkey

.ValueKey = [.VnArial Narrow Bold (TrueType)]
.valuetype = 1
.value = [VNARIANB.TTF]
.createkey

.ValueKey = [.VnArial Narrow Italic (TrueType)]
.valuetype = 1
.value = [VNARIANI.TTF]
.createkey

.ValueKey = [.VnArial NarrowH (TrueType)]
.valuetype = 1
.value = [VHARIALN.TTF]
.createkey

.ValueKey = [.VnArialH (TrueType)]
.valuetype = 1
.value = [VHARIAL.TTF]
.createkey

.ValueKey = [.VnArialH Bold (TrueType)]
.valuetype = 1
.value = [VHARIALB.TTF]
.createkey

.ValueKey = [.VnArialH Bold Italic (TrueType)]
.valuetype = 1
.value = [VHARIABI.TTF]
.createkey

.ValueKey = [.VnArialH Italic (TrueType)]
.valuetype = 1
.value = [VHARIALI.TTF]
.createkey
endif
endwith
case ('Windows 5.' $ cVersion) or ('Windows NT' $ cVersion) && Windows 2000
WITH oReg
.ClassKey = -2147483646
.SecTionKey = [SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts]
IF .KeyExists
.ValueKey = [.VnArial (TrueType)]
.valuetype = 1
.value = [VNARIAL.TTF]
.createkey

.ValueKey = [.VnArial Bold (TrueType)]
.valuetype = 1
.value = [VNARIALB.TTF]
.createkey

.ValueKey = [.VnArial Bold Italic (TrueType)]
.valuetype = 1
.value = [VNARIABI.TTF]
.createkey

.ValueKey = [.VnArial Italic (TrueType)]
.valuetype = 1
.value = [VNARIALI.TTF]
.createkey

.ValueKey = [.VnArial Narrow (TrueType)]
.valuetype = 1
.value = [VNARIALN.TTF]
.createkey

.ValueKey = [.VnArial Narrow Bold (TrueType)]
.valuetype = 1
.value = [VNARIANB.TTF]
.createkey

.ValueKey = [.VnArial Narrow Italic (TrueType)]
.valuetype = 1
.value = [VNARIANI.TTF]
.createkey

.ValueKey = [.VnArial NarrowH (TrueType)]
.valuetype = 1
.value = [VHARIALN.TTF]
.createkey

.ValueKey = [.VnArialH (TrueType)]
.valuetype = 1
.value = [VHARIAL.TTF]
.createkey

.ValueKey = [.VnArialH Bold (TrueType)]
.valuetype = 1
.value = [VHARIALB.TTF]
.createkey

.ValueKey = [.VnArialH Bold Italic (TrueType)]
.valuetype = 1
.value = [VHARIABI.TTF]
.createkey

.ValueKey = [.VnArialH Italic (TrueType)]
.valuetype = 1
.value = [VHARIALI.TTF]
.createkey
endif
endwith
endcase
endif

oInfo = createobject('udf.getinfo')

*-- Reboot the system
do case
case 'Windows 4.' $ cVersion && Windows 9x
= oInfo.rebootMachine9x()
case ('Windows 5.' $ cVersion) or ('Windows NT' $ cVersion) && Windows 2000
= oInfo.rebootMachine2k()
endcase
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform