Forum AtoutFox : Re: paramétrer la police des tooltiptext   

ven. 22 mai 2015, 11h00

Vilhelm-Ion Praisach
Roumanie
atoutfox.public.association

Re: paramétrer la police des tooltiptext

Oui, mais il affecté tous les logiciels
Vous pouvez utiliser le même code pour les menus du système, tootltip et messagebox.
La seule différence est un nombre (nWhat dans cette démo)

http://www.foxite.com/archives/change-sysmenu-font-0000423302.htm

DECLARE INTEGER ShellExecute IN shell32.dll INTEGER hndWin, STRING cAction, STRING cFileName, STRING cParams, STRING cDir, INTEGER nShowWin
Declare integer SystemParametersInfo in win32api integer uiAction, integer uiParam, string@ pvParam, integer fWinIni
#define SPI_GETNONCLIENTMETRICS 41
#define SPI_SETNONCLIENTMETRICS 42
#define SPIF_SENDCHANGE  2
#define NCM_SIZE 10*4+5*60

#define FW_ULTRALIGHT 200
#define FW_REGULAR 400
#define FW_BOLD 700
#define FW_HEAVY 900

* Get current settings
ncm_current = Padr(BinToC(NCM_SIZE,"4RS"),NCM_SIZE,Chr(0))
SystemParametersInfo(SPI_GETNONCLIENTMETRICS,NCM_SIZE, @ncm_current, 0)

ncm_changed = m.ncm_current
CLEAR
* menu height
cnmenuh = SUBSTR(m.ncm_changed,157,4)
nmenuh = CTOBIN(cnmenuh,"4RS")
cnmenuw = SUBSTR(m.ncm_changed,153,4)
nmenuw = CTOBIN(cnmenuw,"4RS")
?nmenuw,nmenuh

***********************************************
* The same logfont structure for :
***********************************************
*nWhat = 161 && system menu
nWhat = 221 && tooltip
*nWhat = 281 && messagebox
* For shellexecute
cFileName = "C:\Program Files (x86)\Microsoft Visual FoxPro 9\vfp9.exe"
cAction = "open"

* get the logfont structure
lcFontStr = SUBSTR(m.ncm_current,m.nWhat,60)
lcFontStrChanged = lcFontStr
* get the current values
nheight = CTOBIN(LEFT(m.lcFontStr,4),"4RS")
nweight = CTOBIN(SUBSTR(m.lcFontStr,17,4),"4RS")
nitalic = CTOBIN(SUBSTR(m.lcFontStr,21,1),"1RS")
nunderline = CTOBIN(SUBSTR(m.lcFontStr,22,1),"1RS")
nstrike =  CTOBIN(SUBSTR(m.lcFontStr,23,1),"1RS")
cfontname = SUBSTR(lcFontStr,29)
nangle1 = CTOBIN(SUBSTR(m.lcFontStr,9,4),"4RS")
nangle2 = CTOBIN(SUBSTR(m.lcFontStr,13,4),"4RS")

?nheight,nweight,nitalic,nunderline,nstrike,cfontname,nangle1,nangle2

* Fontsize = 14
lnFontSize = 14
lcFontStrChanged = STUFF(m.lcFontStrChanged,1,4,BINTOC(getheight(m.lnFontSize),"4RS"))
ncm_changed = STUFF(m.ncm_changed,m.nWhat,60,m.lcFontStrChanged)
SystemParametersInfo(SPI_SETNONCLIENTMETRICS,NCM_SIZE, ncm_changed,SPIF_SENDCHANGE)
MESSAGEBOX("Fontsize = 14")
IF nWhat = 221
  ShellExecute(0,cAction,cFileName,"","",1)
ENDIF
* Fontname = Arial
lcFont = "Arial"
lcFontStrChanged = STUFF(m.lcFontStrChanged,29,32,m.lcFont + REPLICATE(CHR(0), 32 - LEN(m.lcFont)))
ncm_changed = STUFF(m.ncm_changed,m.nWhat,60,m.lcFontStrChanged)
SystemParametersInfo(SPI_SETNONCLIENTMETRICS,NCM_SIZE, ncm_changed,SPIF_SENDCHANGE)
MESSAGEBOX("Arial")
IF nWhat = 221
  ShellExecute(0,cAction,cFileName,"","",1)
