apifont.cls

1500个WINDOWS API类全集,包括了主要的API调用接口

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ApiLogFont"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

'\\ --[ApiFont]--------------------------------------------------
'\\ Encapsulates the API structures and methods used to deal with
'\\ logical fonts (LOGFONT) in the Windows API
'\\ -------------------------------------------------------------
Private Const LF_FACESIZE = 32

Private Type LOGFONT
    lfHeight As Long
    lfWidth As Long
    lfEscapement As Long
    lfOrientation As Long
    lfWeight As Long
    lfItalic As Byte
    lfUnderline As Byte
    lfStrikeOut As Byte
    lfCharSet As Byte
    lfOutPrecision As Byte
    lfClipPrecision As Byte
    lfQuality As Byte
    lfPitchAndFamily As Byte
    lfFaceName(LF_FACESIZE) As Byte
End Type

Private Declare Function CreateFontIndirect Lib "gdi32" Alias _
            "CreateFontIndirectA" (lpLOGFONT As LOGFONT) As Long
            
Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" _
            (ByVal Height As Long, ByVal Width As Long, _
            ByVal Escapement As Long, ByVal Orientation As Long, _
            ByVal Weight As Long, ByVal Italic As Long, _
            ByVal Underline As Long, ByVal StrikeOut As Long, _
            ByVal CharSet As Long, ByVal OutPrecision As Long, _
            ByVal ClipPrecision As Long, ByVal Quality As Long, _
            ByVal PitchAndFamily As Long, ByVal Facename As String) As Long


Public Enum FontOutputPrecisions
    OUT_DEFAULT_PRECIS = 0
    OUT_STRING_PRECIS = 1
    OUT_CHARACTER_PRECIS = 2
    OUT_STROKE_PRECIS = 3
    OUT_TT_PRECIS = 4
    OUT_DEVICE_PRECIS = 5
    OUT_RASTER_PRECIS = 6
    OUT_TT_ONLY_PRECIS = 7
    OUT_OUTLINE_PRECIS = 8
    OUT_SCREEN_OUTLINE_PRECIS = 9
    OUT_PS_ONLY_PRECIS = 10
End Enum

Public Enum FontClipPrecisions
    CLIP_DEFAULT_PRECIS = 0
    CLIP_CHARACTER_PRECIS = 1
    CLIP_STROKE_PRECIS = 2
End Enum

Public Enum FontQualitySettings
    DEFAULT_QUALITY = 0
    DRAFT_QUALITY = 1
    PROOF_QUALITY = 2
    NONANTIALIASED_QUALITY = 3
    ANTIALIASED_QUALITY = 4
End Enum

Public Enum FontFamilies
    FF_DONTCARE = 0    '  Don't care or don't know.
    FF_ROMAN = 16      '  Variable stroke width, serifed.
    FF_SWISS = 32      '  Variable stroke width, sans-serifed.
    FF_MODERN = 48     '  Constant stroke width, serifed or sans-serifed.
    FF_SCRIPT = 64     '  Cursive, etc.
    FF_DECORATIVE = 80 '  Old English, etc.
End Enum

Public Enum FontPitchSettings
    DEFAULT_PITCH = 0
    FIXED_PITCH = 1
    VARIABLE_PITCH = 2
    MONO_FONT = 8
End Enum

Public Enum FontWeights
     FW_DONTCARE = 0
     FW_THIN = 100
     FW_EXTRALIGHT = 200
     FW_LIGHT = 300
     FW_NORMAL = 400
     FW_MEDIUM = 500
     FW_SEMIBOLD = 600
     FW_BOLD = 700
     FW_EXTRABOLD = 800
     FW_HEAVY = 900
End Enum

Public Enum FontCharsets
    ANSI_CHARSET = 0
    DEFAULT_CHARSET = 1
    SYMBOL_CHARSET = 2
    SHIFTJIS_CHARSET = 128
    HANGEUL_CHARSET = 129
    HANGUL_CHARSET = 129
    GB2312_CHARSET = 134
    CHINESEBIG5_CHARSET = 136
    OEM_CHARSET = 255
    JOHAB_CHARSET = 130
    HEBREW_CHARSET = 177
    ARABIC_CHARSET = 178
    GREEK_CHARSET = 161
    TURKISH_CHARSET = 162
    VIETNAMESE_CHARSET = 163
    THAI_CHARSET = 222
    EASTEUROPE_CHARSET = 238
    RUSSIAN_CHARSET = 204
    MAC_CHARSET = 77
    BALTIC_CHARSET = 186
End Enum


'\\ -- Private member variables....
Private mLogFont As LOGFONT
Private mHFONT As Long

'\\ Private memory handling functions
Private Declare Sub CopyMemoryLOGFONT Lib "kernel32" Alias "RtlMoveMemory" (Destination As LOGFONT, ByVal Source As Long, ByVal Length As Long)
Private Declare Function IsBadReadPtrLOGFONT Lib "kernel32" Alias "IsBadReadPtr" (ByVal lp As Long, ByVal ucb As Long) As Long
Private Declare Function IsBadWritePtrLOGFONT Lib "kernel32" Alias "IsBadWritePtr" (ByVal lp As Long, ByVal ucb As Long) As Long

Public CreatedOK As Boolean
'\\ --[CreateFromPointer]---------------------------------------------
'\\ Fills this LOGFONT object from the location pointed to by
'\\ lpLOGFONT
'\\ VB.NET Porting note: This function should be replaced with an override
'\\ of the New() for correctness
'\\ ----------------------------------------------------------------------------------------
'\\ (c) 2001 - Merrion Computing.  All rights  to use, reproduce or publish this code reserved
'\\ Please check http://www.merrioncomputing.com for updates.
'\\ ----------------------------------------------------------------------------------------
Public Function CreateFromPointer(lpLOGFONT As Long) As Boolean

Dim ftThis As LOGFONT
Dim nIndex As Long

CreatedOK = False

If Not IsBadReadPtrLOGFONT(lpLOGFONT, Len(ftThis)) Then
    Call CopyMemoryLOGFONT(ftThis, lpLOGFONT, Len(ftThis))
    If Err.LastDllError = 0 Then
        With ftThis
            mLogFont.lfCharSet = .lfCharSet
            mLogFont.lfCharSet = .lfClipPrecision
            mLogFont.lfEscapement = .lfEscapement
            For nIndex = 0 To LF_FACESIZE
                mLogFont.lfFaceName(nIndex) = .lfFaceName(nIndex)
            Next nIndex
            mLogFont.lfHeight = .lfHeight
            mLogFont.lfItalic = .lfItalic
            mLogFont.lfOrientation = .lfOrientation
            mLogFont.lfOutPrecision = .lfOutPrecision
            mLogFont.lfPitchAndFamily = .lfPitchAndFamily
            mLogFont.lfQuality = .lfQuality
            mLogFont.lfStrikeOut = .lfStrikeOut
            mLogFont.lfUnderline = .lfUnderline
            mLogFont.lfWeight = .lfWeight
            mLogFont.lfWidth = .lfWidth
        End With
    End If
End If

CreateFromPointer = CreatedOK

End Function