txeapis.bas

四方图 用于股市走势分析

Attribute VB_Name = "TxeAPIs"
    Option Explicit
    
    Public Type Size
    cx As Long
    cy As Long
    End Type

    Public Type RECT
        Left    As Long
        Top     As Long
        Right   As Long
        Bottom  As Long
    End Type
    
    Public Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hDC As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As Size) As Long
    
    Public Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
    Public 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(1 To 32) As Byte
    End Type
    Public Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
    Public Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
    Public Const FW_NORMAL = 400
    Public Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    
    '指定阴影刷子、虚线画笔以及字符中的空隙的填充方式
    Public Declare Function SetBkMode Lib "gdi32" (ByVal hDC As Long, ByVal nBkMode As Long) As Long
    Public Const TRANSPARENT = 1
    Public Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal H As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, ByVal W As Long, ByVal I As Long, ByVal u As Long, ByVal S As Long, ByVal C As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal F As String) As Long
    Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    Public Const FW_DONTCARE = 0
    Public Const FW_THIN = 100
    Public Const FW_EXTRALIGHT = 200
    Public Const FW_ULTRALIGHT = 200
    Public Const FW_LIGHT = 300
    Public Const FW_REGULAR = 400
    Public Const FW_MEDIUM = 500
    Public Const FW_SEMIBOLD = 600
    Public Const FW_DEMIBOLD = 600
    Public Const FW_BOLD = 700
    Public Const FW_EXTRABOLD = 800
    Public Const FW_ULTRABOLD = 800
    Public Const FW_HEAVY = 900
    Public Const FW_BLACK = 900
    Public Const ANSI_CHARSET = 0
    Public Const ARABIC_CHARSET = 178
    Public Const BALTIC_CHARSET = 186
    Public Const CHINESEBIG5_CHARSET = 136
    Public Const DEFAULT_CHARSET = 1
    Public Const EASTEUROPE_CHARSET = 238
    Public Const GB2312_CHARSET = 134
    Public Const GREEK_CHARSET = 161
    Public Const HANGEUL_CHARSET = 129
    Public Const HEBREW_CHARSET = 177
    Public Const MAC_CHARSET = 77
    Public Const OEM_CHARSET = 255
    Public Const SHIFTJIS_CHARSET = 128
    Public Const SYMBOL_CHARSET = 2
    Public Const TURKISH_CHARSET = 162
    Public Const OUT_DEVICE_PRECIS = 5
    Public Const OUT_RASTER_PRECIS = 6
    Public Const OUT_STRING_PRECIS = 1
    Public Const OUT_STROKE_PRECIS = 3
    Public Const OUT_TT_ONLY_PRECIS = 7
    Public Const OUT_TT_PRECIS = 4
    Public Const CLIP_DEFAULT_PRECIS = 0
    Public Const CLIP_EMBEDDED = 128
    Public Const CLIP_LH_ANGLES = 16
    Public Const CLIP_STROKE_PRECIS = 2
    Public Const DEFAULT_QUALITY = 0
    Public Const DRAFT_QUALITY = 1
    Public Const PROOF_QUALITY = 2
    Public Const DEFAULT_PITCH = 0
    Public Const FIXED_PITCH = 1
    Public Const VARIABLE_PITCH = 2
    Public Const FF_DECORATIVE = 80
    Public Const FF_DONTCARE = 0
    Public Const FF_MODERN = 48
    Public Const FF_ROMAN = 16
    Public Const FF_SCRIPT = 64
    Public Const FF_SWISS = 32
    
    ' Enumerated raster operation constants
    Public Enum RasterOps
        ' Copies the source bitmap to destination bitmap
        SRCCOPY = &HCC0020
        ' Combines pixels of the destination with source bitmap using the Boolean AND operator.
        SRCAND = &H8800C6
        ' Combines pixels of the destination with source bitmap using the Boolean XOR operator.
        SRCINVERT = &H660046
        nXor = &H660046
        ' Combines pixels of the destination with source bitmap using the Boolean OR operator.
        SRCPAINT = &HEE0086
        nOR = &HEE0086
        ' Inverts the destination bitmap and then combines the results with the source bitmap
        ' using the Boolean AND operator.
        SRCERASE = &H4400328
        ' Turns all output white.
        WHITENESS = &HFF0062
        ' Turn output black.
        BLACKNESS = &H42
        
        NOTSRCCOPY = &H330008      ' (DWORD) dest = (NOT source)
        NOTSRCERASE = &H1100A6     ' (DWORD) dest = (NOT src) AND (NOT dest)
        MERGECOPY = &HC000CA       ' (DWORD) dest = (source AND pattern)
        MERGEPAINT = &HBB0226      ' (DWORD) dest = (NOT source) OR dest
        DSTINVERT = &H550009       ' (DWORD) dest = (NOT dest)
        
        PATCOPY = &HF00021 ' (DWORD) dest = pattern
        PATPAINT = &HFB0A09        ' (DWORD) dest = DPSnoo
        PATINVERT = &H5A0049       ' (DWORD) dest = pattern XOR dest
        R_WHITE = 16
    End Enum
 
    '字体倾斜
    Public Enum ANT_QUALITY
        ANTIALIASED_QUALITY = 4
        NONANTIALIASED_QUALITY = 3
    End Enum
    
Public Declare Function PatBlt Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As RasterOps) As Long
Public Declare Function StretchBlt Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long

'创建字体
Public Function CreateFont_(ByVal FontName As String, lfWeight As Boolean, lfUnderline As Boolean, lfStrikeOut As Boolean, lfItalic As Boolean, _
                lfHeight&, lfAliasing As ANT_QUALITY, lfAngle As Long, _
                Optional lfWidth As Long = 0, Optional Rotation As Boolean = False) As Long
    '参数说明
    '字体名/粗体/下划线/中划线/斜体
    '高度/反锯齿/旋转角度
    '宽度/旋转
    On Error Resume Next
    Dim plf As LOGFONT, I As Long
    
    FontName = FontName + String(32 - Len(FontName), 0)
    For I = 1 To 32
        plf.lfFaceName(I) = Asc(Mid$(FontName, I, 1))
    Next
    
    '取高度Height
    plf.lfHeight = lfHeight
    '取宽度Width
    plf.lfWidth = lfWidth
    
    '粗体/下划线/中划线/斜体
    If lfWeight Then plf.lfWeight = 700
    If lfUnderline Then plf.lfUnderline = 1
    If lfStrikeOut Then plf.lfStrikeOut = 1
    If lfItalic Then plf.lfItalic = 1
    
    '是否反锯齿效果
    plf.lfQuality = lfAliasing
    
    '取得旋转角度
    If Rotation Then plf.lfEscapement = lfAngle * 10
    
    CreateFont_ = CreateFontIndirect(plf)
End Function