************************************************************************* * Description.......: GetTitleAttributes * Calling Samples...: local lcFont, lnSize, lcStyle * lcFont=space(32) * lnSize=0 * lcStyle=space(4) * =GetTitleAttributes(@lcFont, @lnSize, @lcStyle) * Parameter List....: pcFontName, pnSize, pcStyle * Created by........: Vlad Grynchyshyn UT #035257 * Modified by.......: Nadya Nosonovsky 10/05/00 08:28:33 PM ************************************************************************** lparameters pcFontName, pnSize, pcStyle #DEFINE SIZE_OF_SPI_GETNONCLIENTMETRICS 340 #DEFINE OFFSET_OF_cbSize 1 #DEFINE SPI_GETNONCLIENTMETRICS 41 * prepare string buffer for structure local lcMyStr lcMyStr = space(SIZE_OF_SPI_GETNONCLIENTMETRICS) * put buffer length into structure lcMyStr = stuff(lcMyStr, OFFSET_OF_cbSize, 4, IntToSTR(SIZE_OF_SPI_GETNONCLIENTMETRICS) ) DECLARE INTEGER SystemParametersInfo IN WIN32API integer nOption, integer n2, string cStruct, integer n2 if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @lcMyStr, 0)>0 * examine result string * values of lfCaptionFont structure should start at the offset 24. * these values are: * lfHeight - 24 * lfWidth - 28 * lfEscapement - 32 * lfOrientation - 36 * lfWeight - 40 * lfItalic - 44 * lfUnderline - 45 * lfStrikeOut - 46 * lfCharSet - 47 * lfOutPrecision - 48 * lfClipPrecision - 49 * lfQuality - 50 * lfPitchAndFamily - 51 * lfFaceName - 52 * note that you need to add 1 to each offset value when working with strings in VFP * the last one is the most interesting - its 32 bytes of Font Face name. So you can take it, for example, by easy way: local lcCaptionFont, llBold, llStrikeOut, llItalic, llUnderline, lnHeight lcCaptionFont = substr(lcMyStr, 53, 32) if at(chr(0), lcCaptionFont) > 0 lcCaptionFont = left(lcCaptionFont, at(chr(0), lcCaptionFont) - 1) endif llItalic = asc(substr(lcMyStr, 45, 1))>0 && .T. if Italic llUnderline = asc(substr(lcMyStr, 46, 1))>0 && .T. if underline lIStrikeOut = asc(substr(lcMyStr, 47, 1))>0 && .T. if StrikeOut llBold = strToInt(substr(lcMyStr, 41, 4)) > 500 && .T. if bold ?lcMyStr ?lcCaptionFont ?llItalic ?llBold ?lIStrikeOut ?llUnderline * ............ * something tricky with font size: DECLARE INTEGER CreateDC in gdi32 string cDriver, integer, integer, integer DECLARE INTEGER DeleteDC in gdi32 integer hDC DECLARE INTEGER GetDeviceCaps in Win32API integer hDC, integer nOption #DEFINE LOGPIXELSY 90 local lcDriverName, lnDC lcDriverName = 'DISPLAY' + chr(0) lnDC = CreateDC(@lcDriverName, 0, 0, 0) if lnDC0 lnHeight = StrToInt(substr(lcMyStr, 25, 4)) * its integer, not UInt if lnHeight > 65536*32768 - 1 && if it is lnHeight = lnHeight - 65536*65536 lnHeight = round( (-lnHeight) * 72 / GetDeviceCaps(lnDC, LOGPIXELSY), 0) endif && otherwise lnHeight should contain 0 or correct height. = DeleteDC(lnDC) endif ?lnHeight endif pnSize=lnHeight && Return font size pcFontName=lcCaptionFont *!* B Bold *!* I Italic *!* N Normal *!* O Outline *!* Q Opaque *!* S Shadow *!* – Strikeout *!* T Transparent *!* U Underline pcStyle=iif(llBold,'B','')+iif(llItalic,'I','')+iif(llUnderline,'U','')+iif(lIStrikeOut,'-','') if empty(pcStyle) pcStyle='N' endif ?pcStyle return ******************************************************************** procedure IntToSTR lparameters pnValue return chr(pnValue % 256) + ; chr(int(pnValue / 256) % 256) + ; chr(int(pnValue / 65536) % 256) + ; chr(int(pnValue / 16777216) % 256 ) ********************************************** procedure STRToInt lparameters pcValue return asc(left(pcValue,1)) + ; asc(substr(pcValue,2,1))*256 + ; asc(substr(pcValue,3,1))*65536 + ; asc(substr(pcValue,4,1))*16777216
************************************************************************** * Description.......: Form.Caption_Assign * Calling Samples...: * Parameter List....: * Created by........: Nadya Nosonovsky 10/04/2000 10:37:20 AM * Modified by.......: Nadya Nosonovsky 10/05/00 08:31:55 PM *Caption_Assign method was based on code, kindly provided by Cetin Basoz.: **************************************************************************** lparameters vNewVal if not 'version' $ vNewVal && not already there local lcCaption, lcFont, lnSize, lcStyle, lnCaptionWidth, lnSpaces * Form.scalemode should be = 0 - Pixels lcFont = space(32) lnSize = 0 lcStyle = space(4) * Retrieve Title Bar font attributes =GetTitleAttributes(@lcFont,@lnSize, @lcStyle) lcCaption=rtrim(vNewVal) +'version ' +alltrim(str(this.nVersion,5,2)) lnCaptionWidth=txtwidth(lcCaption,lcFont,lnSize,lcStyle)*; fontmetric(6,lcFont,lnSize,lcStyle)+iif(this.controlbox, ; iif(this.maxbutton or this.minbutton, 3, 1) * sysmetric(33)+sysmetric(16),0) lnSpaces = (FLOOR(this.width-lnCaptionWidth) / ; (txtwidth(" ",lcFont,lnSize,lcStyle) * fontmetric(6,lcFont,lnSize,lcStyle))) if lnSpaces>0 vNewVal = rtrim(vNewVal) + space(lnSpaces)+'version ' +alltrim(str(this.nVersion,5,2)) endif endif this.caption = m.vNewVal