ENDIF
* Bold
lcFontStrChanged = STUFF(m.lcFontStrChanged,17,4,BINTOC(FW_BOLD ,"4RS"))
ncm_changed = STUFF(m.ncm_changed,m.nWhat,60,m.lcFontStrChanged)
SystemParametersInfo(SPI_SETNONCLIENTMETRICS,NCM_SIZE, ncm_changed,SPIF_SENDCHANGE)
MESSAGEBOX("Bold")
IF nWhat = 221
  ShellExecute(0,cAction,cFileName,"","",1)
ENDIF
* Italic
lcFontStrChanged = STUFF(m.lcFontStrChanged,21,1,BINTOC(1 ,"1RS"))
ncm_changed = STUFF(m.ncm_changed,m.nWhat,60,m.lcFontStrChanged)
SystemParametersInfo(SPI_SETNONCLIENTMETRICS,NCM_SIZE, ncm_changed,SPIF_SENDCHANGE)
MESSAGEBOX("Italic")
IF nWhat = 221
  ShellExecute(0,cAction,cFileName,"","",1)
ENDIF
* Underline
lcFontStrChanged = STUFF(m.lcFontStrChanged,22,1,BINTOC(1 ,"1RS"))
ncm_changed = STUFF(m.ncm_changed,m.nWhat,60,m.lcFontStrChanged)
SystemParametersInfo(SPI_SETNONCLIENTMETRICS,NCM_SIZE, ncm_changed,SPIF_SENDCHANGE)
MESSAGEBOX("Underline")
IF nWhat = 221
  ShellExecute(0,cAction,cFileName,"","",1)
ENDIF
* Strikethrough
lcFontStrChanged = STUFF(m.lcFontStrChanged,23,1,BINTOC(1 ,"1RS"))
ncm_changed = STUFF(m.ncm_changed,m.nWhat,60,m.lcFontStrChanged)
SystemParametersInfo(SPI_SETNONCLIENTMETRICS,NCM_SIZE, ncm_changed,SPIF_SENDCHANGE)
MESSAGEBOX("Strikethrough")
IF nWhat = 221
  ShellExecute(0,cAction,cFileName,"","",1)
ENDIF
* Angle = 45 degrees
lnAngle = 45
lnAngle2 = 45
lcFontStrChanged = STUFF(m.lcFontStrChanged,9,4,BINTOC(lnAngle,"4RS"))
lcFontStrChanged = STUFF(m.lcFontStrChanged,13,4,BINTOC(lnAngle2,"4RS"))
ncm_changed = STUFF(m.ncm_changed,m.nWhat,60,m.lcFontStrChanged)
ncm_changed = STUFF(m.ncm_changed,157,4,BINTOC(100 ,"4RS"))
ncm_changed = STUFF(m.ncm_changed,153,4,BINTOC(100 ,"4RS"))

SystemParametersInfo(SPI_SETNONCLIENTMETRICS,NCM_SIZE, ncm_changed,SPIF_SENDCHANGE)
MESSAGEBOX("Angle = 45 degrees")
IF nWhat = 221
  ShellExecute(0,cAction,cFileName,"","",1)
ENDIF

* change back
SystemParametersInfo(SPI_SETNONCLIENTMETRICS,NCM_SIZE, ncm_current,SPIF_SENDCHANGE)

FUNCTION getheight
  LPARAMETERS tnPointSize
  DECLARE INTEGER GetDC IN USER32 INTEGER hwnd
  DECLARE INTEGER ReleaseDC IN USER32 INTEGER hwnd, INTEGER hdc
  DECLARE INTEGER GetDeviceCaps IN GDI32 INTEGER hdc, INTEGER nIndex
  DECLARE integer MulDiv IN Kernel32 INTEGER, INTEGER, INTEGER
  LOCAL lnhDC, lnfHeight, LOGPIXELSY
  LOGPIXELSY = 90
  lnhDC = GetDC(0)
  lnfHeight = -MulDiv(tnPointSize, GetDeviceCaps(lnhDC, LOGPIXELSY), 72)
  lnhDC = ReleaseDC(0, lnhDC)
  CLEAR DLLS "GetCD", "ReleaseDC", "GetDeviceCaps", "MulDiv"
RETURN lnfHeight


Permalink : http://www.atoutfox.org/nntp.asp?ID=0000016377