Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Change font menu of VFP
Message
From
14/01/2003 21:59:35
 
 
To
14/01/2003 02:18:06
General information
Forum:
Visual FoxPro
Category:
Other
Miscellaneous
Thread ID:
00741318
Message ID:
00741737
Views:
193
Try this code:

*-- Change windows system font
*-- Place below code in post installing program

* Get OS version
cVersion = os(1)

* Source font file name
* You should remember copy this source font to target computer
cFontname = 'c:\fonts\Sserife.fon'

DECLARE INTEGER RegOpenKey IN Win32API ;
INTEGER nHKey,;
STRING cSubKey,;
INTEGER @nHandle

DECLARE INTEGER RegSetValueEx IN Win32API ;
INTEGER nHKey,;
STRING lpszEntry,;
INTEGER dwReserved,;
INTEGER fdwType,;
STRING @lpbData,;
INTEGER cbData

*-- Change windows metric
lnRegHandle = 0
lnResult = RegOpenKey(-2147483647,[Control Panel\desktop\WindowMetrics],@lnRegHandle)

*-- Set MenuFont
cHex = 'f5ffffff0000000000000000000000009001000000' + ;
'000000000000004d0053002000530061006e00730020005300' + ;
'650072006900660000007600610000008874bcc2e806010000' + ;
'0000000000728b8874f0c2e8064376887432000000'

cDex = ''
for i = 1 to len(cHex) step 2
cTmp = substr(cHex,i,2)
cDex = cDex + chr(hextodec(cTmp))
endfor

if lnResult = 0
= RegSetValueEx(lnRegHandle,[MenuFont],0,3,@cDex,len(cDex))
endif

do case
case 'Windows 4.' $ cVersion && Windows 9x
lnRegHandle = 0
lnResult = RegOpenKey(-2147483646,[SOFTWARE\Microsoft\Windows\CurrentVersion\Fonts],@lnRegHandle)
if lnResult = 0
= RegSetValueEx(lnRegHandle,[MS Sans Serif 8,10,12,14,18,24 (VGA res)],0,1,cFontname,len(cFontname))

lnRegHandle = 0
lnResult = RegOpenKey(-2147483646,[Config\0001\Display\Fonts],@lnRegHandle)
if lnResult = 0
= RegSetValueEx(lnRegHandle,[MS Sans Serif 8,10,12,14,18,24 (VGA res)],0,1,cFontname,len(cFontname))
endif

case 'Windows 5.' $ cVersion or 'Windows NT' $ cVersion && Windows 2000 & XP
lnRegHandle = 0
lnResult = RegOpenKey(-2147483646,[SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts],@lnRegHandle)
if lnResult = 0
= RegSetValueEx(lnRegHandle,[MS Sans Serif 8,10,12,14,18,24 (VGA res)],0,1,cFontname,len(cFontname))

lnRegHandle = 0
lnResult = RegOpenKey(-2147483646,[SYSTEM\ControlSet001\Hardware Profiles\0001\Display\Fonts],@lnRegHandle)
if lnResult = 0
= RegSetValueEx(lnRegHandle,[MS Sans Serif 8,10,12,14,18,24 (VGA res)],0,1,cFontname,len(cFontname))

lnRegHandle = 0
lnResult = RegOpenKey(-2147483646,[SYSTEM\ControlSet002\Hardware Profiles\0001\Display\Fonts],@lnRegHandle)
if lnResult = 0
= RegSetValueEx(lnRegHandle,[MS Sans Serif 8,10,12,14,18,24 (VGA res)],0,1,cFontname,len(cFontname))

lnRegHandle = 0
lnResult = RegOpenKey(-2147483646,[SYSTEM\ControlSet003\Hardware Profiles\0001\Display\Fonts],@lnRegHandle)
if lnResult = 0
= RegSetValueEx(lnRegHandle,[MS Sans Serif 8,10,12,14,18,24 (VGA res)],0,1,cFontname,len(cFontname))

lnRegHandle = 0
lnResult = RegOpenKey(-2147483646,[SYSTEM\CurrentControlSet\Hardware Profiles\0001\Display\Fonts],@lnRegHandle)
if lnResult = 0
= RegSetValueEx(lnRegHandle,[MS Sans Serif 8,10,12,14,18,24 (VGA res)],0,1,cFontname,len(cFontname))
endcase

* You must reboot here to make change to system
*
* End


*-----------------------------------------
* Function to transfer from hex (2 digit) to dec
*
function hextodec
lparameter lcHex

lcHex = lower(lcHex)

chuc = left(lcHex,1)
donvi = right(lcHex,1)
nChuc = 0
nDonvi = 0
do case
case chuc $ 'abcdef'
nChuc = asc(chuc)-87
case chuc $ '0123456789'
nChuc = val(chuc)
endcase

do case
case donvi $ 'abcdef'
nDonvi = asc(donvi)-87
case donvi $ '0123456789'
nDonvi = val(donvi)
endcase
return nChuc*16 + nDonvi
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform