?? apifont.cls
字號(hào):
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
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -