clsrender.cls

一款Grid表格控件源代码,非常棒.不下你一定会后悔

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsRender"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit


Private Const VER_PLATFORM_WIN32s               As Long = 0
Private Const VER_PLATFORM_WIN32_WINDOWS        As Long = 1
Private Const VER_PLATFORM_WIN32_NT             As Long = 2
Private Const ICC_USEREX_CLASSES                As Long = &H200
Private Const AC_SRC_OVER                       As Long = &H0
Private Const AC_SRC_ALPHA                      As Long = &H1

Private Const AC_SRC_NO_PREMULT_ALPHA           As Long = &H1
Private Const AC_SRC_NO_ALPHA                   As Long = &H2
Private Const C_DST_NO_PREMULT_ALPHA            As Long = &H10
Private Const AC_DST_NO_ALPHA                   As Long = &H20

'/* StretchBlt Modes
Private Const BLACKONWHITE                      As Long = 1
Private Const WHITEONBLACK                      As Long = 2
Private Const COLORONCOLOR                      As Long = 3
Private Const HALFTONE                          As Long = 4
Private Const MAXSTRETCHBLTMODE                 As Long = 4

'/* New StretchBlt Modes
Private Const STRETCH_ANDSCANS                  As Long = BLACKONWHITE
Private Const STRETCH_ORSCANS                   As Long = WHITEONBLACK
Private Const STRETCH_DELETESCANS               As Long = COLORONCOLOR
Private Const STRETCH_HALFTONE                  As Long = HALFTONE

Private Type SAFEARRAYBOUND
    cElements                                   As Long
    lLbound                                     As Long
End Type

Private Type SAFEARRAY1D
    cDims                                       As Integer
    fFeatures                                   As Integer
    cbElements                                  As Long
    cLocks                                      As Long
    pvData                                      As Long
    Bounds                                      As SAFEARRAYBOUND
End Type

Private Type SAFEARRAY2D
    cDims                                       As Integer
    fFeatures                                   As Integer
    cbElements                                  As Long
    cLocks                                      As Long
    pvData                                      As Long
    Bounds(0 To 1)                              As SAFEARRAYBOUND
End Type

Private Type VERSIONINFO
    dwOSVersionInfoSize                         As Long
    dwMajorVersion                              As Long
    dwMinorVersion                              As Long
    dwBuildNumber                               As Long
    dwPlatformId                                As Long
    szCSDVersion                                As String * 128
End Type

Private Type TRIVERTEX
    x                                           As Long
    y                                           As Long
    Red                                         As Integer
    Green                                       As Integer
    Blue                                        As Integer
    alpha                                       As Integer
End Type

Private Type BLENDFUNCTION
    BlendOp                                     As Byte
    BlendFlags                                  As Byte
    SourceConstantAlpha                         As Byte
    AlphaFormat                                 As Byte
End Type

Private Type BITMAP
    bmType                                      As Long
    bmWidth                                     As Long
    bmHeight                                    As Long
    bmWidthBytes                                As Long
    bmPlanes                                    As Integer
    bmBitsPixel                                 As Integer
    bmBits                                      As Long
End Type

Private Type BITMAPINFOHEADER
    biSize                                      As Long
    biWidth                                     As Long
    biHeight                                    As Long
    biPlanes                                    As Integer
    biBitCount                                  As Integer
    biCompression                               As Long
    biSizeImage                                 As Long
    biXPelsPerMeter                             As Long
    biYPelsPerMeter                             As Long
    biClrUsed                                   As Long
    biClrImportant                              As Long
End Type

Private Type RECT
    lLeft                                       As Long
    lTop                                        As Long
    lRight                                      As Long
    lBottom                                     As Long
End Type

Public Enum RAST_FLAGS
    SRCCOPY = &HCC0020
    SRCPAINT = &HEE0086
    SRCAND = &H8800C6
    SRCINVERT = &H660046
    SRCERASE = &H440328
    NOTSRCCOPY = &H330008
    NOTSRCERASE = &H1100A6
    MERGECOPY = &HC000CA
    MERGEPAINT = &HBB0226
    PATCOPYX = &HF00021
    PATPAINT = &HFB0A09
    PATINVERT = &H5A0049
    DSTINVERT = &H550009
    BLACKNESS = &H42
    WHITENESS = &HFF0062
