*************************************************************************
*  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 lnDC<>0
    lnHeight = StrToInt(substr(lcMyStr, 25, 4))
    * its integer, not UInt
    if lnHeight > 65536*32768 - 1 && if it is <0
      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
****************************************************************************
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 = (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