home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / GDI_Manage1841911192005.psc / cFont.cls < prev    next >
Text File  |  2005-01-19  |  22KB  |  634 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 1  'Persistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "cFont"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = True
  14. '==================================================================================================
  15. 'cFont.cls                  1/17/04
  16. '
  17. '           GENERAL PURPOSE:
  18. '               Wrap a LOGFONT structure and expose its members.
  19. '               Convert LOGFONT <--> StdFont
  20. '
  21. '               Browse For Font.
  22. '
  23. '               Font Source can be any system, ambient or custom font.
  24. '               When set to a system or ambient font, you will need to call
  25. '               OnSettingChange or OnAmbientFontChanged in the WM_SETTINGCHANGE
  26. '               handler or the usercontrol's AmbientChanged event, respectively,
  27. '               for the font to update itself.
  28. '
  29. '               Persistable.
  30. '
  31. '           LINEAGE:
  32. '               N/A
  33. '
  34. '==================================================================================================
  35.  
  36. Option Explicit
  37.  
  38.  
  39. Public Enum eFontWeight
  40.     fntWeightDefault = 0
  41.     fntWeightThin = 100
  42.     fntWeightExtraLight = 200
  43.     fntWeightLight = 300
  44.     fntWeightNormal = 400
  45.     fntWeightMedium = 500
  46.     fntWeightSemibold = 600
  47.     fntWeightBold = 700
  48.     fntWeightExtraBold = 800
  49.     fntWeightHeavy = 900
  50. End Enum
  51.  
  52. Public Enum eFontCharset
  53.     fntCharsetANSI = 0
  54.     fntCharsetDefault = 1
  55.     fntCharsetSymbol = 2
  56.     fntCharsetShiftJIS = 128
  57.     fntCharsetOEM = 255
  58. End Enum
  59.  
  60. Public Enum eFontOutputPrecision
  61.     fntOutPrecCharacter = 2
  62.     fntOutPrecDefault = 0
  63.     fntOutPrecDevice = 5
  64.     fntOutPrecOutline = 8
  65.     fntOutPrecRaster = 6
  66.     fntOutPrecString = 1
  67.     fntOutPrecStroke = 3
  68.     fntOutPrecTTOnly = 7
  69.     fntOutPrecTT = 4
  70. End Enum
  71.  
  72. Public Enum eFontClipPrecision
  73.     fntClipPrecDefault = 0
  74.     fntClipPrecCharacter = 1
  75.     fntClipPrecStroke = 2
  76.     fntClipPrecMask = &HF&
  77.     fntClipPrecEmbedded = 128
  78.     fntClipPrecLHAngles = 16
  79. End Enum
  80.  
  81. Public Enum eFontQuality
  82.     fntQualityDefault = 0
  83.     fntQualityDraft = 1
  84.     fntQuallityProof = 2
  85. End Enum
  86.  
  87. Public Enum eFontPitchAndFamily
  88.     fntPitchDefault = 0
  89.     fntPitchFixed = 1
  90.     fntPitchVariable = 2
  91.     fntFamilyDecorative = 80
  92.     fntFamilyDefault = 0
  93.     fntFamilyModern = 48
  94.     fntFamilyRoman = 16
  95.     fntFamilyScript = 64
  96.     fntFamilySwiss = 32
  97. End Enum
  98.  
  99. Public Enum eFontSource
  100.     fntSourceCustom = 0
  101.     fntSourceAmbient
  102.     fntSourceSysMenu
  103.     fntSourceSysMessage
  104.     fntSourceSysStatus
  105.     fntSourceSysCaption
  106.     fntSourceSysSmallCaption
  107. End Enum
  108.  
  109. Public Enum eFontDialog
  110.     dlgFontScreenFonts = &H1
  111.     dlgFontPrinterFonts = &H2
  112.     dlgFontScreenAndPrinterFonts = &H3
  113.     dlgFontUseStyle = &H80
  114.     dlgFontEffects = &H100
  115.     dlgFontAnsiOnly = &H400
  116.     dlgFontNoVectorFonts = &H800
  117.     dlgFontNoOemFonts = dlgFontNoVectorFonts
  118.     dlgFontNoSimulations = &H1000
  119.     dlgFontFixedPitchOnly = &H4000
  120.     dlgFontWysiwyg = &H8000&  ' Must also have ScreenFonts And PrinterFonts
  121.     dlgFontForceExist = &H10000
  122.     dlgFontScalableOnly = &H20000
  123.     dlgFontTTOnly = &H40000
  124.     dlgFontNoFaceSel = &H80000
  125.     dlgFontNoStyleSel = &H100000
  126.     dlgFontNoSizeSel = &H200000
  127.     ' Win95 only
  128.     dlgFontSelectScript = &H400000
  129.     dlgFontNoScriptSel = &H800000
  130.     dlgFontNoVertFonts = &H1000000
  131.  
  132.     
  133.     dlgFontApply = &H200
  134.     dlgFontEnableHook = &H8
  135.     'dlgFontEnableTemplate = &H10
  136.     'dlgFontEnableTemplateHandle = &H20
  137.     'dlgFontNotSupported = &H238
  138.     dlgFontRaiseError = &H10000000
  139. End Enum
  140.  
  141. Public Event Changed()
  142.  
  143. Private Type TCHOOSEFONT
  144.     lStructSize                     As Long      ' Filled with UDT size
  145.     hWndOwner                       As Long      ' Caller's window handle
  146.     hdc                             As Long      ' Printer DC/IC or NULL
  147.     lpLogFont                       As Long      ' Pointer to LOGFONT
  148.     iPointSize                      As Long      ' 10 * size in points of font
  149.     Flags                           As Long      ' Type flags
  150.     rgbColors                       As Long      ' Returned text color
  151.     lCustData                       As Long      ' Data passed to hook function
  152.     lpfnHook                        As Long      ' Pointer to hook function
  153.     lpTemplateName                  As Long      ' Custom template name
  154.     hInstance                       As Long      ' Instance handle for template
  155.     lpszStyle                       As String    ' Return style field
  156.     nFontType                       As Integer   ' Font type bits
  157.     iAlign                          As Integer   ' Filler
  158.     nSizeMin                        As Long      ' Minimum point size allowed
  159.     nSizeMax                        As Long      ' Maximum point size allowed
  160. End Type
  161.  
  162. Private Const DEF_FaceName          As String = "MS Sans Serif"
  163. Private Const DEF_Height            As Long = -11&
  164. Private Const DEF_Width             As Long = ZeroL
  165. Private Const DEF_Escapement        As Long = ZeroL
  166. Private Const DEF_Orientation       As Long = ZeroL
  167. Private Const DEF_Weight            As Long = fntWeightNormal
  168. Private Const DEF_Italic            As Byte = ZeroY
  169. Private Const DEF_Underline         As Byte = ZeroY
  170. Private Const DEF_Strikeout         As Byte = ZeroY
  171. Private Const DEF_Charset           As Byte = ZeroY
  172. Private Const DEF_OutPrecision      As Byte = ZeroY
  173. Private Const DEF_ClipPrecision     As Byte = ZeroY
  174. Private Const DEF_Quality           As Byte = ZeroY
  175. Private Const DEF_PitchAndFamily    As Byte = ZeroY
  176. Private Const DEF_Source            As Long = fntSourceAmbient
  177.  
  178. Private Const PROP_FaceName         As String = "Name"
  179. Private Const PROP_Height           As String = "Height"
  180. Private Const PROP_Width            As String = "Width"
  181. Private Const PROP_Escapement       As String = "Esc"
  182. Private Const PROP_Orientation      As String = "Orient"
  183. Private Const PROP_Weight           As String = "Weight"
  184. Private Const PROP_Italic           As String = "Italic"
  185. Private Const PROP_Underline        As String = "Underline"
  186. Private Const PROP_Strikeout        As String = "Strikeout"
  187. Private Const PROP_Charset          As String = "Charset"
  188. Private Const PROP_OutPrecision     As String = "OutPrec"
  189. Private Const PROP_ClipPrecision    As String = "ClipPrec"
  190. Private Const PROP_Quality          As String = "Quality"
  191. Private Const PROP_PitchAndFamily   As String = "PitchFam"
  192. Private Const PROP_Source           As String = "Source"
  193.  
  194. Private Const SPI_SETNONCLIENTMETRICS As Long = 42
  195.  
  196. Private Const ClassName             As String = "cFont"
  197.  
  198. Private Declare Function ChooseFont Lib "comdlg32.dll" Alias "ChooseFontA" (chfont As TCHOOSEFONT) As Long
  199. Private Declare Function MulDiv Lib "kernel32.dll" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
  200. Private Declare Function lstrcmpi Lib "kernel32.dll" Alias "lstrcmpiA" (ByRef yStart1 As Byte, ByRef yStart2 As Byte) As Long
  201. Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
  202. Private Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" (ByRef Destination As Any, ByVal Length As Long)
  203.  
  204. Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
  205. Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hdc As Long) As Long
  206.  
  207. Private mtLogFont                   As LOGFONT
  208. Private miFontSource                As eFontSource
  209.  
  210. Private Property Let pFaceName(ByRef sName As String)
  211.     
  212.     Dim ls As String
  213.     Dim iLen As Long
  214.     
  215.     ls = StrConv(sName, vbFromUnicode)
  216.     
  217.     iLen = LenB(ls)
  218.     If iLen > LF_FACESIZE Then iLen = LF_FACESIZE
  219.     
  220.     If iLen > 0& Then CopyMemory mtLogFont.lfFaceName(0), ByVal StrPtr(ls), iLen
  221.     
  222.     If iLen < LF_FACESIZE _
  223.         Then ZeroMemory mtLogFont.lfFaceName(iLen), (LF_FACESIZE - iLen) _
  224.         Else mtLogFont.lfFaceName(LF_FACESIZE - 1&) = ZeroY
  225.     
  226. End Property
  227.  
  228. Private Property Get pFaceName() As String
  229.     pFaceName = StrConv(mtLogFont.lfFaceName, vbUnicode)
  230.     Dim i As Long
  231.     i = InStr(1&, pFaceName, vbNullChar)
  232.     If i Then pFaceName = Left$(pFaceName, i - 1&)
  233. End Property
  234.  
  235. Private Sub pPutStdFont(ByVal oFont As StdFont)
  236.     On Error Resume Next
  237.     pFaceName = oFont.Name
  238.     With mtLogFont
  239.         .lfHeight = -MulDiv(oFont.Size, 1440& / Screen.TwipsPerPixelY, 72&)
  240.         .lfWeight = IIf(oFont.Bold, fntWeightBold, fntWeightNormal)
  241.         .lfItalic = Abs(oFont.Italic)
  242.         .lfUnderline = Abs(oFont.Underline)
  243.         .lfStrikeOut = Abs(oFont.Strikethrough)
  244.         .lfCharSet = oFont.Charset And &HFF
  245.         .lfEscapement = 0&
  246.         .lfOrientation = 0&
  247.         .lfWidth = 0&
  248.         .lfOutPrecision = 0
  249.         .lfClipPrecision = 0
  250.         .lfQuality = 0
  251.         .lfPitchAndFamily = 0
  252.     End With
  253.     On Error GoTo 0
  254. End Sub
  255.  
  256. Private Sub pGetStdFont(ByVal oFont As StdFont)
  257.     On Error Resume Next
  258.     With oFont
  259.         .Name = pFaceName()
  260.         If mtLogFont.lfHeight Then
  261.             .Size = MulDiv(72&, Abs(mtLogFont.lfHeight), (1440& / Screen.TwipsPerPixelY))
  262.         End If
  263.         .Charset = mtLogFont.lfCharSet
  264.         .Italic = CBool(mtLogFont.lfItalic)
  265.         .Underline = CBool(mtLogFont.lfUnderline)
  266.         .Strikethrough = CBool(mtLogFont.lfStrikeOut)
  267.         .Bold = CBool(mtLogFont.lfWeight > fntWeightNormal)
  268.     End With
  269.     On Error GoTo 0
  270. End Sub
  271.  
  272. Private Sub pPutFont(ByVal oFont As cFont)
  273.     oFont.fGetLogFont mtLogFont, miFontSource
  274. End Sub
  275.  
  276. Private Sub pGetFont(ByVal oFont As cFont)
  277.     oFont.fPutLogFont mtLogFont, miFontSource
  278. End Sub
  279.  
  280. Friend Sub fPutLogFont(ByRef tLogFont As LOGFONT, ByVal iFontSource As eFontSource)
  281.     LSet mtLogFont = tLogFont
  282.     miFontSource = iFontSource
  283.     RaiseEvent Changed
  284. End Sub
  285.  
  286. Friend Sub fGetLogFont(ByRef tLogFont As LOGFONT, ByRef iFontSource As eFontSource)
  287.     LSet tLogFont = mtLogFont
  288.     iFontSource = miFontSource
  289. End Sub
  290.  
  291. Friend Sub fPutLogFontLong(ByVal lptr As Long)
  292.     CopyMemory mtLogFont, ByVal lptr, Len(mtLogFont)
  293.     miFontSource = fntSourceCustom
  294.     RaiseEvent Changed
  295. End Sub
  296.  
  297. Friend Sub fGetLogFontLong(ByVal lptr As Long)
  298.     CopyMemory ByVal lptr, mtLogFont, Len(mtLogFont)
  299. End Sub
  300.  
  301.  
  302. Public Property Get Height() As Long
  303.     Height = mtLogFont.lfHeight
  304. End Property
  305. Public Property Let Height(ByVal iNew As Long)
  306.     If CBool(iNew Xor mtLogFont.lfHeight) Then
  307.         mtLogFont.lfHeight = iNew
  308.         miFontSource = fntSourceCustom
  309.         RaiseEvent Changed
  310.     End If
  311. End Property
  312.  
  313. Public Property Get Width() As Long
  314.     Width = mtLogFont.lfWidth
  315. End Property
  316. Public Property Let Width(ByVal iNew As Long)
  317.     If CBool(iNew Xor mtLogFont.lfWidth) Then
  318.         mtLogFont.lfWidth = iNew
  319.         miFontSource = fntSourceCustom
  320.         RaiseEvent Changed
  321.     End If
  322. End Property
  323.  
  324. Public Property Get Escapement() As Long
  325.     Escapement = mtLogFont.lfEscapement
  326. End Property
  327. Public Property Let Escapement(ByVal iNew As Long)
  328.     If CBool(iNew Xor mtLogFont.lfEscapement) Then
  329.         mtLogFont.lfEscapement = iNew
  330.         miFontSource = fntSourceCustom
  331.         RaiseEvent Changed
  332.     End If
  333. End Property
  334.  
  335. Public Property Get Orientation() As Long
  336.     Orientation = mtLogFont.lfOrientation
  337. End Property
  338. Public Property Let Orientation(ByVal iNew As Long)
  339.     If CBool(iNew Xor mtLogFont.lfOrientation) Then
  340.         mtLogFont.lfOrientation = iNew
  341.         miFontSource = fntSourceCustom
  342.         RaiseEvent Changed
  343.     End If
  344. End Property
  345.  
  346. Public Property Get Weight() As eFontWeight
  347.     Weight = mtLogFont.lfWeight
  348. End Property
  349. Public Property Let Weight(ByVal iNew As eFontWeight)
  350.     If CBool(iNew Xor mtLogFont.lfWeight) Then
  351.         mtLogFont.lfWeight = iNew
  352.         miFontSource = fntSourceCustom
  353.         RaiseEvent Changed
  354.     End If
  355. End Property
  356.  
  357. Public Property Get Italic() As Boolean
  358.     Italic = CBool(mtLogFont.lfItalic)
  359. End Property
  360. Public Property Let Italic(ByVal bNew As Boolean)
  361.     If CBool(bNew Xor Italic) Then
  362.         mtLogFont.lfItalic = Abs(bNew)
  363.         miFontSource = fntSourceCustom
  364.         RaiseEvent Changed
  365.     End If
  366. End Property
  367.  
  368. Public Property Get Underline() As Boolean
  369.     Underline = CBool(mtLogFont.lfUnderline)
  370. End Property
  371. Public Property Let Underline(ByVal bNew As Boolean)
  372.     If CBool(bNew Xor Underline) Then
  373.         mtLogFont.lfUnderline = Abs(bNew)
  374.         miFontSource = fntSourceCustom
  375.         RaiseEvent Changed
  376.     End If
  377. End Property
  378.  
  379. Public Property Get Strikeout() As Boolean
  380.     Strikeout = mtLogFont.lfStrikeOut
  381. End Property
  382. Public Property Let Strikeout(ByVal bNew As Boolean)
  383.     If CBool(bNew Xor Me.Strikeout) Then
  384.         mtLogFont.lfStrikeOut = Abs(bNew)
  385.         miFontSource = fntSourceCustom
  386.         RaiseEvent Changed
  387.     End If
  388. End Property
  389.  
  390. Public Property Get Charset() As eFontCharset
  391.     Charset = mtLogFont.lfCharSet
  392. End Property
  393. Public Property Let Charset(ByVal iNew As eFontCharset)
  394.     If CBool(iNew Xor CLng(mtLogFont.lfCharSet)) Then
  395.         mtLogFont.lfCharSet = iNew And &HFF
  396.         miFontSource = fntSourceCustom
  397.         RaiseEvent Changed
  398.     End If
  399. End Property
  400.  
  401. Public Property Get OutPrecision() As eFontOutputPrecision
  402.     OutPrecision = mtLogFont.lfOutPrecision
  403. End Property
  404. Public Property Let OutPrecision(ByVal iNew As eFontOutputPrecision)
  405.     If CBool(iNew Xor CLng(mtLogFont.lfOutPrecision)) Then
  406.         mtLogFont.lfOutPrecision = iNew And &HFF
  407.         miFontSource = fntSourceCustom
  408.         RaiseEvent Changed
  409.     End If
  410. End Property
  411.  
  412. Public Property Get ClipPrecision() As eFontClipPrecision
  413.     ClipPrecision = mtLogFont.lfClipPrecision
  414. End Property
  415. Public Property Let ClipPrecision(ByVal iNew As eFontClipPrecision)
  416.     If CBool(iNew Xor CLng(mtLogFont.lfClipPrecision)) Then
  417.         mtLogFont.lfClipPrecision = iNew And &HFF
  418.         miFontSource = fntSourceCustom
  419.         RaiseEvent Changed
  420.     End If
  421. End Property
  422.  
  423. Public Property Get Quality() As eFontQuality
  424.     Quality = mtLogFont.lfQuality
  425. End Property
  426. Public Property Let Quality(ByVal iNew As eFontQuality)
  427.     If CBool(iNew Xor CLng(mtLogFont.lfQuality)) Then
  428.         mtLogFont.lfQuality = iNew And &HFF
  429.         miFontSource = fntSourceCustom
  430.         RaiseEvent Changed
  431.     End If
  432. End Property
  433.  
  434. Public Property Get PitchAndFamily() As eFontPitchAndFamily
  435.     PitchAndFamily = mtLogFont.lfPitchAndFamily
  436. End Property
  437. Public Property Let PitchAndFamily(ByVal iNew As eFontPitchAndFamily)
  438.     If CBool(iNew Xor CLng(mtLogFont.lfPitchAndFamily)) Then
  439.         mtLogFont.lfPitchAndFamily = iNew And &HFF
  440.         miFontSource = fntSourceCustom
  441.         RaiseEvent Changed
  442.     End If
  443. End Property
  444.  
  445. Public Property Get FaceName() As String
  446.     FaceName = pFaceName()
  447. End Property
  448.  
  449. Public Property Let FaceName(ByRef sNew As String)
  450.     pFaceName = sNew
  451.     miFontSource = fntSourceCustom
  452.     RaiseEvent Changed
  453. End Property
  454.  
  455. Public Property Get Source() As eFontSource
  456.     Source = miFontSource
  457. End Property
  458.  
  459. Public Property Let Source(ByVal iNew As eFontSource)
  460.     If iNew >= fntSourceCustom And iNew <= fntSourceSysSmallCaption Then
  461.         If iNew > fntSourceAmbient Then
  462.             mSysParamInfo.GetSystemFont iNew, mtLogFont
  463.             miFontSource = iNew
  464.             RaiseEvent Changed
  465.         Else
  466.             If iNew Xor miFontSource Then
  467.                 miFontSource = iNew
  468.                 RaiseEvent Changed
  469.             End If
  470.         End If
  471.     Else
  472.         miFontSource = fntSourceCustom
  473.     End If
  474. End Property
  475.  
  476. Public Sub OnAmbientFontChanged(ByVal oFont As StdFont)
  477.     If miFontSource = fntSourceAmbient Then
  478.         If Not oFont Is Nothing Then
  479.             pPutStdFont oFont
  480.             miFontSource = fntSourceAmbient
  481.             RaiseEvent Changed
  482.         End If
  483.     End If
  484. End Sub
  485.  
  486. Public Sub OnSettingChange(Optional ByVal wParam As Long = SPI_SETNONCLIENTMETRICS)
  487.     If wParam = SPI_SETNONCLIENTMETRICS Then
  488.         If miFontSource >= fntSourceSysMenu And miFontSource <= fntSourceSysSmallCaption Then
  489.             mSysParamInfo.GetSystemFont miFontSource, mtLogFont
  490.             RaiseEvent Changed
  491.         End If
  492.     End If
  493. End Sub
  494.  
  495. Public Function GetHandle() As Long
  496.     GetHandle = CreateFontIndirect(mtLogFont)
  497. End Function
  498. Public Function ReleaseHandle(ByVal hFont As Long) As Boolean
  499.     ReleaseHandle = DeleteObject(hFont) <> 0&
  500. End Function
  501.  
  502. Public Sub GetFontInfo(ByVal oObject As Object)
  503.     If Not oObject Is Nothing Then
  504.         If TypeOf oObject Is StdFont Then
  505.             pGetStdFont oObject
  506.         ElseIf TypeOf oObject Is cFont Then
  507.             pGetFont oObject
  508.         End If
  509.     End If
  510. End Sub
  511.  
  512. Public Sub PutFontInfo(ByVal oFont As Object)
  513.     If Not oFont Is Nothing Then
  514.         If TypeOf oFont Is StdFont Then
  515.             pPutStdFont oFont
  516.         ElseIf TypeOf oFont Is cFont Then
  517.             pPutFont oFont
  518.         End If
  519.     End If
  520.     miFontSource = fntSourceCustom
  521.     RaiseEvent Changed
  522. End Sub
  523.  
  524. Public Function Browse( _
  525.                 Optional ByVal iFlags As eFontDialog = dlgFontScreenFonts, _
  526.                 Optional ByVal hdc As Long, _
  527.                 Optional ByVal hWndOwner As Long, _
  528.                 Optional ByVal iMinSize As Long = 6, _
  529.                 Optional ByVal iMaxSize As Long = 72) _
  530.                     As Boolean
  531.     
  532.     'init to log font and limit size
  533.     Const FontFlags = &H2000& Or &H40&
  534.     
  535.     Dim ltLogFont As LOGFONT
  536.    
  537.     LSet ltLogFont = mtLogFont
  538.    
  539.     Dim ltChooseFont As TCHOOSEFONT
  540.     With ltChooseFont
  541.         .lStructSize = LenB(ltChooseFont)
  542.         .Flags = iFlags Or FontFlags
  543.         .hdc = hdc
  544.         .hInstance = ZeroL
  545.         .hWndOwner = hWndOwner
  546.         .lpLogFont = VarPtr(ltLogFont)
  547.         .nSizeMax = iMaxSize
  548.         .nSizeMin = iMinSize
  549.     End With
  550.     
  551.     If ChooseFont(ltChooseFont) = OneL Then
  552.         Browse = True
  553.         LSet mtLogFont = ltLogFont
  554.         miFontSource = fntSourceCustom
  555.         RaiseEvent Changed
  556.     End If
  557.     
  558. End Function
  559.  
  560. Friend Function fComp(ByRef tLF As LOGFONT) As Boolean
  561.     fComp = CBool(MemCmp(VarPtr(tLF), VarPtr(mtLogFont), LenB(mtLogFont)))
  562. End Function
  563.  
  564. Public Function Comp(ByVal oFont As cFont) As Boolean
  565.     Comp = oFont.fComp(mtLogFont)
  566. End Function
  567.  
  568. Private Sub Class_InitProperties()
  569.     miFontSource = DEF_Source
  570.     pFaceName = DEF_FaceName
  571.     With mtLogFont
  572.         .lfCharSet = DEF_Charset
  573.         .lfClipPrecision = DEF_ClipPrecision
  574.         .lfEscapement = DEF_Escapement
  575.         .lfHeight = DEF_Height
  576.         .lfItalic = DEF_Italic
  577.         .lfOrientation = DEF_Orientation
  578.         .lfOutPrecision = DEF_OutPrecision
  579.         .lfPitchAndFamily = DEF_PitchAndFamily
  580.         .lfQuality = DEF_Quality
  581.         .lfStrikeOut = DEF_Strikeout
  582.         .lfUnderline = DEF_Underline
  583.         .lfWeight = DEF_Weight
  584.         .lfWidth = DEF_Width
  585.     End With
  586. End Sub
  587.  
  588. Private Sub Class_ReadProperties(PropBag As PropertyBag)
  589.     miFontSource = PropBag.ReadProperty(PROP_Source, DEF_Source)
  590.     If miFontSource >= fntSourceSysMenu And miFontSource <= fntSourceSysSmallCaption Then
  591.         mSysParamInfo.GetSystemFont miFontSource, mtLogFont
  592.     ElseIf miFontSource <> fntSourceAmbient Then
  593.         miFontSource = fntSourceCustom
  594.         pFaceName = PropBag.ReadProperty(PROP_FaceName, DEF_FaceName)
  595.         With mtLogFont
  596.             .lfHeight = PropBag.ReadProperty(PROP_Height, DEF_Height)
  597.             .lfWidth = PropBag.ReadProperty(PROP_Width, DEF_Width)
  598.             .lfEscapement = PropBag.ReadProperty(PROP_Escapement, DEF_Escapement)
  599.             .lfOrientation = PropBag.ReadProperty(PROP_Orientation, DEF_Orientation)
  600.             .lfWeight = PropBag.ReadProperty(PROP_Weight, DEF_Weight)
  601.             .lfItalic = PropBag.ReadProperty(PROP_Italic, DEF_Italic)
  602.             .lfUnderline = PropBag.ReadProperty(PROP_Underline, DEF_Underline)
  603.             .lfStrikeOut = PropBag.ReadProperty(PROP_Strikeout, DEF_Strikeout)
  604.             .lfCharSet = PropBag.ReadProperty(PROP_Charset, DEF_Charset)
  605.             .lfOutPrecision = PropBag.ReadProperty(PROP_OutPrecision, DEF_OutPrecision)
  606.             .lfClipPrecision = PropBag.ReadProperty(PROP_ClipPrecision, DEF_ClipPrecision)
  607.             .lfQuality = PropBag.ReadProperty(PROP_Quality, DEF_Quality)
  608.             .lfPitchAndFamily = PropBag.ReadProperty(PROP_PitchAndFamily, DEF_PitchAndFamily)
  609.         End With
  610.     End If
  611. End Sub
  612.  
  613. Private Sub Class_WriteProperties(PropBag As PropertyBag)
  614.     PropBag.WriteProperty PROP_Source, miFontSource, DEF_Source
  615.     If miFontSource = fntSourceCustom Then
  616.         PropBag.WriteProperty PROP_FaceName, pFaceName, DEF_FaceName
  617.         With mtLogFont
  618.             PropBag.WriteProperty PROP_Height, .lfHeight, DEF_Height
  619.             PropBag.WriteProperty PROP_Width, .lfWidth, DEF_Width
  620.             PropBag.WriteProperty PROP_Escapement, .lfEscapement, DEF_Escapement
  621.             PropBag.WriteProperty PROP_Orientation, .lfOrientation, DEF_Orientation
  622.             PropBag.WriteProperty PROP_Weight, .lfWeight, DEF_Weight
  623.             PropBag.WriteProperty PROP_Italic, .lfItalic, DEF_Italic
  624.             PropBag.WriteProperty PROP_Underline, .lfUnderline, DEF_Underline
  625.             PropBag.WriteProperty PROP_Strikeout, .lfStrikeOut, DEF_Strikeout
  626.             PropBag.WriteProperty PROP_Charset, .lfCharSet, DEF_Charset
  627.             PropBag.WriteProperty PROP_OutPrecision, .lfOutPrecision, DEF_OutPrecision
  628.             PropBag.WriteProperty PROP_ClipPrecision, .lfClipPrecision, DEF_ClipPrecision
  629.             PropBag.WriteProperty PROP_Quality, .lfQuality, DEF_Quality
  630.             PropBag.WriteProperty PROP_PitchAndFamily, .lfPitchAndFamily, DEF_PitchAndFamily
  631.         End With
  632.     End If
  633. End Sub
  634.