End Enum

Private Type GRADIENT_RECT
    UpperLeft As Long
    LowerRight As Long
End Type

Public Enum GRADIENT_DIRECTION
    [Fill_None] = -1
    [Fill_Horizontal] = 0
    [Fill_Vertical] = 1
End Enum

Private Declare Function AlphaBlend Lib "Msimg32.dll" (ByVal DstHdc As Long, _
                                                       ByVal DstX As Long, _
                                                       ByVal DstY As Long, _
                                                       ByVal DstWidth As Long, _
                                                       ByVal DstHeight As Long, _
                                                       ByVal SrcHdc As Long, _
                                                       ByVal SrcX As Long, _
                                                       ByVal SrcY As Long, _
                                                       ByVal SrcWidth As Long, _
                                                       ByVal ScrHeight As Long, _
                                                       ByVal lpBlend As Long) As Long

Private Declare Function BitBlt Lib "gdi32" (ByVal DstHdc As Long, _
                                             ByVal DstX As Long, _
                                             ByVal DstY As Long, _
                                             ByVal DstWidth As Long, _
                                             ByVal DstHeight As Long, _
                                             ByVal SrcHdc As Long, _
                                             ByVal SrcX As Long, _
                                             ByVal SrcY As Long, _
                                             ByVal dwRop As RAST_FLAGS) As Long

Private Declare Function StretchBlt Lib "gdi32.dll" (ByVal DstHdc As Long, _
                                                     ByVal DstX As Long, _
                                                     ByVal DstY As Long, _
                                                     ByVal DstWidth As Long, _
                                                     ByVal DstHeight As Long, _
                                                     ByVal SrcHdc As Long, _
                                                     ByVal SrcX As Long, _
                                                     ByVal SrcY As Long, _
                                                     ByVal nSrcWidth As Long, _
                                                     ByVal nSrcHeight As Long, _
                                                     ByVal dwRop As RAST_FLAGS) As Long

Private Declare Function SetStretchBltMode Lib "gdi32" (ByVal hdc As Long, ByVal hStretchMode As Long) As Long

Private Declare Function TransparentBlt Lib "Msimg32.dll" (ByVal DstHdc As Long, _
                                                           ByVal DstX As Long, _
                                                           ByVal DstY As Long, _
                                                           ByVal DstWidth As Long, _
                                                           ByVal DstHeight As Long, _
                                                           ByVal SrcHdc As Long, _
                                                           ByVal SrcX As Long, _
                                                           ByVal SrcY As Long, _
                                                           ByVal SrcWidth As Long, _
                                                           ByVal ScrHeight As Long, _
                                                           ByVal crTransparent As Long) As Boolean

Private Declare Function GradientFill Lib "Msimg32.dll" (ByVal hdc As Long, _
                                                         pVertex As TRIVERTEX, _
                                                         ByVal dwNumVertex As Long, _
                                                         pMesh As GRADIENT_RECT, _
                                                         ByVal dwNumMesh As Long, _
                                                         ByVal dwMode As Long) As Long


Private Declare Function StretchDIBits Lib "gdi32" (ByVal DstHdc As Long, _
                                                    ByVal DstX As Long, _
                                                    ByVal DstY As Long, _
                                                    ByVal dX As Long, _
                                                    ByVal dy As Long, _
                                                    ByVal SrcX As Long, _
                                                    ByVal SrcY As Long, _
                                                    ByVal wSrcWidth As Long, _
                                                    ByVal wSrcHeight As Long, _
                                                    lpBits As Any, _
                                                    lpBitsInfo As BITMAPINFOHEADER, _
                                                    ByVal wUsage As Long, _
                                                    ByVal dwRop As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, _
                                                                     pSrc As Any, _
                                                                     ByVal ByteLen As Long)

Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, _
                                                     lpRect As RECT) As Long

Private Declare Function OffsetRect Lib "user32" (lpRect As RECT, _
                                                  ByVal x As Long, _
                                                  ByVal y As Long) As Long

Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, _
                                                 ByVal hdc As Long) As Long

Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, _
                                                                      ByVal nCount As Long, _
                                                                      lpObject As Any) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, _
                                                   ByVal hObject As Long) As Long

Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Declare Function OleTranslateColor Lib "olepro32" (ByVal OLE_COLOR As Long, _
                                                           ByVal HPALETTE As Long, _
                                                           ColorRef As Long) As Long

Private Declare Function SetBrushOrgEx Lib "gdi32" (ByVal hdc As Long, _
                                                    ByVal nXOrg As Long, _
                                                    ByVal nYOrg As Long, _
                                                    lppt As Any) As Long

Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersion As VERSIONINFO) As Long

Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, _
                                                 ByVal crColor As Long) As Long

Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long

Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, _
                                                lpRect As RECT, _
                                                ByVal hBrush As Long) As Long

Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long

Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, _
                                                             ByVal nWidth As Long, _
                                                             ByVal nHeight As Long) As Long



Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function GetDesktopWindow Lib "user32" () As Long

Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, _
                                               ByVal x As Long, _
                                               ByVal y As Long) As Long

Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Ptr() As Any) As Long


Private m_bWin32                                As Boolean
Private m_lXOriginOffset                        As Long
Private m_lYOriginOffset                        As Long
Private m_lMaskColor                            As Long


Private Sub Class_Initialize()

    '/* os check & default mask
    m_bWin32 = Compatability_Check
    m_lMaskColor = &HFF00FF

End Sub

Public Property Get Mask() As Long
    Mask = m_lMaskColor
End Property

Public Property Let Mask(PropVal As Long)
    m_lMaskColor = PropVal
End Property

Public Sub AlphaBlit(ByVal lDstDc As Long, _
                     ByVal lDstX As Long, _
                     ByVal lDstY As Long, _
                     ByVal lDstWidth As Long, _
                     ByVal lDstHeight As Long, _
                     ByVal lSrcDc As Long, _
                     ByVal lSrcX As Long, _
                     ByVal lSrcY As Long, _
                     ByVal lSrcWidth As Long, _
                     ByVal lSrcHeight As Long, _
                     ByVal lTrsIdx As Byte)

 
 Dim tBlend     As BLENDFUNCTION
 Dim lBfPtr     As Long

    If (lTrsIdx = 0) Or (lTrsIdx > 255) Then
        lTrsIdx = 200
    End If
    With tBlend
        .BlendOp = AC_SRC_OVER
        .BlendFlags = 0
        .SourceConstantAlpha = lTrsIdx
        .AlphaFormat = 0
    End With
    
    CopyMemory lBfPtr, tBlend, 4
    AlphaBlend lDstDc, lDstX, lDstY, lDstWidth, lDstHeight, lSrcDc, lSrcX, lSrcY, lSrcWidth, lSrcHeight, lBfPtr
    
End Sub

Public Sub AlphaPixel(ByVal lDstDc As Long, _
                      ByVal lDstX As Long, _
                      ByVal lDstY As Long, _
                      ByVal lDstWidth As Long, _
                      ByVal lDstHeight As Long, _
                      ByVal lSrcDc As Long, _
                      ByVal lSrcX As Long, _
                      ByVal lSrcY As Long, _
                      ByVal lSrcWidth As Long, _
                      ByVal lSrcHeight As Long, _
                      ByVal lTrsIdx As Long)

 Dim tBlend     As BLENDFUNCTION
 Dim lBfPtr     As Long

    If (lTrsIdx = 0) Or (lTrsIdx > 255) Then
        lTrsIdx = 200
    End If
    With tBlend
        .BlendOp = AC_SRC_OVER
        .BlendFlags = 0
        .SourceConstantAlpha = lTrsIdx
        .AlphaFormat = AC_SRC_ALPHA
    End With
    
    CopyMemory lBfPtr, tBlend, 4
    AlphaBlend lDstDc, lDstX, lDstY, lDstWidth, lDstHeight, lSrcDc, lSrcX, lSrcY, lSrcWidth, lSrcHeight, lBfPtr

End Sub

Public Sub Blit(ByVal lDstDc As Long, _
                ByVal lDstX As Long, _
                ByVal lDstY As Long, _
                ByVal lDstWidth As Long, _
                ByVal lDstHeight As Long, _
                ByVal lSrcDc As Long, _
                ByVal lSrcX As Long, _